WIP new Ledger: adapt to change of StakePoolParams

Author: geo2a

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/PeerSelection.hs

@@ -37,6 +37,14 @@ instance SL.EraCertState era => LedgerSupportsPeerSelection (ShelleyBlock proto
     poolDistr :: SL.PoolDistr
     poolDistr = SL.nesPd shelleyLedgerState
 
+    futurePoolParams
+      , poolParams ::
+        Map (SL.KeyHash 'SL.StakePool) SL.StakePoolParams
+    (futurePoolParams, poolParams) =
+      ( SL.psFutureStakePoolParams pstate
+      , Map.mapWithKey SL.stakePoolStateToStakePoolParams (SL.psStakePools pstate)
+      )
+
     -- Sort stake pools by descending stake
     orderByStake ::
       SL.PoolDistr ->
@@ -72,14 +80,14 @@ instance SL.EraCertState era => LedgerSupportsPeerSelection (ShelleyBlock proto
     -- Note that a stake pool can have multiple registered relays
     pparamsLedgerRelayAccessPoints ::
       (LedgerRelayAccessPoint -> StakePoolRelay) ->
-      SL.StakePoolState ->
+      SL.StakePoolParams ->
       Maybe (NonEmpty StakePoolRelay)
     pparamsLedgerRelayAccessPoints injStakePoolRelay =
       NE.nonEmpty
         . force
         . mapMaybe (fmap injStakePoolRelay . relayToLedgerRelayAccessPoint)
         . toList
-        . SL.spsRelays
+        . SL.sppRelays
 
     -- Combine the stake pools registered in the future and the current pool
     -- parameters, and remove duplicates.
@@ -88,8 +96,8 @@ instance SL.EraCertState era => LedgerSupportsPeerSelection (ShelleyBlock proto
     poolLedgerRelayAccessPoints =
       Map.unionWith
         (\futureRelays currentRelays -> NE.nub (futureRelays <> currentRelays))
-        (Map.mapMaybe (pparamsLedgerRelayAccessPoints FutureRelay) (SL.psStakePools pstate))
-        (Map.mapMaybe (pparamsLedgerRelayAccessPoints CurrentRelay) (SL.psFutureStakePools pstate))
+        (Map.mapMaybe (pparamsLedgerRelayAccessPoints FutureRelay) futurePoolParams)
+        (Map.mapMaybe (pparamsLedgerRelayAccessPoints CurrentRelay) poolParams)
 
     pstate :: SL.PState era
     pstate =

ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs

@@ -232,7 +232,7 @@ data instance BlockQuery (ShelleyBlock proto era) fp result where
     BlockQuery
       (ShelleyBlock proto era)
       QFNoTables
-      (Map (SL.KeyHash 'SL.StakePool) SL.PoolParams)
+      (Map (SL.KeyHash 'SL.StakePool) SL.StakePoolParams)
   GetRewardInfoPools ::
     BlockQuery
       (ShelleyBlock proto era)

ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/TxGen/Cardano.hs

@@ -256,19 +256,19 @@ migrateUTxO migrationInfo curSlot lcfg lst
       (SL.StakeRefBase $ Shelley.mkCredential stakingSK)
 
   -- A simplistic individual pool
-  poolParams :: SL.Coin -> SL.PoolParams
+  poolParams :: SL.Coin -> SL.StakePoolParams
   poolParams pledge =
-    SL.PoolParams
-      { SL.ppCost = SL.Coin 1
-      , SL.ppMetadata = SL.SNothing
-      , SL.ppMargin = minBound
-      , SL.ppOwners = Set.singleton $ Shelley.mkKeyHash poolSK
-      , SL.ppPledge = pledge
-      , SL.ppId = Shelley.mkKeyHash poolSK
-      , SL.ppRewardAccount =
+    SL.StakePoolParams
+      { SL.sppCost = SL.Coin 1
+      , SL.sppMetadata = SL.SNothing
+      , SL.sppMargin = minBound
+      , SL.sppOwners = Set.singleton $ Shelley.mkKeyHash poolSK
+      , SL.sppPledge = pledge
+      , SL.sppId = Shelley.mkKeyHash poolSK
+      , SL.sppRewardAccount =
           SL.RewardAccount Shelley.networkId $ Shelley.mkCredential poolSK
-      , SL.ppRelays = StrictSeq.empty
-      , SL.ppVrf = Shelley.mkKeyHashVrf @c vrfSK
+      , SL.sppRelays = StrictSeq.empty
+      , SL.sppVrf = Shelley.mkKeyHashVrf @c vrfSK
       }
 
 -----

ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/ThreadNet/Infra/Shelley.hs

@@ -417,7 +417,7 @@ mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes =
       { sgsPools =
           ListMap
             [ (pk, pp)
-            | pp@SL.PoolParams{ppId = pk} <- Map.elems coreNodeToPoolMapping
+            | pp@SL.StakePoolParams{sppId = pk} <- Map.elems coreNodeToPoolMapping
             ]
       , -- The staking key maps to the key hash of the pool, which is set to the
         -- "delegate key" in order that nodes may issue blocks both as delegates
@@ -432,23 +432,23 @@ mkGenesisConfig pVer k f d maxLovelaceSupply slotLength kesCfg coreNodes =
       }
    where
     coreNodeToPoolMapping ::
-      Map (SL.KeyHash 'SL.StakePool) SL.PoolParams
+      Map (SL.KeyHash 'SL.StakePool) SL.StakePoolParams
     coreNodeToPoolMapping =
       Map.fromList
         [ ( SL.hashKey . SL.VKey . deriveVerKeyDSIGN $ cnStakingKey
-          , SL.PoolParams
-              { SL.ppId = poolHash
-              , SL.ppVrf = vrfHash
+          , SL.StakePoolParams
+              { SL.sppId = poolHash
+              , SL.sppVrf = vrfHash
               , -- Each core node pledges its full stake to the pool.
-                SL.ppPledge = SL.Coin $ fromIntegral initialLovelacePerCoreNode
-              , SL.ppCost = SL.Coin 1
-              , SL.ppMargin = minBound
+                SL.sppPledge = SL.Coin $ fromIntegral initialLovelacePerCoreNode
+              , SL.sppCost = SL.Coin 1
+              , SL.sppMargin = minBound
               , -- Reward accounts live in a separate "namespace" to other
                 -- accounts, so it should be fine to use the same address.
-                SL.ppRewardAccount = SL.RewardAccount networkId $ mkCredential cnDelegateKey
-              , SL.ppOwners = Set.singleton poolOwnerHash
-              , SL.ppRelays = Seq.empty
-              , SL.ppMetadata = SL.SNothing
+                SL.sppRewardAccount = SL.RewardAccount networkId $ mkCredential cnDelegateKey
+              , SL.sppOwners = Set.singleton poolOwnerHash
+              , SL.sppRelays = Seq.empty
+              , SL.sppMetadata = SL.SNothing
               }
           )
         | CoreNode{cnDelegateKey, cnStakingKey, cnVRF} <- coreNodes