From 58f80987bbb1953ece9655c8f598177eccdd9227 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 23 Jan 2024 18:32:52 +0100 Subject: [PATCH 1/9] Add `OSet.fromFoldable` --- libs/cardano-data/CHANGELOG.md | 1 + libs/cardano-data/src/Data/OSet/Strict.hs | 9 +++++++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/libs/cardano-data/CHANGELOG.md b/libs/cardano-data/CHANGELOG.md index a1799e06e7e..c767a8fe8ee 100644 --- a/libs/cardano-data/CHANGELOG.md +++ b/libs/cardano-data/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.2.0.0 +* Add `fromFoldable` * Moved `ToExpr` instances out of the main library and into the testlib. ## 1.1.2.0 diff --git a/libs/cardano-data/src/Data/OSet/Strict.hs b/libs/cardano-data/src/Data/OSet/Strict.hs index bea63d96435..5da2e0cea15 100644 --- a/libs/cardano-data/src/Data/OSet/Strict.hs +++ b/libs/cardano-data/src/Data/OSet/Strict.hs @@ -24,6 +24,7 @@ module Data.OSet.Strict ( fromStrictSeqDuplicates, toStrictSeq, fromSet, + fromFoldable, invariantHolds, invariantHolds', (|>), @@ -74,7 +75,7 @@ instance Ord a => Monoid (OSet a) where instance Ord a => IsList (OSet a) where type Item (OSet a) = a - fromList = fromStrictSeq . SSeq.fromList + fromList = fromFoldable toList = F.toList . osSSeq instance Foldable OSet where @@ -175,11 +176,15 @@ unsnoc (OSet seq set) = case seq of SSeq.Empty -> Nothing xs' SSeq.:|> x -> Just (OSet xs' (x `Set.delete` set), x) +-- | Using a `Foldable` instance of the source data structure convert it to an `OSet` +fromFoldable :: (Foldable f, Ord a) => f a -> OSet a +fromFoldable = F.foldl' snoc empty + -- | \(O(n \log n)\). Checks membership before snoc-ing. -- De-duplicates the StrictSeq without overwriting. -- Starts from the left or head, using `foldl'` fromStrictSeq :: Ord a => SSeq.StrictSeq a -> OSet a -fromStrictSeq = F.foldl' snoc empty +fromStrictSeq = fromFoldable -- | \(O(n \log n)\). Checks membership before snoc-ing. -- Returns a 2-tuple, with `fst` as a `Set` of duplicates found From 08bbbd71455b3af4e2711339afbab86c7c624b73 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 23 Jan 2024 23:25:04 +0100 Subject: [PATCH 2/9] Add `OSet.toSet` --- libs/cardano-data/CHANGELOG.md | 1 + libs/cardano-data/src/Data/OSet/Strict.hs | 7 ++++++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/libs/cardano-data/CHANGELOG.md b/libs/cardano-data/CHANGELOG.md index c767a8fe8ee..18ad894ff7b 100644 --- a/libs/cardano-data/CHANGELOG.md +++ b/libs/cardano-data/CHANGELOG.md @@ -2,6 +2,7 @@ ## 1.2.0.0 +* Add `toSet` * Add `fromFoldable` * Moved `ToExpr` instances out of the main library and into the testlib. diff --git a/libs/cardano-data/src/Data/OSet/Strict.hs b/libs/cardano-data/src/Data/OSet/Strict.hs index 5da2e0cea15..763509701f8 100644 --- a/libs/cardano-data/src/Data/OSet/Strict.hs +++ b/libs/cardano-data/src/Data/OSet/Strict.hs @@ -23,6 +23,7 @@ module Data.OSet.Strict ( fromStrictSeq, fromStrictSeqDuplicates, toStrictSeq, + toSet, fromSet, fromFoldable, invariantHolds, @@ -199,10 +200,14 @@ fromStrictSeqDuplicates = F.foldl' snoc' (Set.empty, empty) then (x `Set.insert` duplicates, oset) else (duplicates, OSet (seq SSeq.|> x) (x `Set.insert` set)) --- | \( O(1) \). +-- | \( O(1) \) - Extract underlying strict sequence toStrictSeq :: OSet a -> SSeq.StrictSeq a toStrictSeq = osSSeq +-- | \( O(1) \) - Extract underlying Set +toSet :: OSet a -> Set.Set a +toSet = osSet + -- | \( O(n) \). fromSet :: Set.Set a -> OSet a fromSet set = OSet (SSeq.fromList $ Set.elems set) set From 8b9c872510618dc3969499652f2ff1991aca6205 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 23 Jan 2024 23:18:33 +0100 Subject: [PATCH 3/9] Fix OSet Arbitrary instance --- libs/cardano-data/testlib/Test/Cardano/Data/Arbitrary.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libs/cardano-data/testlib/Test/Cardano/Data/Arbitrary.hs b/libs/cardano-data/testlib/Test/Cardano/Data/Arbitrary.hs index c5b6872ff87..805b7e5595d 100644 --- a/libs/cardano-data/testlib/Test/Cardano/Data/Arbitrary.hs +++ b/libs/cardano-data/testlib/Test/Cardano/Data/Arbitrary.hs @@ -13,7 +13,7 @@ import Test.Cardano.Ledger.Binary.Arbitrary () import Test.QuickCheck instance (Arbitrary a, Ord a) => Arbitrary (OSet.OSet a) where - arbitrary = fmap (OSet.fromSet . Set.fromList) . shuffle . Set.toList =<< arbitrary + arbitrary = fmap OSet.fromFoldable . shuffle . Set.toList =<< arbitrary instance (Ord v, Arbitrary v, OMap.HasOKey k v, Arbitrary k) => Arbitrary (OMap.OMap k v) where arbitrary = From ecd71a9a0150e72ed1f6417ed9a4e17c637dda39 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 23 Jan 2024 21:50:05 +0100 Subject: [PATCH 4/9] Prefix Set encoding with tag 258 Starting with Conway we need to prefix all places where a Set is used --- libs/cardano-data/cardano-data.cabal | 2 +- .../test/Test/Cardano/Data/OSet/StrictSpec.hs | 13 +++++++++---- .../src/Cardano/Ledger/Binary/Encoding/Encoder.hs | 12 ++++++++++-- .../Test/Cardano/Ledger/Binary/RoundTripSpec.hs | 8 ++++++-- 4 files changed, 26 insertions(+), 9 deletions(-) diff --git a/libs/cardano-data/cardano-data.cabal b/libs/cardano-data/cardano-data.cabal index 84fbd70b2b2..b083869d34e 100644 --- a/libs/cardano-data/cardano-data.cabal +++ b/libs/cardano-data/cardano-data.cabal @@ -88,7 +88,7 @@ test-suite cardano-data-tests containers, hspec, cardano-data, - cardano-ledger-binary:testlib, + cardano-ledger-binary:{cardano-ledger-binary, testlib}, testlib, QuickCheck, quickcheck-classes-base, diff --git a/libs/cardano-data/test/Test/Cardano/Data/OSet/StrictSpec.hs b/libs/cardano-data/test/Test/Cardano/Data/OSet/StrictSpec.hs index 0dedd1cd537..e44bdbeeea7 100644 --- a/libs/cardano-data/test/Test/Cardano/Data/OSet/StrictSpec.hs +++ b/libs/cardano-data/test/Test/Cardano/Data/OSet/StrictSpec.hs @@ -1,15 +1,18 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Test.Cardano.Data.OSet.StrictSpec where +import Cardano.Ledger.Binary (natVersion) +import Control.Monad (forM_) import Data.OSet.Strict hiding (empty) import Data.Proxy import Data.Sequence.Strict (StrictSeq, fromList, (><)) import Data.Set (Set, elems, empty) import Test.Cardano.Data.Arbitrary () -import Test.Cardano.Ledger.Binary.RoundTrip (roundTripCborSpec) +import Test.Cardano.Ledger.Binary.RoundTrip (cborTrip, embedTripSpec, roundTripCborSpec) import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck.Classes.Base @@ -82,6 +85,11 @@ spec = context "CBOR round-trip" $ do roundTripCborSpec @(OSet Int) roundTripCborSpec @(OSet (OSet Int)) + forM_ [natVersion @9 .. maxBound] $ \v -> do + embedTripSpec v v (cborTrip @(Set Word) @(OSet Word)) $ + \oset set -> set `shouldBe` toSet oset + embedTripSpec v v (cborTrip @(OSet Word) @(Set Word)) $ + \set oset -> toSet oset `shouldBe` set context "Typeclass laws" $ do it "Type" $ lawsCheckOne @@ -91,6 +99,3 @@ spec = , monoidLaws , semigroupMonoidLaws ] - --- it "Type -> Type" $ do --- lawsCheck $ foldableLaws (Proxy :: Proxy OSet) diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/Encoder.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/Encoder.hs index 46ef12154a1..827c83b2e62 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/Encoder.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Encoding/Encoder.hs @@ -468,16 +468,24 @@ variableListLenEncoding len contents = -- | Encode a Set. Versions variance: -- +-- * [>= 9] - Variable length encoding for Sets larger than 23 elements, otherwise exact +-- length encoding. Prefixes with a special 258 `setTag`. +-- -- * [>= 2] - Variable length encoding for Sets larger than 23 elements, otherwise exact -- length encoding -- --- * [< 2] - Variable length encoding. Also prefixes with a special 258 tag. +-- * [< 2] - Variable length encoding. Prefixes with a special 258 `setTag`. encodeSet :: (a -> Encoding) -> Set.Set a -> Encoding encodeSet encodeValue f = let foldableEncoding = foldMap' encodeValue f + varLenSetEncoding = variableListLenEncoding (Set.size f) foldableEncoding in ifEncodingVersionAtLeast (natVersion @2) - (variableListLenEncoding (Set.size f) foldableEncoding) + ( ifEncodingVersionAtLeast + (natVersion @9) + (encodeTag setTag <> varLenSetEncoding) + varLenSetEncoding + ) (encodeTag setTag <> exactListLenEncoding (Set.size f) foldableEncoding) {-# INLINE encodeSet #-} diff --git a/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/RoundTripSpec.hs b/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/RoundTripSpec.hs index e868bc71ea1..fdd4709260b 100644 --- a/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/RoundTripSpec.hs +++ b/libs/cardano-ledger-binary/test/Test/Cardano/Ledger/Binary/RoundTripSpec.hs @@ -42,6 +42,7 @@ import Cardano.Slotting.Slot (EpochNo, EpochSize, SlotNo, WithOrigin) import Cardano.Slotting.Time (SystemStart) import Codec.CBOR.ByteArray (ByteArray (..)) import Codec.CBOR.ByteArray.Sliced (SlicedByteArray (..)) +import Control.Monad (when) import Data.Fixed (Nano, Pico) import Data.Foldable as F import Data.IP (IPv4, IPv6) @@ -310,8 +311,11 @@ spec = do \xs sxs -> xs `shouldBe` F.toList sxs embedTripSpec v v (cborTrip @(SSeq.StrictSeq Word) @[Word]) $ \xs sxs -> xs `shouldBe` F.toList sxs - embedTripSpec v v (cborTrip @(Set.Set Word) @[Word]) $ - \xs sxs -> xs `shouldBe` Set.toList sxs + when (v < natVersion @9) $ do + -- Starting with version 9 Set is prefixed with tag 258, which prevents it from + -- being deserialized into a list. + embedTripSpec v v (cborTrip @(Set.Set Word) @[Word]) $ + \xs sxs -> xs `shouldBe` Set.toList sxs embedTripSpec v v (cborTrip @(VMap.VMap VMap.VP VMap.VP Word Int) @(Map.Map Word Int)) $ \xs sxs -> xs `shouldBe` VMap.toMap sxs forM_ [minBound .. natVersion @8] $ \v -> From ac860c55c941e316dd0c11d9eab5b27d8fee275f Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Tue, 23 Jan 2024 23:07:21 +0100 Subject: [PATCH 5/9] Add a few more laws to be tested --- libs/cardano-data/cardano-data.cabal | 2 +- libs/cardano-data/test/Test/Cardano/Data/OMap/StrictSpec.hs | 5 +++-- libs/cardano-data/test/Test/Cardano/Data/OSet/StrictSpec.hs | 6 ++++-- 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/libs/cardano-data/cardano-data.cabal b/libs/cardano-data/cardano-data.cabal index b083869d34e..a53ec20ab16 100644 --- a/libs/cardano-data/cardano-data.cabal +++ b/libs/cardano-data/cardano-data.cabal @@ -91,5 +91,5 @@ test-suite cardano-data-tests cardano-ledger-binary:{cardano-ledger-binary, testlib}, testlib, QuickCheck, - quickcheck-classes-base, + quickcheck-classes, microlens diff --git a/libs/cardano-data/test/Test/Cardano/Data/OMap/StrictSpec.hs b/libs/cardano-data/test/Test/Cardano/Data/OMap/StrictSpec.hs index fca3dc01529..e9cd9ca85ec 100644 --- a/libs/cardano-data/test/Test/Cardano/Data/OMap/StrictSpec.hs +++ b/libs/cardano-data/test/Test/Cardano/Data/OMap/StrictSpec.hs @@ -19,7 +19,7 @@ import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck (Arbitrary) import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary)) -import Test.QuickCheck.Classes.Base +import Test.QuickCheck.Classes import Prelude hiding (elem, filter, lookup, null) spec :: Spec @@ -148,7 +148,8 @@ spec = it "Type" $ lawsCheckOne (Proxy :: Proxy (OMap Int Int)) - [ isListLaws + [ eqLaws + , isListLaws , semigroupLaws , monoidLaws , semigroupMonoidLaws diff --git a/libs/cardano-data/test/Test/Cardano/Data/OSet/StrictSpec.hs b/libs/cardano-data/test/Test/Cardano/Data/OSet/StrictSpec.hs index e44bdbeeea7..0931968d3a6 100644 --- a/libs/cardano-data/test/Test/Cardano/Data/OSet/StrictSpec.hs +++ b/libs/cardano-data/test/Test/Cardano/Data/OSet/StrictSpec.hs @@ -15,7 +15,7 @@ import Test.Cardano.Data.Arbitrary () import Test.Cardano.Ledger.Binary.RoundTrip (cborTrip, embedTripSpec, roundTripCborSpec) import Test.Hspec import Test.Hspec.QuickCheck -import Test.QuickCheck.Classes.Base +import Test.QuickCheck.Classes spec :: Spec spec = @@ -94,7 +94,9 @@ spec = it "Type" $ lawsCheckOne (Proxy :: Proxy (OSet Int)) - [ isListLaws + [ eqLaws + , ordLaws + , isListLaws , semigroupLaws , monoidLaws , semigroupMonoidLaws From 36b2a6cc6aa0ebfe3f0f4c12bc5c52c1eb1d6101 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Wed, 24 Jan 2024 01:31:07 +0100 Subject: [PATCH 6/9] Allow set tag during Set Conway decoding --- .../src/Cardano/Ledger/Binary/Decoding/Annotated.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Annotated.hs b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Annotated.hs index 2710f613789..df089d64ae5 100644 --- a/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Annotated.hs +++ b/libs/cardano-ledger-binary/src/Cardano/Ledger/Binary/Decoding/Annotated.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} @@ -6,6 +7,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Cardano.Ledger.Binary.Decoding.Annotated ( @@ -28,11 +30,15 @@ where import Cardano.Ledger.Binary.Decoding.DecCBOR (DecCBOR (..)) import Cardano.Ledger.Binary.Decoding.Decoder ( Decoder, + allowTag, decodeList, decodeWithByteSpan, fromPlainDecoder, + setTag, + whenDecoderVersionAtLeast, ) import Cardano.Ledger.Binary.Encoding (EncCBOR, Version, serialize') +import Cardano.Ledger.Binary.Version (natVersion) import Codec.CBOR.Read (ByteOffset) import qualified Codec.Serialise as Serialise (decode) import Control.DeepSeq (NFData) @@ -192,6 +198,8 @@ withSlice dec = do -- order to enforce no duplicates. decodeAnnSet :: Ord t => Decoder s (Annotator t) -> Decoder s (Annotator (Set.Set t)) decodeAnnSet dec = do + whenDecoderVersionAtLeast (natVersion @9) $ + allowTag setTag xs <- decodeList dec pure (Set.fromList <$> sequence xs) {-# INLINE decodeAnnSet #-} From 10d8189c3da9d5d2f24623014dd7046ae700cab2 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Wed, 24 Jan 2024 10:39:40 +0100 Subject: [PATCH 7/9] Switch Conway key witnesses to use a set tag 258 --- eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs | 8 ++++++-- eras/conway/impl/cddl-files/conway.cddl | 4 ++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs index aa3cdf16778..2ae8a60992a 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs @@ -593,7 +593,9 @@ instance ( D $ ifDecoderVersionAtLeast (natVersion @9) - (mapTraverseableDecoderA (decodeNonEmptyList decCBOR) (Set.fromList . NE.toList)) + ( allowTag setTag + >> mapTraverseableDecoderA (decodeNonEmptyList decCBOR) (Set.fromList . NE.toList) + ) (mapTraverseableDecoderA (decodeList decCBOR) Set.fromList) ) txWitnessField 1 = @@ -606,7 +608,9 @@ instance ( D $ ifDecoderVersionAtLeast (natVersion @9) - (mapTraverseableDecoderA (decodeNonEmptyList decCBOR) (Set.fromList . NE.toList)) + ( allowTag setTag + >> mapTraverseableDecoderA (decodeNonEmptyList decCBOR) (Set.fromList . NE.toList) + ) (mapTraverseableDecoderA (decodeList decCBOR) Set.fromList) ) txWitnessField 3 = fieldA addScripts (decodePlutus SPlutusV1) diff --git a/eras/conway/impl/cddl-files/conway.cddl b/eras/conway/impl/cddl-files/conway.cddl index 9f737a97872..6fee7b56d51 100644 --- a/eras/conway/impl/cddl-files/conway.cddl +++ b/eras/conway/impl/cddl-files/conway.cddl @@ -430,9 +430,9 @@ drep_voting_thresholds = ] transaction_witness_set = - { ? 0: [+ vkeywitness ] + { ? 0: nonempty_set , ? 1: [+ native_script ] - , ? 2: [+ bootstrap_witness ] + , ? 2: nonempty_set , ? 3: nonempty_set , ? 4: [+ plutus_data ] , ? 5: redeemers From cbc84a048bf87d21cd0af175c38e687d2d7e54a6 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Wed, 24 Jan 2024 10:51:37 +0100 Subject: [PATCH 8/9] Switch Conway NativeScript witnesses to use a set tag 258 --- .../impl/src/Cardano/Ledger/Alonzo/TxWits.hs | 19 ++++++++++--------- eras/conway/impl/cddl-files/conway.cddl | 2 +- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs index 2ae8a60992a..4f140d0d20c 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs @@ -499,7 +499,7 @@ instance AlonzoEraScript era => EncCBOR (AlonzoTxWitsRaw era) where null ( Key 1 $ E - (encCBOR . mapMaybe getNativeScript . Map.elems) + (encodeWithSetTag . mapMaybe getNativeScript . Map.elems) (Map.filter isNativeScript scripts) ) !> Omit null (Key 3 $ encodePlutus SPlutusV1) @@ -508,19 +508,18 @@ instance AlonzoEraScript era => EncCBOR (AlonzoTxWitsRaw era) where !> Omit nullDats (Key 4 $ To dats) !> Omit nullRedeemers (Key 5 $ To rdmrs) where + encodeWithSetTag xs = + ifEncodingVersionAtLeast + (natVersion @9) + (encodeTag setTag <> encCBOR xs) + (encCBOR xs) encodePlutus :: PlutusLanguage l => SLanguage l -> Encode ('Closed 'Dense) (Map.Map (ScriptHash (EraCrypto era)) (Plutus l)) encodePlutus slang = E - ( \m -> - let enc = encCBOR . map plutusBinary $ Map.elems m - in ifEncodingVersionAtLeast - (natVersion @9) - (encodeTag setTag <> enc) - enc - ) + (encodeWithSetTag . encCBOR . map plutusBinary . Map.elems) (Map.mapMaybe (toPlutusScript >=> toPlutusSLanguage slang) scripts) toScript :: forall l h. PlutusLanguage l => Map.Map h (Plutus l) -> Map.Map h (Script era) @@ -628,7 +627,9 @@ instance nativeScriptsDecoder = ifDecoderVersionAtLeast (natVersion @9) - (mapTraverseableDecoderA (decodeNonEmptyList pairDecoder) (Map.fromList . NE.toList)) + ( allowTag setTag + >> mapTraverseableDecoderA (decodeNonEmptyList pairDecoder) (Map.fromList . NE.toList) + ) (mapTraverseableDecoderA (decodeList pairDecoder) Map.fromList) where pairDecoder :: Decoder s (Annotator (ScriptHash (EraCrypto era), Script era)) diff --git a/eras/conway/impl/cddl-files/conway.cddl b/eras/conway/impl/cddl-files/conway.cddl index 6fee7b56d51..821c3e8e490 100644 --- a/eras/conway/impl/cddl-files/conway.cddl +++ b/eras/conway/impl/cddl-files/conway.cddl @@ -431,7 +431,7 @@ drep_voting_thresholds = transaction_witness_set = { ? 0: nonempty_set - , ? 1: [+ native_script ] + , ? 1: nonempty_set , ? 2: nonempty_set , ? 3: nonempty_set , ? 4: [+ plutus_data ] From f26eab523c47c7a3deb4fc397ddc97418ce9e864 Mon Sep 17 00:00:00 2001 From: Alexey Kuleshevich Date: Wed, 24 Jan 2024 11:13:34 +0100 Subject: [PATCH 9/9] Switch Conway TxDats witnesses to use a set tag 258 --- .../impl/src/Cardano/Ledger/Alonzo/TxWits.hs | 23 ++++++++++++------- eras/conway/impl/cddl-files/conway.cddl | 2 +- 2 files changed, 16 insertions(+), 9 deletions(-) diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs index 4f140d0d20c..fdf758141e5 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo/TxWits.hs @@ -76,6 +76,7 @@ import Cardano.Ledger.Binary ( Decoder, EncCBOR (..), EncCBORGroup (..), + Encoding, ToCBOR (..), allowTag, decodeList, @@ -275,14 +276,14 @@ isEmptyTxWitness (getMemoRawType -> AlonzoTxWitsRaw a b c d (Redeemers e)) = Set.null a && Set.null b && Map.null c && nullDats d && Map.null e -- ===================================================== -newtype TxDatsRaw era = TxDatsRaw (Map (DataHash (EraCrypto era)) (Data era)) +newtype TxDatsRaw era = TxDatsRaw {unTxDatsRaw :: Map (DataHash (EraCrypto era)) (Data era)} deriving (Generic, Typeable, Eq) deriving newtype (NoThunks, NFData) deriving instance HashAlgorithm (HASH (EraCrypto era)) => Show (TxDatsRaw era) instance (Typeable era, EncCBOR (Data era)) => EncCBOR (TxDatsRaw era) where - encCBOR (TxDatsRaw m) = encCBOR $ Map.elems m + encCBOR = encodeWithSetTag . Map.elems . unTxDatsRaw pattern TxDats' :: Map (DataHash (EraCrypto era)) (Data era) -> TxDats era pattern TxDats' m <- (getMemoRawType -> TxDatsRaw m) @@ -306,7 +307,11 @@ instance Era era => DecCBOR (Annotator (TxDatsRaw era)) where decCBOR = ifDecoderVersionAtLeast (natVersion @9) - (mapTraverseableDecoderA (decodeNonEmptyList decCBOR) (TxDatsRaw . keyBy hashData . NE.toList)) + ( allowTag setTag + >> mapTraverseableDecoderA + (decodeNonEmptyList decCBOR) + (TxDatsRaw . keyBy hashData . NE.toList) + ) (mapTraverseableDecoderA (decodeList decCBOR) (TxDatsRaw . keyBy hashData)) {-# INLINE decCBOR #-} @@ -508,11 +513,6 @@ instance AlonzoEraScript era => EncCBOR (AlonzoTxWitsRaw era) where !> Omit nullDats (Key 4 $ To dats) !> Omit nullRedeemers (Key 5 $ To rdmrs) where - encodeWithSetTag xs = - ifEncodingVersionAtLeast - (natVersion @9) - (encodeTag setTag <> encCBOR xs) - (encCBOR xs) encodePlutus :: PlutusLanguage l => SLanguage l -> @@ -700,3 +700,10 @@ mapTraverseableDecoderA :: (f a -> m b) -> Decoder s (Annotator (m b)) mapTraverseableDecoderA decList transformList = fmap transformList . sequence <$> decList + +encodeWithSetTag :: EncCBOR a => a -> Encoding +encodeWithSetTag xs = + ifEncodingVersionAtLeast + (natVersion @9) + (encodeTag setTag <> encCBOR xs) + (encCBOR xs) diff --git a/eras/conway/impl/cddl-files/conway.cddl b/eras/conway/impl/cddl-files/conway.cddl index 821c3e8e490..473fe95cc91 100644 --- a/eras/conway/impl/cddl-files/conway.cddl +++ b/eras/conway/impl/cddl-files/conway.cddl @@ -434,7 +434,7 @@ transaction_witness_set = , ? 1: nonempty_set , ? 2: nonempty_set , ? 3: nonempty_set - , ? 4: [+ plutus_data ] + , ? 4: nonempty_set , ? 5: redeemers , ? 6: nonempty_set , ? 7: nonempty_set