Re-add Byron related roundtrip tests and generators

IntersectMBO · Nov 10, 2023 · 6492b07 · 6492b07
1 parent 4462226
commit 6492b07
Show file tree

Hide file tree

Showing 4 changed files with 103 additions and 5 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -245,6 +245,7 @@ library gen
   hs-source-dirs:       gen
 
   exposed-modules:      Test.Gen.Cardano.Api
+                        Test.Gen.Cardano.Api.Byron
                         Test.Gen.Cardano.Api.Era
                         Test.Gen.Cardano.Api.Metadata
                         Test.Gen.Cardano.Api.Typed

diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Byron.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Byron.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Test.Gen.Cardano.Api.Byron
+  ( tests
+  ) where
+
+import           Cardano.Api hiding (txIns)
+
+import           Data.Proxy
+
+import           Test.Gen.Cardano.Api.Typed
+
+import           Hedgehog
+import           Test.Hedgehog.Roundtrip.CBOR
+import           Test.Tasty
+import           Test.Tasty.Hedgehog
+
+prop_byron_roundtrip_txbody_CBOR :: Property
+prop_byron_roundtrip_txbody_CBOR = property $ do
+  let byron = ByronEra
+  x <- forAll $ makeSignedTransaction [] <$> genTxBodyByron
+  tripping x (serialiseTxLedgerCddl byron) (deserialiseTxLedgerCddl byron)
+
+
+prop_byron_roundtrip_tx_CBOR :: Property
+prop_byron_roundtrip_tx_CBOR =  property $ do
+  let byron = ByronEra
+  x <- forAll genTxByron
+  cardanoEraConstraints byron $ trippingCbor (proxyToAsType Proxy) x
+
+
+prop_byron_roundtrip_witness_CBOR :: Property
+prop_byron_roundtrip_witness_CBOR = property $ do
+  let byron = ByronEra
+  x <- forAll genByronKeyWitness
+  cardanoEraConstraints byron $ trippingCbor (AsKeyWitness (proxyToAsType Proxy)) x
+
+
+prop_byron_roundtrip_Tx_Cddl :: Property
+prop_byron_roundtrip_Tx_Cddl = property $ do
+  let byron = ByronEra
+  x <- forAll genTxByron
+  tripping x (serialiseTxLedgerCddl byron) (deserialiseTxLedgerCddl byron)
+
+tests :: TestTree
+tests = testGroup "Test.Gen.Cardano.Api.Byron"
+  [ testProperty "Byron roundtrip txbody CBOR"         prop_byron_roundtrip_txbody_CBOR
+  , testProperty "Byron roundtrip tx certificate CBOR" prop_byron_roundtrip_tx_CBOR
+  , testProperty "Byron roundtrip witness CBOR"        prop_byron_roundtrip_witness_CBOR
+  , testProperty "Byron roundtrip tx CBOR"             prop_byron_roundtrip_Tx_Cddl
+  ]
+
diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
@@ -15,7 +15,13 @@ module Test.Gen.Cardano.Api.Typed
   ( genFeaturedInEra
   , genMaybeFeaturedInEra
 
+  -- * Byron
+  , genAddressInEraByron
   , genAddressByron
+  , genTxBodyByron
+  , genTxByron
+  , genWitnessesByron
+
   , genAddressInEra
   , genAddressShelley
   , genCertificate
@@ -185,8 +191,8 @@ genAddressShelley = makeShelleyAddress <$> genNetworkId
 genAddressInEra :: ShelleyBasedEra era -> Gen (AddressInEra era)
 genAddressInEra sbe = shelleyAddressInEra sbe <$> genAddressShelley
 
-_genByronAddressInEra :: Gen (AddressInEra era)
-_genByronAddressInEra = byronAddressInEra <$> genAddressByron
+_genAddressInEraByron :: Gen (AddressInEra era)
+_genAddressInEraByron = byronAddressInEra <$> genAddressByron
 
 genKESPeriod :: Gen KESPeriod
 genKESPeriod = KESPeriod <$> Gen.word Range.constantBounded
@@ -707,6 +713,40 @@ genTxFee =
     undefined -- (pure . TxFeeImplicit)
     (\w -> TxFeeExplicit w <$> genLovelace)
 
+genAddressInEraByron :: Gen (AddressInEra ByronEra)
+genAddressInEraByron = byronAddressInEra <$> genAddressByron
+
+genTxByron :: Gen (Tx ByronEra)
+genTxByron =
+  makeSignedTransaction
+    <$> genWitnessesByron
+    <*> genTxBodyByron
+
+genTxOutValueByron :: Gen (TxOutValue ByronEra)
+genTxOutValueByron = TxOutValueByron <$> genPositiveLovelace
+
+genTxOutByron :: Gen (TxOut CtxTx ByronEra)
+genTxOutByron =
+  TxOut <$> genAddressInEraByron
+        <*> genTxOutValueByron
+        <*> pure TxOutDatumNone
+        <*> pure ReferenceScriptNone
+
+genTxBodyByron :: Gen (TxBody ByronEra)
+genTxBodyByron = do
+  txIns <- map (, BuildTxWith (KeyWitness KeyWitnessForSpending)) <$> Gen.list (Range.constant 1 10) genTxIn
+  txOuts <- Gen.list (Range.constant 1 10) genTxOutByron
+  let byronTxBodyContent = (defaultTxBodyContent ByronEra)
+                             { Api.txIns
+                             , Api.txOuts
+                             }
+  case Api.createAndValidateTransactionBody ByronEra byronTxBodyContent of
+    Left err -> fail (displayError err)
+    Right txBody -> pure txBody
+
+genWitnessesByron :: Gen [KeyWitness ByronEra]
+genWitnessesByron = Gen.list (Range.constant 1 10) genByronKeyWitness
+
 genTxBody :: ShelleyBasedEra era -> Gen (TxBody era)
 genTxBody era = do
   res <- Api.createAndValidateTransactionBody (toCardanoEra era) <$> genTxBodyContent era
@@ -781,8 +821,8 @@ genVerificationKeyHash :: ()
 genVerificationKeyHash roletoken =
   verificationKeyHash <$> genVerificationKey roletoken
 
-genByronKeyWitness :: ByronEraOnly era -> Gen (KeyWitness era)
-genByronKeyWitness ByronEraOnlyByron = do
+genByronKeyWitness :: Gen (KeyWitness ByronEra)
+genByronKeyWitness = do
   pmId <- genProtocolMagicId
   txinWitness <- genVKWitness pmId
   return $ ByronKeyWitness txinWitness

diff --git a/cardano-api/test/cardano-api-test/cardano-api-test.hs b/cardano-api/test/cardano-api-test/cardano-api-test.hs
@@ -4,6 +4,8 @@ import           Cardano.Crypto.Libsodium (sodiumInit)
 
 import           System.IO (BufferMode (LineBuffering), hSetBuffering, hSetEncoding, stdout, utf8)
 
+import qualified Test.Gen.Cardano.Api.Byron
+
 import qualified Test.Cardano.Api.Crypto
 import qualified Test.Cardano.Api.Eras
 import qualified Test.Cardano.Api.IO
@@ -34,7 +36,8 @@ main = do
 tests :: TestTree
 tests =
   testGroup "Cardano.Api"
-    [ Test.Cardano.Api.Crypto.tests
+    [ Test.Gen.Cardano.Api.Byron.tests
+    , Test.Cardano.Api.Crypto.tests
     , Test.Cardano.Api.Eras.tests
     , Test.Cardano.Api.IO.tests
     , Test.Cardano.Api.Json.tests