Fix all of state spec tests

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

@@ -129,7 +129,6 @@ import Test.Hydra.Tx.Gen (
  )
 import Test.QuickCheck (choose, frequency, oneof, suchThat, vector)
 import Test.QuickCheck.Gen (elements)
-import Test.QuickCheck.Modifiers (Positive (Positive))
 
 -- | A class for accessing the known 'UTxO' set in a type. This is useful to get
 -- all the relevant UTxO for resolving transaction inputs.
@@ -306,7 +305,7 @@ data ClosedState = ClosedState
 instance Arbitrary ClosedState where
   arbitrary = do
     -- XXX: Untangle the whole generator mess here
-    (_, st, _, _) <- genFanoutTx maxGenParties maxGenAssets
+    (_, st, _, _) <- genFanoutTx maxGenParties
     pure st
 
   shrink = genericShrink
@@ -1003,10 +1002,7 @@ genChainStateWithTx =
 
   genFanoutWithState :: Gen (ChainContext, ChainState, UTxO, Tx, ChainTransition)
   genFanoutWithState = do
-    Positive numParties <- arbitrary
-    Positive numOutputs <- arbitrary
-    (hctx, st, utxo, tx) <- genFanoutTx numParties numOutputs
-    ctx <- pickChainContext hctx
+    (ctx, st, utxo, tx) <- genFanoutTx maxGenParties
     pure (ctx, Closed st, utxo, tx, Fanout)
 
 -- ** Warning zone
@@ -1237,7 +1233,7 @@ genCloseTx numParties = do
   let cp = ctxContestationPeriod ctx
   (startSlot, pointInTime) <- genValidityBoundsFromContestationPeriod cp
   let utxo = getKnownUTxO stOpen
-  pure (cctx, stOpen, mempty, unsafeClose cctx utxo headId (ctxHeadParameters ctx) version snapshot startSlot pointInTime, snapshot)
+  pure (cctx, stOpen, utxo, unsafeClose cctx utxo headId (ctxHeadParameters ctx) version snapshot startSlot pointInTime, snapshot)
 
 genContestTx :: Gen (HydraContext, PointInTime, ClosedState, UTxO, Tx)
 genContestTx = do
@@ -1259,16 +1255,15 @@ genContestTx = do
   contestPointInTime <- genPointInTimeBefore (getContestationDeadline stClosed)
   pure (ctx, closePointInTime, stClosed, mempty, unsafeContest cctx utxo headId cp version contestSnapshot contestPointInTime)
 
-genFanoutTx :: Int -> Int -> Gen (HydraContext, ClosedState, UTxO, Tx)
-genFanoutTx numParties numOutputs = do
-  ctx <- genHydraContext numParties
-  utxo <- genUTxOAdaOnlyOfSize numOutputs
-  let (inHead', toDecommit') = splitUTxO utxo
-  (_, toFanout, toDecommit, stClosed@ClosedState{seedTxIn}) <- genStClosed ctx inHead' (Just toDecommit')
-  cctx <- pickChainContext ctx
+genFanoutTx :: Int -> Gen (ChainContext, ClosedState, UTxO, Tx)
+genFanoutTx numParties = do
+  (cctx, stOpen, _utxo, txClose, snapshot) <- genCloseTx numParties
+  let toDecommit = utxoToDecommit $ getSnapshot snapshot
+  let toFanout = utxo $ getSnapshot snapshot
+  let stClosed@ClosedState{seedTxIn} = snd $ fromJust $ observeClose stOpen txClose
   let deadlineSlotNo = slotNoFromUTCTime systemStart slotLength (getContestationDeadline stClosed)
       spendableUTxO = getKnownUTxO stClosed
-  pure (ctx, stClosed, mempty, unsafeFanout cctx spendableUTxO seedTxIn toFanout toDecommit deadlineSlotNo)
+  pure (cctx, stClosed, mempty, unsafeFanout cctx spendableUTxO seedTxIn toFanout toDecommit deadlineSlotNo)
 
 getContestationDeadline :: ClosedState -> UTCTime
 getContestationDeadline

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

@@ -144,7 +144,6 @@ import Test.QuickCheck (
   forAllShrink,
   getPositive,
   label,
-  sized,
   sublistOf,
   tabulate,
   (.&&.),
@@ -350,20 +349,20 @@ spec = parallel $ do
             False & counterexample ("observeRecoverTx ignored transaction: " <> renderTxWithUTxO utxo tx)
 
   describe "increment" $ do
-    -- propBelowSizeLimit maxTxSize forAllIncrement
+    propBelowSizeLimit maxTxSize forAllIncrement
     propIsValid forAllIncrement
 
   describe "decrement" $ do
     propBelowSizeLimit maxTxSize forAllDecrement
     propIsValid forAllDecrement
 
-    prop "observes distributed outputs" $
-      forAllDecrement' $ \toDistribute utxo tx ->
-        case observeDecrementTx utxo tx of
-          Just DecrementObservation{distributedOutputs} ->
-            distributedOutputs === toDistribute
-          Nothing ->
-            False & counterexample ("observeDecrementTx ignored transaction: " <> renderTxWithUTxO utxo tx)
+  prop "observes distributed outputs" $
+    forAllDecrement' $ \toDistribute utxo tx ->
+      case observeDecrementTx utxo tx of
+        Just DecrementObservation{distributedOutputs} ->
+          distributedOutputs === toDistribute
+        Nothing ->
+          False & counterexample ("observeDecrementTx ignored transaction: " <> renderTxWithUTxO utxo tx)
 
   describe "close" $ do
     propBelowSizeLimit maxTxSize forAllClose
@@ -692,8 +691,8 @@ forAllDecrement' ::
   ([TxOut CtxUTxO] -> UTxO -> Tx -> property) ->
   Property
 forAllDecrement' action = do
-  forAllShrink (genDecrementTx maximumNumberOfParties) shrink $ \(ctx, distributed, st, _, tx) ->
-    let utxo = getKnownUTxO st <> getKnownUTxO ctx <> utxo
+  forAllShrink (genDecrementTx maximumNumberOfParties) shrink $ \(ctx, distributed, st, utxo', tx) ->
+    let utxo = getKnownUTxO st <> getKnownUTxO ctx <> utxo'
      in action distributed utxo tx
 
 forAllClose ::
@@ -753,11 +752,10 @@ forAllFanout ::
   Property
 forAllFanout action =
   -- TODO: The utxo to fanout should be more arbitrary to have better test coverage
-  forAll (sized $ \n -> genFanoutTx maximumNumberOfParties (n `min` maxSupported)) $ \(hctx, stClosed, _, tx) ->
-    forAllBlind (pickChainContext hctx) $ \ctx ->
-      let utxo = getKnownUTxO stClosed <> getKnownUTxO ctx
-       in action utxo tx
-            & label ("Fanout size: " <> prettyLength (countAssets $ txOuts' tx))
+  forAll (genFanoutTx maximumNumberOfParties) $ \(ctx, stClosed, _, tx) ->
+    let utxo = getKnownUTxO stClosed <> getKnownUTxO ctx
+     in action utxo tx
+          & label ("Fanout size: " <> prettyLength (countAssets $ txOuts' tx))
  where
   maxSupported = 44
 

hydra-tx/src/Hydra/Tx/IsTx.hs

@@ -22,7 +22,6 @@ import Data.Text.Lazy.Builder (toLazyText)
 import Formatting.Buildable (build)
 import Hydra.Cardano.Api.Tx qualified as Api
 import Hydra.Cardano.Api.UTxO qualified as Api
-import Hydra.Contract.Head qualified as Head
 import Hydra.Contract.Util qualified as Util
 import PlutusLedgerApi.V3 (fromBuiltin)