Inline test_roundtrip_Tx_Cddl and test_roundtrip_TxWitness_Cddl and convert tests into property tests

Author: newhoggy

cardano-api/cardano-api.cabal

@@ -240,6 +240,7 @@ test-suite cardano-api-test
                       , time
 
   other-modules:        Test.Cardano.Api.Crypto
+                        Test.Cardano.Api.Eras
                         Test.Cardano.Api.Genesis
                         Test.Cardano.Api.Json
                         Test.Cardano.Api.KeysByron

cardano-api/gen/Test/Hedgehog/Roundtrip/CBOR.hs

@@ -5,7 +5,6 @@
 
 module Test.Hedgehog.Roundtrip.CBOR
   ( roundtrip_CBOR
-  -- , roundtrip_CDDL_Tx
   ) where
 
 import           Cardano.Api

cardano-api/src/Cardano/Api/Eras.hs

@@ -342,12 +342,7 @@ deriving instance Ord  (ShelleyBasedEra era)
 deriving instance Show (ShelleyBasedEra era)
 
 instance ToJSON (ShelleyBasedEra era) where
-   toJSON ShelleyBasedEraShelley = "Shelley"
-   toJSON ShelleyBasedEraAllegra = "Allegra"
-   toJSON ShelleyBasedEraMary    = "Mary"
-   toJSON ShelleyBasedEraAlonzo  = "Alonzo"
-   toJSON ShelleyBasedEraBabbage = "Babbage"
-   toJSON ShelleyBasedEraConway  = "Conway"
+   toJSON = toJSON . shelleyBasedToCardanoEra
 
 instance TestEquality ShelleyBasedEra where
     testEquality ShelleyBasedEraShelley ShelleyBasedEraShelley = Just Refl
@@ -436,7 +431,7 @@ instance FromJSON AnyShelleyBasedEra where
         "Alonzo" -> pure $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
         "Babbage" -> pure $ AnyShelleyBasedEra ShelleyBasedEraBabbage
         "Conway" -> pure $ AnyShelleyBasedEra ShelleyBasedEraConway
-        wrong -> fail $ "Failed to parse unknown era: " <> Text.unpack wrong
+        wrong -> fail $ "Failed to parse unknown shelley-based era: " <> Text.unpack wrong
 
 
 -- | This pairs up some era-dependent type with a 'ShelleyBasedEra' value that

cardano-api/test/Test/Cardano/Api/Eras.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Cardano.Api.Eras
+  ( tests
+  ) where
+
+import           Cardano.Api
+import           Cardano.Api.Orphans ()
+import           Data.Aeson (ToJSON (..), decode, encode)
+import           Hedgehog (Property, forAll, property, (===))
+import qualified Hedgehog as H
+import qualified Hedgehog.Gen as Gen
+import           Test.Tasty (TestTree, testGroup)
+import           Test.Tasty.Hedgehog (testPropertyNamed)
+
+--------------------------------------------------------------------------------
+-- Bounded instances
+
+prop_maxBound_CardanoMatchesShelley :: Property
+prop_maxBound_CardanoMatchesShelley = property $ do
+  AnyCardanoEra era <- forAll $ Gen.element [maxBound]
+  AnyShelleyBasedEra sbe <- forAll $ Gen.element [maxBound]
+
+  fromEnum (AnyCardanoEra era) === fromEnum (AnyCardanoEra (shelleyBasedToCardanoEra sbe))
+
+--------------------------------------------------------------------------------
+-- Aeson instances
+
+prop_roundtrip_JSON_Shelley :: Property
+prop_roundtrip_JSON_Shelley = property $ do
+  anySbe <- forAll $ Gen.element @_ @AnyShelleyBasedEra [minBound..maxBound]
+
+  H.tripping anySbe encode decode
+
+prop_roundtrip_JSON_Cardano :: Property
+prop_roundtrip_JSON_Cardano = property $ do
+  anyEra <- forAll $ Gen.element @_ @AnyCardanoEra [minBound..maxBound]
+
+  H.tripping anyEra encode decode
+
+prop_toJSON_CardanoMatchesShelley :: Property
+prop_toJSON_CardanoMatchesShelley = property $ do
+  AnyShelleyBasedEra sbe <- forAll $ Gen.element [minBound..maxBound]
+
+  toJSON (AnyShelleyBasedEra sbe) === toJSON (AnyCardanoEra (shelleyBasedToCardanoEra sbe))
+
+tests :: TestTree
+tests = testGroup "Test.Cardano.Api.Json"
+  [ testPropertyNamed "maxBound cardano matches shelley"           "maxBound cardano matches shelley"           prop_maxBound_CardanoMatchesShelley
+  , testPropertyNamed "roundtrip JSON shelley"                     "roundtrip JSON shelley"                     prop_roundtrip_JSON_Shelley
+  , testPropertyNamed "roundtrip JSON cardano"                     "roundtrip JSON cardano"                     prop_roundtrip_JSON_Cardano
+  , testPropertyNamed "toJSON cardano matches shelley"             "toJSON cardano matches shelley"             prop_toJSON_CardanoMatchesShelley
+  ]

cardano-api/test/Test/Cardano/Api/Typed/CBOR.hs

@@ -10,7 +10,7 @@ import           Cardano.Api
 
 import           Data.Proxy (Proxy (..))
 import           Data.String (IsString (..))
-import           Hedgehog (Property, forAll, property, success, tripping)
+import           Hedgehog (Property, forAll, tripping)
 import qualified Hedgehog as H
 import qualified Hedgehog.Gen as Gen
 import           Test.Cardano.Api.Typed.Orphans ()
@@ -156,38 +156,18 @@ prop_roundtrip_UpdateProposal_CBOR :: Property
 prop_roundtrip_UpdateProposal_CBOR =
   roundtrip_CBOR AsUpdateProposal genUpdateProposal
 
+prop_roundtrip_Tx_Cddl :: Property
+prop_roundtrip_Tx_Cddl = H.property $ do
+  AnyCardanoEra era <- H.forAll $ Gen.element [minBound..maxBound]
+  x <- forAll $ genTx era
+  H.tripping x serialiseTxLedgerCddl (deserialiseTxLedgerCddl era)
 
-test_roundtrip_Tx_Cddl :: [TestTree]
-test_roundtrip_Tx_Cddl =
-  [ testPropertyNamed (show era) (fromString (show era)) $ roundtrip_Tx_Cddl anyEra
-  | anyEra@(AnyCardanoEra era) <- [minBound..(AnyCardanoEra AlonzoEra)] --TODO: Babbage era
-  ]
-
-test_roundtrip_TxWitness_Cddl :: [TestTree]
-test_roundtrip_TxWitness_Cddl =
-  [ testPropertyNamed (show era) (fromString (show era)) $ roundtrip_TxWitness_Cddl era
-  | AnyCardanoEra era <- [minBound..(AnyCardanoEra AlonzoEra)] --TODO: Babbage era
-  , AnyCardanoEra era /= AnyCardanoEra ByronEra
-  ]
+prop_roundtrip_TxWitness_Cddl :: Property
+prop_roundtrip_TxWitness_Cddl = H.property $ do
+  AnyShelleyBasedEra sbe <- H.forAll $ Gen.element [minBound..maxBound]
+  x <- forAll $ genShelleyKeyWitness $ shelleyBasedToCardanoEra sbe
+  tripping x (serialiseWitnessLedgerCddl sbe) (deserialiseWitnessLedgerCddl sbe)
 
-roundtrip_TxWitness_Cddl :: CardanoEra era -> Property
-roundtrip_TxWitness_Cddl era =
-  property $
-    case cardanoEraStyle era of
-      LegacyByronEra -> success
-      ShelleyBasedEra sbe -> do
-        keyWit <- forAll $ genShelleyKeyWitness era
-        tripping keyWit
-          (serialiseWitnessLedgerCddl sbe)
-          (deserialiseWitnessLedgerCddl sbe)
-
-roundtrip_Tx_Cddl :: AnyCardanoEra -> Property
-roundtrip_Tx_Cddl (AnyCardanoEra era) =
-  property $ do
-   tx <- forAll $ genTx era
-   tripping tx
-     serialiseTxLedgerCddl
-     (deserialiseTxLedgerCddl era)
 
 -- -----------------------------------------------------------------------------
 
@@ -223,7 +203,7 @@ tests = testGroup "Test.Cardano.Api.Typed.CBOR"
   , testPropertyNamed "roundtrip UpdateProposal CBOR"                        "roundtrip UpdateProposal CBOR"                        prop_roundtrip_UpdateProposal_CBOR
   , testPropertyNamed "roundtrip ScriptData CBOR"                            "roundtrip ScriptData CBOR"                            prop_roundtrip_ScriptData_CBOR
   , testPropertyNamed "roundtrip txbody CBOR"                                "roundtrip txbody CBOR"                                prop_roundtrip_txbody_CBOR
+  , testPropertyNamed "roundtrip Tx Cddl"                                    "roundtrip Tx Cddl"                                    prop_roundtrip_Tx_Cddl
+  , testPropertyNamed "roundtrip TxWitness Cddl"                             "roundtrip TxWitness Cddl"                             prop_roundtrip_TxWitness_Cddl
   , testGroup "roundtrip tx CBOR"         test_roundtrip_tx_CBOR
-  , testGroup "roundtrip Tx Cddl"         test_roundtrip_Tx_Cddl
-  , testGroup "roundtrip TxWitness Cddl"  test_roundtrip_TxWitness_Cddl
   ]

cardano-api/test/cardano-api-test.hs

@@ -4,6 +4,7 @@ import           Cardano.Crypto.Libsodium (sodiumInit)
 import           Test.Tasty (TestTree, defaultMain, testGroup)
 
 import qualified Test.Cardano.Api.Crypto
+import qualified Test.Cardano.Api.Eras
 import qualified Test.Cardano.Api.Json
 import qualified Test.Cardano.Api.KeysByron
 import qualified Test.Cardano.Api.Ledger
@@ -29,6 +30,7 @@ tests :: TestTree
 tests =
   testGroup "Cardano.Api"
     [ Test.Cardano.Api.Crypto.tests
+    , Test.Cardano.Api.Eras.tests
     , Test.Cardano.Api.Json.tests
     , Test.Cardano.Api.KeysByron.tests
     , Test.Cardano.Api.Ledger.tests