Fix genDecrementTx to use correct snapshots

Author: ch1bo

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

@@ -125,7 +125,7 @@ import Hydra.Snapshot (
   genConfirmedSnapshot,
   getSnapshot,
  )
-import Test.QuickCheck (choose, frequency, oneof, suchThat, vector)
+import Test.QuickCheck (choose, frequency, getPositive, oneof, vector)
 import Test.QuickCheck.Gen (elements)
 import Test.QuickCheck.Modifiers (Positive (Positive))
 
@@ -1045,13 +1045,22 @@ genCollectComTx = do
 genDecrementTx :: Int -> Gen (ChainContext, OpenState, Tx)
 genDecrementTx numParties = do
   ctx <- genHydraContextFor numParties
-  (_, stOpen@OpenState{headId}) <- genStOpen ctx
+  (u0, stOpen@OpenState{headId}) <- genStOpen ctx
   cctx <- pickChainContext ctx
-  snapshot <- arbitrary `suchThat` (\Snapshot{utxoToDecommit} -> isJust utxoToDecommit)
+  snapshot <- do
+    number <- getPositive <$> arbitrary
+    (utxo, toDecommit) <- splitUTxO u0
+    pure Snapshot{headId, number, confirmed = [], utxo, utxoToDecommit = Just toDecommit}
   signatures <- arbitrary
   let openUTxO = getKnownUTxO stOpen
   pure (cctx, stOpen, unsafeDecrement cctx headId (ctxHeadParameters ctx) openUTxO snapshot signatures)
 
+splitUTxO :: UTxO -> Gen (UTxO, UTxO)
+splitUTxO utxo = do
+  ix <- choose (0, length utxo)
+  let (p1, p2) = splitAt ix (UTxO.pairs utxo)
+  pure (UTxO.fromPairs p1, UTxO.fromPairs p2)
+
 genCloseTx :: Int -> Gen (ChainContext, OpenState, Tx, ConfirmedSnapshot Tx)
 genCloseTx numParties = do
   ctx <- genHydraContextFor numParties

hydra-node/src/Hydra/Snapshot.hs

@@ -35,6 +35,7 @@ data Snapshot tx = Snapshot
   -- ^ The set of transactions that lead to 'utxo'
   , utxoToDecommit :: Maybe (UTxOType tx)
   -- ^ UTxO to be decommitted. Spec: Ûω
+  -- TODO: what is the difference between Noting and (Just mempty) here?
   }
   deriving stock (Generic)
 
@@ -179,6 +180,7 @@ genConfirmedSnapshot headId minSn utxo sks
     -- snapshots
     number <- arbitrary `suchThat` (> minSn)
     -- TODO: check whether we are fine with this not producing any decommitting utxo ever
+    -- TODO: use splitUTxO generator
     let snapshot = Snapshot{headId, number, utxo, confirmed = [], utxoToDecommit = mempty}
     let signatures = aggregate $ fmap (`sign` snapshot) sks
     pure $ ConfirmedSnapshot{snapshot, signatures}

hydra-node/test/Hydra/Chain/Direct/Contract/Decrement.hs

@@ -99,6 +99,7 @@ healthySnapshotNumber = 1
 
 healthySnapshot :: Snapshot Tx
 healthySnapshot =
+  -- TODO: use splitUTxO generator
   let (utxoToDecommit', utxo) = splitDecommitUTxO healthyUTxO
    in Snapshot
         { headId = mkHeadId testPolicyId