Made inital funds and staking use ListMap instead of Map

eras/shelley/impl/src/Cardano/Ledger/Shelley/Genesis.hs

@@ -70,6 +70,7 @@ import Data.Word (Word32, Word64)
 import GHC.Generics (Generic)
 import GHC.Natural (Natural)
 import NoThunks.Class (NoThunks (..))
+import qualified Data.ListMap as LM
 
 -- | Genesis Shelley staking configuration.
 --
@@ -85,36 +86,36 @@ data ShelleyGenesisStaking crypto = ShelleyGenesisStaking
     --   The key in this map is the hash of the public key of the _pool_. This
     --   need not correspond to any payment or staking key, but must correspond
     --   to the cold key held by 'TPraosIsCoreNode'.
-    sgsPools :: !(Map (KeyHash 'StakePool crypto) (PoolParams crypto)),
+    sgsPools :: LM.ListMap (KeyHash 'StakePool crypto) (PoolParams crypto),
     -- | Stake-holding key hash credentials and the pools to delegate that stake
     -- to. We require the raw staking key hash in order to:
     --
     -- - Avoid pointer addresses, which would be tricky when there's no slot or
     --   transaction to point to.
     -- - Avoid script credentials.
-    sgsStake :: !(Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto))
+    sgsStake :: LM.ListMap (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
   }
   deriving stock (Eq, Show, Generic)
 
 instance NoThunks (ShelleyGenesisStaking crypto)
 
 instance CC.Crypto crypto => ToCBOR (ShelleyGenesisStaking crypto) where
   toCBOR (ShelleyGenesisStaking pools stake) =
-    encodeListLen 2 <> mapToCBOR pools <> mapToCBOR stake
+    encodeListLen 2 <> toCBOR pools <> toCBOR stake
 
 instance CC.Crypto crypto => FromCBOR (ShelleyGenesisStaking crypto) where
   fromCBOR = do
     decodeRecordNamed "ShelleyGenesisStaking" (const 2) $ do
-      pools <- mapFromCBOR
-      stake <- mapFromCBOR
+      pools <- fromCBOR
+      stake <- fromCBOR
       pure $ ShelleyGenesisStaking pools stake
 
 -- | Empty genesis staking
 emptyGenesisStaking :: ShelleyGenesisStaking crypto
 emptyGenesisStaking =
   ShelleyGenesisStaking
-    { sgsPools = Map.empty,
-      sgsStake = Map.empty
+    { sgsPools = mempty,
+      sgsStake = mempty
     }
 
 -- | Shelley genesis information
@@ -137,8 +138,8 @@ data ShelleyGenesis era = ShelleyGenesis
     sgMaxLovelaceSupply :: !Word64,
     sgProtocolParams :: !(PParams era),
     sgGenDelegs :: !(Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))),
-    sgInitialFunds :: !(Map (Addr (Crypto era)) Coin),
-    sgStaking :: !(ShelleyGenesisStaking (Crypto era))
+    sgInitialFunds :: LM.ListMap (Addr (Crypto era)) Coin,
+    sgStaking :: ShelleyGenesisStaking (Crypto era)
   }
   deriving stock (Eq, Show, Generic)
 
@@ -239,7 +240,7 @@ instance Era era => ToCBOR (ShelleyGenesis era) where
         <> toCBOR sgMaxLovelaceSupply
         <> toCBOR sgProtocolParams
         <> mapToCBOR sgGenDelegs
-        <> mapToCBOR sgInitialFunds
+        <> toCBOR sgInitialFunds
         <> toCBOR sgStaking
 
 instance Era era => FromCBOR (ShelleyGenesis era) where
@@ -258,7 +259,7 @@ instance Era era => FromCBOR (ShelleyGenesis era) where
       sgMaxLovelaceSupply <- fromCBOR
       sgProtocolParams <- fromCBOR
       sgGenDelegs <- mapFromCBOR
-      sgInitialFunds <- mapFromCBOR
+      sgInitialFunds <- fromCBOR
       sgStaking <- fromCBOR
       pure $
         ShelleyGenesis
@@ -291,7 +292,7 @@ genesisUTxO genesis =
   UTxO $
     Map.fromList
       [ (txIn, txOut)
-        | (addr, amount) <- Map.toList (sgInitialFunds genesis),
+        | (addr, amount) <- LM.unListMap (sgInitialFunds genesis),
           let txIn = initialFundsPseudoTxIn addr
               txOut = makeTxOut (Proxy @era) addr (Val.inject amount)
       ]

eras/shelley/test-suite/bench/Cardano/Ledger/Shelley/Bench/Rewards.hs

@@ -31,6 +31,7 @@ import qualified Cardano.Ledger.Shelley.LedgerState as LS
 import Cardano.Ledger.Shelley.PParams (PParams' (..))
 import Cardano.Ledger.Shelley.RewardProvenance (RewardProvenance)
 import Cardano.Ledger.Shelley.TxBody (PoolParams (..), TxOut (..))
+import qualified Data.ListMap as LM
 import Cardano.Ledger.Shelley.UTxO (UTxO (..))
 import Cardano.Slotting.EpochInfo
 import Cardano.Slotting.Slot (EpochNo)
@@ -136,7 +137,7 @@ genChainInEpoch epoch = do
     mkGenesisStaking stakeMap =
       ShelleyGenesisStaking
         { sgsPools =
-            Map.fromList
+            LM.ListMap
               [ (hk, pp)
                 | (AllIssuerKeys {vrf, hk}, (owner : _)) <- stakeMap,
                   let pp =
@@ -153,7 +154,7 @@ genChainInEpoch epoch = do
                           }
               ],
           sgsStake =
-            Map.fromList
+            LM.ListMap
               [ (dlg, hk)
                 | (AllIssuerKeys {hk}, dlgs) <- stakeMap,
                   dlg <- dlgs

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs

@@ -284,7 +284,7 @@ testShelleyGenesis =
       sgMaxLovelaceSupply = maxLovelaceSupply testGlobals,
       sgProtocolParams = emptyPParams,
       sgGenDelegs = Map.empty,
-      sgInitialFunds = Map.empty,
+      sgInitialFunds = mempty,
       sgStaking = emptyGenesisStaking
     }
 

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/Chain.hs

@@ -80,6 +80,7 @@ import Test.Cardano.Ledger.Shelley.Utils
     mkHash,
   )
 import Test.QuickCheck (Gen)
+import qualified Data.ListMap as LM
 
 -- ======================================================
 
@@ -243,8 +244,8 @@ registerGenesisStaking
         (dpsDState oldDPState)
           { _unified =
               UM.unify
-                (Map.map (const $ Coin 0) . Map.mapKeys KeyHashObj $ sgsStake)
-                (Map.mapKeys KeyHashObj sgsStake)
+                (Map.map (const $ Coin 0) . Map.mapKeys KeyHashObj . LM.toMap $ sgsStake)
+                (Map.mapKeys KeyHashObj $ LM.toMap sgsStake)
                 (UM.ptrView (_unified (dpsDState oldDPState)))
           }
 
@@ -253,7 +254,7 @@ registerGenesisStaking
       newPState :: PState (Crypto era)
       newPState =
         (dpsPState oldDPState)
-          { _pParams = sgsPools
+          { _pParams = LM.toMap sgsPools
           }
 
       -- The new stake distribution is made on the basis of a snapshot taken

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/Generators/Genesis.hs

@@ -39,6 +39,7 @@ import Data.Ratio ((%))
 import qualified Data.Sequence.Strict as StrictSeq
 import qualified Data.Set as Set
 import Data.Time.Clock (NominalDiffTime, UTCTime)
+import qualified Data.ListMap as LM
 import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
 import GHC.Word (Word32, Word64, Word8)
 import Hedgehog (Gen)
@@ -65,14 +66,14 @@ genShelleyGenesis =
     <*> Gen.word64 (Range.linear 1 100000)
     <*> genPParams
     <*> fmap Map.fromList genGenesisDelegationList
-    <*> fmap Map.fromList genFundsList
+    <*> fmap LM.ListMap genFundsList
     <*> genStaking
 
 genStaking :: CC.Crypto crypto => Gen (ShelleyGenesisStaking crypto)
 genStaking =
   ShelleyGenesisStaking
-    <$> fmap Map.fromList genPools
-    <*> fmap Map.fromList genStake
+    <$> fmap LM.ListMap genPools
+    <*> fmap LM.ListMap genStake
 
 genPools ::
   CC.Crypto crypto =>

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Genesis.hs

@@ -16,6 +16,7 @@ where
 
 import Cardano.Binary (Encoding (..), ToCBOR (..), Tokens (..), serializeEncoding)
 import qualified Cardano.Crypto.Hash as Hash
+import qualified Data.ListMap as LM
 import Cardano.Ledger.BaseTypes (textToDns, textToUrl)
 import Cardano.Ledger.Crypto (HASH)
 import Cardano.Ledger.Era (Crypto (..))
@@ -214,7 +215,7 @@ exampleShelleyGenesis =
             _maxBHSize = 217569
           },
       sgGenDelegs = Map.fromList [(genesisVerKeyHash, genDelegPair)],
-      sgInitialFunds = Map.fromList [(initialFundedAddress, initialFunds)],
+      sgInitialFunds = LM.ListMap [(initialFundedAddress, initialFunds)],
       sgStaking = staking
     }
   where
@@ -274,11 +275,11 @@ exampleShelleyGenesis =
     staking =
       ShelleyGenesisStaking
         { sgsPools =
-            Map.fromList
+            LM.ListMap
               [ (L.KeyHash "f583a45e4947c102091b96170ef50ef0cf8edb62666193a2163247bb", poolParams)
               ],
           sgsStake =
-            Map.fromList
+            LM.ListMap
               [ ( L.KeyHash "83a192dec0e8da2188e520d0c536a69a747cf173a3df16a6daa94d86",
                   L.KeyHash "649eda82bf644d34a6925f24ea4c4c36d27e51de1b44ef47e3560be7"
                 )

libs/cardano-data/src/Data/ListMap.hs

@@ -13,6 +13,7 @@ module Data.ListMap
     elems,
     lookup,
     filter,
+    toMap,
   )
 where
 
@@ -46,6 +47,7 @@ import GHC.Generics (Generic, Generic1)
 import NoThunks.Class (NoThunks)
 import Prelude hiding (filter, lookup)
 import qualified Prelude as Pre
+import qualified Data.Map.Strict as Map
 
 -- | ListMap is a wrapper around an associative list. It is encoded in CBOR
 --   and JSON as an object/map.
@@ -134,3 +136,7 @@ lookup k (ListMap xs) = L.lookup k xs
 
 filter :: (k -> v -> Bool) -> ListMap k v -> ListMap k v
 filter f (ListMap xs) = ListMap $ Pre.filter (uncurry f) xs
+
+toMap :: Ord k => ListMap k v -> Map.Map k v
+toMap (ListMap xs) = Map.fromList xs
+

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Model/Elaborators/Shelley.hs

@@ -71,6 +71,7 @@ import Test.Cardano.Ledger.Model.Rules (ModelPredicateFailure (..))
 import Test.Cardano.Ledger.Model.Value
   ( evalModelValue,
   )
+import qualified Data.ListMap as LM
 
 instance
   ( PraosCrypto crypto,
@@ -140,7 +141,7 @@ fromShelleyGlobals globals pp genDelegs initialFunds =
       sgMaxLovelaceSupply = maxLovelaceSupply globals,
       sgProtocolParams = pp,
       sgGenDelegs = genDelegs, --  genGenesisDelegationList
-      sgInitialFunds = initialFunds, -- genFundsList
+      sgInitialFunds = LM.ListMap $ Map.toList initialFunds, -- genFundsList
       sgStaking = emptyGenesisStaking -- genStaking
     }