Add tests for cddlTypeToEra

IntersectMBO · Sep 17, 2024 · e7a7066 · e7a7066
1 parent b33f0af
commit e7a7066
Show file tree

Hide file tree

Showing 3 changed files with 61 additions and 26 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -338,6 +338,7 @@ test-suite cardano-api-test
     tasty,
     tasty-hedgehog,
     tasty-quickcheck,
+    text,
     time,
 
   other-modules:

diff --git a/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs b/cardano-api/internal/Cardano/Api/SerialiseLedgerCddl.hs
@@ -12,6 +12,7 @@
 module Cardano.Api.SerialiseLedgerCddl
   ( TextEnvelopeCddlError (..)
   , FromSomeTypeCDDL (..)
+  , cddlTypeToEra
 
     -- * Reading one of several transaction or
 
@@ -315,32 +316,33 @@ deserialiseFromTextEnvelopeCddlAnyOf types teCddl =
 -- will make it easier to keep track of the different Cddl descriptions via
 -- a single sum data type.
 cddlTypeToEra :: Text -> Either TextEnvelopeCddlError AnyShelleyBasedEra
-cddlTypeToEra = \case
-  "TxSignedShelley" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley
-  "Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
-  "Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary
-  "Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
-  "Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
-  "Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway
-  "Witnessed Tx ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley
-  "Witnessed Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
-  "Witnessed Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary
-  "Witnessed Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
-  "Witnessed Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
-  "Witnessed Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway
-  "Unwitnessed Tx ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley
-  "Unwitnessed Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
-  "Unwitnessed Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary
-  "Unwitnessed Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
-  "Unwitnessed Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
-  "Unwitnessed Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway
-  "TxWitness ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley
-  "TxWitness AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
-  "TxWitness MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary
-  "TxWitness AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
-  "TxWitness BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
-  "TxWitness ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway
-  unknownCddlType -> Left $ TextEnvelopeCddlErrUnknownType unknownCddlType
+cddlTypeToEra =
+  \case
+    "TxSignedShelley" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley
+    "Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
+    "Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary
+    "Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
+    "Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
+    "Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway
+    "Witnessed Tx ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley
+    "Witnessed Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
+    "Witnessed Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary
+    "Witnessed Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
+    "Witnessed Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
+    "Witnessed Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway
+    "Unwitnessed Tx ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley
+    "Unwitnessed Tx AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
+    "Unwitnessed Tx MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary
+    "Unwitnessed Tx AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
+    "Unwitnessed Tx BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
+    "Unwitnessed Tx ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway
+    "TxWitness ShelleyEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraShelley
+    "TxWitness AllegraEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAllegra
+    "TxWitness MaryEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraMary
+    "TxWitness AlonzoEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraAlonzo
+    "TxWitness BabbageEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraBabbage
+    "TxWitness ConwayEra" -> return $ AnyShelleyBasedEra ShelleyBasedEraConway
+    unknownCddlType -> Left $ TextEnvelopeCddlErrUnknownType unknownCddlType
 
 readFileTextEnvelopeCddlAnyOf
   :: [FromSomeTypeCDDL TextEnvelope b]

diff --git a/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs b/cardano-api/test/cardano-api-test/Test/Cardano/Api/CBOR.hs
@@ -10,10 +10,12 @@ module Test.Cardano.Api.CBOR
 where
 
 import           Cardano.Api
+import           Cardano.Api.SerialiseLedgerCddl (cddlTypeToEra)
 import           Cardano.Api.SerialiseTextEnvelope (TextEnvelopeDescr (TextEnvelopeDescr))
 import           Cardano.Api.Shelley (AsType (..))
 
 import           Data.Proxy (Proxy (..))
+import qualified Data.Text as T
 
 import           Test.Gen.Cardano.Api.Typed
 
@@ -188,6 +190,30 @@ prop_roundtrip_UpdateProposal_CBOR = H.property $ do
   proposal <- H.forAll $ genUpdateProposal era
   H.trippingCbor AsUpdateProposal proposal
 
+prop_Tx_cddlTypeToEra :: Property
+prop_Tx_cddlTypeToEra = H.property $ do
+  AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound]
+  x <- forAll $ genTx era
+  shelleyBasedEraConstraints era $ do
+    let TextEnvelopeType d = textEnvelopeType (proxyToAsType (getProxy x))
+    H.note_ $ "Envelope type: " <> show d
+    cddlTypeToEra (T.pack d) H.=== Right (AnyShelleyBasedEra era)
+ where
+  getProxy :: forall a. a -> Proxy a
+  getProxy _ = Proxy
+
+prop_TxWitness_cddlTypeToEra :: Property
+prop_TxWitness_cddlTypeToEra = H.property $ do
+  AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound]
+  x <- forAll $ genCardanoKeyWitness era
+  shelleyBasedEraConstraints era $ do
+    let TextEnvelopeType d = textEnvelopeType (proxyToAsType (getProxy x))
+    H.note_ $ "Envelope type: " <> show d
+    cddlTypeToEra (T.pack d) H.=== Right (AnyShelleyBasedEra era)
+ where
+  getProxy :: forall a. a -> Proxy a
+  getProxy _ = Proxy
+
 prop_roundtrip_Tx_Cddl :: Property
 prop_roundtrip_Tx_Cddl = H.property $ do
   AnyShelleyBasedEra era <- H.noteShowM . H.forAll $ Gen.element [minBound .. maxBound]
@@ -281,6 +307,12 @@ tests =
     , testProperty
         "roundtrip script PlutusScriptV2 CBOR"
         prop_roundtrip_script_PlutusScriptV2_CBOR
+    , testProperty
+        "cddlTypeToEra for Tx types"
+        prop_Tx_cddlTypeToEra
+    , testProperty
+        "cddlTypeToEra for TxWitness types"
+        prop_TxWitness_cddlTypeToEra
     , testProperty
         "roundtrip UpdateProposal CBOR"
         prop_roundtrip_UpdateProposal_CBOR