Starting in major version 9, we know raise a decoding error if a CBOR map contains duplicate keys. resolves #2965
decodeMapByKey decodeKey decodeValue =
ifDecoderVersionAtLeast
(natVersion @2)
(decodeIsListByKey decodeKey decodeValue)
( ifDecoderVersionAtLeast
(natVersion @9)
(decodeMapEnforceNoDuplicates decodeKey decodeValue)
(decodeIsListByKey decodeKey decodeValue)
)
(decodeMapSkel Map.fromDistinctDescList decodeKey decodeValue)
-- | Decode `VMap`. Unlike `decodeMap` it does not behavee differently for
!value <- decodeValue
pure (key, value)
-- | Just like `decodeMap`, but fails on duplicate keys
decodeMapEnforceNoDuplicates ::
Ord k => Decoder s k -> (k -> Decoder s v) -> Decoder s (Map.Map k v)
decodeMapEnforceNoDuplicates decodeKey decodeValueFor = do
(numValues, xs) <- decodeCollectionWithLen decodeMapLenOrIndef decodeInlinedPair
unless (numValues == (length . Set.toList . fromList . (map fst)) xs) $
fail "Map has duplicates"
pure $ Map.fromList xs
where
decodeInlinedPair = do
!key <- decodeKey
!value <- decodeValueFor key
pure (key, value)
decodeMapContents :: Decoder s a -> Decoder s [a]
decodeMapContents = decodeCollection decodeMapLenOrIndef
\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 ->
forM_ [minBound .. natVersion @9] $ \v ->
describe (show v) $ do
embedTripSpec v v (cborTrip @Rational @(Integer, Integer)) $
\(x, y) r -> (x, y) `shouldBe` (numerator r, denominator r)
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module Test.Cardano.Ledger.Binary.Vintage.Failure (tests) where
import Cardano.Ledger.Binary hiding (Range)
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Set (Set)
import GHC.Stack (HasCallStack, withFrozenCallStack)
import Hedgehog
genNegativeInteger =
negate . toInteger <$> Gen.word64 (Range.exponential 1 maxBound)
-- | Generate an association list with at least one duplicate key
genDuplicateAssocList :: Gen [(Int, Int)]
genDuplicateAssocList = do
xs <- Gen.list (Range.constant 1 20) genPair -- note nonempty
(a, _) <- Gen.element xs -- pick a key to duplicate
c <- Gen.int Range.constantBounded -- pick a value for duplicate key
Gen.shuffle ((a, c) : xs)
where
genPair = (,) <$> (Gen.int Range.constantBounded) <*> (Gen.int Range.constantBounded)
----------------------------------------------------------------------
------------------------- Properties -----------------------------
n <- forAll genNegativeInteger
assertIsLeft (decode byronProtVer (toCBOR n) :: Either DecoderError Natural)
prop_shouldFailMapWithDupKeys :: Property
prop_shouldFailMapWithDupKeys = property $ do
xs <- forAll genDuplicateAssocList
let encodedMap = encodeMapLen (fromIntegral $ length xs) <> mconcat (toCBOR <$> xs)
assertIsLeft (decode (natVersion @9) encodedMap :: Either DecoderError (Map Int Int))
---------------------------------------------------------------------
------------------------------- helpers -----------------------------
