Change genUTxO and genTxOut

Re-using the generators more and also including reference scripts.

Unsure whether this will break some of the Commit script tests (where
bespoke non-visibility of reference scripts could be a problem), but we
should instead modify the generators there.

Author: ch1bo

hydra-tx/hydra-tx.cabal

@@ -130,7 +130,6 @@ library testlib
     , cardano-ledger-conway:testlib
     , cardano-ledger-core
     , cardano-ledger-mary
-    , cardano-ledger-shelley
     , cardano-strict-containers
     , cborg
     , containers

hydra-tx/test/Hydra/Tx/Contract/Deposit.hs

@@ -15,7 +15,7 @@ import Hydra.Tx.Deposit (depositTx)
 import Test.Hydra.Tx.Fixture (depositDeadline, testNetworkId, testPolicyId)
 import Test.Hydra.Tx.Gen (genUTxO)
 import Test.Hydra.Tx.Mutation (Mutation (ChangeOutput), SomeMutation (..))
-import Test.QuickCheck (chooseInteger, elements, oneof)
+import Test.QuickCheck (chooseInteger, elements, oneof, resize)
 
 healthyDepositTx :: (Tx, UTxO)
 healthyDepositTx =
@@ -29,7 +29,7 @@ healthyDepositTx =
       depositDeadline
 
 healthyDepositUTxO :: UTxO
-healthyDepositUTxO = genUTxO `generateWith` 42
+healthyDepositUTxO = resize 3 genUTxO `generateWith` 42
 
 data DepositMutation
   = -- | Change the output value to a subset of the deposited value. This

hydra-tx/testlib/Test/Hydra/Tx/Gen.hs

@@ -11,7 +11,6 @@ import Cardano.Crypto.DSIGN qualified as CC
 import Cardano.Crypto.Hash (hashToBytes)
 import Cardano.Ledger.BaseTypes qualified as Ledger
 import Cardano.Ledger.Credential qualified as Ledger
-import Cardano.Ledger.Shelley.UTxO qualified as Ledger
 import Codec.CBOR.Magic (uintegerFromBytes)
 import Data.ByteString qualified as BS
 import Data.Map.Strict qualified as Map
@@ -28,24 +27,23 @@ import Hydra.Tx.Party (Party (..))
 import PlutusTx.Builtins (fromBuiltin)
 import Test.Cardano.Ledger.Conway.Arbitrary ()
 import Test.Hydra.Tx.Fixture qualified as Fixtures
-import Test.QuickCheck (listOf, oneof, scale, shrinkList, shrinkMapBy, suchThat, vector, vectorOf)
+import Test.QuickCheck (listOf, oneof, scale, shrinkList, shrinkMapBy, sized, suchThat, vector, vectorOf)
 
 -- * TxOut
 
 instance Arbitrary (TxOut CtxUTxO) where
   arbitrary = genTxOut
   shrink txOut = fromLedgerTxOut <$> shrink (toLedgerTxOut txOut)
 
--- | Generate a 'Babbage' era 'TxOut', which may contain arbitrary assets
+-- | Generate a 'Conway' era 'TxOut', which may contain arbitrary assets
 -- addressed to public keys and scripts, as well as datums.
 --
 -- NOTE: This generator does
 --  * not produce byron addresses as most of the cardano ecosystem dropped support for that (including plutus),
---  * not produce reference scripts as they are not fully "visible" from plutus,
 --  * replace stake pointers with null references as nobody uses that.
 genTxOut :: Gen (TxOut ctx)
 genTxOut =
-  (noRefScripts . noStakeRefPtr <$> gen)
+  (noStakeRefPtr <$> gen)
     `suchThat` notByronAddress
  where
   gen =
@@ -71,9 +69,6 @@ genTxOut =
           TxOut (ShelleyAddressInEra (ShelleyAddress Ledger.Testnet cre sr)) val dat refScript
     _ -> out
 
-  noRefScripts out =
-    out{txOutReferenceScript = ReferenceScriptNone}
-
 -- | Generate a 'TxOut' with a byron address. This is usually not supported by
 -- Hydra or Plutus.
 genTxOutByron :: Gen (TxOut ctx)
@@ -114,19 +109,11 @@ shrinkUTxO = shrinkMapBy (UTxO . fromList) UTxO.pairs (shrinkList shrinkOne)
       | value' <- shrinkValue value
       ]
 
--- | Generate a complete arbitrary UTxO, which may contain arbitrary assets in
--- 'TxOut's addressed to public keys *and* scripts. NOTE: This is not reducing
--- size when generating assets in 'TxOut's, so will end up regularly with 300+
--- assets with generator size 30. NOTE: The Arbitrary TxIn instance from the
--- ledger is producing colliding values, so we replace them.
+-- | Generate a complete arbitrary UTxO. See also 'genTxOut'.
 genUTxO :: Gen UTxO
-genUTxO = do
-  utxoMap <- Map.toList . Ledger.unUTxO <$> arbitrary
-  fmap UTxO.fromPairs . forM utxoMap $ \(_, o) -> do
-    i <- arbitrary
-    pure (i, fromLedgerTxOut o)
+genUTxO = sized genUTxOSized
 
--- | Generate a 'Babbage' era 'UTxO' with given number of outputs. See also
+-- | Generate a 'Conway' era 'UTxO' with given number of outputs. See also
 -- 'genTxOut'.
 genUTxOSized :: Int -> Gen UTxO
 genUTxOSized numUTxO =