From 02b57ba956361d33b1a9960bc198a6718beb87bf Mon Sep 17 00:00:00 2001 From: Franco Testagrossa Date: Thu, 28 Nov 2024 14:08:09 +0100 Subject: [PATCH] introduce SerialisedScriptRegistry to be passed during hydra tx observations to keep all serialized script references in one place. --- .../src/Hydra/ChainObserver/NodeClient.hs | 3 +- hydra-node/src/Hydra/Chain/Direct/Handlers.hs | 3 +- hydra-node/src/Hydra/Chain/Direct/State.hs | 13 +-- hydra-node/src/Hydra/Chain/Direct/Tx.hs | 80 ++++++++++--------- .../test/Hydra/Chain/Direct/StateSpec.hs | 17 ++-- hydra-node/test/Hydra/Chain/Direct/TxSpec.hs | 4 +- .../test/Hydra/Chain/Direct/TxTraceSpec.hs | 4 +- hydra-tx/src/Hydra/Tx/Deposit.hs | 9 ++- hydra-tx/src/Hydra/Tx/Recover.hs | 4 +- hydra-tx/src/Hydra/Tx/ScriptRegistry.hs | 20 +++++ 10 files changed, 98 insertions(+), 59 deletions(-) diff --git a/hydra-chain-observer/src/Hydra/ChainObserver/NodeClient.hs b/hydra-chain-observer/src/Hydra/ChainObserver/NodeClient.hs index ecf87a10391..bf412d5fc50 100644 --- a/hydra-chain-observer/src/Hydra/ChainObserver/NodeClient.hs +++ b/hydra-chain-observer/src/Hydra/ChainObserver/NodeClient.hs @@ -21,6 +21,7 @@ import Hydra.Chain.Direct.Tx ( import Hydra.Contract (ScriptInfo) import Hydra.Ledger.Cardano (adjustUTxO) import Hydra.Tx.HeadId (HeadId (..)) +import Hydra.Tx.ScriptRegistry (serialisedScriptRegistry) type ObserverHandler m = [ChainObservation] -> m () @@ -85,7 +86,7 @@ logOnChainTx = \case observeTx :: NetworkId -> UTxO -> Tx -> (UTxO, Maybe HeadObservation) observeTx networkId utxo tx = let utxo' = adjustUTxO tx utxo - in case observeHeadTx networkId utxo tx of + in case observeHeadTx networkId serialisedScriptRegistry utxo tx of NoHeadTx -> (utxo, Nothing) observation -> (utxo', pure observation) diff --git a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs index 0665818c6fa..3d15d2d4fdd 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Handlers.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Handlers.hs @@ -84,6 +84,7 @@ import Hydra.Tx ( CommitBlueprintTx (..), HeadParameters (..), UTxOType, + serialisedScriptRegistry, ) import Hydra.Tx.Contest (ClosedThreadOutput (..)) import Hydra.Tx.ContestationPeriod (toNominalDiffTime) @@ -305,7 +306,7 @@ chainSyncHandler tracer callback getTimeHandle ctx localChainState = maybeObserveSomeTx point tx = atomically $ do ChainStateAt{spendableUTxO} <- getLatest - let observation = observeHeadTx networkId spendableUTxO tx + let observation = observeHeadTx networkId serialisedScriptRegistry spendableUTxO tx case convertObservation observation of Nothing -> pure Nothing Just observedTx -> do diff --git a/hydra-node/src/Hydra/Chain/Direct/State.hs b/hydra-node/src/Hydra/Chain/Direct/State.hs index 4cd449d44b2..f01ef7bcf63 100644 --- a/hydra-node/src/Hydra/Chain/Direct/State.hs +++ b/hydra-node/src/Hydra/Chain/Direct/State.hs @@ -102,6 +102,7 @@ import Hydra.Tx ( getSnapshot, partyToChain, registryUTxO, + serialisedScriptRegistry, utxoFromTx, ) import Hydra.Tx.Abort (AbortTxError (..), abortTx) @@ -796,7 +797,7 @@ observeInit :: Tx -> Either NotAnInitReason (OnChainTx Tx, InitialState) observeInit _ctx _allVerificationKeys tx = do - observation <- observeInitTx tx + observation <- observeInitTx serialisedScriptRegistry tx pure (toEvent observation, toState observation) where toEvent InitObservation{contestationPeriod, parties, headId, seedTxIn, participants} = @@ -831,7 +832,7 @@ observeCommit :: Maybe (OnChainTx Tx, InitialState) observeCommit ctx st tx = do let utxo = getKnownUTxO st - observation <- observeCommitTx networkId utxo tx + observation <- observeCommitTx networkId serialisedScriptRegistry utxo tx let CommitObservation{commitOutput, party, committed, headId = commitHeadId} = observation guard $ commitHeadId == headId let event = OnCommitTx{headId, party, committed} @@ -862,7 +863,7 @@ observeCollect :: Maybe (OnChainTx Tx, OpenState) observeCollect st tx = do let utxo = getKnownUTxO st - observation <- observeCollectComTx utxo tx + observation <- observeCollectComTx serialisedScriptRegistry utxo tx let CollectComObservation{threadOutput = threadOutput, headId = collectComHeadId, utxoHash} = observation guard (headId == collectComHeadId) -- REVIEW: is it enough to pass here just the 'openThreadUTxO' or we need also @@ -892,7 +893,7 @@ observeClose :: Maybe (OnChainTx Tx, ClosedState) observeClose st tx = do let utxo = getKnownUTxO st - observation <- observeCloseTx utxo tx + observation <- observeCloseTx serialisedScriptRegistry utxo tx let CloseObservation{threadOutput, headId = closeObservationHeadId, snapshotNumber} = observation guard (headId == closeObservationHeadId) let ClosedThreadOutput{closedContestationDeadline} = threadOutput @@ -1188,7 +1189,7 @@ genRecoverTx :: genRecoverTx = do (_depositedUTxO, txDeposit) <- genDepositTx let DepositObservation{deposited} = - fromJust $ observeDepositTx testNetworkId txDeposit + fromJust $ observeDepositTx testNetworkId serialisedScriptRegistry txDeposit -- TODO: generate multiple various slots after deadline let tx = recoverTx (getTxId $ getTxBody txDeposit) deposited 100 pure (utxoFromTx txDeposit, tx) @@ -1198,7 +1199,7 @@ genIncrementTx numParties = do (_utxo, txDeposit) <- genDepositTx ctx <- genHydraContextFor numParties cctx <- pickChainContext ctx - let DepositObservation{deposited, depositTxId} = fromJust $ observeDepositTx (ctxNetworkId ctx) txDeposit + let DepositObservation{deposited, depositTxId} = fromJust $ observeDepositTx (ctxNetworkId ctx) serialisedScriptRegistry txDeposit (_, st@OpenState{headId}) <- genStOpen ctx let openUTxO = getKnownUTxO st let version = 1 diff --git a/hydra-node/src/Hydra/Chain/Direct/Tx.hs b/hydra-node/src/Hydra/Chain/Direct/Tx.hs index 981918c045b..1d176dcb7f3 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Tx.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Tx.hs @@ -22,12 +22,10 @@ import Data.Map qualified as Map import GHC.IsList (IsList (..)) import Hydra.Contract.Commit qualified as Commit import Hydra.Contract.Deposit qualified as Deposit -import Hydra.Contract.Head qualified as Head import Hydra.Contract.HeadState qualified as Head import Hydra.Contract.HeadTokens qualified as HeadTokens import Hydra.Data.ContestationPeriod qualified as OnChain import Hydra.Data.Party qualified as OnChain -import Hydra.Plutus (commitValidatorScript, initialValidatorScript) import Hydra.Plutus.Extras (posixToUTCTime) import Hydra.Plutus.Orphans () import Hydra.Tx ( @@ -48,6 +46,7 @@ import Hydra.Tx.ContestationPeriod (ContestationPeriod, fromChain) import Hydra.Tx.Deposit (DepositObservation (..), observeDepositTx) import Hydra.Tx.OnChainId (OnChainId (..)) import Hydra.Tx.Recover (RecoverObservation (..), observeRecoverTx) +import Hydra.Tx.ScriptRegistry (SerialisedScriptRegistry (..)) import Hydra.Tx.Utils (assetNameToOnChainId, findFirst, hydraHeadV1AssetName, hydraMetadataLabel) import PlutusLedgerApi.V3 (CurrencySymbol, fromBuiltin) import PlutusLedgerApi.V3 qualified as Plutus @@ -121,20 +120,20 @@ instance Arbitrary HeadObservation where arbitrary = genericArbitrary -- | Observe any Hydra head transaction. -observeHeadTx :: NetworkId -> UTxO -> Tx -> HeadObservation -observeHeadTx networkId utxo tx = +observeHeadTx :: NetworkId -> SerialisedScriptRegistry -> UTxO -> Tx -> HeadObservation +observeHeadTx networkId serializedScripts utxo tx = fromMaybe NoHeadTx $ - either (const Nothing) (Just . Init) (observeInitTx tx) - <|> Abort <$> observeAbortTx utxo tx - <|> Commit <$> observeCommitTx networkId utxo tx - <|> CollectCom <$> observeCollectComTx utxo tx - <|> Deposit <$> observeDepositTx networkId tx - <|> Recover <$> observeRecoverTx networkId utxo tx - <|> Increment <$> observeIncrementTx utxo tx - <|> Decrement <$> observeDecrementTx utxo tx - <|> Close <$> observeCloseTx utxo tx - <|> Contest <$> observeContestTx utxo tx - <|> Fanout <$> observeFanoutTx utxo tx + either (const Nothing) (Just . Init) (observeInitTx serializedScripts tx) + <|> Abort <$> observeAbortTx serializedScripts utxo tx + <|> Commit <$> observeCommitTx networkId serializedScripts utxo tx + <|> CollectCom <$> observeCollectComTx serializedScripts utxo tx + <|> Deposit <$> observeDepositTx networkId serializedScripts tx + <|> Recover <$> observeRecoverTx networkId serializedScripts utxo tx + <|> Increment <$> observeIncrementTx serializedScripts utxo tx + <|> Decrement <$> observeDecrementTx serializedScripts utxo tx + <|> Close <$> observeCloseTx serializedScripts utxo tx + <|> Contest <$> observeContestTx serializedScripts utxo tx + <|> Fanout <$> observeFanoutTx serializedScripts utxo tx -- | Data which can be observed from an `initTx`. data InitObservation = InitObservation @@ -169,9 +168,10 @@ instance Arbitrary NotAnInitReason where -- | Identify a init tx by checking the output value for holding tokens that are -- valid head tokens (checked by seed + policy). observeInitTx :: + SerialisedScriptRegistry -> Tx -> Either NotAnInitReason InitObservation -observeInitTx tx = do +observeInitTx SerialisedScriptRegistry{initialScriptValidator, headScriptValidator} tx = do -- XXX: Lots of redundant information here (ix, headOut, headState) <- maybeLeft NoHeadOutput $ @@ -211,7 +211,7 @@ observeInitTx tx = do guard $ isScriptTxOut headScript out (ix,out,) <$> (fromScriptData =<< txOutScriptData out) - headScript = fromPlutusScript @PlutusScriptV3 Head.validatorScript + headScript = fromPlutusScript @PlutusScriptV3 headScriptValidator indexedOutputs = zip [0 ..] (txOuts' tx) @@ -224,7 +224,7 @@ observeInitTx tx = do isInitial = isScriptTxOut initialScript - initialScript = fromPlutusScript @PlutusScriptV3 initialValidatorScript + initialScript = fromPlutusScript @PlutusScriptV3 initialScriptValidator mintedTokenNames pid = [ assetName @@ -255,12 +255,13 @@ instance Arbitrary CommitObservation where -- - Reconstruct the committed UTxO from both values (tx input and output). observeCommitTx :: NetworkId -> + SerialisedScriptRegistry -> -- | A UTxO set to lookup tx inputs. Should at least contain the input -- spending from νInitial. UTxO -> Tx -> Maybe CommitObservation -observeCommitTx networkId utxo tx = do +observeCommitTx networkId SerialisedScriptRegistry{initialScriptValidator, commitScriptValidator} utxo tx = do -- NOTE: Instead checking to spend from initial we could be looking at the -- seed: -- @@ -305,11 +306,11 @@ observeCommitTx networkId utxo tx = do initialAddress = mkScriptAddress @PlutusScriptV3 networkId initialScript - initialScript = fromPlutusScript @PlutusScriptV3 initialValidatorScript + initialScript = fromPlutusScript @PlutusScriptV3 initialScriptValidator commitAddress = mkScriptAddress networkId commitScript - commitScript = fromPlutusScript @PlutusScriptV3 commitValidatorScript + commitScript = fromPlutusScript @PlutusScriptV3 commitScriptValidator data CollectComObservation = CollectComObservation { threadOutput :: OpenThreadOutput @@ -324,11 +325,12 @@ instance Arbitrary CollectComObservation where -- | Identify a collectCom tx by lookup up the input spending the Head output -- and decoding its redeemer. observeCollectComTx :: + SerialisedScriptRegistry -> -- | A UTxO set to lookup tx inputs UTxO -> Tx -> Maybe CollectComObservation -observeCollectComTx utxo tx = do +observeCollectComTx SerialisedScriptRegistry{headScriptValidator} utxo tx = do let inputUTxO = resolveInputsUTxO utxo tx (headInput, headOutput) <- findTxOutByScript @PlutusScriptV3 inputUTxO headScript redeemer <- findRedeemerSpending tx headInput @@ -353,7 +355,7 @@ observeCollectComTx utxo tx = do } _ -> Nothing where - headScript = fromPlutusScript Head.validatorScript + headScript = fromPlutusScript headScriptValidator decodeUtxoHash datum = case fromScriptData datum of Just (Head.Open Head.OpenDatum{utxoHash}) -> Just $ fromBuiltin utxoHash @@ -370,10 +372,11 @@ instance Arbitrary IncrementObservation where arbitrary = genericArbitrary observeIncrementTx :: + SerialisedScriptRegistry -> UTxO -> Tx -> Maybe IncrementObservation -observeIncrementTx utxo tx = do +observeIncrementTx SerialisedScriptRegistry{headScriptValidator, depositScriptValidator} utxo tx = do let inputUTxO = resolveInputsUTxO utxo tx (headInput, headOutput) <- findTxOutByScript @PlutusScriptV3 inputUTxO headScript (TxIn depositTxId _, depositOutput) <- findTxOutByScript @PlutusScriptV3 utxo depositScript @@ -398,8 +401,8 @@ observeIncrementTx utxo tx = do _ -> Nothing _ -> Nothing where - depositScript = fromPlutusScript Deposit.validatorScript - headScript = fromPlutusScript Head.validatorScript + depositScript = fromPlutusScript depositScriptValidator + headScript = fromPlutusScript headScriptValidator data DecrementObservation = DecrementObservation { headId :: HeadId @@ -412,10 +415,11 @@ instance Arbitrary DecrementObservation where arbitrary = genericArbitrary observeDecrementTx :: + SerialisedScriptRegistry -> UTxO -> Tx -> Maybe DecrementObservation -observeDecrementTx utxo tx = do +observeDecrementTx SerialisedScriptRegistry{headScriptValidator} utxo tx = do let inputUTxO = resolveInputsUTxO utxo tx (headInput, headOutput) <- findTxOutByScript @PlutusScriptV3 inputUTxO headScript redeemer <- findRedeemerSpending tx headInput @@ -440,7 +444,7 @@ observeDecrementTx utxo tx = do _ -> Nothing _ -> Nothing where - headScript = fromPlutusScript Head.validatorScript + headScript = fromPlutusScript headScriptValidator data CloseObservation = CloseObservation { threadOutput :: ClosedThreadOutput @@ -455,11 +459,12 @@ instance Arbitrary CloseObservation where -- | Identify a close tx by lookup up the input spending the Head output and -- decoding its redeemer. observeCloseTx :: + SerialisedScriptRegistry -> -- | A UTxO set to lookup tx inputs UTxO -> Tx -> Maybe CloseObservation -observeCloseTx utxo tx = do +observeCloseTx SerialisedScriptRegistry{headScriptValidator} utxo tx = do let inputUTxO = resolveInputsUTxO utxo tx (headInput, headOutput) <- findTxOutByScript @PlutusScriptV3 inputUTxO headScript redeemer <- findRedeemerSpending tx headInput @@ -488,7 +493,7 @@ observeCloseTx utxo tx = do } _ -> Nothing where - headScript = fromPlutusScript Head.validatorScript + headScript = fromPlutusScript headScriptValidator data ContestObservation = ContestObservation { contestedThreadOutput :: (TxIn, TxOut CtxUTxO) @@ -505,11 +510,12 @@ instance Arbitrary ContestObservation where -- | Identify a close tx by lookup up the input spending the Head output and -- decoding its redeemer. observeContestTx :: + SerialisedScriptRegistry -> -- | A UTxO set to lookup tx inputs UTxO -> Tx -> Maybe ContestObservation -observeContestTx utxo tx = do +observeContestTx SerialisedScriptRegistry{headScriptValidator} utxo tx = do let inputUTxO = resolveInputsUTxO utxo tx (headInput, headOutput) <- findTxOutByScript @PlutusScriptV3 inputUTxO headScript redeemer <- findRedeemerSpending tx headInput @@ -531,7 +537,7 @@ observeContestTx utxo tx = do } _ -> Nothing where - headScript = fromPlutusScript Head.validatorScript + headScript = fromPlutusScript headScriptValidator decodeDatum headDatum = case fromScriptData headDatum of @@ -547,11 +553,12 @@ instance Arbitrary FanoutObservation where -- | Identify a fanout tx by lookup up the input spending the Head output and -- decoding its redeemer. observeFanoutTx :: + SerialisedScriptRegistry -> -- | A UTxO set to lookup tx inputs UTxO -> Tx -> Maybe FanoutObservation -observeFanoutTx utxo tx = do +observeFanoutTx SerialisedScriptRegistry{headScriptValidator} utxo tx = do let inputUTxO = resolveInputsUTxO utxo tx (headInput, headOutput) <- findTxOutByScript @PlutusScriptV3 inputUTxO headScript headId <- findStateToken headOutput @@ -560,7 +567,7 @@ observeFanoutTx utxo tx = do Head.Fanout{} -> pure FanoutObservation{headId} _ -> Nothing where - headScript = fromPlutusScript Head.validatorScript + headScript = fromPlutusScript headScriptValidator newtype AbortObservation = AbortObservation {headId :: HeadId} deriving stock (Eq, Show, Generic) @@ -570,11 +577,12 @@ instance Arbitrary AbortObservation where -- | Identify an abort tx by looking up the input spending the Head output and -- decoding its redeemer. observeAbortTx :: + SerialisedScriptRegistry -> -- | A UTxO set to lookup tx inputs UTxO -> Tx -> Maybe AbortObservation -observeAbortTx utxo tx = do +observeAbortTx SerialisedScriptRegistry{headScriptValidator} utxo tx = do let inputUTxO = resolveInputsUTxO utxo tx (headInput, headOutput) <- findTxOutByScript @PlutusScriptV3 inputUTxO headScript headId <- findStateToken headOutput @@ -582,7 +590,7 @@ observeAbortTx utxo tx = do Head.Abort -> pure $ AbortObservation headId _ -> Nothing where - headScript = fromPlutusScript Head.validatorScript + headScript = fromPlutusScript headScriptValidator -- * Cardano specific identifiers diff --git a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs index ea0f66182f6..5e43850ed0b 100644 --- a/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/StateSpec.hs @@ -115,6 +115,7 @@ import Hydra.Tx.Contest (ClosedThreadOutput (closedContesters)) import Hydra.Tx.ContestationPeriod (toNominalDiffTime) import Hydra.Tx.Deposit (DepositObservation (..), observeDepositTx) import Hydra.Tx.Recover (RecoverObservation (..), observeRecoverTx) +import Hydra.Tx.ScriptRegistry (serialisedScriptRegistry) import Hydra.Tx.Snapshot (ConfirmedSnapshot (InitialSnapshot, initialUTxO)) import Hydra.Tx.Snapshot qualified as Snapshot import Hydra.Tx.Utils (dummyValidatorScript, splitUTxO) @@ -183,7 +184,7 @@ spec = parallel $ do let utxo = UTxO.singleton (seedInput, seedTxOut) let (tx', utxo') = applyMutation mutation (tx, utxo) - originalIsObserved = property $ isRight (observeInitTx tx) + originalIsObserved = property $ isRight (observeInitTx serialisedScriptRegistry tx) -- We expected mutated transaction to still be valid, but not observed. mutatedIsValid = property $ @@ -194,7 +195,7 @@ spec = parallel $ do | otherwise -> False mutatedIsNotObserved = - observeInitTx tx' === Left expected + observeInitTx serialisedScriptRegistry tx' === Left expected pure $ conjoin @@ -224,7 +225,7 @@ spec = parallel $ do mutation <- pick $ genCommitTxMutation utxo tx let (tx', utxo') = applyMutation mutation (tx, utxo) - originalIsObserved = property $ isJust $ observeCommitTx testNetworkId utxo tx + originalIsObserved = property $ isJust $ observeCommitTx testNetworkId serialisedScriptRegistry utxo tx -- We expected mutated transaction to still be valid, but not observed. mutatedIsValid = @@ -235,7 +236,7 @@ spec = parallel $ do | otherwise -> property False & counterexample (show ok) mutatedIsNotObserved = - isNothing $ observeCommitTx testNetworkId utxo' tx' + isNothing $ observeCommitTx testNetworkId serialisedScriptRegistry utxo' tx' pure $ conjoin @@ -332,7 +333,7 @@ spec = parallel $ do prop "observes deposit" $ forAllDeposit $ \utxo tx -> - case observeDepositTx testNetworkId tx of + case observeDepositTx testNetworkId serialisedScriptRegistry tx of Just DepositObservation{} -> property True Nothing -> False & counterexample ("observeDepositTx ignored transaction: " <> renderTxWithUTxO utxo tx) @@ -343,7 +344,7 @@ spec = parallel $ do prop "observes recover" $ forAllRecover $ \utxo tx -> - case observeRecoverTx testNetworkId utxo tx of + case observeRecoverTx testNetworkId serialisedScriptRegistry utxo tx of Just RecoverObservation{} -> property True Nothing -> False & counterexample ("observeRecoverTx ignored transaction: " <> renderTxWithUTxO utxo tx) @@ -354,7 +355,7 @@ spec = parallel $ do prop "observes distributed outputs" $ forAllDecrement' $ \toDistribute utxo tx -> - case observeDecrementTx utxo tx of + case observeDecrementTx serialisedScriptRegistry utxo tx of Just DecrementObservation{distributedOutputs} -> distributedOutputs === toDistribute Nothing -> @@ -447,7 +448,7 @@ prop_observeAnyTx = genericCoverTable [transition] $ do let expectedHeadId = chainStateHeadId st utxo = getKnownUTxO st <> getKnownUTxO otherSt <> additionalUTxO <> additionalUTxO' - case observeHeadTx (networkId ctx) utxo tx of + case observeHeadTx (networkId ctx) serialisedScriptRegistry utxo tx of NoHeadTx -> False & counterexample ("observeHeadTx ignored transaction: " <> renderTxWithUTxO utxo tx) -- NOTE: we don't have the generated headId easily accessible in the initial state diff --git a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs index f08d9d55c5f..6b5633fa425 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxSpec.hs @@ -50,7 +50,7 @@ import Hydra.Tx.BlueprintTx (CommitBlueprintTx (..)) import Hydra.Tx.Commit (commitTx) import Hydra.Tx.HeadId (headIdToCurrencySymbol, mkHeadId) import Hydra.Tx.Init (mkInitialOutput) -import Hydra.Tx.ScriptRegistry (registryUTxO) +import Hydra.Tx.ScriptRegistry (registryUTxO, serialisedScriptRegistry) import Hydra.Tx.Utils (verificationKeyToOnChainId) import Test.Cardano.Ledger.Shelley.Arbitrary (genMetadata') import Test.Hydra.Prelude @@ -112,7 +112,7 @@ spec = genericCoverTable [transition] $ counterexample (show transition) $ let utxo = getKnownUTxO st <> additionalUTxO - in case observeHeadTx testNetworkId utxo tx of + in case observeHeadTx testNetworkId serialisedScriptRegistry utxo tx of NoHeadTx -> property False Init{} -> transition === Transition.Init Abort{} -> transition === Transition.Abort diff --git a/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs b/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs index 621f190fadf..26939cd393d 100644 --- a/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs +++ b/hydra-node/test/Hydra/Chain/Direct/TxTraceSpec.hs @@ -64,7 +64,7 @@ import Hydra.Tx.HeadId (headIdToCurrencySymbol, mkHeadId) import Hydra.Tx.Init (mkHeadOutput) import Hydra.Tx.IsTx (hashUTxO, utxoFromTx) import Hydra.Tx.Party (partyToChain) -import Hydra.Tx.ScriptRegistry (ScriptRegistry, registryUTxO) +import Hydra.Tx.ScriptRegistry (ScriptRegistry, registryUTxO, serialisedScriptRegistry) import Hydra.Tx.Snapshot (ConfirmedSnapshot (..), Snapshot (..), SnapshotNumber (..), SnapshotVersion (..), number) import PlutusTx.Builtins (toBuiltin) import Test.Hydra.Tx.Fixture (alice, bob, carol, testNetworkId) @@ -568,7 +568,7 @@ performTx result = let validationError = getValidationError tx utxo when (isNothing validationError) $ do put $ adjustUTxO tx utxo - let observation = observeHeadTx Fixture.testNetworkId utxo tx + let observation = observeHeadTx Fixture.testNetworkId serialisedScriptRegistry utxo tx pure TxResult { constructedTx = Right tx diff --git a/hydra-tx/src/Hydra/Tx/Deposit.hs b/hydra-tx/src/Hydra/Tx/Deposit.hs index cd774caeb10..11163080564 100644 --- a/hydra-tx/src/Hydra/Tx/Deposit.hs +++ b/hydra-tx/src/Hydra/Tx/Deposit.hs @@ -13,6 +13,7 @@ import Hydra.Contract.Commit qualified as Commit import Hydra.Contract.Deposit qualified as Deposit import Hydra.Plutus.Extras.Time (posixFromUTCTime) import Hydra.Tx (CommitBlueprintTx (..), HeadId, fromCurrencySymbol, headIdToCurrencySymbol) +import Hydra.Tx.ScriptRegistry (SerialisedScriptRegistry (..)) import Hydra.Tx.Utils (addMetadata, mkHydraHeadV1TxName) import PlutusLedgerApi.V3 (POSIXTime) @@ -72,9 +73,10 @@ data DepositObservation = DepositObservation observeDepositTx :: NetworkId -> + SerialisedScriptRegistry -> Tx -> Maybe DepositObservation -observeDepositTx networkId tx = do +observeDepositTx networkId SerialisedScriptRegistry{} tx = do -- TODO: could just use the first output and fail otherwise (TxIn depositTxId _, depositOut) <- findTxOutByAddress depositAddress tx (headId, deposited, deadline) <- observeDepositTxOut (networkIdToNetwork networkId) (toUTxOContext depositOut) @@ -93,7 +95,10 @@ observeDepositTx networkId tx = do depositAddress = mkScriptAddress @PlutusScriptV3 networkId depositScript -observeDepositTxOut :: Network -> TxOut CtxUTxO -> Maybe (HeadId, UTxO, POSIXTime) +observeDepositTxOut :: + Network -> + TxOut CtxUTxO -> + Maybe (HeadId, UTxO, POSIXTime) observeDepositTxOut network depositOut = do dat <- case txOutDatum depositOut of TxOutDatumInline d -> pure d diff --git a/hydra-tx/src/Hydra/Tx/Recover.hs b/hydra-tx/src/Hydra/Tx/Recover.hs index 9505df15eab..43f5a862158 100644 --- a/hydra-tx/src/Hydra/Tx/Recover.hs +++ b/hydra-tx/src/Hydra/Tx/Recover.hs @@ -14,6 +14,7 @@ import Hydra.Ledger.Cardano.Builder ( unsafeBuildTransaction, ) import Hydra.Tx (HeadId, mkHeadId) +import Hydra.Tx.ScriptRegistry (SerialisedScriptRegistry (..)) import Hydra.Tx.Utils (mkHydraHeadV1TxName) -- | Builds a recover transaction to recover locked funds from the v_deposit script. @@ -55,10 +56,11 @@ data RecoverObservation = RecoverObservation observeRecoverTx :: NetworkId -> + SerialisedScriptRegistry -> UTxO -> Tx -> Maybe RecoverObservation -observeRecoverTx networkId utxo tx = do +observeRecoverTx networkId SerialisedScriptRegistry{} utxo tx = do let inputUTxO = resolveInputsUTxO utxo tx (TxIn depositTxId _, depositOut) <- findTxOutByScript @PlutusScriptV3 inputUTxO depositScript dat <- txOutScriptData $ toTxContext depositOut diff --git a/hydra-tx/src/Hydra/Tx/ScriptRegistry.hs b/hydra-tx/src/Hydra/Tx/ScriptRegistry.hs index 72e4400f1d9..8e4d20a44c0 100644 --- a/hydra-tx/src/Hydra/Tx/ScriptRegistry.hs +++ b/hydra-tx/src/Hydra/Tx/ScriptRegistry.hs @@ -18,6 +18,10 @@ import Hydra.Cardano.Api ( pattern ReferenceScriptNone, ) import Hydra.Contract (ScriptInfo (..), scriptInfo) +import Hydra.Contract.Deposit qualified as Deposit +import Hydra.Contract.Head qualified as Head +import Hydra.Plutus (commitValidatorScript, initialValidatorScript) +import PlutusLedgerApi.Common (SerialisedScript) -- | Hydra scripts published as reference scripts at these UTxO. data ScriptRegistry = ScriptRegistry @@ -73,6 +77,22 @@ newScriptRegistry = , headScriptHash } = scriptInfo +data SerialisedScriptRegistry = SerialisedScriptRegistry + { initialScriptValidator :: SerialisedScript + , commitScriptValidator :: SerialisedScript + , headScriptValidator :: SerialisedScript + , depositScriptValidator :: SerialisedScript + } + +serialisedScriptRegistry :: SerialisedScriptRegistry +serialisedScriptRegistry = + SerialisedScriptRegistry + { initialScriptValidator = initialValidatorScript + , commitScriptValidator = commitValidatorScript + , headScriptValidator = Head.validatorScript + , depositScriptValidator = Deposit.validatorScript + } + -- | Get the UTxO that corresponds to a script registry. -- -- **Property**: