Make explicit that pools form a set

IntersectMBO · Nov 30, 2023 · 3836a7c · 3836a7c
1 parent 708ae17
commit 3836a7c
Show file tree

Hide file tree

Showing 2 changed files with 12 additions and 9 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs
@@ -79,6 +79,8 @@ import           Data.Map.Strict (Map, fromList, toList)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromMaybe)
 import qualified Data.Sequence.Strict as Seq
+import           Data.Set (Set)
+import qualified Data.Set as Set
 import           Data.String (fromString)
 import qualified Data.Text as Text
 import           Data.Time (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
@@ -276,13 +278,13 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
   let network = toShelleyNetwork networkId
   stuffedUtxoAddrs <- liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) $ genStuffedAddress network
 
-  let stake = second Ledger.ppId . mkDelegationMapEntry <$> delegations
-      stakePools = [ (Ledger.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations ]
+  let stakeDelegations = second Ledger.ppId . mkDelegationMapEntry <$> delegations
+      stakePools = Set.fromList [ (Ledger.ppId poolParams', poolParams') | poolParams' <- dPoolParams <$> delegations ]
       delegAddrs = dInitialUtxoAddr <$> delegations
       !shelleyGenesis' =
         updateCreateStakedOutputTemplate
           -- Shelley genesis parameters
-          start genDlgs supply (length nonDelegAddrs) nonDelegAddrs stakePools stake
+          start genDlgs supply (length nonDelegAddrs) nonDelegAddrs stakePools stakeDelegations
           supplyDelegated (length delegations) delegAddrs stuffedUtxoAddrs shelleyGenesis
 
   -- Write genesis.json file to output
@@ -392,9 +394,9 @@ createPoolCredentials fmt dir = do
    opCertCtr = File $ dir </> "opcert.counter"
 
 data Delegation = Delegation
-  { dInitialUtxoAddr  :: !(AddressInEra ShelleyEra)
-  , dDelegStaking     :: !(Ledger.KeyHash Ledger.Staking StandardCrypto)
-  , dPoolParams       :: !(Ledger.PoolParams StandardCrypto)
+  { dInitialUtxoAddr  :: !(AddressInEra ShelleyEra) -- ^ The payment address
+  , dDelegStaking     :: !(Ledger.KeyHash Ledger.Staking StandardCrypto) -- ^ The staking address
+  , dPoolParams       :: !(Ledger.PoolParams StandardCrypto) -- ^ The pool being delegated to
   }
   deriving (Generic, NFData)
 
@@ -470,7 +472,7 @@ updateCreateStakedOutputTemplate
     -> Maybe Lovelace -- ^ Amount of lovelace not delegated
     -> Int -- ^ Number of UTxO addresses that are delegating
     -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating
-    -> [(Ledger.KeyHash 'Ledger.StakePool StandardCrypto, Ledger.PoolParams StandardCrypto)] -- ^ Pool map
+    -> Set (Ledger.KeyHash 'Ledger.StakePool StandardCrypto, Ledger.PoolParams StandardCrypto) -- ^ Pools
     -> [(Ledger.KeyHash 'Ledger.Staking StandardCrypto, Ledger.KeyHash 'Ledger.StakePool StandardCrypto)] -- ^ Delegaton map
     -> Maybe Lovelace -- ^ Amount of lovelace to delegate
     -> Int -- ^ Number of UTxO address for delegation
@@ -500,7 +502,7 @@ updateCreateStakedOutputTemplate
                                 ]
           , sgStaking =
             ShelleyGenesisStaking
-              { sgsPools = ListMap pools
+              { sgsPools = ListMap . Set.toList $ pools
               , sgsStake = ListMap stake
               }
           , sgProtocolParams = pparamsFromTemplate

diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs
@@ -111,6 +111,7 @@ import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromMaybe)
 import qualified Data.Sequence.Strict as Seq
+import qualified Data.Set as Set
 import           Data.Text (Text)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
@@ -639,7 +640,7 @@ runGenesisCreateStakedCmd
   stuffedUtxoAddrs <- liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) $ TN.genStuffedAddress network
 
   let stake = second Ledger.ppId . mkDelegationMapEntry <$> delegations
-      stakePools = [ (Ledger.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations ]
+      stakePools = Set.fromList [ (Ledger.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations ]
       delegAddrs = dInitialUtxoAddr <$> delegations
       !shelleyGenesis =
         TN.updateCreateStakedOutputTemplate