Move snapshot version into coordinated head state in open state

This respects the spec.
Also introduced newtype instead of plain natural.
This maintains consistency with snapshot number.
Also refactor version check to verify against previous instead of different.
Finally, also fixed how the balance utxo occurs in TxTraceSpec model spec.

hydra-node/src/Hydra/Chain.hs

@@ -27,7 +27,7 @@ import Hydra.HeadId (HeadId, HeadSeed)
 import Hydra.Ledger (ChainSlot, IsTx, UTxOType)
 import Hydra.OnChainId (OnChainId)
 import Hydra.Party (Party)
-import Hydra.Snapshot (ConfirmedSnapshot, Snapshot, SnapshotNumber)
+import Hydra.Snapshot (ConfirmedSnapshot, Snapshot, SnapshotNumber, SnapshotVersion)
 import Test.Cardano.Ledger.Core.Arbitrary ()
 import Test.QuickCheck.Instances.Semigroup ()
 import Test.QuickCheck.Instances.Time ()
@@ -73,7 +73,7 @@ data PostChainTx tx
       , snapshot :: Snapshot tx
       , signatures :: MultiSignature (Snapshot tx)
       }
-  | CloseTx {headId :: HeadId, headParameters :: HeadParameters, confirmedSnapshot :: ConfirmedSnapshot tx, version :: Integer, closeUTxOToDecommit :: UTxOType tx}
+  | CloseTx {headId :: HeadId, headParameters :: HeadParameters, confirmedSnapshot :: ConfirmedSnapshot tx, version :: SnapshotVersion, closeUTxOToDecommit :: UTxOType tx}
   | ContestTx {headId :: HeadId, headParameters :: HeadParameters, confirmedSnapshot :: ConfirmedSnapshot tx}
   | FanoutTx {utxo :: UTxOType tx, utxoToDecommit :: Maybe (UTxOType tx), headSeed :: HeadSeed, contestationDeadline :: UTCTime}
   deriving stock (Generic)

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

@@ -118,6 +118,7 @@ import Hydra.Snapshot (
   ConfirmedSnapshot (..),
   Snapshot (..),
   SnapshotNumber,
+  SnapshotVersion,
   genConfirmedSnapshot,
   getSnapshot,
  )
@@ -518,7 +519,7 @@ close ::
   -- | 'Tx' validity upper bound
   PointInTime ->
   -- | Current off-chain snapshot version
-  Integer ->
+  SnapshotVersion ->
   Either CloseTxError Tx
 close ctx spendableUTxO headId HeadParameters{parties, contestationPeriod} confirmedSnapshot startSlotNo pointInTime offChainVersion = do
   pid <- headIdToPolicyId headId ?> InvalidHeadIdInClose{headId}
@@ -1193,10 +1194,10 @@ unsafeClose ::
   SlotNo ->
   -- | 'Tx' validity upper bound
   PointInTime ->
-  Integer ->
+  SnapshotVersion ->
   Tx
-unsafeClose ctx spendableUTxO headId headParameters confirmedSnapshot startSlotNo pointInTime version =
-  either (error . show) id $ close ctx spendableUTxO headId headParameters confirmedSnapshot startSlotNo pointInTime version
+unsafeClose ctx spendableUTxO headId headParameters confirmedSnapshot startSlotNo pointInTime offChainVersion =
+  either (error . show) id $ close ctx spendableUTxO headId headParameters confirmedSnapshot startSlotNo pointInTime offChainVersion
 
 unsafeCollect ::
   ChainContext ->

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

@@ -77,7 +77,7 @@ import Hydra.OnChainId (OnChainId (..))
 import Hydra.Party (Party, partyFromChain, partyToChain)
 import Hydra.Plutus.Extras (posixFromUTCTime, posixToUTCTime)
 import Hydra.Plutus.Orphans ()
-import Hydra.Snapshot (Snapshot (..), SnapshotNumber, fromChainSnapshot)
+import Hydra.Snapshot (Snapshot (..), SnapshotNumber, SnapshotVersion, fromChainSnapshot)
 import PlutusLedgerApi.V2 (CurrencySymbol (CurrencySymbol), fromBuiltin, getPubKeyHash, toBuiltin)
 import PlutusLedgerApi.V2 qualified as Plutus
 import Test.QuickCheck (vectorOf)
@@ -480,7 +480,7 @@ decrementTx scriptRegistry vk headId headParameters (headInput, headOutput) snap
         , snapshotNumber = toInteger number
         , contestationPeriod = toChain contestationPeriod
         , headId = headIdToCurrencySymbol headId
-        , version = version -- TODO: should version here come from a snapshot or previous datum?
+        , version = toInteger version -- TODO: should version here come from a snapshot or previous datum?
         }
   Snapshot{utxo, utxoToDecommit, number, version} = snapshot
 
@@ -497,7 +497,7 @@ data ClosingSnapshot
         -- SignableRepresentation of 'Snapshot' is in fact the snapshotNumber
         -- and the closeUtxoHash as also included above
         signatures :: MultiSignature (Snapshot Tx)
-      , version :: Integer
+      , version :: SnapshotVersion
       }
 
 data CloseTxError
@@ -522,7 +522,7 @@ closeTx ::
   OpenThreadOutput ->
   -- | Head identifier
   HeadId ->
-  Integer ->
+  SnapshotVersion ->
   Tx
 closeTx scriptRegistry vk closing startSlotNo (endSlotNo, utcTime) openThreadOutput headId offChainVersion =
   unsafeBuildTransaction $
@@ -556,7 +556,7 @@ closeTx scriptRegistry vk closing startSlotNo (endSlotNo, utcTime) openThreadOut
     toScriptData
       Head.Close
         { signature
-        , version = offChainVersion
+        , version = toInteger offChainVersion
         , utxoToDecommitHash = toBuiltin decommitUTxOHashBytes
         }
 
@@ -569,15 +569,15 @@ closeTx scriptRegistry vk closing startSlotNo (endSlotNo, utcTime) openThreadOut
         { snapshotNumber
         , utxoHash = toBuiltin utxoHashBytes
         , utxoToDecommitHash =
-            if offChainVersion /= version
+            if offChainVersion == version - 1
               then toBuiltin $ hashUTxO @Tx mempty
               else toBuiltin decommitUTxOHashBytes
         , parties = openParties
         , contestationDeadline
         , contestationPeriod = openContestationPeriod
         , headId = headIdToCurrencySymbol headId
         , contesters = []
-        , version = version
+        , version = toInteger version
         }
 
   (UTxOHash utxoHashBytes, UTxOHash decommitUTxOHashBytes, snapshotNumber, signature, version) = case closing of
@@ -671,7 +671,7 @@ contestTx scriptRegistry vk Snapshot{number, utxo, utxoToDecommit, version} sig
         , contestationPeriod = onChainConstestationPeriod
         , headId = headIdToCurrencySymbol headId
         , contesters = contester : closedContesters
-        , version = version -- TODO: should version here come from a Snapshot or previous datum?
+        , version = toInteger version -- TODO: should version here come from a Snapshot or previous datum?
         }
   utxoHash = toBuiltin $ hashUTxO @Tx utxo
 

hydra-node/src/Hydra/HeadLogic.hs

@@ -96,7 +96,7 @@ import Hydra.Ledger (
 import Hydra.Network.Message (Connectivity (..), HydraVersionedProtocolNumber (..), KnownHydraVersions (..), Message (..), NetworkEvent (..))
 import Hydra.OnChainId (OnChainId)
 import Hydra.Party (Party (vkey))
-import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..), SnapshotNumber, getSnapshot)
+import Hydra.Snapshot (ConfirmedSnapshot (..), Snapshot (..), SnapshotNumber, bumpSnapshotVersion, getSnapshot, snapshotVersion)
 
 defaultTTL :: TTL
 defaultTTL = 5
@@ -413,7 +413,7 @@ onOpenNetworkReqSn env ledger st otherParty sn requestedTxIds mDecommitTx =
                     , utxo = u
                     , confirmed = requestedTxIds
                     , utxoToDecommit = mUtxoToDecommit
-                    , version = version
+                    , version
                     }
             -- Spec: σᵢ
             let snapshotSignature = sign signingKey nextSnapshot
@@ -496,7 +496,9 @@ onOpenNetworkReqSn env ledger st otherParty sn requestedTxIds mDecommitTx =
 
   CoordinatedHeadState{confirmedSnapshot, seenSnapshot, allTxs, localTxs} = coordinatedHeadState
 
-  OpenState{parameters, coordinatedHeadState, currentSlot, headId, version} = st
+  OpenState{parameters, coordinatedHeadState, currentSlot, headId} = st
+
+  Snapshot{version} = getSnapshot confirmedSnapshot
 
   Environment{signingKey} = env
 
@@ -751,7 +753,9 @@ onOpenClientClose st =
  where
   CoordinatedHeadState{confirmedSnapshot} = coordinatedHeadState
 
-  OpenState{coordinatedHeadState, headId, parameters, version} = st
+  OpenState{coordinatedHeadState, headId, parameters} = st
+
+  Snapshot{version} = getSnapshot confirmedSnapshot
 
 -- | Observe a close transaction. If the closed snapshot number is smaller than
 -- our last confirmed, we post a contest transaction. Also, we do schedule a
@@ -839,11 +843,23 @@ onClosedClientFanout ::
   ClosedState tx ->
   Outcome tx
 onClosedClientFanout closedState =
-  cause OnChainEffect{postChainTx = FanoutTx{utxo, utxoToDecommit = if version == snapshotVersion then utxoToDecommit else mempty, headSeed, contestationDeadline}}
+  cause
+    OnChainEffect
+      { postChainTx =
+          FanoutTx
+            { utxo
+            , utxoToDecommit =
+                if offChainVersion == version - 1
+                  then mempty
+                  else utxoToDecommit
+            , headSeed
+            , contestationDeadline
+            }
+      }
  where
-  Snapshot{utxo, utxoToDecommit, version = snapshotVersion} = getSnapshot confirmedSnapshot
+  Snapshot{utxo, utxoToDecommit, version} = getSnapshot confirmedSnapshot
 
-  ClosedState{headSeed, confirmedSnapshot, contestationDeadline, version} = closedState
+  ClosedState{headSeed, confirmedSnapshot, contestationDeadline, version = offChainVersion} = closedState
 
 -- | Observe a fanout transaction by finalize the head state and notifying
 -- clients about it.
@@ -1070,10 +1086,10 @@ aggregate st = \case
           , coordinatedHeadState =
             CoordinatedHeadState
               { confirmedSnapshot
+              , version
               }
           , headId
           , headSeed
-          , version
           } ->
           Closed
             ClosedState
@@ -1113,24 +1129,25 @@ aggregate st = \case
   HeadOpened{chainState, initialUTxO} ->
     case st of
       Initial InitialState{parameters, headId, headSeed} ->
-        Open
-          OpenState
-            { parameters
-            , coordinatedHeadState =
-                CoordinatedHeadState
-                  { localUTxO = initialUTxO
-                  , allTxs = mempty
-                  , localTxs = mempty
-                  , confirmedSnapshot = InitialSnapshot{headId, initialUTxO}
-                  , seenSnapshot = NoSeenSnapshot
-                  , decommitTx = Nothing
-                  }
-            , chainState
-            , headId
-            , headSeed
-            , currentSlot = chainStateSlot chainState
-            , version = 0
-            }
+        let confirmedSnapshot = InitialSnapshot{headId, initialUTxO}
+         in Open
+              OpenState
+                { parameters
+                , coordinatedHeadState =
+                    CoordinatedHeadState
+                      { localUTxO = initialUTxO
+                      , allTxs = mempty
+                      , localTxs = mempty
+                      , confirmedSnapshot
+                      , seenSnapshot = NoSeenSnapshot
+                      , decommitTx = Nothing
+                      , version = snapshotVersion confirmedSnapshot
+                      }
+                , chainState
+                , headId
+                , headSeed
+                , currentSlot = chainStateSlot chainState
+                }
       _otherState -> st
   SnapshotConfirmed{snapshot, signatures} ->
     case st of
@@ -1182,15 +1199,14 @@ aggregate st = \case
   DecommitFinalized ->
     case st of
       Open
-        os@OpenState
-          { coordinatedHeadState
-          , version
-          } ->
+        os@OpenState{coordinatedHeadState = chs@CoordinatedHeadState{confirmedSnapshot}} ->
           Open
             os
               { coordinatedHeadState =
-                  coordinatedHeadState{decommitTx = Nothing}
-              , version = version + 1
+                  chs
+                    { decommitTx = Nothing
+                    , confirmedSnapshot = bumpSnapshotVersion confirmedSnapshot
+                    }
               }
       _otherState -> st
   HeadIsReadyToFanout ->

hydra-node/src/Hydra/HeadLogic/State.hs

@@ -12,7 +12,7 @@ import Hydra.Crypto (Signature)
 import Hydra.HeadId (HeadId, HeadSeed)
 import Hydra.Ledger (ChainSlot, IsTx (..))
 import Hydra.Party (Party)
-import Hydra.Snapshot (ConfirmedSnapshot, Snapshot (..), SnapshotNumber)
+import Hydra.Snapshot (ConfirmedSnapshot, Snapshot (..), SnapshotNumber, SnapshotVersion)
 
 -- | The main state of the Hydra protocol state machine. It holds both, the
 -- overall protocol state, but also the off-chain 'CoordinatedHeadState'.
@@ -115,7 +115,6 @@ data OpenState tx = OpenState
   , headId :: HeadId
   , currentSlot :: ChainSlot
   , headSeed :: HeadSeed
-  , version :: Integer
   }
   deriving stock (Generic)
 
@@ -133,7 +132,6 @@ instance (IsTx tx, Arbitrary (ChainStateType tx)) => Arbitrary (OpenState tx) wh
       <*> arbitrary
       <*> arbitrary
       <*> arbitrary
-      <*> arbitrary
 
 -- | Off-chain state of the Coordinated Head protocol.
 data CoordinatedHeadState tx = CoordinatedHeadState
@@ -152,6 +150,8 @@ data CoordinatedHeadState tx = CoordinatedHeadState
   , decommitTx :: Maybe tx
   -- ^ Client requested to decommit a 'UTxO' which is present in the
   -- 'ConfirmedSnapshot'.
+  , version :: SnapshotVersion
+  -- ^ Last seen open state version.
   }
   deriving stock (Generic)
 
@@ -213,7 +213,8 @@ data ClosedState tx = ClosedState
   , chainState :: ChainStateType tx
   , headId :: HeadId
   , headSeed :: HeadSeed
-  , version :: Integer
+  , version :: SnapshotVersion
+  -- ^ Last seen open state version.
   }
   deriving stock (Generic)
 

hydra-node/src/Hydra/Snapshot.hs

@@ -27,6 +27,14 @@ newtype SnapshotNumber
 instance Arbitrary SnapshotNumber where
   arbitrary = UnsafeSnapshotNumber <$> arbitrary
 
+newtype SnapshotVersion
+  = UnsafeSnapshotVersion Natural
+  deriving stock (Eq, Ord, Generic)
+  deriving newtype (Show, ToJSON, FromJSON, ToCBOR, FromCBOR, Real, Num, Enum, Integral)
+
+instance Arbitrary SnapshotVersion where
+  arbitrary = UnsafeSnapshotVersion <$> arbitrary
+
 data Snapshot tx = Snapshot
   { headId :: HeadId
   , number :: SnapshotNumber
@@ -38,7 +46,7 @@ data Snapshot tx = Snapshot
   -- TODO: what is the difference between Noting and (Just mempty) here?
   -- | Snapshot version is 0 at start and is only bumped further on each
   -- decommit that happens.
-  , version :: Integer
+  , version :: SnapshotVersion
   }
   deriving stock (Generic)
 
@@ -99,11 +107,11 @@ instance IsTx tx => Arbitrary (Snapshot tx) where
 instance forall tx. IsTx tx => SignableRepresentation (Snapshot tx) where
   getSignableRepresentation Snapshot{number, headId, utxo, utxoToDecommit, version} =
     LBS.toStrict $
-      serialise (toData $ toBuiltin $ serialiseToRawBytes headId)
-        <> serialise (toData $ toBuiltin $ toInteger number) -- CBOR(I(integer))
-        <> serialise (toData $ toBuiltin $ hashUTxO @tx utxo) -- CBOR(B(bytestring)
+      serialise (toData . toBuiltin $ serialiseToRawBytes headId)
+        <> serialise (toData . toBuiltin $ toInteger number) -- CBOR(I(integer))
+        <> serialise (toData . toBuiltin $ hashUTxO @tx utxo) -- CBOR(B(bytestring)
         <> serialise (toData . toBuiltin . hashUTxO @tx $ fromMaybe mempty utxoToDecommit) -- CBOR(B(bytestring)
-        <> serialise (toData $ toBuiltin version) -- CBOR(I(integer))
+        <> serialise (toData . toBuiltin $ toInteger version) -- CBOR(I(integer))
 
 instance (Typeable tx, ToCBOR (UTxOType tx), ToCBOR (TxIdType tx)) => ToCBOR (Snapshot tx) where
   toCBOR Snapshot{headId, number, utxo, confirmed, utxoToDecommit, version} =
@@ -159,6 +167,17 @@ getSnapshot = \case
       }
   ConfirmedSnapshot{snapshot} -> snapshot
 
+bumpSnapshotVersion :: ConfirmedSnapshot tx -> ConfirmedSnapshot tx
+bumpSnapshotVersion = \case
+  csn@InitialSnapshot{} -> csn
+  csn@ConfirmedSnapshot{snapshot = sn@Snapshot{version = confirmedSnVersion}} ->
+    csn{snapshot = sn{version = confirmedSnVersion + 1}}
+
+snapshotVersion :: ConfirmedSnapshot tx -> SnapshotVersion
+snapshotVersion = \case
+  InitialSnapshot{} -> UnsafeSnapshotVersion 0
+  ConfirmedSnapshot{snapshot = Snapshot{version}} -> version
+
 -- | Tell whether a snapshot is the initial snapshot coming from the collect-com
 -- transaction.
 isInitialSnapshot :: ConfirmedSnapshot tx -> Bool
@@ -186,7 +205,7 @@ genConfirmedSnapshot ::
   -- Otherwise we generate only `ConfirmedSnapshot` with a number strictly superior to
   -- this lower bound.
   SnapshotNumber ->
-  Integer ->
+  SnapshotVersion ->
   UTxOType tx ->
   Maybe (UTxOType tx) ->
   [SigningKey HydraKey] ->

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

@@ -216,9 +216,10 @@ prop_verifyOffChainSignatures =
           onChainSig = List.head . toPlutusSignatures $ aggregate [offChainSig]
           onChainParty = partyToChain $ deriveParty sk
           snapshotNumber = toInteger number
+          snapshotVersion = toInteger version
           utxoHash = (toBuiltin $ hashUTxO @SimpleTx utxo)
           utxoToDecommitHash = (toBuiltin . hashUTxO @SimpleTx $ fromMaybe mempty utxoToDecommit)
-       in verifyPartySignature (headIdToCurrencySymbol headId) snapshotNumber utxoHash utxoToDecommitHash version onChainParty onChainSig
+       in verifyPartySignature (headIdToCurrencySymbol headId) snapshotNumber utxoHash utxoToDecommitHash snapshotVersion onChainParty onChainSig
             & counterexample ("headId: " <> show headId)
             & counterexample ("signed: " <> show onChainSig)
             & counterexample ("party: " <> show onChainParty)
@@ -234,6 +235,7 @@ prop_verifySnapshotSignatures =
           onChainParties = partyToChain <$> parties
           signatures = toPlutusSignatures $ aggregate [sign sk snapshot | sk <- sks]
           snapshotNumber = toInteger number
+          snapshotVersion = toInteger version
           utxoHash = toBuiltin (hashUTxO @SimpleTx utxo)
           utxoToDecommitHash = (toBuiltin . hashUTxO @SimpleTx $ fromMaybe mempty utxoToDecommit)
-       in verifySnapshotSignature onChainParties (headIdToCurrencySymbol headId) snapshotNumber utxoHash utxoToDecommitHash version signatures
+       in verifySnapshotSignature onChainParties (headIdToCurrencySymbol headId) snapshotNumber utxoHash utxoToDecommitHash snapshotVersion signatures