{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}

module Hydra.Tx.CollectCom where

import Data.Map qualified as Map
import Hydra.Cardano.Api
import Hydra.Prelude

import Data.ByteString qualified as BS
import Hydra.Contract.Commit qualified as Commit
import Hydra.Contract.Head qualified as Head
import Hydra.Contract.HeadState qualified as Head
import Hydra.Data.ContestationPeriod qualified as OnChain
import Hydra.Data.Party qualified as OnChain
import Hydra.Ledger.Cardano.Builder (
  unsafeBuildTransaction,
 )
import Hydra.Plutus (commitValidatorScript)
import Hydra.Tx.ContestationPeriod (toChain)
import Hydra.Tx.HeadId (HeadId, headIdToCurrencySymbol)
import Hydra.Tx.HeadParameters (HeadParameters (..))
import Hydra.Tx.IsTx (hashUTxO)
import Hydra.Tx.Party (partyToChain)
import Hydra.Tx.ScriptRegistry (ScriptRegistry (..))
import Hydra.Tx.Utils (findStateToken, mkHydraHeadV1TxName)
import PlutusLedgerApi.Common (fromBuiltin)
import PlutusLedgerApi.V3 (toBuiltin)
import Test.QuickCheck (vectorOf)

-- * Construction

-- | Create a transaction collecting all "committed" utxo and opening a Head,
-- i.e. driving the Head script state.
collectComTx ::
  NetworkId ->
  -- | Published Hydra scripts to reference.
  ScriptRegistry ->
  -- | Party who's authorizing this transaction
  VerificationKey PaymentKey ->
  -- | Head identifier
  HeadId ->
  -- | Parameters of the head to collect .
  HeadParameters ->
  -- | Everything needed to spend the Head state-machine output.
  (TxIn, TxOut CtxUTxO) ->
  -- | Data needed to spend the commit output produced by each party.
  -- Should contain the PT and is locked by @ν_commit@ script.
  Map TxIn (TxOut CtxUTxO) ->
  -- | UTxO to be used to collect.
  -- Should match whatever is recorded in the commit inputs.
  UTxO ->
  Tx
collectComTx :: NetworkId
-> ScriptRegistry
-> VerificationKey PaymentKey
-> HeadId
-> HeadParameters
-> (TxIn, TxOut CtxUTxO)
-> Map TxIn (TxOut CtxUTxO)
-> UTxO
-> Tx
collectComTx NetworkId
networkId ScriptRegistry
scriptRegistry VerificationKey PaymentKey
vk HeadId
headId HeadParameters
headParameters (TxIn
headInput, TxOut CtxUTxO
initialHeadOutput) Map TxIn (TxOut CtxUTxO)
commits UTxO
utxoToCollect =
  HasCallStack => TxBodyContent BuildTx -> Tx
TxBodyContent BuildTx -> Tx
unsafeBuildTransaction (TxBodyContent BuildTx -> Tx) -> TxBodyContent BuildTx -> Tx
forall a b. (a -> b) -> a -> b
$
    TxBodyContent BuildTx
defaultTxBodyContent
      TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& TxIns BuildTx Era -> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall build era.
TxIns build era
-> TxBodyContent build era -> TxBodyContent build era
addTxIns ((TxIn
headInput, BuildTxWith BuildTx (Witness WitCtxTxIn)
headWitness) (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))
-> TxIns BuildTx Era -> TxIns BuildTx Era
forall a. a -> [a] -> [a]
: (TxIn -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))
mkCommit (TxIn -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn)))
-> [TxIn] -> TxIns BuildTx Era
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxIn (TxOut CtxUTxO) -> [TxIn]
forall k a. Map k a -> [k]
Map.keys Map TxIn (TxOut CtxUTxO)
commits))
      TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall era build.
IsBabbageBasedEra era =>
[TxIn] -> TxBodyContent build era -> TxBodyContent build era
addTxInsReference [TxIn
commitScriptRef, TxIn
headScriptRef]
      TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [TxOut CtxTx Era] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall era build.
[TxOut CtxTx era]
-> TxBodyContent build era -> TxBodyContent build era
addTxOuts [TxOut CtxTx Era
headOutput]
      TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& [Hash PaymentKey] -> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall era build.
IsAlonzoBasedEra era =>
[Hash PaymentKey]
-> TxBodyContent build era -> TxBodyContent build era
addTxExtraKeyWits [VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
vk]
      TxBodyContent BuildTx
-> (TxBodyContent BuildTx -> TxBodyContent BuildTx)
-> TxBodyContent BuildTx
forall a b. a -> (a -> b) -> b
& TxMetadataInEra Era
-> TxBodyContent BuildTx -> TxBodyContent BuildTx
forall era build.
TxMetadataInEra era
-> TxBodyContent build era -> TxBodyContent build era
setTxMetadata (TxMetadata -> TxMetadataInEra Era
TxMetadataInEra (TxMetadata -> TxMetadataInEra Era)
-> TxMetadata -> TxMetadataInEra Era
forall a b. (a -> b) -> a -> b
$ Text -> TxMetadata
mkHydraHeadV1TxName Text
"CollectComTx")
 where
  HeadParameters{[Party]
parties :: [Party]
$sel:parties:HeadParameters :: HeadParameters -> [Party]
parties, ContestationPeriod
contestationPeriod :: ContestationPeriod
$sel:contestationPeriod:HeadParameters :: HeadParameters -> ContestationPeriod
contestationPeriod} = HeadParameters
headParameters

  headWitness :: BuildTxWith BuildTx (Witness WitCtxTxIn)
headWitness =
    Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn))
-> Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$
      ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall ctx.
ScriptWitnessInCtx ctx -> ScriptWitness ctx -> Witness ctx
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
forall ctx. IsScriptWitnessInCtx ctx => ScriptWitnessInCtx ctx
scriptWitnessInCtx (ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn)
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall a b. (a -> b) -> a -> b
$
        TxIn
-> PlutusScript PlutusScriptV3
-> ScriptDatum WitCtxTxIn
-> ScriptRedeemer
-> ScriptWitness WitCtxTxIn
forall ctx era lang.
(IsPlutusScriptLanguage lang, HasScriptLanguageInEra lang era) =>
TxIn
-> PlutusScript lang
-> ScriptDatum ctx
-> ScriptRedeemer
-> ScriptWitness ctx era
mkScriptReference TxIn
headScriptRef PlutusScript PlutusScriptV3
Head.validatorScript ScriptDatum WitCtxTxIn
InlineScriptDatum ScriptRedeemer
headRedeemer
  headScriptRef :: TxIn
headScriptRef = (TxIn, TxOut CtxUTxO) -> TxIn
forall a b. (a, b) -> a
fst (ScriptRegistry -> (TxIn, TxOut CtxUTxO)
headReference ScriptRegistry
scriptRegistry)
  headRedeemer :: ScriptRedeemer
headRedeemer = Input -> ScriptRedeemer
forall a. ToScriptData a => a -> ScriptRedeemer
toScriptData Input
Head.CollectCom
  headOutput :: TxOut CtxTx Era
headOutput =
    AddressInEra
-> Value -> TxOutDatum CtxTx -> ReferenceScript -> TxOut CtxTx Era
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut
      (NetworkId -> PlutusScript PlutusScriptV3 -> AddressInEra
forall lang era.
(IsShelleyBasedEra era, IsPlutusScriptLanguage lang) =>
NetworkId -> PlutusScript lang -> AddressInEra era
mkScriptAddress NetworkId
networkId PlutusScript PlutusScriptV3
Head.validatorScript)
      (TxOut CtxUTxO -> Value
forall ctx. TxOut ctx -> Value
txOutValue TxOut CtxUTxO
initialHeadOutput Value -> Value -> Value
forall a. Semigroup a => a -> a -> a
<> Value
commitValue)
      TxOutDatum CtxTx
headDatumAfter
      ReferenceScript
ReferenceScriptNone
  headDatumAfter :: TxOutDatum CtxTx
headDatumAfter =
    State -> TxOutDatum CtxTx
forall era a ctx.
(ToScriptData a, IsBabbageBasedEra era) =>
a -> TxOutDatum ctx era
mkTxOutDatumInline (State -> TxOutDatum CtxTx) -> State -> TxOutDatum CtxTx
forall a b. (a -> b) -> a -> b
$
      OpenDatum -> State
Head.Open
        Head.OpenDatum
          { $sel:parties:OpenDatum :: [Party]
Head.parties = Party -> Party
partyToChain (Party -> Party) -> [Party] -> [Party]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Party]
parties
          , Hash
ToBuiltin ByteString
utxoHash :: ToBuiltin ByteString
$sel:utxoHash:OpenDatum :: Hash
utxoHash
          , $sel:contestationPeriod:OpenDatum :: ContestationPeriod
contestationPeriod = ContestationPeriod -> ContestationPeriod
toChain ContestationPeriod
contestationPeriod
          , $sel:headId:OpenDatum :: CurrencySymbol
headId = HeadId -> CurrencySymbol
headIdToCurrencySymbol HeadId
headId
          , $sel:version:OpenDatum :: SnapshotVersion
version = SnapshotVersion
0
          }

  utxoHash :: ToBuiltin ByteString
utxoHash = ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> ToBuiltin ByteString)
-> ByteString -> ToBuiltin ByteString
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @Tx UTxO
UTxOType Tx
utxoToCollect

  mkCommit :: TxIn -> (TxIn, BuildTxWith BuildTx (Witness WitCtxTxIn))
mkCommit TxIn
commitTxIn = (TxIn
commitTxIn, BuildTxWith BuildTx (Witness WitCtxTxIn)
commitWitness)
  commitWitness :: BuildTxWith BuildTx (Witness WitCtxTxIn)
commitWitness =
    Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a. a -> BuildTxWith BuildTx a
BuildTxWith (Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn))
-> Witness WitCtxTxIn -> BuildTxWith BuildTx (Witness WitCtxTxIn)
forall a b. (a -> b) -> a -> b
$
      ScriptWitnessInCtx WitCtxTxIn
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall ctx.
ScriptWitnessInCtx ctx -> ScriptWitness ctx -> Witness ctx
ScriptWitness ScriptWitnessInCtx WitCtxTxIn
forall ctx. IsScriptWitnessInCtx ctx => ScriptWitnessInCtx ctx
scriptWitnessInCtx (ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn)
-> ScriptWitness WitCtxTxIn -> Witness WitCtxTxIn
forall a b. (a -> b) -> a -> b
$
        TxIn
-> PlutusScript PlutusScriptV3
-> ScriptDatum WitCtxTxIn
-> ScriptRedeemer
-> ScriptWitness WitCtxTxIn
forall ctx era lang.
(IsPlutusScriptLanguage lang, HasScriptLanguageInEra lang era) =>
TxIn
-> PlutusScript lang
-> ScriptDatum ctx
-> ScriptRedeemer
-> ScriptWitness ctx era
mkScriptReference TxIn
commitScriptRef PlutusScript PlutusScriptV3
commitValidatorScript ScriptDatum WitCtxTxIn
InlineScriptDatum ScriptRedeemer
commitRedeemer
  commitScriptRef :: TxIn
commitScriptRef =
    (TxIn, TxOut CtxUTxO) -> TxIn
forall a b. (a, b) -> a
fst (ScriptRegistry -> (TxIn, TxOut CtxUTxO)
commitReference ScriptRegistry
scriptRegistry)
  commitValue :: Value
commitValue =
    [Value] -> Value
forall a. Monoid a => [a] -> a
mconcat ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$ TxOut CtxUTxO -> Value
forall ctx. TxOut ctx -> Value
txOutValue (TxOut CtxUTxO -> Value) -> [TxOut CtxUTxO] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map TxIn (TxOut CtxUTxO) -> [TxOut CtxUTxO]
forall k a. Map k a -> [a]
Map.elems Map TxIn (TxOut CtxUTxO)
commits
  commitRedeemer :: ScriptRedeemer
commitRedeemer =
    Redeemer -> ScriptRedeemer
forall a. ToScriptData a => a -> ScriptRedeemer
toScriptData (Redeemer -> ScriptRedeemer) -> Redeemer -> ScriptRedeemer
forall a b. (a -> b) -> a -> b
$ RedeemerType -> Redeemer
Commit.redeemer RedeemerType
Commit.ViaCollectCom

-- * Observation

-- | Representation of the Head output after a CollectCom transaction.
data OpenThreadOutput = OpenThreadOutput
  { OpenThreadOutput -> (TxIn, TxOut CtxUTxO)
openThreadUTxO :: (TxIn, TxOut CtxUTxO)
  , OpenThreadOutput -> ContestationPeriod
openContestationPeriod :: OnChain.ContestationPeriod
  , OpenThreadOutput -> [Party]
openParties :: [OnChain.Party]
  }
  deriving stock (OpenThreadOutput -> OpenThreadOutput -> Bool
(OpenThreadOutput -> OpenThreadOutput -> Bool)
-> (OpenThreadOutput -> OpenThreadOutput -> Bool)
-> Eq OpenThreadOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpenThreadOutput -> OpenThreadOutput -> Bool
== :: OpenThreadOutput -> OpenThreadOutput -> Bool
$c/= :: OpenThreadOutput -> OpenThreadOutput -> Bool
/= :: OpenThreadOutput -> OpenThreadOutput -> Bool
Eq, Int -> OpenThreadOutput -> ShowS
[OpenThreadOutput] -> ShowS
OpenThreadOutput -> String
(Int -> OpenThreadOutput -> ShowS)
-> (OpenThreadOutput -> String)
-> ([OpenThreadOutput] -> ShowS)
-> Show OpenThreadOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OpenThreadOutput -> ShowS
showsPrec :: Int -> OpenThreadOutput -> ShowS
$cshow :: OpenThreadOutput -> String
show :: OpenThreadOutput -> String
$cshowList :: [OpenThreadOutput] -> ShowS
showList :: [OpenThreadOutput] -> ShowS
Show, (forall x. OpenThreadOutput -> Rep OpenThreadOutput x)
-> (forall x. Rep OpenThreadOutput x -> OpenThreadOutput)
-> Generic OpenThreadOutput
forall x. Rep OpenThreadOutput x -> OpenThreadOutput
forall x. OpenThreadOutput -> Rep OpenThreadOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OpenThreadOutput -> Rep OpenThreadOutput x
from :: forall x. OpenThreadOutput -> Rep OpenThreadOutput x
$cto :: forall x. Rep OpenThreadOutput x -> OpenThreadOutput
to :: forall x. Rep OpenThreadOutput x -> OpenThreadOutput
Generic)

newtype UTxOHash = UTxOHash ByteString
  deriving stock (UTxOHash -> UTxOHash -> Bool
(UTxOHash -> UTxOHash -> Bool)
-> (UTxOHash -> UTxOHash -> Bool) -> Eq UTxOHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UTxOHash -> UTxOHash -> Bool
== :: UTxOHash -> UTxOHash -> Bool
$c/= :: UTxOHash -> UTxOHash -> Bool
/= :: UTxOHash -> UTxOHash -> Bool
Eq, Int -> UTxOHash -> ShowS
[UTxOHash] -> ShowS
UTxOHash -> String
(Int -> UTxOHash -> ShowS)
-> (UTxOHash -> String) -> ([UTxOHash] -> ShowS) -> Show UTxOHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UTxOHash -> ShowS
showsPrec :: Int -> UTxOHash -> ShowS
$cshow :: UTxOHash -> String
show :: UTxOHash -> String
$cshowList :: [UTxOHash] -> ShowS
showList :: [UTxOHash] -> ShowS
Show, (forall x. UTxOHash -> Rep UTxOHash x)
-> (forall x. Rep UTxOHash x -> UTxOHash) -> Generic UTxOHash
forall x. Rep UTxOHash x -> UTxOHash
forall x. UTxOHash -> Rep UTxOHash x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UTxOHash -> Rep UTxOHash x
from :: forall x. UTxOHash -> Rep UTxOHash x
$cto :: forall x. Rep UTxOHash x -> UTxOHash
to :: forall x. Rep UTxOHash x -> UTxOHash
Generic)

instance Arbitrary UTxOHash where
  arbitrary :: Gen UTxOHash
arbitrary = ByteString -> UTxOHash
UTxOHash (ByteString -> UTxOHash)
-> ([Word8] -> ByteString) -> [Word8] -> UTxOHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> UTxOHash) -> Gen [Word8] -> Gen UTxOHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

data CollectComObservation = CollectComObservation
  { CollectComObservation -> OpenThreadOutput
threadOutput :: OpenThreadOutput
  , CollectComObservation -> HeadId
headId :: HeadId
  , CollectComObservation -> UTxOHash
utxoHash :: UTxOHash
  }
  deriving stock (Int -> CollectComObservation -> ShowS
[CollectComObservation] -> ShowS
CollectComObservation -> String
(Int -> CollectComObservation -> ShowS)
-> (CollectComObservation -> String)
-> ([CollectComObservation] -> ShowS)
-> Show CollectComObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CollectComObservation -> ShowS
showsPrec :: Int -> CollectComObservation -> ShowS
$cshow :: CollectComObservation -> String
show :: CollectComObservation -> String
$cshowList :: [CollectComObservation] -> ShowS
showList :: [CollectComObservation] -> ShowS
Show, CollectComObservation -> CollectComObservation -> Bool
(CollectComObservation -> CollectComObservation -> Bool)
-> (CollectComObservation -> CollectComObservation -> Bool)
-> Eq CollectComObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CollectComObservation -> CollectComObservation -> Bool
== :: CollectComObservation -> CollectComObservation -> Bool
$c/= :: CollectComObservation -> CollectComObservation -> Bool
/= :: CollectComObservation -> CollectComObservation -> Bool
Eq, (forall x. CollectComObservation -> Rep CollectComObservation x)
-> (forall x. Rep CollectComObservation x -> CollectComObservation)
-> Generic CollectComObservation
forall x. Rep CollectComObservation x -> CollectComObservation
forall x. CollectComObservation -> Rep CollectComObservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CollectComObservation -> Rep CollectComObservation x
from :: forall x. CollectComObservation -> Rep CollectComObservation x
$cto :: forall x. Rep CollectComObservation x -> CollectComObservation
to :: forall x. Rep CollectComObservation x -> CollectComObservation
Generic)

-- | Identify a collectCom tx by lookup up the input spending the Head output
-- and decoding its redeemer.
observeCollectComTx ::
  -- | A UTxO set to lookup tx inputs
  UTxO ->
  Tx ->
  Maybe CollectComObservation
observeCollectComTx :: UTxO -> Tx -> Maybe CollectComObservation
observeCollectComTx UTxO
utxo Tx
tx = do
  let inputUTxO :: UTxO
inputUTxO = UTxO -> Tx -> UTxO
resolveInputsUTxO UTxO
utxo Tx
tx
  (TxIn
headInput, TxOut CtxUTxO
headOutput) <- UTxO -> PlutusScript PlutusScriptV3 -> Maybe (TxIn, TxOut CtxUTxO)
forall lang.
IsPlutusScriptLanguage lang =>
UTxO -> PlutusScript lang -> Maybe (TxIn, TxOut CtxUTxO)
findTxOutByScript UTxO
inputUTxO PlutusScript PlutusScriptV3
Head.validatorScript
  Input
redeemer <- Tx -> TxIn -> Maybe Input
forall a. FromData a => Tx -> TxIn -> Maybe a
findRedeemerSpending Tx
tx TxIn
headInput
  ScriptRedeemer
oldHeadDatum <- TxOut CtxTx Era -> Maybe ScriptRedeemer
forall era. TxOut CtxTx era -> Maybe ScriptRedeemer
txOutScriptData (TxOut CtxTx Era -> Maybe ScriptRedeemer)
-> TxOut CtxTx Era -> Maybe ScriptRedeemer
forall a b. (a -> b) -> a -> b
$ TxOut CtxUTxO -> TxOut CtxTx Era
forall era. TxOut CtxUTxO era -> TxOut CtxTx era
forall {k} (f :: * -> k -> *) (era :: k).
ToTxContext f =>
f CtxUTxO era -> f CtxTx era
toTxContext TxOut CtxUTxO
headOutput
  State
datum <- ScriptRedeemer -> Maybe State
forall a. FromScriptData a => ScriptRedeemer -> Maybe a
fromScriptData ScriptRedeemer
oldHeadDatum
  HeadId
headId <- TxOut CtxUTxO -> Maybe HeadId
forall ctx. TxOut ctx -> Maybe HeadId
findStateToken TxOut CtxUTxO
headOutput
  case (State
datum, Input
redeemer) of
    (Head.Initial{[Party]
parties :: [Party]
$sel:parties:Initial :: State -> [Party]
parties, ContestationPeriod
contestationPeriod :: ContestationPeriod
$sel:contestationPeriod:Initial :: State -> ContestationPeriod
contestationPeriod}, Input
Head.CollectCom) -> do
      (TxIn
newHeadInput, TxOut CtxUTxO
newHeadOutput) <- UTxO -> PlutusScript PlutusScriptV3 -> Maybe (TxIn, TxOut CtxUTxO)
forall lang.
IsPlutusScriptLanguage lang =>
UTxO -> PlutusScript lang -> Maybe (TxIn, TxOut CtxUTxO)
findTxOutByScript (Tx -> UTxO
utxoFromTx Tx
tx) PlutusScript PlutusScriptV3
Head.validatorScript
      ScriptRedeemer
newHeadDatum <- TxOut CtxTx Era -> Maybe ScriptRedeemer
forall era. TxOut CtxTx era -> Maybe ScriptRedeemer
txOutScriptData (TxOut CtxTx Era -> Maybe ScriptRedeemer)
-> TxOut CtxTx Era -> Maybe ScriptRedeemer
forall a b. (a -> b) -> a -> b
$ TxOut CtxUTxO -> TxOut CtxTx Era
forall era. TxOut CtxUTxO era -> TxOut CtxTx era
forall {k} (f :: * -> k -> *) (era :: k).
ToTxContext f =>
f CtxUTxO era -> f CtxTx era
toTxContext TxOut CtxUTxO
newHeadOutput
      UTxOHash
utxoHash <- ByteString -> UTxOHash
UTxOHash (ByteString -> UTxOHash) -> Maybe ByteString -> Maybe UTxOHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptRedeemer -> Maybe ByteString
decodeUtxoHash ScriptRedeemer
newHeadDatum
      CollectComObservation -> Maybe CollectComObservation
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        CollectComObservation
          { $sel:threadOutput:CollectComObservation :: OpenThreadOutput
threadOutput =
              OpenThreadOutput
                { $sel:openThreadUTxO:OpenThreadOutput :: (TxIn, TxOut CtxUTxO)
openThreadUTxO = (TxIn
newHeadInput, TxOut CtxUTxO
newHeadOutput)
                , $sel:openParties:OpenThreadOutput :: [Party]
openParties = [Party]
parties
                , $sel:openContestationPeriod:OpenThreadOutput :: ContestationPeriod
openContestationPeriod = ContestationPeriod
contestationPeriod
                }
          , HeadId
$sel:headId:CollectComObservation :: HeadId
headId :: HeadId
headId
          , UTxOHash
$sel:utxoHash:CollectComObservation :: UTxOHash
utxoHash :: UTxOHash
utxoHash
          }
    (State, Input)
_ -> Maybe CollectComObservation
forall a. Maybe a
Nothing
 where
  decodeUtxoHash :: ScriptRedeemer -> Maybe ByteString
decodeUtxoHash ScriptRedeemer
datum =
    case ScriptRedeemer -> Maybe State
forall a. FromScriptData a => ScriptRedeemer -> Maybe a
fromScriptData ScriptRedeemer
datum of
      Just (Head.Open Head.OpenDatum{Hash
$sel:utxoHash:OpenDatum :: OpenDatum -> Hash
utxoHash :: Hash
utxoHash}) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Hash -> FromBuiltin Hash
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
fromBuiltin Hash
utxoHash
      Maybe State
_ -> Maybe ByteString
forall a. Maybe a
Nothing