Prefix Set encoding with tag 258

Starting with Conway we need to prefix all places where a Set is used
IntersectMBO · Jan 23, 2024 · 86c8c5e · 86c8c5e
1 parent 8b9c872
commit 86c8c5e
Show file tree

Hide file tree

Showing 4 changed files with 27 additions and 9 deletions.
diff --git 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
@@ -1,15 +1,19 @@
+{-# 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.Foldable (toList)
 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 +86,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 +100,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
@@ -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
@@ -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 ->