Merge pull request #1162 from input-output-hk/inline-datums

Protocol change: Inline datums

Author: ch1bo

CHANGELOG.md

@@ -36,8 +36,13 @@ changes.
 
 - Persist network messages on disk in order to gracefully handle crashes
 
-- **BREAKING** Changes to Hydra script hashes due to upgrading our toolchain to
-  GHC 9.6
+- **BREAKING** Changes to Hydra scripts:
+  - Switch to using inline datums instead of (optionally) published datums in
+    transactions.
+  - Upgrading our toolchain to GHC 9.6
+
+- **BREAKING** Changes to persisted state:
+  - The internal chain state serialization changed when switching to inline datums.
 
 ## [0.13.0] - 2023-10-03
 

fourmolu.yaml

@@ -11,3 +11,4 @@ fixities:
   - infixr 0 $
   - infixr 1 &
   - infixl 3 <|>
+  - infixr 3 &&

hydra-cluster/test/Test/ChainObserverSpec.hs

@@ -53,7 +53,7 @@ spec = do
                 chainObserverSees observer "HeadInitTx" headId
 
                 requestCommitTx hydraNode mempty >>= submitTx cardanoNode
-                waitFor hydraTracer 600 [hydraNode] $
+                waitFor hydraTracer 5 [hydraNode] $
                   output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId]
 
                 chainObserverSees observer "HeadCommitTx" headId
@@ -63,7 +63,7 @@ spec = do
 
                 chainObserverSees observer "HeadCloseTx" headId
 
-                waitFor hydraTracer 600 [hydraNode] $
+                waitFor hydraTracer 50 [hydraNode] $
                   output "ReadyToFanout" ["headId" .= headId]
 
                 send hydraNode $ input "Fanout" []

hydra-node/golden/ChainState.json

@@ -80,7 +80,6 @@ import Hydra.Chain.Direct.Tx (
   NotAnInit (..),
   OpenThreadOutput (..),
   UTxOHash (UTxOHash),
-  UTxOWithScript,
   abortTx,
   closeTx,
   collectComTx,
@@ -241,8 +240,8 @@ allVerificationKeys ChainContext{peerVerificationKeys, ownVerificationKey} =
 
 data InitialState = InitialState
   { initialThreadOutput :: InitialThreadOutput
-  , initialInitials :: [UTxOWithScript]
-  , initialCommits :: [UTxOWithScript]
+  , initialInitials :: [(TxIn, TxOut CtxUTxO)]
+  , initialCommits :: [(TxIn, TxOut CtxUTxO)]
   , headId :: HeadId
   , seedTxIn :: TxIn
   }
@@ -253,10 +252,8 @@ instance HasKnownUTxO InitialState where
   getKnownUTxO st =
     UTxO $
       Map.fromList $
-        take2Of3 initialThreadUTxO : (take2Of3 <$> (initialInitials <> initialCommits))
+        initialThreadUTxO : initialCommits <> initialInitials
    where
-    take2Of3 (a, b, _c) = (a, b)
-
     InitialState
       { initialThreadOutput = InitialThreadOutput{initialThreadUTxO}
       , initialInitials
@@ -274,10 +271,10 @@ data OpenState = OpenState
 
 instance HasKnownUTxO OpenState where
   getKnownUTxO st =
-    UTxO.singleton (i, o)
+    UTxO.singleton openThreadUTxO
    where
     OpenState
-      { openThreadOutput = OpenThreadOutput{openThreadUTxO = (i, o, _)}
+      { openThreadOutput = OpenThreadOutput{openThreadUTxO}
       } = st
 
 data ClosedState = ClosedState
@@ -290,10 +287,10 @@ data ClosedState = ClosedState
 
 instance HasKnownUTxO ClosedState where
   getKnownUTxO st =
-    UTxO.singleton (i, o)
+    UTxO.singleton closedThreadUTxO
    where
     ClosedState
-      { closedThreadOutput = ClosedThreadOutput{closedThreadUTxO = (i, o, _)}
+      { closedThreadOutput = ClosedThreadOutput{closedThreadUTxO}
       } = st
 
 -- * Constructing transactions
@@ -354,7 +351,7 @@ ownInitial ChainContext{ownVerificationKey} st@InitialState{initialInitials} =
   foldl' go Nothing initialInitials
  where
   go (Just x) _ = Just x
-  go Nothing (i, out, _) = do
+  go Nothing (i, out) = do
     let vkh = verificationKeyHash ownVerificationKey
     guard $ hasMatchingPT st vkh (txOutValue out)
     pure (i, out, vkh)
@@ -403,10 +400,10 @@ abort ::
   UTxO ->
   Tx
 abort ctx st committedUTxO = do
-  let InitialThreadOutput{initialThreadUTxO = (i, o, dat)} = initialThreadOutput
-      initials = Map.fromList $ map tripleToPair initialInitials
-      commits = Map.fromList $ map tripleToPair initialCommits
-   in case abortTx committedUTxO scriptRegistry ownVerificationKey (i, o, dat) headTokenScript initials commits of
+  let InitialThreadOutput{initialThreadUTxO = (i, o)} = initialThreadOutput
+      initials = Map.fromList initialInitials
+      commits = Map.fromList initialCommits
+   in case abortTx committedUTxO scriptRegistry ownVerificationKey (i, o) headTokenScript initials commits of
         Left OverlappingInputs ->
           -- FIXME: This is a "should not happen" error. We should try to fix
           -- the arguments of abortTx to make it impossible of having
@@ -426,16 +423,14 @@ abort ctx st committedUTxO = do
     , seedTxIn
     } = st
 
-  tripleToPair (a, b, c) = (a, (b, c))
-
 -- | Construct a collect transaction based on the 'InitialState'. This will know
 -- collect all the committed outputs.
 collect ::
   ChainContext ->
   InitialState ->
   Tx
 collect ctx st = do
-  let commits = Map.fromList $ fmap tripleToPair initialCommits
+  let commits = Map.fromList initialCommits
    in collectComTx networkId scriptRegistry ownVerificationKey initialThreadOutput commits headId
  where
   ChainContext{networkId, ownVerificationKey, scriptRegistry} = ctx
@@ -446,8 +441,6 @@ collect ctx st = do
     , headId
     } = st
 
-  tripleToPair (a, b, c) = (a, (b, c))
-
 -- | Construct a close transaction based on the 'OpenState' and a confirmed
 -- snapshot.
 --  - 'SlotNo' parameter will be used as the 'Tx' lower bound.
@@ -519,15 +512,15 @@ fanout ::
   SlotNo ->
   Tx
 fanout ctx st utxo deadlineSlotNo = do
-  fanoutTx scriptRegistry utxo (i, o, dat) deadlineSlotNo headTokenScript
+  fanoutTx scriptRegistry utxo closedThreadUTxO deadlineSlotNo headTokenScript
  where
   headTokenScript = mkHeadTokenScript seedTxIn
 
   ChainContext{scriptRegistry} = ctx
 
   ClosedState{closedThreadOutput, seedTxIn} = st
 
-  ClosedThreadOutput{closedThreadUTxO = (i, o, dat)} = closedThreadOutput
+  ClosedThreadOutput{closedThreadUTxO} = closedThreadOutput
 
 -- * Observing Transitions
 
@@ -617,7 +610,7 @@ observeCommit ctx st tx = do
           { initialInitials =
               -- NOTE: A commit tx has been observed and thus we can
               -- remove all it's inputs from our tracked initials
-              filter ((`notElem` txIns' tx) . fst3) initialInitials
+              filter ((`notElem` txIns' tx) . fst) initialInitials
           , initialCommits =
               commitOutput : initialCommits
           }
@@ -631,8 +624,6 @@ observeCommit ctx st tx = do
     , headId
     } = st
 
-  fst3 (a, _b, _c) = a
-
 -- | Observe an collect transition using a 'InitialState' and 'observeCollectComTx'.
 -- This function checks the head id and ignores if not relevant.
 observeCollect ::