Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
24 changed files
with
912 additions
and
113 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
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,54 @@ | ||
| {-# LANGUAGE DeriveGeneric #-} | ||
|
|
||
| module Cardano.Ledger.Conway.Core | ||
| ( ConwayEraTxBody (..), | ||
| GovernanceAction, | ||
| Vote, | ||
| ) | ||
| where | ||
|
|
||
| import Cardano.Ledger.Babbage.Core (BabbageEraTxBody, Era, EraTxBody (..)) | ||
| import Cardano.Ledger.Binary (FromCBOR (..), ToCBOR (..)) | ||
| import Control.DeepSeq (NFData) | ||
| import Data.Sequence.Strict (StrictSeq) | ||
| import GHC.Generics (Generic) | ||
| import Lens.Micro (Lens') | ||
| import NoThunks.Class (NoThunks) | ||
|
|
||
| class BabbageEraTxBody era => ConwayEraTxBody era where | ||
| govActionsL :: Lens' (TxBody era) (StrictSeq (GovernanceAction era)) | ||
| votesL :: Lens' (TxBody era) (StrictSeq (Vote era)) | ||
|
|
||
| ----- PLACEHOLDERS ----- | ||
|
|
||
| data GovernanceAction era = GovernanceAction | ||
| deriving (Generic, Eq) | ||
|
|
||
| instance NoThunks (GovernanceAction era) | ||
|
|
||
| instance NFData (GovernanceAction era) | ||
|
|
||
| instance Show (GovernanceAction era) where | ||
| show = undefined | ||
|
|
||
| instance Era era => FromCBOR (GovernanceAction era) where | ||
| fromCBOR = undefined | ||
|
|
||
| instance Era era => ToCBOR (GovernanceAction era) where | ||
| toCBOR = undefined | ||
|
|
||
| data Vote era = Vote | ||
| deriving (Generic, Eq) | ||
|
|
||
| instance NoThunks (Vote era) | ||
|
|
||
| instance NFData (Vote era) | ||
|
|
||
| instance Show (Vote era) where | ||
| show = undefined | ||
|
|
||
| instance Era era => FromCBOR (Vote era) where | ||
| fromCBOR = undefined | ||
|
|
||
| instance Era era => ToCBOR (Vote era) where | ||
| toCBOR = undefined |
102 changes: 102 additions & 0 deletions
102
eras/conway/impl/src/Cardano/Ledger/Conway/Delegation/Certificates.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,102 @@ | ||
| {-# LANGUAGE DeriveGeneric #-} | ||
| {-# LANGUAGE LambdaCase #-} | ||
|
|
||
| module Cardano.Ledger.Conway.Delegation.Certificates | ||
| ( ConwayDCert (..), | ||
| transDCert, | ||
| ) | ||
| where | ||
|
|
||
| import Cardano.Ledger.BaseTypes (invalidKey) | ||
| import Cardano.Ledger.Binary | ||
| ( FromCBOR (..), | ||
| FromCBORGroup (..), | ||
| ToCBOR (..), | ||
| ToCBORGroup (..), | ||
| decodeRecordSum, | ||
| encodeListLen, | ||
| listLenInt, | ||
| ) | ||
| import qualified Cardano.Ledger.Crypto as CC | ||
| import Cardano.Ledger.Shelley.Delegation.Certificates (DCert (..), DelegCert (..), Delegation (..), GenesisDelegCert (..), PoolCert (..)) | ||
| import Cardano.Ledger.Slot (EpochNo (..)) | ||
| import Control.DeepSeq (NFData) | ||
| import Data.Word (Word8) | ||
| import GHC.Generics (Generic) | ||
| import NoThunks.Class (NoThunks) | ||
|
|
||
| data ConwayDCert c | ||
| = ConwayDCertDeleg !(DelegCert c) | ||
| | ConwayDCertPool !(PoolCert c) | ||
| | ConwayDCertGenesis !(GenesisDelegCert c) | ||
| deriving (Show, Generic, Eq) | ||
|
|
||
| instance NFData (ConwayDCert c) | ||
|
|
||
| instance NoThunks (ConwayDCert c) | ||
|
|
||
| instance CC.Crypto c => FromCBOR (ConwayDCert c) where | ||
| fromCBOR = decodeRecordSum "ConwayDCert c" $ | ||
| \case | ||
| 0 -> do | ||
| x <- fromCBOR | ||
| pure (2, ConwayDCertDeleg . RegKey $ x) | ||
| 1 -> do | ||
| x <- fromCBOR | ||
| pure (2, ConwayDCertDeleg . DeRegKey $ x) | ||
| 2 -> do | ||
| a <- fromCBOR | ||
| b <- fromCBOR | ||
| pure (3, ConwayDCertDeleg $ Delegate (Delegation a b)) | ||
| 3 -> do | ||
| group <- fromCBORGroup | ||
| pure (fromIntegral (1 + listLenInt group), ConwayDCertPool (RegPool group)) | ||
| 4 -> do | ||
| a <- fromCBOR | ||
| b <- fromCBOR | ||
| pure (3, ConwayDCertPool $ RetirePool a (EpochNo b)) | ||
| 5 -> do | ||
| a <- fromCBOR | ||
| b <- fromCBOR | ||
| c <- fromCBOR | ||
| pure (4, ConwayDCertGenesis $ GenesisDelegCert a b c) | ||
| k -> invalidKey k | ||
|
|
||
| instance CC.Crypto c => ToCBOR (ConwayDCert c) where | ||
| toCBOR = \case | ||
| -- DCertDeleg | ||
| ConwayDCertDeleg (RegKey cred) -> | ||
| encodeListLen 2 | ||
| <> toCBOR (0 :: Word8) | ||
| <> toCBOR cred | ||
| ConwayDCertDeleg (DeRegKey cred) -> | ||
| encodeListLen 2 | ||
| <> toCBOR (1 :: Word8) | ||
| <> toCBOR cred | ||
| ConwayDCertDeleg (Delegate (Delegation cred poolkh)) -> | ||
| encodeListLen 3 | ||
| <> toCBOR (2 :: Word8) | ||
| <> toCBOR cred | ||
| <> toCBOR poolkh | ||
| -- DCertPool | ||
| ConwayDCertPool (RegPool poolParams) -> | ||
| encodeListLen (1 + listLen poolParams) | ||
| <> toCBOR (3 :: Word8) | ||
| <> toCBORGroup poolParams | ||
| ConwayDCertPool (RetirePool vk epoch) -> | ||
| encodeListLen 3 | ||
| <> toCBOR (4 :: Word8) | ||
| <> toCBOR vk | ||
| <> toCBOR epoch | ||
| -- DCertGenesis | ||
| ConwayDCertGenesis (GenesisDelegCert gk kh vrf) -> | ||
| encodeListLen 4 | ||
| <> toCBOR (5 :: Word8) | ||
| <> toCBOR gk | ||
| <> toCBOR kh | ||
| <> toCBOR vrf | ||
|
|
||
| transDCert :: ConwayDCert c -> DCert c | ||
| transDCert (ConwayDCertDeleg dc) = DCertDeleg dc | ||
| transDCert (ConwayDCertPool pc) = DCertPool pc | ||
| transDCert (ConwayDCertGenesis gdc) = DCertGenesis gdc |
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
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,11 @@ | ||
| {-# OPTIONS_GHC -Wno-dodgy-exports #-} | ||
| {-# OPTIONS_GHC -Wno-unused-imports #-} | ||
|
|
||
| module Cardano.Ledger.Conway.Rules | ||
| ( module Cardano.Ledger.Conway.Rules.Utxo, | ||
| module Cardano.Ledger.Conway.Rules.Utxos, | ||
| ) | ||
| where | ||
|
|
||
| import Cardano.Ledger.Conway.Rules.Utxo | ||
| import Cardano.Ledger.Conway.Rules.Utxos |
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,85 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE MultiParamTypeClasses #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
| {-# LANGUAGE UndecidableInstances #-} | ||
| {-# OPTIONS_GHC -Wno-orphans #-} | ||
|
|
||
| module Cardano.Ledger.Conway.Rules.Utxo () where | ||
|
|
||
| import Cardano.Ledger.Alonzo.Rules (AlonzoUtxoEvent (..), AlonzoUtxoPredFailure (..), AlonzoUtxosEvent, AlonzoUtxosPredFailure, AlonzoUtxowEvent (..)) | ||
| import Cardano.Ledger.Alonzo.Scripts (AlonzoScript) | ||
| import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..)) | ||
| import Cardano.Ledger.Babbage (BabbageTxOut) | ||
| import Cardano.Ledger.Babbage.PParams (BabbagePParamsUpdate) | ||
| import Cardano.Ledger.Babbage.Rules (BabbageUTXOW, BabbageUtxoPredFailure (..), BabbageUtxowPredFailure (UtxoFailure)) | ||
| import Cardano.Ledger.BaseTypes (ShelleyBase) | ||
| import Cardano.Ledger.Conway.Era (ConwayUTXO, ConwayUTXOS) | ||
| import Cardano.Ledger.Conway.Rules.Utxos () | ||
| import Cardano.Ledger.Core | ||
| ( EraPParams (..), | ||
| EraRule, | ||
| EraScript (..), | ||
| EraTx, | ||
| EraTxOut (..), | ||
| Value, | ||
| ) | ||
| import Cardano.Ledger.Era (Era (..)) | ||
| import Cardano.Ledger.Mary.Value (MaryValue (..)) | ||
| import Cardano.Ledger.Rules.ValidationMode (Inject) | ||
| import Cardano.Ledger.Shelley.API (PPUPState (..)) | ||
| import qualified Cardano.Ledger.Shelley.LedgerState as Shelley | ||
| import Cardano.Ledger.Shelley.Rules (ShelleyPpupPredFailure, ShelleyUtxowEvent (UtxoEvent), UtxoEnv (..)) | ||
| import Control.State.Transition.Extended (Embed (..), STS (..)) | ||
|
|
||
| instance | ||
| ( EraTx era, | ||
| Value era ~ MaryValue era, | ||
| TxOut era ~ BabbageTxOut era, | ||
| State (EraRule "PPUP" era) ~ PPUPState era, | ||
| PredicateFailure (EraRule "UTXOS" era) ~ AlonzoUtxosPredFailure era, | ||
| PredicateFailure (EraRule "UTXO" era) ~ BabbageUtxoPredFailure era, | ||
| PredicateFailure (EraRule "PPUP" era) ~ ShelleyPpupPredFailure era | ||
| ) => | ||
| STS (ConwayUTXO era) | ||
| where | ||
| type State (ConwayUTXO era) = Shelley.UTxOState era | ||
| type Signal (ConwayUTXO era) = AlonzoTx era | ||
| type Environment (ConwayUTXO era) = UtxoEnv era | ||
| type BaseM (ConwayUTXO era) = ShelleyBase | ||
| type PredicateFailure (ConwayUTXO era) = BabbageUtxoPredFailure era | ||
| type Event (ConwayUTXO era) = AlonzoUtxoEvent era | ||
|
|
||
| initialRules = [] | ||
| transitionRules = [] | ||
|
|
||
| instance | ||
| ( EraScript era, | ||
| PredicateFailure (EraRule "PPUP" era) ~ ShelleyPpupPredFailure era, | ||
| PredicateFailure (EraRule "UTXOS" era) ~ AlonzoUtxosPredFailure era, | ||
| Event (EraRule "UTXOS" era) ~ AlonzoUtxosEvent era, | ||
| Script era ~ AlonzoScript era, | ||
| State (EraRule "PPUP" era) ~ PPUPState era, | ||
| Value era ~ MaryValue (EraCrypto era), | ||
| TxOut era ~ BabbageTxOut era, | ||
| PParamsUpdate era ~ BabbagePParamsUpdate era, | ||
| Inject (PredicateFailure (EraRule "PPUP" era)) (PredicateFailure (EraRule "UTXOS" era)) | ||
| ) => | ||
| Embed (ConwayUTXOS era) (ConwayUTXO era) | ||
| where | ||
| wrapFailed = AlonzoInBabbageUtxoPredFailure . UtxosFailure | ||
| wrapEvent = UtxosEvent | ||
|
|
||
| instance | ||
| ( Era era, | ||
| STS (ConwayUTXO era), | ||
| PredicateFailure (EraRule "UTXO" era) ~ BabbageUtxoPredFailure era, | ||
| Event (EraRule "UTXO" era) ~ AlonzoUtxoEvent era, | ||
| BaseM (EraRule "UTXOW" era) ~ ShelleyBase, | ||
| PredicateFailure (EraRule "UTXOW" era) ~ BabbageUtxowPredFailure era, | ||
| Event (EraRule "UTXOW" era) ~ AlonzoUtxowEvent era | ||
| ) => | ||
| Embed (ConwayUTXO era) (BabbageUTXOW era) | ||
| where | ||
| wrapFailed = UtxoFailure | ||
| wrapEvent = WrappedShelleyEraEvent . UtxoEvent |
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,42 @@ | ||
| {-# LANGUAGE DataKinds #-} | ||
| {-# LANGUAGE FlexibleContexts #-} | ||
| {-# LANGUAGE TypeFamilies #-} | ||
| {-# LANGUAGE UndecidableInstances #-} | ||
| {-# OPTIONS_GHC -Wno-orphans #-} | ||
|
|
||
| module Cardano.Ledger.Conway.Rules.Utxos () where | ||
|
|
||
| import Cardano.Ledger.Alonzo.Rules (AlonzoUtxosEvent, AlonzoUtxosPredFailure) | ||
| import Cardano.Ledger.Alonzo.Scripts (AlonzoScript) | ||
| import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..)) | ||
| import Cardano.Ledger.BaseTypes (ShelleyBase) | ||
| import Cardano.Ledger.Conway.Era (ConwayUTXOS) | ||
| import Cardano.Ledger.Conway.PParams (BabbagePParamsUpdate) | ||
| import Cardano.Ledger.Conway.TxOut (BabbageTxOut (..)) | ||
| import Cardano.Ledger.Core (Era (..), EraPParams (..), EraRule, EraScript (..), EraTxOut (..), Value) | ||
| import Cardano.Ledger.Mary.Value (MaryValue (..)) | ||
| import Cardano.Ledger.Rules.ValidationMode (Inject) | ||
| import Cardano.Ledger.Shelley.LedgerState (PPUPState (..), UTxOState (..)) | ||
| import Cardano.Ledger.Shelley.Rules (ShelleyPpupPredFailure, UtxoEnv (..)) | ||
| import Control.State.Transition.Extended (STS (..)) | ||
|
|
||
| instance | ||
| ( EraScript era, | ||
| PredicateFailure (EraRule "PPUP" era) ~ ShelleyPpupPredFailure era, | ||
| TxOut era ~ BabbageTxOut era, | ||
| Value era ~ MaryValue (EraCrypto era), | ||
| Script era ~ AlonzoScript era, | ||
| State (EraRule "PPUP" era) ~ PPUPState era, | ||
| PParamsUpdate era ~ BabbagePParamsUpdate era, | ||
| Inject (PredicateFailure (EraRule "PPUP" era)) (PredicateFailure (EraRule "UTXOS" era)) | ||
| ) => | ||
| STS (ConwayUTXOS era) | ||
| where | ||
| type BaseM (ConwayUTXOS era) = ShelleyBase | ||
| type Environment (ConwayUTXOS era) = UtxoEnv era | ||
| type State (ConwayUTXOS era) = UTxOState era | ||
| type Signal (ConwayUTXOS era) = AlonzoTx era | ||
| type PredicateFailure (ConwayUTXOS era) = AlonzoUtxosPredFailure era | ||
| type Event (ConwayUTXOS era) = AlonzoUtxosEvent era | ||
|
|
||
| transitionRules = [] |
Oops, something went wrong.