Replace some generators with generators from cardano-api and cardano-ledger

hydra-cardano-api/hydra-cardano-api.cabal

@@ -75,23 +75,25 @@ library
   -- NOTE: We only use an upper bound on cardano-api and have the other
   -- dependencies on cardano-ledger* and plutus-ledger-api follow.
   build-depends:
-    , aeson                   >=2
-    , base                    >=4.16
+    , aeson                      >=2
+    , base                       >=4.16
     , bytestring
-    , cardano-api             ^>=10.5
+    , cardano-api                ^>=10.5
+    , cardano-api:gen
     , cardano-binary
     , cardano-crypto-class
     , cardano-ledger-allegra
     , cardano-ledger-alonzo
     , cardano-ledger-api
     , cardano-ledger-babbage
     , cardano-ledger-binary
-    , cardano-ledger-byron
+    , cardano-ledger-byron-test
     , cardano-ledger-core
     , cardano-ledger-mary
     , cardano-ledger-shelley
     , containers
+    , hedgehog-quickcheck
     , lens
     , plutus-ledger-api
     , QuickCheck
-    , text                    >=2
+    , text                       >=2

hydra-cardano-api/src/Hydra/Cardano/Api/Address.hs

@@ -4,57 +4,10 @@ module Hydra.Cardano.Api.Address where
 
 import Hydra.Cardano.Api.Prelude
 
-import Cardano.Binary (unsafeDeserialize')
-import Cardano.Chain.Common qualified as Ledger
-import Data.ByteString qualified as BS
-import Test.QuickCheck (frequency, oneof, vector)
+import Test.Cardano.Chain.Common.Gen (genAddress)
+import Test.QuickCheck.Hedgehog (hedgehog)
 
 -- * Orphans
 
 instance Arbitrary (Address ByronAddr) where
-  arbitrary = do
-    address <- Ledger.makeAddress <$> genSpendingData <*> genAttributes
-    pure $ ByronAddress address
-   where
-    genSpendingData :: Gen Ledger.AddrSpendingData
-    genSpendingData =
-      let keyLen = 32
-          chainCodeLen = 32
-          majorType02 = 88
-          cborPrefix n = BS.pack [majorType02, fromIntegral n]
-       in frequency
-            [
-              ( 5
-              , Ledger.VerKeyASD
-                  . unsafeDeserialize'
-                  . (cborPrefix (keyLen + chainCodeLen) <>)
-                  <$> genBytes (keyLen + chainCodeLen)
-              )
-            ,
-              ( 1
-              , Ledger.RedeemASD
-                  . unsafeDeserialize'
-                  . (cborPrefix keyLen <>)
-                  <$> genBytes keyLen
-              )
-            ]
-
-    genAttributes :: Gen Ledger.AddrAttributes
-    genAttributes =
-      let payloadLen = 32
-       in Ledger.AddrAttributes
-            <$> oneof
-              [ pure Nothing
-              , Just . Ledger.HDAddressPayload <$> genBytes payloadLen
-              ]
-            <*> genNetworkMagic
-
-    genNetworkMagic :: Gen Ledger.NetworkMagic
-    genNetworkMagic =
-      oneof
-        [ pure Ledger.NetworkMainOrStage
-        , Ledger.NetworkTestnet <$> arbitrary
-        ]
-
-    genBytes :: Int -> Gen ByteString
-    genBytes = fmap BS.pack . vector
+  arbitrary = ByronAddress <$> hedgehog genAddress

hydra-cardano-api/src/Hydra/Cardano/Api/PlutusScript.hs

@@ -4,19 +4,11 @@ module Hydra.Cardano.Api.PlutusScript where
 
 import Hydra.Cardano.Api.Prelude
 
-import Data.ByteString.Short qualified as SBS
 import PlutusLedgerApi.Common qualified as Plutus
-import Test.QuickCheck (listOf)
 
 -- * Type Conversions
 
 -- | Convert a serialized plutus script into a cardano-api 'PlutusScript'.
 fromPlutusScript :: Plutus.SerialisedScript -> PlutusScript lang
 fromPlutusScript =
   PlutusScriptSerialised
-
--- * Orphans
-
-instance Arbitrary (PlutusScript lang) where
-  arbitrary =
-    PlutusScriptSerialised . SBS.pack <$> listOf arbitrary

hydra-cardano-api/src/Hydra/Cardano/Api/PolicyId.hs

@@ -8,11 +8,13 @@ import Cardano.Ledger.Alonzo.Plutus.TxInfo qualified as Ledger
 import Cardano.Ledger.Mary.Value qualified as Ledger
 import Hydra.Cardano.Api.ScriptHash ()
 import PlutusLedgerApi.V3 (CurrencySymbol, fromBuiltin, unCurrencySymbol)
+import Test.Gen.Cardano.Api.Typed (genPolicyId)
+import Test.QuickCheck.Hedgehog (hedgehog)
 
 -- * Orphans
 
 instance Arbitrary PolicyId where
-  arbitrary = PolicyId <$> arbitrary
+  arbitrary = hedgehog genPolicyId
 
 -- * Type conversions
 

hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs

@@ -6,9 +6,7 @@ import Hydra.Cardano.Api.Prelude hiding (left)
 
 import Cardano.Ledger.Era qualified as Ledger
 import Cardano.Ledger.Plutus.Data qualified as Ledger
-import Data.ByteString qualified as BS
 import PlutusLedgerApi.V3 qualified as Plutus
-import Test.QuickCheck (arbitrarySizedNatural, choose, oneof, scale, sized, vector)
 
 -- * Extras
 
@@ -51,24 +49,3 @@ fromLedgerData =
 toLedgerData :: Ledger.Era era => HashableScriptData -> Ledger.Data era
 toLedgerData =
   toAlonzoData
-
--- * Orphans
-
-instance Arbitrary ScriptData where
-  arbitrary =
-    scale (`div` 2) $
-      oneof
-        [ ScriptDataConstructor <$> arbitrarySizedNatural <*> arbitrary
-        , ScriptDataNumber <$> arbitrary
-        , ScriptDataBytes <$> arbitraryBS
-        , ScriptDataList <$> arbitrary
-        , ScriptDataMap <$> arbitrary
-        ]
-   where
-    arbitraryBS = sized $ \n ->
-      BS.pack <$> (choose (0, min n 64) >>= vector)
-
-instance Arbitrary HashableScriptData where
-  arbitrary =
-    -- NOTE: Safe to use here as the data was not available in serialized form.
-    unsafeHashableScriptData <$> arbitrary

hydra-cardano-api/src/Hydra/Cardano/Api/ScriptHash.hs

@@ -12,9 +12,3 @@ import Hydra.Cardano.Api.PlutusScript ()
 hashScriptInAnyLang :: ScriptInAnyLang -> ScriptHash
 hashScriptInAnyLang (ScriptInAnyLang _ script) =
   hashScript script
-
--- * Orphans
-
-instance Arbitrary ScriptHash where
-  arbitrary = do
-    hashScript . PlutusScript PlutusScriptV3 <$> arbitrary

hydra-cardano-api/src/Hydra/Cardano/Api/ValidityInterval.hs

@@ -6,7 +6,8 @@ import Hydra.Cardano.Api.Prelude
 
 import Cardano.Ledger.Allegra.Scripts qualified as Ledger
 import Cardano.Ledger.BaseTypes (StrictMaybe (..), maybeToStrictMaybe)
-import Test.QuickCheck (oneof)
+import Test.Gen.Cardano.Api.Typed (genTxValidityLowerBound, genTxValidityUpperBound)
+import Test.QuickCheck.Hedgehog (hedgehog)
 
 toLedgerValidityInterval ::
   (TxValidityLowerBound era, TxValidityUpperBound era) ->
@@ -35,11 +36,7 @@ fromLedgerValidityInterval validityInterval =
    in (lowerBound, upperBound)
 
 instance Arbitrary (TxValidityLowerBound Era) where
-  arbitrary =
-    oneof
-      [ pure TxValidityNoLowerBound
-      , TxValidityLowerBound allegraBasedEra . SlotNo <$> arbitrary
-      ]
+  arbitrary = hedgehog $ genTxValidityLowerBound cardanoEra
 
 instance Arbitrary (TxValidityUpperBound Era) where
-  arbitrary = TxValidityUpperBound (shelleyBasedEra @Era) . fmap SlotNo <$> arbitrary
+  arbitrary = hedgehog $ genTxValidityUpperBound shelleyBasedEra

hydra-node/hydra-node.cabal

@@ -324,6 +324,7 @@ test-suite tests
     , aeson
     , base
     , bytestring
+    , cardano-api:gen
     , cardano-binary
     , cardano-crypto-class
     , cardano-ledger-alonzo
@@ -341,6 +342,7 @@ test-suite tests
     , contra-tracer
     , directory
     , filepath
+    , hedgehog-quickcheck
     , hspec
     , hspec-core
     , hspec-golden-aeson

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

@@ -53,6 +53,7 @@ import Hydra.Tx.Init (mkInitialOutput)
 import Hydra.Tx.ScriptRegistry (registryUTxO)
 import Hydra.Tx.Utils (verificationKeyToOnChainId)
 import Test.Cardano.Ledger.Shelley.Arbitrary (genMetadata')
+import Test.Gen.Cardano.Api.Typed (genHashableScriptData)
 import Test.Hydra.Prelude
 import Test.Hydra.Tx.Fixture (
   pparams,
@@ -80,6 +81,7 @@ import Test.QuickCheck (
   (.&&.),
   (===),
  )
+import Test.QuickCheck.Hedgehog (hedgehog)
 import Test.QuickCheck.Instances.Semigroup ()
 import Test.QuickCheck.Monadic (monadicIO)
 
@@ -288,7 +290,7 @@ genBlueprintTxWithUTxO =
       [ pure (utxo, txbody)
       , do
           lovelace <- arbitrary
-          let redeemer = arbitrary `generateWith` 42
+          let redeemer = hedgehog genHashableScriptData `generateWith` 42
               alwaysSucceedingScript = PlutusScriptSerialised dummyValidatorScript
               scriptWitness = mkScriptWitness alwaysSucceedingScript NoScriptDatumForStake redeemer
               stakeAddress = mkScriptStakeAddress testNetworkId alwaysSucceedingScript