Introduce OnChainHeadState to keep track of state

To build correct transactions for the on-chain protocol we need to
construct or provide datumhashes with the correct datums, but these
datums are only available from previous transactions' data so we must
keep state while observing the chain.

hydra-node/src/Hydra/Chain/Direct.hs

@@ -23,14 +23,7 @@ import Hydra.Chain (
   ChainComponent,
   PostChainTx (..),
  )
-import Hydra.Chain.Direct.Tx (constructTx, observeTx)
-import Hydra.Chain.Direct.Util (
-  Block,
-  Era,
-  defaultCodecs,
-  nullConnectTracers,
-  versions,
- )
+import Hydra.Chain.Direct.Tx (OnChainHeadState (Ready), constructTx, observeTx)
 import Hydra.Ledger.Cardano (generateWith)
 import Hydra.Logging (Tracer)
 import Ouroboros.Consensus.Cardano.Block (GenTx (..), HardForkBlock (BlockAlonzo))
@@ -192,7 +185,7 @@ txSubmissionClient queue =
   fromPostChainTx :: PostChainTx tx -> GenTx Block
   fromPostChainTx postChainTx = do
     let txIn = generateWith arbitrary 42
-        unsignedTx = constructTx txIn postChainTx
+        unsignedTx = constructTx (Ready txIn) postChainTx
     GenTxAlonzo $ mkShelleyTx unsignedTx
 
 --

hydra-node/src/Hydra/Chain/Direct/Tx.hs

@@ -25,8 +25,9 @@ import Cardano.Ledger.Val (inject)
 import qualified Data.Map as Map
 import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
-import Hydra.Chain (HeadParameters (..), OnChainTx (OnInitTx), PostChainTx (InitTx))
-import Hydra.Contract.Head (State (Initial))
+import Hydra.Chain (HeadParameters (..), OnChainTx (OnAbortTx, OnInitTx), PostChainTx (..))
+import qualified Hydra.Contract.Head as Head
+import qualified Hydra.Contract.Initial as Initial
 import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime, contestationPeriodToDiffTime)
 import Hydra.Data.Party (partyFromVerKey, partyToVerKey)
 import Hydra.Party (anonymousParty, vkey)
@@ -51,15 +52,23 @@ type Era = AlonzoEra StandardCrypto
 
 -- * Post Hydra Head transactions
 
+-- | Maintains information needed to construct on-chain transactions
+-- depending on the current state of the head.
+data OnChainHeadState
+  = Ready {seedTx :: TxIn StandardCrypto}
+  | Initial {commits :: (TxIn StandardCrypto, PubKeyHash)}
+  deriving (Eq, Show, Generic)
+
 -- | Construct the Head protocol transactions as Alonzo 'Tx'. Note that
 -- 'ValidatedTx' this produces an unbalanced, unsigned transaction and this type
 -- was used (in contrast to 'TxBody') to be able to express included datums,
 -- onto which at least the 'initTx' relies on.
-constructTx :: TxIn StandardCrypto -> PostChainTx tx -> ValidatedTx Era
-constructTx txIn = \case
-  InitTx p -> initTx p txIn
-  AbortTx _utxo -> abortTx (txIn, error "where is this coming from?")
-  _ -> error "not implemented"
+constructTx :: OnChainHeadState -> PostChainTx tx -> ValidatedTx Era
+constructTx txIn tx =
+  case (txIn, tx) of
+    (Ready{seedTx}, InitTx p) -> initTx p seedTx
+    (Initial{commits}, AbortTx _utxo) -> abortTx commits
+    _ -> error "not implemented"
 
 -- | Create the init transaction from some 'HeadParameters' and a single TxIn
 -- which will be used as unique parameter for minting NFTs.
@@ -102,7 +111,7 @@ initTx HeadParameters{contestationPeriod, parties} txIn =
 
   headDatum =
     Data . toData $
-      Initial
+      Head.Initial
         (contestationPeriodFromDiffTime contestationPeriod)
         (map (partyFromVerKey . vkey) parties)
 
@@ -162,7 +171,7 @@ observeInitTx :: ValidatedTx Era -> Maybe (OnChainTx tx)
 observeInitTx ValidatedTx{wits} = do
   (Data d) <- firstDatum
   fromData d >>= \case
-    Initial cp ps ->
+    Head.Initial cp ps ->
       pure $ OnInitTx (contestationPeriodToDiffTime cp) (map convertParty ps)
     _ -> Nothing
  where

hydra-node/test/Hydra/Chain/Direct/TxSpec.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 -- | Unit tests for our "hand-rolled" transactions as they are used in the
 -- "direct" chain component.
@@ -30,7 +31,7 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import Hydra.Chain (HeadParameters (..), PostChainTx (InitTx), toOnChainTx)
 import Hydra.Chain.Direct.Tx (constructTx, initTx, observeTx)
 import Hydra.Chain.Direct.Util (Era)
-import Hydra.Contract.Head (State (Initial))
+import qualified Hydra.Contract.Head as Head
 import qualified Hydra.Contract.Initial as Initial
 import Hydra.Data.ContestationPeriod (contestationPeriodFromDiffTime)
 import Hydra.Data.Party (partyFromVerKey)
@@ -40,7 +41,7 @@ import Plutus.V1.Ledger.Api (PubKeyHash (PubKeyHash), toBuiltin, toBuiltinData,
 import Shelley.Spec.Ledger.API (Coin (Coin), StrictMaybe (SJust), UTxO (UTxO))
 import Test.Cardano.Ledger.Alonzo.PlutusScripts (defaultCostModel)
 import Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
-import Test.QuickCheck (counterexample, (===), (==>))
+import Test.QuickCheck (Gen, counterexample, oneof, (===), (==>))
 import Test.QuickCheck.Instances ()
 
 -- TODO(SN): use real max tx size
@@ -51,11 +52,11 @@ spec :: Spec
 spec =
   parallel $ do
     prop "observeTx . constructTx roundtrip" $ \postTx txIn time ->
-      isImplemented postTx -- TODO(SN): test all constructors
+      isImplemented postTx txIn -- TODO(SN): test all constructors
         ==> observeTx (constructTx txIn postTx) === Just (toOnChainTx @SimpleTx time postTx)
 
     prop "transaction size below limit" $ \postTx txIn ->
-      isImplemented postTx -- TODO(SN): test all constructors
+      isImplemented postTx txIn -- TODO(SN): test all constructors
         ==> let tx = constructTx @SimpleTx txIn postTx
                 cbor = serialize tx
                 len = LBS.length cbor
@@ -73,7 +74,7 @@ spec =
             HeadParameters{contestationPeriod, parties} = params
             onChainPeriod = contestationPeriodFromDiffTime contestationPeriod
             onChainParties = map (partyFromVerKey . vkey) parties
-            datum = Initial onChainPeriod onChainParties
+            datum = Head.Initial onChainPeriod onChainParties
          in Map.elems (unTxDats dats) === [Data . toData $ toBuiltinData datum]
 
     describe "abortTx" $ do
@@ -103,11 +104,12 @@ spec =
               & counterexample ("Tx: " <> show tx)
               & counterexample ("Input utxo: " <> show utxo)
 
-isImplemented :: PostChainTx tx -> Bool
-isImplemented = \case
-  InitTx _ -> True
-  AbortTx _ -> True
-  _ -> False
+isImplemented :: PostChainTx tx -> OnChainHeadState -> Bool
+isImplemented tx st =
+  case (tx, st) of
+    (InitTx{}, Ready{}) -> True
+    (AbortTx{}, Initial{}) -> True
+    _ -> False
 
 -- | Evaluate all plutus scripts and return execution budgets of a given
 -- transaction (any included budgets are ignored).
@@ -139,3 +141,8 @@ txOutNFT (TxOut _ value _) =
     pure (policy, name)
 
   unitQuantity (_name, q) = q == 1
+
+instance Arbitrary OnChainHeadState where
+  arbitrary = oneof [Ready <$> arbitrary, Initial <$> ((,) <$> arbitrary <*> genPubKeyHash)]
+   where
+    genPubKeyHash = PubKeyHash . toBuiltin <$> (arbitrary :: Gen ByteString)