Merge pull request #2563 from input-output-hk/lehins/minor-bugfixes

Minor bugfixes
IntersectMBO · Nov 24, 2021 · 93c3dec · 93c3dec
2 parents 60e820d + 7ef96a6
commit 93c3dec
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 4 deletions.
diff --git 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
@@ -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