diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Properties.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Properties.hs index 3e5f611a15c..1088a34a38e 100644 --- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Properties.hs +++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Properties.hs @@ -766,7 +766,7 @@ genTxAndLEDGERState = do txIx <- arbitrary maxTxExUnits <- arbitrary Positive maxCollateralInputs <- arbitrary - collateralPercentage <- fromIntegral <$> chooseInt (0, 10000) + collateralPercentage <- fromIntegral <$> chooseInt (1, 10000) minfeeA <- fromIntegral <$> chooseInt (0, 1000) minfeeB <- fromIntegral <$> chooseInt (0, 10000) let genT = do diff --git a/libs/small-steps/src/Control/Iterate/SetAlgebra.hs b/libs/small-steps/src/Control/Iterate/SetAlgebra.hs index 950b60a7be9..4dfd3800d90 100644 --- a/libs/small-steps/src/Control/Iterate/SetAlgebra.hs +++ b/libs/small-steps/src/Control/Iterate/SetAlgebra.hs @@ -7,6 +7,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} @@ -17,6 +18,7 @@ module Control.Iterate.SetAlgebra where import Cardano.Binary ( Decoder, + DecoderError (DecoderErrorCustom), FromCBOR (..), ToCBOR (..), decodeListLen, @@ -26,8 +28,8 @@ import Cardano.Binary import Codec.CBOR.Encoding (encodeListLen) import Control.DeepSeq (NFData (rnf)) import Control.Iterate.Collect -import Control.Monad (void) -import Data.Coders (invalidKey) +import Control.Monad (unless, void) +import Data.Coders (cborError, invalidKey) import Data.List (sortBy) import qualified Data.List as List import Data.Map.Internal (Map (..), link, link2) @@ -179,7 +181,11 @@ instance decodeMapAsBimap :: (FromCBOR a, FromCBOR b, Ord a, Ord b) => Decoder s (BiMap b a b) -decodeMapAsBimap = decodeMapSkel biMapFromAscDistinctList +decodeMapAsBimap = do + bimap@(MkBiMap mf mb) <- decodeMapSkel biMapFromAscDistinctList + unless (Map.valid mf && Map.valid mb) $ + cborError $ DecoderErrorCustom "BiMap" "Expected distinct keys in ascending order" + pure bimap instance (NoThunks a, NoThunks b) => NoThunks (BiMap v a b) where showTypeOf _ = "BiMap" @@ -236,6 +242,8 @@ biMapFromList comb xs = foldr addEntry biMapEmpty xs where newv = comb oldv v +-- | /Warning/ - invariant that keys are distinct and in ascending order is not +-- checked. Make sure it is not violated, otherwise crazy things will happen. biMapFromAscDistinctList :: (Ord k, Ord v) => [(k, v)] -> BiMap v k v biMapFromAscDistinctList xs = MkBiMap bmForward bmBackward