Address review comments

Co-authored-by: Alexey Kuleshevich <[email protected]>

Author: Soupstraw

eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Binary/Golden.hs

@@ -27,9 +27,11 @@ import Test.Cardano.Ledger.Allegra.Binary.Golden hiding (spec)
 import Test.Cardano.Ledger.Alonzo.Era (AlonzoEraTest)
 import Test.Cardano.Ledger.Binary.Plain.Golden (Enc (..))
 import Test.Cardano.Ledger.Common (
+  NonNegative (..),
   Spec,
   describe,
   it,
+  prop,
  )
 import Test.Cardano.Ledger.Imp.Common (forEachEraVersion)
 
@@ -65,9 +67,13 @@ spec = do
         -- from there onwards
         it "plutusV2Script" $ expectSuccessOnEmptyFieldRaw 6
         it "plutusV3Script" $ expectSuccessOnEmptyFieldRaw 7
-        it "8th field" . expectFailureOnEmptyField 8 $
-          DecoderErrorDeserialiseFailure
-            (Binary.label $ Proxy @(Annotator (TxWits era)))
-            (DeserialiseFailure 2 "An error occured while decoding (Int,Void) not a valid key:.\nError: 8")
+        prop "Invalid field" $ \(NonNegative n) ->
+          let invalidTag = n + 8
+           in expectFailureOnEmptyField invalidTag $
+                DecoderErrorDeserialiseFailure
+                  (Binary.label $ Proxy @(Annotator (TxWits era)))
+                  ( DeserialiseFailure 2 $
+                      "An error occurred while decoding (Int,Void) not a valid key:.\nError: " <> show invalidTag
+                  )
   describe "TxCerts" $ do
     forEachEraVersion @era $ allegraDecodeDuplicateDelegCertSucceeds @era

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Binary/Golden.hs

@@ -11,7 +11,7 @@ module Test.Cardano.Ledger.Conway.Binary.Golden (
   spec,
   listRedeemersEnc,
   goldenListRedeemers,
-  witsEmptyFieldWithTag,
+  witsEmptyFieldWithSetTag,
   conwayDecodeDuplicateDelegCertFails,
   module Test.Cardano.Ledger.Alonzo.Binary.Golden,
 ) where
@@ -73,8 +73,8 @@ goldenListRedeemers =
       (Redeemers $ Map.singleton (SpendingPurpose $ AsIx 10) (Data $ I 20, ExUnits 30 40))
       unRedeemers
 
-witsEmptyFieldWithTag :: Int -> Enc
-witsEmptyFieldWithTag k =
+witsEmptyFieldWithSetTag :: Int -> Enc
+witsEmptyFieldWithSetTag k =
   mconcat
     [ E $ TkMapLen 1
     , E k
@@ -142,7 +142,7 @@ spec = do
         describe "Tagged" $ do
           let
             expectFailureOnEmptyField k =
-              expectDecoderFailureAnn @(TxWits era) version (witsEmptyFieldWithTag k)
+              expectDecoderFailureAnn @(TxWits era) version (witsEmptyFieldWithSetTag k)
           it "addrTxWits" . expectFailureOnEmptyField 0 $
             DecoderErrorDeserialiseFailure
               (Binary.label $ Proxy @(Annotator (TxWits era)))

eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -101,7 +100,7 @@ goldenEmptyFields version =
     describe "Tagged" $ do
       let
         expectFailureOnEmptyField k =
-          expectDecoderFailureAnn @(TxWits era) version (witsEmptyFieldWithTag k)
+          expectDecoderFailureAnn @(TxWits era) version (witsEmptyFieldWithSetTag k)
       it "addrTxWits" . expectFailureOnEmptyField 0 $
         DecoderErrorDeserialiseFailure
           (Binary.label $ Proxy @(Annotator (TxWits era)))

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Binary/Golden.hs

@@ -37,7 +37,6 @@ import Test.Cardano.Ledger.Binary.Plain.Golden
 import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.Binary.Golden
 import Test.Cardano.Ledger.Core.KeyPair (mkKeyHash)
-import Test.Cardano.Ledger.Imp.Common (forEachEraVersion)
 import Test.Cardano.Ledger.Shelley.Arbitrary ()
 import Test.Cardano.Ledger.Shelley.Era (ShelleyEraTest)
 

libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Common.hs

@@ -1,3 +1,8 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
 module Test.Cardano.Ledger.Common (
   module X,
   ledgerTestMain,
@@ -47,8 +52,11 @@ module Test.Cardano.Ledger.Common (
 
   -- * Miscellanous helpers
   tracedDiscard,
+  forEachEraVersion,
 ) where
 
+import Cardano.Ledger.Binary (Version)
+import Cardano.Ledger.Core (Era, eraProtVersions)
 import Control.DeepSeq (NFData)
 import Control.Monad as X (forM_, replicateM, replicateM_, unless, void, when, (>=>))
 import qualified Debug.Trace as Debug
@@ -136,3 +144,7 @@ runGen ::
   Gen a ->
   a
 runGen seed size gen = unGen gen (mkQCGen seed) size
+
+forEachEraVersion :: forall era. (Era era, HasCallStack) => (Version -> Spec) -> Spec
+forEachEraVersion sv = forM_ (eraProtVersions @era) $
+  \version -> describe (show version) $ sv version

libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Binary/Golden.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -31,10 +30,9 @@ import Test.Cardano.Ledger.Common (
   diffExprString,
   expectationFailure,
   shouldBe,
-  shouldBeExpr,
   showExpr,
  )
-import Test.Cardano.Ledger.TreeDiff (ToExpr)
+import Test.Cardano.Ledger.TreeDiff (ToExpr, expectExprEqualWithMessage)
 
 decodeEnc :: forall a. DecCBOR (Annotator a) => Version -> Enc -> Either DecoderError a
 decodeEnc version enc = decodeFullAnnotator @a version (Binary.label $ Proxy @(Annotator a)) decCBOR bytes
@@ -51,11 +49,12 @@ expectDecoderSuccessAnnWith ::
   Expectation
 expectDecoderSuccessAnnWith equals version enc expected =
   case decodeEnc @a version enc of
+    Left err -> expectationFailure $ "Unexpected decoder failure: " <> show err
     Right x | x `equals` expected -> pure ()
-    decResult -> expectationFailure $ diffExprString (Right expected) decResult
+    Right result -> expectationFailure $ diffExprString expected result
 
 expectDecoderSuccessAnn ::
-  (ToExpr a, DecCBOR (Annotator a), Eq a) => Version -> Enc -> a -> Expectation
+  (ToExpr a, DecCBOR (Annotator a), Eq a, HasCallStack) => Version -> Enc -> a -> Expectation
 expectDecoderSuccessAnn = expectDecoderSuccessAnnWith (==)
 
 expectDecoderFailureAnn ::
@@ -78,4 +77,8 @@ expectDecoderResultOn ::
   (ToExpr b, DecCBOR (Annotator a), Eq b, HasCallStack) =>
   Version -> Enc -> a -> (a -> b) -> Expectation
 expectDecoderResultOn version enc expected f =
-  embedTripAnnExpectation version version (\x _ -> f x `shouldBeExpr` f expected) enc
+  embedTripAnnExpectation
+    version
+    version
+    (\x _ -> expectExprEqualWithMessage "" (f x) (f expected))
+    enc

libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Imp/Common.hs

@@ -84,11 +84,8 @@ module Test.Cardano.Ledger.Imp.Common (
   -- * Re-exports from ImpSpec
   withImpInit,
   modifyImpInit,
-  forEachEraVersion,
 ) where
 
-import Cardano.Ledger.Binary (Version)
-import Cardano.Ledger.Core (eraProtVersions)
 import Control.Monad.IO.Class
 import Data.List (isInfixOf)
 import qualified System.Random.Stateful as R
@@ -147,7 +144,6 @@ import Test.Cardano.Ledger.Common as X hiding (
   vectorOf,
  )
 import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkCredential)
-import Test.Cardano.Ledger.Era (EraTest)
 import Test.ImpSpec (modifyImpInit, withImpInit)
 import Test.ImpSpec.Expectations.Lifted
 import Test.ImpSpec.Random (
@@ -229,7 +225,3 @@ expectNothingExpr (Just x) =
   assertFailure $
     "Expected Nothing, got Just:\n" <> showExpr x
 expectNothingExpr Nothing = pure ()
-
-forEachEraVersion :: forall era. EraTest era => (Version -> Spec) -> Spec
-forEachEraVersion sv = forM_ (eraProtVersions @era) $
-  \version -> describe (show version) $ sv version