Merge pull request #5413 from IntersectMBO/td/nested-tx-deserializer

Subtransactions CBOR deserializer

Author: teodanciu

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

@@ -80,7 +80,7 @@ import Cardano.Ledger.Binary (
   decodeMapLenOrIndef,
   decodeMapLikeEnforceNoDuplicates,
   decodeNonEmptyList,
-  decodeSetLikeEnforceNoDuplicates,
+  decodeNonEmptySetLikeEnforceNoDuplicatesAnn,
   encodeFoldableEncoder,
   encodeListLen,
   encodeTag,
@@ -317,18 +317,10 @@ noDuplicateNonEmptySetAsMapDecoderAnn ::
   (Ord k, DecCBOR (Annotator a)) =>
   (a -> (k, v)) ->
   Decoder s (Annotator (Map k v))
-noDuplicateNonEmptySetAsMapDecoderAnn toKV = do
-  allowTag setTag
-  vals <- decodeList decCBOR
-  pure $ go (Map.empty, 0) vals
-  where
-    go (m, n) []
-      | Map.null m = fail "Empty script Set is not allowed"
-      | length m /= n = fail "Duplicate elements in the scripts Set were encountered"
-      | otherwise = pure m
-    go (!m, !n) (x : xs) = do
-      (k, v) <- toKV <$> x
-      go (Map.insert k v m, n + 1) xs
+noDuplicateNonEmptySetAsMapDecoderAnn toKV =
+  decodeNonEmptySetLikeEnforceNoDuplicatesAnn
+    (\x m -> let (k, v) = toKV x in Map.insert k v m)
+    (\m -> (Map.size m, m))
 {-# INLINE noDuplicateNonEmptySetAsMapDecoderAnn #-}
 
 instance Era era => DecCBOR (Annotator (TxDatsRaw era)) where
@@ -611,18 +603,21 @@ instance
         txWitnessField
         []
     where
-      addrWitsSetDecoder :: (Ord a, DecCBOR a) => Decoder s (Annotator (Set a))
-      addrWitsSetDecoder =
-        pure <$> do
-          let
-            nonEmptyDecoder = do
-              allowTag setTag
-              Set.fromList . NE.toList <$> decodeNonEmptyList decCBOR
-            nonEmptyNoDuplicatesDecoder = do
-              s <- decodeSetLikeEnforceNoDuplicates Set.insert (\s -> (length s, s)) decCBOR
-              when (Set.null s) $ fail "Set cannot be empty"
-              pure s
-          ifDecoderVersionAtLeast (natVersion @12) nonEmptyNoDuplicatesDecoder nonEmptyDecoder
+      addrWitsSetDecoder ::
+        (Ord a, DecCBOR (Annotator a), DecCBOR a) => Decoder s (Annotator (Set a))
+      addrWitsSetDecoder = do
+        let
+          nonEmptyDecoder = do
+            allowTag setTag
+            s <- Set.fromList . NE.toList <$> decodeNonEmptyList decCBOR
+            pure $ pure s
+
+          nonEmptyNoDuplicatesDecoder =
+            decodeNonEmptySetLikeEnforceNoDuplicatesAnn
+              Set.insert
+              (\s -> (Set.size s, s))
+
+        ifDecoderVersionAtLeast (natVersion @12) nonEmptyNoDuplicatesDecoder nonEmptyDecoder
       {-# INLINE addrWitsSetDecoder #-}
 
       txWitnessField :: Word -> Field (Annotator (AlonzoTxWitsRaw era))

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

@@ -141,6 +141,7 @@ instance
       auxDataField 2 = field (addPlutusScripts PlutusV1) (D (guardPlutus PlutusV1 >> decCBOR))
       auxDataField 3 = field (addPlutusScripts PlutusV2) (D (guardPlutus PlutusV2 >> decCBOR))
       auxDataField 4 = field (addPlutusScripts PlutusV3) (D (guardPlutus PlutusV3 >> decCBOR))
+      auxDataField 5 = field (addPlutusScripts PlutusV4) (D (guardPlutus PlutusV4 >> decCBOR))
       auxDataField n = invalidField n
 
 deriving newtype instance (Era era, DecCBOR (NativeScript era)) => DecCBOR (AlonzoTxAuxData era)

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

@@ -205,7 +205,7 @@ test-suite tests
     cardano-ledger-alonzo,
     cardano-ledger-babbage:testlib,
     cardano-ledger-binary:testlib,
-    cardano-ledger-conway,
+    cardano-ledger-conway:{cardano-ledger-conway, testlib},
     cardano-ledger-core:{cardano-ledger-core, testlib},
     cardano-ledger-dijkstra:{cardano-ledger-dijkstra, testlib},
     cardano-ledger-shelley:testlib,