introduce SerialisedScriptRegistry to be passed during hydra tx obser…

…vations

to keep all serialized script references in one place.

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)
 

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

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

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,19 +577,20 @@ 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
   findRedeemerSpending tx headInput >>= \case
     Head.Abort -> pure $ AbortObservation headId
     _ -> Nothing
  where
-  headScript = fromPlutusScript Head.validatorScript
+  headScript = fromPlutusScript headScriptValidator
 
 -- * Cardano specific identifiers