Use genTxOut from cardano-api

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

@@ -125,7 +125,6 @@ import Test.Hydra.Tx.Fixture (testNetworkId)
 import Test.Hydra.Tx.Gen (
   genOneUTxOFor,
   genScriptRegistry,
-  genTxOut,
   genUTxO1,
   genUTxOAdaOnlyOfSize,
   genVerificationKey,
@@ -1257,7 +1256,7 @@ genContestTx = do
   let txClose = unsafeClose cctx openUTxO headId (ctxHeadParameters ctx) version confirmed startSlot closePointInTime
   let stClosed = snd $ fromJust $ observeClose stOpen txClose
   let utxo = getKnownUTxO stClosed
-  someUtxo <- genUTxO1 genTxOut
+  someUtxo <- genUTxO1 arbitrary
   let (confirmedUTxO', utxoToDecommit') = splitUTxO someUtxo
   contestSnapshot <- genConfirmedSnapshot headId version (succ $ number $ getSnapshot confirmed) confirmedUTxO' Nothing (Just utxoToDecommit') (ctxHydraSigningKeys ctx)
   contestPointInTime <- genPointInTimeBefore (getContestationDeadline stClosed)

hydra-node/test/Hydra/API/HTTPServerSpec.hs

@@ -13,6 +13,8 @@ import Hydra.API.HTTPServer (DraftCommitTxRequest (..), DraftCommitTxResponse (.
 import Hydra.API.ServerOutput (CommitInfo (CannotCommit, NormalCommit))
 import Hydra.API.ServerSpec (dummyChainHandle)
 import Hydra.Cardano.Api (
+  CtxUTxO,
+  TxOut,
   mkTxOutDatumInline,
   modifyTxOutDatum,
   renderTxIn,
@@ -31,7 +33,6 @@ import Test.Hspec.Wai (MatchBody (..), ResponseMatcher (matchBody), get, post, s
 import Test.Hspec.Wai.Internal (withApplication)
 import Test.Hydra.Node.Fixture (testEnvironment)
 import Test.Hydra.Tx.Fixture (defaultPParams)
-import Test.Hydra.Tx.Gen (genTxOut)
 import Test.QuickCheck (
   checkCoverage,
   counterexample,
@@ -198,7 +199,7 @@ apiServerSpec = do
                   }
 
       prop "has inlineDatumRaw" $ \i ->
-        forAll genTxOut $ \o -> do
+        forAll (arbitrary :: Gen (TxOut CtxUTxO)) $ \o -> do
           let o' = modifyTxOutDatum (const $ mkTxOutDatumInline (123 :: Integer)) o
           let getUTxO = pure $ Just $ UTxO.fromPairs [(i, o')]
           withApplication (httpApp @Tx nullTracer dummyChainHandle testEnvironment defaultPParams cantCommit getUTxO getPendingDeposits putClientInput) $ do

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

@@ -121,7 +121,7 @@ import Hydra.Tx.Utils (dummyValidatorScript, splitUTxO)
 import PlutusLedgerApi.V3 qualified as Plutus
 import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)
 import Test.Hydra.Tx.Fixture (slotLength, systemStart, testNetworkId)
-import Test.Hydra.Tx.Gen (genOutput, genTxOut, genTxOutAdaOnly, genTxOutByron, genUTxO1, genUTxOSized)
+import Test.Hydra.Tx.Gen (genOutput, genTxOutAdaOnly, genTxOutByron, genUTxO1, genUTxOSized)
 import Test.Hydra.Tx.Mutation (
   Mutation (..),
   applyMutation,
@@ -432,7 +432,7 @@ genCommitTxMutation utxo tx =
 genAdaOnlyUTxOOnMainnetWithAmountBiggerThanOutLimit :: Gen UTxO
 genAdaOnlyUTxOOnMainnetWithAmountBiggerThanOutLimit = do
   adaAmount <- (+ maxMainnetLovelace) . getPositive <$> arbitrary
-  genUTxO1 (modifyTxOutValue (const $ lovelaceToValue adaAmount) <$> genTxOut)
+  genUTxO1 (modifyTxOutValue (const $ lovelaceToValue adaAmount) <$> arbitrary)
 
 -- * Properties
 

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

@@ -62,7 +62,6 @@ import Test.Hydra.Tx.Fixture (
 import Test.Hydra.Tx.Fixture qualified as Fixture
 import Test.Hydra.Tx.Gen (
   genSigningKey,
-  genTxOutWithReferenceScript,
   genUTxO1,
   genUTxOAdaOnlyOfSize,
   genValue,
@@ -263,7 +262,7 @@ genBlueprintTxWithUTxO =
       )
 
   addSomeReferenceInputs (utxo, txbody) = do
-    txout <- genTxOutWithReferenceScript
+    txout <- arbitrary
     txin <- arbitrary
     pure (utxo <> UTxO.singleton (txin, txout), txbody & addReferenceInputs [txin])
 

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

@@ -72,7 +72,6 @@ import Test.Hydra.Tx.Fixture qualified as Fixture
 import Test.Hydra.Tx.Gen (
   genForParty,
   genScriptRegistry,
-  genTxOut,
   genUTxO1,
   genVerificationKey,
  )
@@ -604,7 +603,7 @@ realWorldModelUTxO =
  where
   gen = do
     lovelace <- arbitrary
-    genUTxO1 (modifyTxOutValue (const $ lovelaceToValue lovelace) <$> genTxOut)
+    genUTxO1 (modifyTxOutValue (const $ lovelaceToValue lovelace) <$> arbitrary)
 
 -- | A correctly signed snapshot. Given a snapshot number a snapshot signed by
 -- all participants (alice, bob and carol) with some UTxO contained is produced.

hydra-node/test/Hydra/Ledger/CardanoSpec.hs

@@ -21,7 +21,7 @@ import Hydra.Ledger.Cardano (cardanoLedger, genSequenceOfSimplePaymentTransactio
 import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)
 import Test.Cardano.Ledger.Babbage.Arbitrary ()
 import Test.Hydra.Node.Fixture (defaultGlobals, defaultLedgerEnv, defaultPParams)
-import Test.Hydra.Tx.Gen (genOneUTxOFor, genOutput, genTxOut, genUTxO, genUTxOAdaOnlyOfSize, genUTxOFor, genValue)
+import Test.Hydra.Tx.Gen (genOneUTxOFor, genOutput, genUTxO, genUTxOAdaOnlyOfSize, genUTxOFor, genValue)
 import Test.QuickCheck (
   Property,
   checkCoverage,
@@ -80,7 +80,7 @@ spec =
 
       describe "genTxOut" $
         it "does generate good values" $
-          forAll genTxOut propGeneratesGoodTxOut
+          forAll arbitrary propGeneratesGoodTxOut
 
       describe "genOutput" $
         it "has enough lovelace to cover assets" $

hydra-tx/hydra-tx.cabal

@@ -121,6 +121,7 @@ library testlib
   build-depends:
     , base
     , bytestring
+    , cardano-api:gen
     , cardano-crypto-class
     , cardano-ledger-alonzo
     , cardano-ledger-api
@@ -133,6 +134,7 @@ library testlib
     , cborg
     , containers
     , directory
+    , hedgehog-quickcheck
     , hydra-cardano-api
     , hydra-plutus
     , hydra-plutus-extras

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

@@ -9,8 +9,6 @@ import Hydra.Prelude hiding (toList)
 import Cardano.Api.UTxO qualified as UTxO
 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
@@ -30,53 +28,17 @@ import Hydra.Tx.Party (Party (..))
 import Hydra.Tx.Recover (RecoverObservation)
 import PlutusTx.Builtins (fromBuiltin)
 import Test.Cardano.Ledger.Conway.Arbitrary ()
+import Test.Gen.Cardano.Api.Typed (genTxId, genTxOutUTxOContext)
 import Test.Hydra.Tx.Fixture qualified as Fixtures
 import Test.QuickCheck (listOf, oneof, scale, shrinkList, shrinkMapBy, suchThat, vector, vectorOf)
+import Test.QuickCheck.Hedgehog (hedgehog)
 
 -- * TxOut
 
 instance Arbitrary (TxOut CtxUTxO) where
-  arbitrary = genTxOut
+  arbitrary = hedgehog $ genTxOutUTxOContext shelleyBasedEra
   shrink txOut = fromLedgerTxOut <$> shrink (toLedgerTxOut txOut)
 
--- | Generate a 'Babbage' 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)
-    `suchThat` notByronAddress
- where
-  gen =
-    modifyTxOutValue (<> (lovelaceToValue $ Coin 10_000_000))
-      <$> oneof
-        [ fromLedgerTxOut <$> arbitrary
-        , notMultiAsset . fromLedgerTxOut <$> arbitrary
-        ]
-
-  notMultiAsset =
-    modifyTxOutValue (lovelaceToValue . selectLovelace)
-
-  notByronAddress (TxOut addr _ _ _) = case addr of
-    ByronAddressInEra{} -> False
-    _ -> True
-
-  noStakeRefPtr out@(TxOut addr val dat refScript) = case addr of
-    ShelleyAddressInEra (ShelleyAddress _ cre sr) ->
-      case sr of
-        Ledger.StakeRefPtr _ ->
-          TxOut (ShelleyAddressInEra (ShelleyAddress Ledger.Testnet cre Ledger.StakeRefNull)) val dat refScript
-        _ ->
-          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)
@@ -91,16 +53,6 @@ genTxOutAdaOnly vk = do
   value <- lovelaceToValue . Coin <$> scale (* 8) arbitrary `suchThat` (> 0)
   pure $ TxOut (mkVkAddress (Testnet $ NetworkMagic 42) vk) value TxOutDatumNone ReferenceScriptNone
 
--- | Generate a 'TxOut' with a reference script. The standard 'genTxOut' is not
--- including reference scripts, use this generator if you are interested in
--- these cases.
-genTxOutWithReferenceScript :: Gen (TxOut ctx)
-genTxOutWithReferenceScript = do
-  -- Have the ledger generate a TxOut with a reference script as instances are
-  -- not so easily accessible.
-  refScript <- (txOutReferenceScript . fromLedgerTxOut <$> arbitrary) `suchThat` (/= ReferenceScriptNone)
-  genTxOut <&> \out -> out{txOutReferenceScript = refScript}
-
 -- * UTxO
 
 instance Arbitrary UTxO where
@@ -135,7 +87,7 @@ genUTxOSized :: Int -> Gen UTxO
 genUTxOSized numUTxO =
   fold <$> vectorOf numUTxO (UTxO.singleton <$> gen)
  where
-  gen = (,) <$> arbitrary <*> genTxOut
+  gen = (,) <$> arbitrary <*> arbitrary
 
 -- | Genereate a 'UTxO' with a single entry using given 'TxOut' generator.
 genUTxO1 :: Gen (TxOut CtxUTxO) -> Gen UTxO
@@ -175,7 +127,7 @@ genUTxOWithSimplifiedAddresses :: Gen UTxO
 genUTxOWithSimplifiedAddresses =
   UTxO.fromPairs <$> listOf genEntry
  where
-  genEntry = (,) <$> genTxIn <*> genTxOut
+  genEntry = (,) <$> genTxIn <*> arbitrary
 
 -- * Others
 
@@ -235,9 +187,7 @@ instance Arbitrary (VerificationKey PaymentKey) where
   arbitrary = fst <$> genKeyPair
 
 instance Arbitrary TxId where
-  arbitrary = onlyTxId <$> arbitrary
-   where
-    onlyTxId (TxIn txi _) = txi
+  arbitrary = hedgehog genTxId
 
 genScriptRegistry :: Gen ScriptRegistry
 genScriptRegistry = do