A couple small steps forward

IntersectMBO · Feb 7, 2023 · bf71235 · bf71235
1 parent cc31cfc
commit bf71235
Show file tree

Hide file tree

Showing 4 changed files with 14 additions and 9 deletions.
diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Config.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Ledger/Config.hs
@@ -62,7 +62,7 @@ deriving instance ShelleyBasedEra era => NoThunks (BlockConfig (ShelleyBlock pro
 mkShelleyBlockConfig ::
      ShelleyBasedEra era
   => SL.ProtVer
-  -> SL.ShelleyGenesis era
+  -> SL.ShelleyGenesis (EraCrypto era)
   -> [SL.VKey 'SL.BlockIssuer (EraCrypto era)]
   -> BlockConfig (ShelleyBlock proto era)
 mkShelleyBlockConfig protVer genesis blockIssuerVKeys = ShelleyConfig {

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node/Common.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node/Common.hs
@@ -123,7 +123,7 @@ instance ShelleyCompatible proto era => NodeInitStorage (ShelleyBlock proto era)
 -- The @era@ parameter determines from which era the genesis config will be
 -- used.
 data ProtocolParamsShelleyBased era = ProtocolParamsShelleyBased
-  { shelleyBasedGenesis           :: SL.ShelleyGenesis era,
+  { shelleyBasedGenesis           :: SL.ShelleyGenesis (EraCrypto era),
     -- | The initial nonce, typically derived from the hash of Genesis
     -- config JSON file.
     --

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node/TPraos.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/Node/TPraos.hs
@@ -66,6 +66,7 @@ import           Ouroboros.Consensus.Util.Assert
 import           Ouroboros.Consensus.Util.IOLike
 
 import qualified Cardano.Ledger.Core as Core
+import qualified Cardano.Ledger.Coin as SL
 import qualified Cardano.Ledger.Shelley.API as SL
 import qualified Cardano.Ledger.Shelley.LedgerState as SL
                      (incrementalStakeDistr, updateStakeDistribution)
@@ -181,8 +182,8 @@ shelleySharedBlockForging hotKey slotToPeriod credentials maxTxCapacityOverrides
 -- | Check the validity of the genesis config. To be used in conjunction with
 -- 'assertWithMsg'.
 validateGenesis ::
-     ShelleyBasedEra era
-  => SL.ShelleyGenesis era -> Either String ()
+     PraosCrypto c
+  => SL.ShelleyGenesis c -> Either String ()
 validateGenesis = first errsToString . SL.validateGenesis
   where
     errsToString :: [SL.ValidationErr] -> String
@@ -341,7 +342,7 @@ protocolInfoTPraosShelleyBased ProtocolParamsShelleyBased {
 -- Any existing staking information is overridden, but the UTxO is left
 -- untouched.
 --
--- TODO adapt and reuse @registerGenesisStaking@ from @cardano-ledger-specs@.
+-- TODO adapt and reuse @registerGenesisStaking@ from @cardano-ledger@.
 registerGenesisStaking ::
      forall era. ShelleyBasedEra era
   => SL.ShelleyGenesisStaking (EraCrypto era)
@@ -378,7 +379,9 @@ registerGenesisStaking staking nes = nes {
     dState' :: SL.DState (EraCrypto era)
     dState' = (SL.dpsDState dpState) {
           SL.dsUnified = UM.unify
-            ( Map.map (const $ SL.Coin 0)
+            -- TODO: this is likely wrong. We probably need to extract previous deposit
+            -- values instead of using 0 here:
+            ( Map.map (const $ UM.RDPair (SL.CompactCoin 0) (SL.CompactCoin 0))
                       . Map.mapKeys SL.KeyHashObj
                       $ sgsStakeMap)
             ( Map.mapKeys SL.KeyHashObj sgsStakeMap )

diff --git a/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/ShelleyHFC.hs b/ouroboros-consensus-shelley/src/Ouroboros/Consensus/Shelley/ShelleyHFC.hs
@@ -49,6 +49,7 @@ import           Ouroboros.Consensus.Ledger.Abstract
 import           Ouroboros.Consensus.Node.NetworkProtocolVersion
 import           Ouroboros.Consensus.TypeFamilyWrappers
 
+import qualified Cardano.Ledger.BaseTypes as SL (mkVersion)
 import qualified Cardano.Ledger.Era as SL
 import qualified Cardano.Ledger.Shelley.API as SL
 
@@ -137,7 +138,7 @@ shelleyTransition ::
   -> LedgerState (ShelleyBlock proto era)
   -> Maybe EpochNo
 shelleyTransition ShelleyPartialLedgerConfig{..}
-                  transitionMajorVersion
+                  transitionMajorVersionRaw
                   state =
       takeAny
     . mapMaybe isTransition
@@ -148,7 +149,7 @@ shelleyTransition ShelleyPartialLedgerConfig{..}
 
     -- 'shelleyLedgerConfig' contains a dummy 'EpochInfo' but this does not
     -- matter for extracting the genesis config
-    genesis :: SL.ShelleyGenesis era
+    genesis :: SL.ShelleyGenesis (EraCrpto era)
     genesis = shelleyLedgerGenesis shelleyLedgerConfig
 
     k :: Word64
@@ -157,7 +158,8 @@ shelleyTransition ShelleyPartialLedgerConfig{..}
     isTransition :: Shelley.Inspect.ProtocolUpdate era -> Maybe EpochNo
     isTransition Shelley.Inspect.ProtocolUpdate{..} = do
          SL.ProtVer major _minor <- proposalVersion
-         guard $ fromIntegral major == transitionMajorVersion
+         transitionMajorVersion <- SL.mkVersion transitionMajorVersionRaw
+         guard $ major == transitionMajorVersion
          guard $ proposalReachedQuorum
          guard $ shelleyAfterVoting >= fromIntegral k
          return proposalEpoch