Do not use suchThat when generating payments

hydra-node/test/Hydra/Model.hs

@@ -109,7 +109,7 @@ import Ouroboros.Consensus.Cardano.Block (HardForkBlock (..))
 import qualified Ouroboros.Consensus.Protocol.Praos.Header as Praos
 import Ouroboros.Consensus.Shelley.Ledger (mkShelleyBlock)
 import Test.Consensus.Cardano.Generators ()
-import Test.QuickCheck (choose, counterexample, elements, frequency, resize, sized, suchThat, tabulate, vectorOf)
+import Test.QuickCheck (choose, counterexample, elements, frequency, resize, sized, tabulate, vectorOf)
 import Test.QuickCheck.DynamicLogic (DynLogicModel)
 import Test.QuickCheck.StateModel (Any (..), LookUp, RunModel (..), StateModel (..), Var)
 import qualified Prelude
@@ -802,9 +802,11 @@ genPayment WorldState{hydraParties, hydraState} =
   case hydraState of
     Open{offChainState = OffChainState{confirmedUTxO}} -> do
       (from, value) <-
-        elements confirmedUTxO `suchThat` (not . null . valueToList . snd)
+        elements (filter (not . null . valueToList . snd) confirmedUTxO)
       let party = deriveParty $ fst $ fromJust $ List.find ((== from) . snd) hydraParties
-      (_, to) <- elements hydraParties `suchThat` ((/= from) . snd)
+      -- NOTE: It's perfectly possible this yields a payment to self and it
+      -- assumes hydraParties is not empty else `elements` will crash
+      (_, to) <- elements hydraParties
       pure (party, Payment{from, to, value})
     _ -> error $ "genPayment impossible in state: " <> show hydraState
 

hydra-node/test/Hydra/ModelSpec.hs

@@ -66,8 +66,7 @@ import Test.Hydra.Prelude hiding (after)
 
 import qualified Cardano.Api.UTxO as UTxO
 import Control.Monad.Class.MonadTimer ()
-import Control.Monad.IOSim (Failure (FailureException), IOSim, ppEvents, runSimTrace, traceEvents, traceResult)
-import Data.Aeson (encode, object, (.=))
+import Control.Monad.IOSim (Failure (FailureException), IOSim, runSimTrace, traceResult)
 import Data.Map ((!))
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -119,13 +118,9 @@ prop_checkConflictFreeLiveness =
 
 prop_HydraModel :: Actions WorldState -> Property
 prop_HydraModel actions = property $
-  trace
-    ( let Actions acts = actions
-       in decodeUtf8 $ encode $ object ["actions" .= fmap (show @String) acts]
-    )
-    $ runIOSimProp $ do
-      _ <- runActions runIt actions
-      assert True
+  runIOSimProp $ do
+    _ <- runActions runIt actions
+    assert True
 
 runIt :: forall s. RunModel WorldState (StateT (Nodes (IOSim s)) (IOSim s))
 runIt = runModel
@@ -248,7 +243,7 @@ runIOSimProp p = do
   let tr = runSimTrace $ evalStateT (eval $ monadic' p) (Nodes mempty traceInIOSim mempty)
       traceDump = printTrace (Proxy :: Proxy Tx) tr
       logsOnError = counterexample ("trace:\n" <> toString traceDump)
-  case (trace . ppEvents . traceEvents) tr $ traceResult False tr of
+  case traceResult False tr of
     Right x ->
       pure $ logsOnError x
     Left (FailureException (SomeException ex)) -> do