Add cbor RoundTrip tests for blocks for each era

IntersectMBO · Feb 3, 2025 · 23d176c · 23d176c
1 parent 513b568
commit 23d176c
Show file tree

Hide file tree

Showing 3 changed files with 57 additions and 2 deletions.
diff --git a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal
@@ -95,7 +95,9 @@ test-suite tests
   type: exitcode-stdio-1.0
   main-is: Main.hs
   hs-source-dirs: test
-  other-modules: Test.Cardano.Protocol.Binary.CddlSpec
+  other-modules:
+    Test.Cardano.Protocol.Binary.CddlSpec
+    Test.Cardano.Protocol.Binary.RoundTrip
   default-language: Haskell2010
   ghc-options:
     -Wall
@@ -112,7 +114,12 @@ test-suite tests
   build-depends:
     base,
     bytestring,
+    cardano-ledger-allegra,
+    cardano-ledger-alonzo,
+    cardano-ledger-babbage,
     cardano-ledger-binary:{cardano-ledger-binary, testlib},
+    cardano-ledger-mary,
+    cardano-ledger-conway:{cardano-ledger-conway, testlib},
     cardano-ledger-core:{cardano-ledger-core, testlib},
     cardano-ledger-shelley:{cardano-ledger-shelley, testlib},
-    cardano-protocol-tpraos,
+    cardano-protocol-tpraos:{cardano-protocol-tpraos, testlib},
diff --git a/libs/cardano-protocol-tpraos/test/Main.hs b/libs/cardano-protocol-tpraos/test/Main.hs
@@ -2,9 +2,11 @@ module Main where
 
 import Test.Cardano.Ledger.Common
 import qualified Test.Cardano.Protocol.Binary.CddlSpec as Cddl
+import qualified Test.Cardano.Protocol.Binary.RoundTrip as RoundTrip
 
 main :: IO ()
 main =
   ledgerTestMain $
     describe "TPraos" $ do
       Cddl.spec
+      RoundTrip.spec
diff --git a/libs/cardano-protocol-tpraos/test/Test/Cardano/Protocol/Binary/RoundTrip.hs b/libs/cardano-protocol-tpraos/test/Test/Cardano/Protocol/Binary/RoundTrip.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Test.Cardano.Protocol.Binary.RoundTrip (spec) where
+
+import Cardano.Ledger.Allegra (AllegraEra)
+import Cardano.Ledger.Alonzo (AlonzoEra)
+import Cardano.Ledger.Babbage (BabbageEra)
+import Cardano.Ledger.Block (Block)
+import Cardano.Ledger.Conway (ConwayEra)
+import Cardano.Ledger.Core
+import Cardano.Ledger.Mary (MaryEra)
+import Cardano.Ledger.Shelley (ShelleyEra)
+import Cardano.Protocol.Crypto (StandardCrypto)
+import Cardano.Protocol.TPraos.BHeader (BHeader)
+import Data.Typeable
+import Test.Cardano.Ledger.Common
+import Test.Cardano.Ledger.Conway.Arbitrary ()
+import Test.Cardano.Ledger.Core.Binary.RoundTrip
+import Test.Cardano.Protocol.TPraos.Arbitrary ()
+
+spec :: Spec
+spec = do
+  describe "RoundTrip" $ do
+    roundTripBlock @ShelleyEra
+    roundTripBlock @AllegraEra
+    roundTripBlock @MaryEra
+    roundTripBlock @AlonzoEra
+    roundTripBlock @BabbageEra
+    roundTripBlock @ConwayEra
+
+roundTripBlock ::
+  forall era.
+  ( EraSegWits era
+  , Arbitrary (Tx era)
+  ) =>
+  Spec
+roundTripBlock =
+  prop (show (typeRep $ Proxy @(Block (BHeader StandardCrypto) era))) $
+    withMaxSuccess 3 $
+      roundTripAnnEraExpectation @era @(Block (BHeader StandardCrypto) era)