Jj/fail on duplicate wits

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs

@@ -89,6 +89,7 @@ import Cardano.Ledger.Binary (
   decodeMapLenOrIndef,
   decodeMapLikeEnforceNoDuplicates,
   decodeNonEmptyList,
+  decodeSetLikeEnforceNoDuplicates,
   encodeFoldableEncoder,
   encodeListLen,
   encodeTag,
@@ -636,55 +637,91 @@ instance
         txWitnessField
         []
     where
+      setDecoder :: (Ord a, DecCBOR a) => Decoder s (Annotator (Set a))
+      setDecoder =
+        pure
+          <$> ifDecoderVersionAtLeast
+            (natVersion @12)
+            (decodeSetLikeEnforceNoDuplicates Set.insert (\s -> (length s, s)) decCBOR)
+            (allowTag setTag >> Set.fromList . NE.toList <$> decodeNonEmptyList decCBOR)
+      {-# INLINE setDecoder #-}
+
       txWitnessField :: Word -> Field (Annotator (AlonzoTxWitsRaw era))
       txWitnessField 0 =
         fieldAA
           (\x wits -> wits {atwrAddrTxWits = x})
           ( D $
               ifDecoderVersionAtLeast
                 (natVersion @9)
-                ( allowTag setTag
-                    >> mapTraverseableDecoderA (decodeNonEmptyList decCBOR) (Set.fromList . NE.toList)
-                )
+                setDecoder
                 (mapTraverseableDecoderA (decodeList decCBOR) Set.fromList)
           )
       txWitnessField 1 =
-        fieldAA
-          addScriptsTxWitsRaw
-          (D nativeScriptsDecoder)
+        fieldAA addScriptsTxWitsRaw (D scriptsDecoder)
       txWitnessField 2 =
         fieldAA
           (\x wits -> wits {atwrBootAddrTxWits = x})
           ( D $
               ifDecoderVersionAtLeast
                 (natVersion @9)
-                ( allowTag setTag
-                    >> mapTraverseableDecoderA (decodeNonEmptyList decCBOR) (Set.fromList . NE.toList)
-                )
+                setDecoder
                 (mapTraverseableDecoderA (decodeList decCBOR) Set.fromList)
           )
       txWitnessField 3 = fieldA addScriptsTxWitsRaw (decodeAlonzoPlutusScript SPlutusV1)
       txWitnessField 4 =
         fieldAA
           (\x wits -> wits {atwrDatsTxWits = x})
-          From
+          ( D $
+              ifDecoderVersionAtLeast
+                (natVersion @12)
+                noDuplicatesDatsDecoder
+                decCBOR
+          )
       txWitnessField 5 = fieldAA (\x wits -> wits {atwrRdmrsTxWits = x}) From
       txWitnessField 6 = fieldA addScriptsTxWitsRaw (decodeAlonzoPlutusScript SPlutusV2)
       txWitnessField 7 = fieldA addScriptsTxWitsRaw (decodeAlonzoPlutusScript SPlutusV3)
       txWitnessField n = invalidField n
       {-# INLINE txWitnessField #-}
 
-      nativeScriptsDecoder :: Decoder s (Annotator (Map ScriptHash (Script era)))
-      nativeScriptsDecoder =
-        ifDecoderVersionAtLeast
-          (natVersion @9)
-          ( allowTag setTag
-              >> mapTraverseableDecoderA (decodeNonEmptyList pairDecoder) (Map.fromList . NE.toList)
-          )
-          (mapTraverseableDecoderA (decodeList pairDecoder) Map.fromList)
+      pairDecoder :: Decoder s (Annotator (ScriptHash, Script era))
+      pairDecoder = fmap (asHashedScriptPair @era . fromNativeScript) <$> decCBOR
+      {-# INLINE pairDecoder #-}
+
+      noDuplicatesDatsDecoder :: Decoder s (Annotator (TxDats era))
+      noDuplicatesDatsDecoder = do
+        allowTag setTag
+        dats <- decodeList decCBOR
+        pure $ TxDats <$> go Map.empty dats
         where
-          pairDecoder :: Decoder s (Annotator (ScriptHash, Script era))
-          pairDecoder = fmap (asHashedScriptPair . fromNativeScript) <$> decCBOR
+          go m [] = pure m
+          go m (x : xs) = do
+            x' <- x
+            let dh = hashData x'
+            if dh `Map.member` m
+              then fail $ "Duplicate dats found: " <> show dh
+              else go (Map.insert dh x' m) xs
+
+      noDuplicatesScriptsDecoder :: Decoder s (Annotator (Map ScriptHash (Script era)))
+      noDuplicatesScriptsDecoder = do
+        allowTag setTag
+        scripts <- decodeList $ fmap (fromNativeScript @era) <$> decCBOR
+        pure $ go Map.empty scripts
+        where
+          go m [] = pure m
+          go m (x : xs) = do
+            x' <- x
+            let sh = hashScript x'
+            if sh `Map.member` m
+              then fail $ "Duplicate scripts found: " <> show sh
+              else go (Map.insert sh x' m) xs
+
+      scriptsDecoder :: Decoder s (Annotator (Map ScriptHash (Script era)))
+      scriptsDecoder =
+        ifDecoderVersionAtLeast
+          (natVersion @12)
+          noDuplicatesScriptsDecoder
+          (allowTag setTag >> mapTraverseableDecoderA (decodeList pairDecoder) Map.fromList)
+      {-# INLINE scriptsDecoder #-}
   {-# INLINE decCBOR #-}
 
 deriving via

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

@@ -36,6 +36,7 @@ import Data.MapExtras as Map (fromElems)
 import Data.Maybe.Strict (maybeToStrictMaybe)
 import qualified Data.Sequence as Seq
 import qualified Data.Sequence.Strict as StrictSeq
+import Data.Set (Set)
 import qualified Data.Set as Set
 import Data.Typeable (Typeable)
 import Lens.Micro
@@ -152,16 +153,23 @@ instance (AlonzoEraScript era, DecCBOR (NativeScript era)) => DecCBOR (AlonzoTxW
         txWitnessField
         []
     where
+      setDecoder :: (Ord a, DecCBOR a) => Decoder s (Set a)
+      setDecoder =
+        allowTag setTag
+          >> ifDecoderVersionAtLeast
+            (natVersion @12)
+            (decodeSetLikeEnforceNoDuplicates Set.insert (\s -> (length s, s)) decCBOR)
+            (Set.fromList . NE.toList <$> decodeNonEmptyList decCBOR)
+      {-# INLINE setDecoder #-}
+
       txWitnessField :: Word -> Field (AlonzoTxWitsRaw era)
       txWitnessField 0 =
         field
           (\x wits -> wits {atwrAddrTxWits = x})
           ( D $
               ifDecoderVersionAtLeast
                 (natVersion @9)
-                ( allowTag setTag
-                    >> Set.fromList . NE.toList <$> decodeNonEmptyList decCBOR
-                )
+                setDecoder
                 (Set.fromList <$> decodeList decCBOR)
           )
       txWitnessField 1 = field addScriptsTxWitsRaw (D nativeScriptsDecoder)
@@ -171,31 +179,49 @@ instance (AlonzoEraScript era, DecCBOR (NativeScript era)) => DecCBOR (AlonzoTxW
           ( D $
               ifDecoderVersionAtLeast
                 (natVersion @9)
-                ( allowTag setTag
-                    >> Set.fromList . NE.toList <$> decodeNonEmptyList decCBOR
-                )
+                setDecoder
                 (Set.fromList <$> decodeList decCBOR)
           )
       txWitnessField 3 = field addScriptsTxWitsRaw (decodeAlonzoPlutusScript SPlutusV1)
-      txWitnessField 4 = field (\x wits -> wits {atwrDatsTxWits = x}) From
+      txWitnessField 4 =
+        field
+          (\x wits -> wits {atwrDatsTxWits = x})
+          ( D $
+              ifDecoderVersionAtLeast
+                (natVersion @12)
+                ( TxDats
+                    <$> decodeSetLikeEnforceNoDuplicates
+                      (\x -> Map.insert (hashData x) x)
+                      (\m -> (length m, m))
+                      decCBOR
+                )
+                decCBOR
+          )
       txWitnessField 5 = field (\x wits -> wits {atwrRdmrsTxWits = x}) From
       txWitnessField 6 = field addScriptsTxWitsRaw (decodeAlonzoPlutusScript SPlutusV2)
       txWitnessField 7 = field addScriptsTxWitsRaw (decodeAlonzoPlutusScript SPlutusV3)
       txWitnessField n = invalidField n
       {-# INLINE txWitnessField #-}
 
+      pairDecoder :: Decoder s (ScriptHash, Script era)
+      pairDecoder = asHashedScriptPair @era . fromNativeScript <$> decCBOR
+      {-# INLINE pairDecoder #-}
+
+      mapDecoder :: Decoder s (Map ScriptHash (Script era))
+      mapDecoder =
+        allowTag setTag
+          >> ifDecoderVersionAtLeast
+            (natVersion @12)
+            (decodeSetLikeEnforceNoDuplicates (uncurry Map.insert) (\m -> (length m, m)) pairDecoder)
+            (Map.fromList . NE.toList <$> decodeNonEmptyList pairDecoder)
+      {-# INLINE mapDecoder #-}
+
       nativeScriptsDecoder :: Decoder s (Map ScriptHash (Script era))
       nativeScriptsDecoder =
         ifDecoderVersionAtLeast
           (natVersion @9)
-          ( allowTag setTag
-              >> Map.fromList . NE.toList <$> decodeNonEmptyList pairDecoder
-          )
+          mapDecoder
           (Map.fromList <$> decodeList pairDecoder)
-        where
-          pairDecoder :: Decoder s (ScriptHash, Script era)
-          pairDecoder = asHashedScriptPair @era . fromNativeScript <$> decCBOR
-          {-# INLINE pairDecoder #-}
       {-# INLINE nativeScriptsDecoder #-}
 
 deriving newtype instance

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

@@ -1,6 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE RankNTypes #-}
@@ -10,7 +9,7 @@
 
 module Test.Cardano.Ledger.Conway.Binary.Golden (
   expectDecoderResultOn,
-  expectDecoderFailure,
+  expectDecoderFailureAnn,
   listRedeemersEnc,
   goldenListRedeemers,
 ) where
@@ -50,14 +49,14 @@ import Test.Cardano.Ledger.Common (
  )
 import Test.Cardano.Ledger.Conway.Era (ConwayEraTest)
 
-expectDecoderFailure ::
+expectDecoderFailureAnn ::
   forall a.
   (ToExpr a, DecCBOR (Annotator a), Typeable a, HasCallStack) =>
   Version ->
   Enc ->
   DecoderError ->
   Expectation
-expectDecoderFailure version enc expectedErr =
+expectDecoderFailureAnn version enc expectedErr =
   case result of
     Left err -> err `shouldBe` expectedErr
     Right x ->

eras/dijkstra/impl/cardano-ledger-dijkstra.cabal

@@ -140,7 +140,7 @@ library testlib
     cardano-ledger-allegra:{cardano-ledger-allegra, testlib},
     cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib},
     cardano-ledger-babbage:{cardano-ledger-babbage, testlib},
-    cardano-ledger-binary,
+    cardano-ledger-binary:{cardano-ledger-binary, testlib},
     cardano-ledger-conway:{cardano-ledger-conway, testlib},
     cardano-ledger-core:{cardano-ledger-core, testlib},
     cardano-ledger-dijkstra,

eras/dijkstra/impl/test/Main.hs

@@ -31,4 +31,4 @@ main =
         txInfoSpec @DijkstraEra SPlutusV3
         txInfoSpec @DijkstraEra SPlutusV4
       describe "Golden" $ do
-        Golden.goldenListRedeemersDisallowed @DijkstraEra
+        Golden.spec @DijkstraEra

eras/dijkstra/impl/test/Test/Cardano/Ledger/Dijkstra/GoldenSpec.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}