-
Notifications
You must be signed in to change notification settings - Fork 87
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Allow registering initial staking and funds in Cardano mode
When the initial ledger state of Cardano mode is not in the Byron era, register the initial staking and initial funds (if provided in the genesis config) in the ledger state. This will only happen when configured to skip the Byron era and hard fork immediately to Shelley or a later era using `TriggerHardForkAtEpoch 0`.
- Loading branch information
Showing
3 changed files
with
152 additions
and
40 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
98 changes: 98 additions & 0 deletions
98
ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/ShelleyBased.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,98 @@ | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE FlexibleInstances #-} | ||
| {-# LANGUAGE MultiParamTypeClasses #-} | ||
| {-# LANGUAGE RankNTypes #-} | ||
| {-# LANGUAGE ScopedTypeVariables #-} | ||
| {-# LANGUAGE TypeApplications #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
| {-# LANGUAGE TypeOperators #-} | ||
| module Ouroboros.Consensus.Cardano.ShelleyBased ( | ||
| -- * Injection from Shelley-based eras into the Cardano eras | ||
| InjectShelley | ||
| , injectShelleyNP | ||
| , injectShelleyOptNP | ||
| -- * Transform Shelley-based types | ||
| , HasCrypto | ||
| , overShelleyBasedLedgerState | ||
| ) where | ||
|
|
||
| import Data.SOP.Strict | ||
|
|
||
| import Ouroboros.Consensus.Util.OptNP (OptNP (..)) | ||
|
|
||
| import Ouroboros.Consensus.HardFork.Combinator | ||
|
|
||
| import Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock) | ||
| import Ouroboros.Consensus.Shelley.Protocol (PraosCrypto) | ||
|
|
||
| import Ouroboros.Consensus.Cardano.Block | ||
|
|
||
| {------------------------------------------------------------------------------- | ||
| Injection from Shelley-based eras into the Cardano eras | ||
| -------------------------------------------------------------------------------} | ||
|
|
||
| -- | Witness the relation between the Cardano eras and the Shelley-based eras. | ||
| class cardanoEra ~ ShelleyBlock shelleyEra => InjectShelley shelleyEra cardanoEra | ||
| instance cardanoEra ~ ShelleyBlock shelleyEra => InjectShelley shelleyEra cardanoEra | ||
|
|
||
| injectShelleyNP :: | ||
| AllZip InjectShelley shelleyEras cardanoEras | ||
| => ( forall shelleyEra cardanoEra. | ||
| InjectShelley shelleyEra cardanoEra | ||
| => f shelleyEra -> g cardanoEra | ||
| ) | ||
| -> NP f shelleyEras -> NP g cardanoEras | ||
| injectShelleyNP _ Nil = Nil | ||
| injectShelleyNP f (x :* xs) = f x :* injectShelleyNP f xs | ||
|
|
||
| injectShelleyOptNP :: | ||
| AllZip InjectShelley shelleyEras cardanoEras | ||
| => ( forall shelleyEra cardanoEra. | ||
| InjectShelley shelleyEra cardanoEra | ||
| => f shelleyEra -> g cardanoEra | ||
| ) | ||
| -> OptNP empty f shelleyEras -> OptNP empty g cardanoEras | ||
| injectShelleyOptNP _ OptNil = OptNil | ||
| injectShelleyOptNP f (OptSkip xs) = OptSkip (injectShelleyOptNP f xs) | ||
| injectShelleyOptNP f (OptCons x xs) = OptCons (f x) (injectShelleyOptNP f xs) | ||
|
|
||
| {------------------------------------------------------------------------------- | ||
| Transform Shelley-based types | ||
| -------------------------------------------------------------------------------} | ||
|
|
||
| -- | Witness the relation between the crypto used by a Shelley-based era. | ||
| -- | ||
| -- Can be partially applied while an equality constraint cannot. | ||
| class EraCrypto era ~ c => HasCrypto c era | ||
| instance EraCrypto era ~ c => HasCrypto c era | ||
|
|
||
| -- | When the given ledger state corresponds to a Shelley-based era, apply the | ||
| -- given function to it. | ||
| overShelleyBasedLedgerState :: | ||
| forall c. PraosCrypto c | ||
| => ( forall era. (EraCrypto era ~ c, ShelleyBasedEra era) | ||
| => LedgerState (ShelleyBlock era) | ||
| -> LedgerState (ShelleyBlock era) | ||
| ) | ||
| -> LedgerState (CardanoBlock c) | ||
| -> LedgerState (CardanoBlock c) | ||
| overShelleyBasedLedgerState f (HardForkLedgerState st) = | ||
| HardForkLedgerState $ hap fs st | ||
| where | ||
| fs :: NP (LedgerState -.-> LedgerState) | ||
| (CardanoEras c) | ||
| fs = fn id | ||
| :* injectShelleyNP | ||
| reassoc | ||
| (hcpure | ||
| (Proxy @(And (HasCrypto c) ShelleyBasedEra)) | ||
| (fn (Comp . f . unComp))) | ||
|
|
||
| reassoc :: | ||
| ( LedgerState :.: ShelleyBlock | ||
| -.-> LedgerState :.: ShelleyBlock | ||
| ) shelleyEra | ||
| -> ( LedgerState | ||
| -.-> LedgerState | ||
| ) (ShelleyBlock shelleyEra) | ||
| reassoc g = fn $ unComp . apFn g . Comp |