Test that consensus emits valid CBOR (#323)

- Check that the encoders used in the serialization roundtrip are valid.
- Add a unit test to check that the encoders used to encode the Cardano
examples are valid.

Needs: well-typed/cborg#324.

Closes IntersectMBO/ouroboros-network#3099.

Author: Damian Nadales

cabal.project

@@ -31,3 +31,11 @@ tests: true
 benchmarks: true
 
 import: ./asserts.cabal
+
+-- This can be removed once this fix is released https://github.com/well-typed/cborg/pull/325
+source-repository-package
+  type: git
+  location: https://github.com/well-typed/cborg.git
+  tag: c8013b3474d876f4da56c869d57e3f3ac7f42dc6
+  --sha256: 1rahq47qm977fawkq3d3718bz7fvd7hvy0s9qnbhlzafkqhqnqzj
+  subdir: cborg

ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Examples.hs

@@ -48,9 +48,10 @@ import qualified Test.Cardano.Chain.Genesis.Dummy as CC
 import qualified Test.Cardano.Chain.Update.Example as CC
 import qualified Test.Cardano.Chain.UTxO.Example as CC
 import           Test.ThreadNet.Infra.Byron.ProtocolInfo (mkLeaderCredentials)
-import qualified Test.Util.Serialisation.Golden as Golden
-import           Test.Util.Serialisation.Golden (Labelled, labelled, unlabelled)
-import           Test.Util.Serialisation.Roundtrip (SomeResult (..))
+import qualified Test.Util.Serialisation.Examples as Examples
+import           Test.Util.Serialisation.Examples (Examples (Examples),
+                     Labelled, labelled, unlabelled)
+import           Test.Util.Serialisation.SomeResult (SomeResult (..))
 
 {-------------------------------------------------------------------------------
   Setup
@@ -89,8 +90,8 @@ leaderCredentials =
   Examples
 -------------------------------------------------------------------------------}
 
-examples :: Golden.Examples ByronBlock
-examples = Golden.Examples {
+examples :: Examples ByronBlock
+examples = Examples {
       exampleBlock            = regularAndEBB exampleBlock            exampleEBB
     , exampleSerialisedBlock  = regularAndEBB exampleSerialisedBlock  exampleSerialisedEBB
     , exampleHeader           = regularAndEBB exampleHeader           exampleEBBHeader

ouroboros-consensus-cardano/src/unstable-byron-testlib/Test/Consensus/Byron/Generators.hs

@@ -56,7 +56,8 @@ import           Test.QuickCheck hiding (Result)
 import           Test.QuickCheck.Hedgehog (hedgehog)
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Serialisation.Roundtrip (Coherent (..),
-                     SomeResult (..), WithVersion (..))
+                     WithVersion (..))
+import           Test.Util.Serialisation.SomeResult (SomeResult (..))
 
 {-------------------------------------------------------------------------------
   Generators

ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/Consensus/Cardano/Examples.hs

@@ -49,9 +49,9 @@ import           Ouroboros.Consensus.TypeFamilyWrappers
 import           Ouroboros.Network.Block (Serialised (..))
 import qualified Test.Consensus.Byron.Examples as Byron
 import qualified Test.Consensus.Shelley.Examples as Shelley
-import qualified Test.Util.Serialisation.Golden as Golden
-import           Test.Util.Serialisation.Golden (Examples, Labelled, labelled)
-import           Test.Util.Serialisation.Roundtrip (SomeResult (..))
+import           Test.Util.Serialisation.Examples (Examples (..), Labelled,
+                     labelled, prefixExamples)
+import           Test.Util.Serialisation.SomeResult (SomeResult (..))
 
 type Crypto = StandardCrypto
 
@@ -91,7 +91,7 @@ combineEras = mconcat . hcollapse . hap eraInjections
       -> Examples blk
       -> Examples (CardanoBlock Crypto)
     injExamples eraName idx =
-          Golden.prefixExamples eraName
+          prefixExamples eraName
         . inject exampleStartBounds idx
 
 {-------------------------------------------------------------------------------
@@ -108,7 +108,7 @@ instance Inject SomeResult where
       SomeResult (QueryIfCurrent (injectQuery idx q)) (Right r)
 
 instance Inject Examples where
-  inject startBounds (idx :: Index xs x) Golden.Examples {..} = Golden.Examples {
+  inject startBounds (idx :: Index xs x) Examples {..} = Examples {
         exampleBlock            = inj (Proxy @I)                       exampleBlock
       , exampleSerialisedBlock  = inj (Proxy @Serialised)              exampleSerialisedBlock
       , exampleHeader           = inj (Proxy @Header)                  exampleHeader
@@ -240,7 +240,7 @@ summary =
       (State.TransitionKnown shelleyTransitionEpoch)
       (hardForkLedgerStatePerEra (ledgerStateByron byronLedger))
   where
-    (_, byronLedger) = head $ Golden.exampleLedgerState Byron.examples
+    (_, byronLedger) = head $ exampleLedgerState Byron.examples
 
 eraInfoByron :: SingleEraInfo ByronBlock
 eraInfoByron = singleEraInfo (Proxy @ByronBlock)
@@ -277,16 +277,16 @@ ledgerStateByron stByron =
 -- | Multi-era examples, e.g., applying a transaction to the wrong era.
 multiEraExamples :: Examples (CardanoBlock Crypto)
 multiEraExamples = mempty {
-      Golden.exampleApplyTxErr = labelled [
+      exampleApplyTxErr = labelled [
           ("WrongEraByron",   exampleApplyTxErrWrongEraByron)
         , ("WrongEraShelley", exampleApplyTxErrWrongEraShelley)
         ]
-    , Golden.exampleQuery = labelled [
+    , exampleQuery = labelled [
           ("AnytimeByron",   exampleQueryAnytimeByron)
         , ("AnytimeShelley", exampleQueryAnytimeShelley)
         , ("HardFork",       exampleQueryHardFork)
         ]
-    , Golden.exampleResult = labelled [
+    , exampleResult = labelled [
           ("EraMismatchByron",   exampleResultEraMismatchByron)
         , ("EraMismatchShelley", exampleResultEraMismatchShelley)
         , ("AnytimeByron",       exampleResultAnytimeByron)

ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs

@@ -59,9 +59,9 @@ import           Test.Cardano.Ledger.Shelley.Examples.Consensus
                      (ShelleyLedgerExamples (..), ShelleyResultExamples (..),
                      ledgerExamplesShelley, testShelleyGenesis)
 import           Test.Util.Orphans.Arbitrary ()
-import qualified Test.Util.Serialisation.Golden as Golden
-import           Test.Util.Serialisation.Golden (labelled, unlabelled)
-import           Test.Util.Serialisation.Roundtrip (SomeResult (..))
+import           Test.Util.Serialisation.Examples (Examples (..), labelled,
+                     unlabelled)
+import           Test.Util.Serialisation.SomeResult (SomeResult (..))
 
 
 {-------------------------------------------------------------------------------
@@ -74,11 +74,11 @@ codecConfig = ShelleyCodecConfig
 fromShelleyLedgerExamples
   :: ShelleyCompatible (TPraos (EraCrypto era)) era
   => ShelleyLedgerExamples era
-  -> Golden.Examples (ShelleyBlock (TPraos (EraCrypto era)) era)
+  -> Examples (ShelleyBlock (TPraos (EraCrypto era)) era)
 fromShelleyLedgerExamples ShelleyLedgerExamples {
                             sleResultExamples = ShelleyResultExamples{..}
                             , ..} =
-  Golden.Examples {
+  Examples {
       exampleBlock            = unlabelled blk
     , exampleSerialisedBlock  = unlabelled serialisedBlock
     , exampleHeader           = unlabelled $ getHeader blk
@@ -148,11 +148,11 @@ fromShelleyLedgerExamplesPraos ::
     TranslateProto (TPraos (EraCrypto era)) (Praos (EraCrypto era))
   )
   => ShelleyLedgerExamples era
-  -> Golden.Examples (ShelleyBlock (Praos (EraCrypto era)) era)
+  -> Examples (ShelleyBlock (Praos (EraCrypto era)) era)
 fromShelleyLedgerExamplesPraos ShelleyLedgerExamples {
                             sleResultExamples = ShelleyResultExamples{..}
                             , ..} =
-  Golden.Examples {
+  Examples {
       exampleBlock            = unlabelled blk
     , exampleSerialisedBlock  = unlabelled serialisedBlock
     , exampleHeader           = unlabelled $ getHeader blk
@@ -237,20 +237,20 @@ fromShelleyLedgerExamplesPraos ShelleyLedgerExamples {
 
 
 
-examplesShelley :: Golden.Examples StandardShelleyBlock
+examplesShelley :: Examples StandardShelleyBlock
 examplesShelley = fromShelleyLedgerExamples ledgerExamplesShelley
 
-examplesAllegra :: Golden.Examples StandardAllegraBlock
+examplesAllegra :: Examples StandardAllegraBlock
 examplesAllegra = fromShelleyLedgerExamples ledgerExamplesAllegra
 
-examplesMary :: Golden.Examples StandardMaryBlock
+examplesMary :: Examples StandardMaryBlock
 examplesMary = fromShelleyLedgerExamples ledgerExamplesMary
 
-examplesAlonzo :: Golden.Examples StandardAlonzoBlock
+examplesAlonzo :: Examples StandardAlonzoBlock
 examplesAlonzo = fromShelleyLedgerExamples ledgerExamplesAlonzo
 
-examplesBabbage :: Golden.Examples StandardBabbageBlock
+examplesBabbage :: Examples StandardBabbageBlock
 examplesBabbage = fromShelleyLedgerExamplesPraos ledgerExamplesBabbage
 
-examplesConway :: Golden.Examples StandardConwayBlock
+examplesConway :: Examples StandardConwayBlock
 examplesConway = fromShelleyLedgerExamplesPraos ledgerExamplesConway

ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Generators.hs

@@ -50,7 +50,8 @@ import           Test.Consensus.Shelley.MockCrypto (CanMock)
 import           Test.QuickCheck hiding (Result)
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Serialisation.Roundtrip (Coherent (..),
-                     SomeResult (..), WithVersion (..))
+                     WithVersion (..))
+import           Test.Util.Serialisation.SomeResult (SomeResult (..))
 
 {-------------------------------------------------------------------------------
   Generators

ouroboros-consensus-cardano/test/byron-test/Test/Consensus/Byron/Serialisation.hs

@@ -38,9 +38,7 @@ import           Test.Util.Serialisation.Roundtrip
 tests :: TestTree
 tests = testGroup "Byron"
     [ roundtrip_all testCodecCfg dictNestedHdr
-
     , testProperty "BinaryBlockInfo sanity check" prop_byronBinaryBlockInfo
-
     , testGroup "Integrity"
         [ testProperty "detect corruption in RegularBlock" prop_detectCorruption_RegularBlock
         ]

ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/ByronCompatibility.hs

@@ -48,6 +48,7 @@ import           Test.Tasty
 import           Test.Tasty.QuickCheck
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Serialisation.Roundtrip
+import           Test.Util.Serialisation.SomeResult (SomeResult (..))
 
 tests :: TestTree
 tests = adjustOption reduceTests $

ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Serialisation.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE EmptyCase           #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE GADTs               #-}
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE NamedFieldPuns      #-}
@@ -19,16 +20,18 @@ import           Ouroboros.Consensus.Shelley.Node ()
 import           Ouroboros.Consensus.Storage.Serialisation
 import           Ouroboros.Consensus.Util (Dict (..))
 import           Ouroboros.Network.Block (Serialised (..))
+import qualified Test.Consensus.Cardano.Examples as Cardano.Examples
 import           Test.Consensus.Cardano.Generators (epochSlots)
 import           Test.Consensus.Cardano.MockCrypto (MockCryptoCompatByron)
 import           Test.Tasty
-import           Test.Tasty.QuickCheck
+import           Test.Tasty.QuickCheck (Property, testProperty, (===))
 import           Test.Util.Orphans.Arbitrary ()
 import           Test.Util.Serialisation.Roundtrip
 
 tests :: TestTree
 tests = testGroup "Cardano"
-    [ roundtrip_all testCodecCfg dictNestedHdr
+    [ testGroup "Examples roundtrip" $ examplesRoundtrip Cardano.Examples.codecConfig Cardano.Examples.examples
+    , roundtrip_all testCodecCfg dictNestedHdr
     , testProperty "BinaryBlockInfo sanity check" prop_CardanoBinaryBlockInfo
     ]
 

ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/Serialisation.hs

@@ -30,13 +30,10 @@ import           Test.Util.Serialisation.Roundtrip
 tests :: TestTree
 tests = testGroup "Shelley"
     [ roundtrip_all testCodecCfg dictNestedHdr
-
       -- Test for real crypto too
     , testProperty "hashSize real crypto"       $ prop_hashSize pReal
     , testProperty "ConvertRawHash real crypto" $ roundtrip_ConvertRawHash pReal
-
     , testProperty "BinaryBlockInfo sanity check" prop_shelleyBinaryBlockInfo
-
     , testGroup "Integrity"
         [ testProperty "generate non-corrupt blocks"  prop_blockIntegrity
         , testProperty "generate non-corrupt headers" prop_headerIntegrity