From 1f409cce1b431777725a7291ae3de5f8195779fd Mon Sep 17 00:00:00 2001 From: Nicholas Clarke Date: Wed, 19 May 2021 15:19:19 +0200 Subject: [PATCH] Implement 'CanStartFromGenesis' for Alonzo. We do a little bit of shuffling in order to make this easier. Otherwise nothing much to see. --- alonzo/impl/cardano-ledger-alonzo.cabal | 7 +- alonzo/impl/src/Cardano/Ledger/Alonzo.hs | 52 +++++++-- .../impl/src/Cardano/Ledger/Alonzo/Genesis.hs | 102 ++++++++++++++++++ .../impl/src/Cardano/Ledger/Alonzo/PParams.hs | 4 - .../src/Cardano/Ledger/Alonzo/Translation.hs | 62 +---------- .../Test/Cardano/Ledger/Alonzo/Translation.hs | 3 +- 6 files changed, 155 insertions(+), 75 deletions(-) create mode 100644 alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs diff --git a/alonzo/impl/cardano-ledger-alonzo.cabal b/alonzo/impl/cardano-ledger-alonzo.cabal index 190f10405fe..31e7da217cf 100644 --- a/alonzo/impl/cardano-ledger-alonzo.cabal +++ b/alonzo/impl/cardano-ledger-alonzo.cabal @@ -33,14 +33,15 @@ library exposed-modules: Cardano.Ledger.Alonzo Cardano.Ledger.Alonzo.Data - Cardano.Ledger.Alonzo.PlutusScriptApi + Cardano.Ledger.Alonzo.Genesis Cardano.Ledger.Alonzo.Language + Cardano.Ledger.Alonzo.PlutusScriptApi Cardano.Ledger.Alonzo.PParams + Cardano.Ledger.Alonzo.Rules.Bbody + Cardano.Ledger.Alonzo.Rules.Ledger Cardano.Ledger.Alonzo.Rules.Utxo Cardano.Ledger.Alonzo.Rules.Utxos Cardano.Ledger.Alonzo.Rules.Utxow - Cardano.Ledger.Alonzo.Rules.Ledger - Cardano.Ledger.Alonzo.Rules.Bbody Cardano.Ledger.Alonzo.Scripts Cardano.Ledger.Alonzo.Translation Cardano.Ledger.Alonzo.Tx diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo.hs index 0eab95bc3c0..6702fe4a0ce 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo.hs @@ -23,6 +23,7 @@ module Cardano.Ledger.Alonzo where import Cardano.Ledger.Alonzo.Data (AuxiliaryData (..), getPlutusData) +import Cardano.Ledger.Alonzo.Genesis import Cardano.Ledger.Alonzo.PParams ( PParams, PParams' (..), @@ -43,6 +44,7 @@ import Cardano.Ledger.Alonzo.TxInfo (validPlutusdata, validScript) import qualified Cardano.Ledger.Alonzo.TxSeq as Alonzo (TxSeq (..), hashTxSeq) import Cardano.Ledger.Alonzo.TxWitness (TxWitness) import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash (..), ValidateAuxiliaryData (..)) +import Cardano.Ledger.Coin import qualified Cardano.Ledger.Core as Core import qualified Cardano.Ledger.Crypto as CC import qualified Cardano.Ledger.Era as EraModule @@ -57,18 +59,22 @@ import Cardano.Ledger.Shelley.Constraints ) import Cardano.Ledger.ShelleyMA.Timelocks (validateTimelock) import Cardano.Ledger.Tx (Tx (Tx)) +import Cardano.Ledger.Val (Val (inject), coin, (<->)) import Control.Arrow (left) import Control.Monad (join) import Control.Monad.Except (liftEither, runExcept) import Control.Monad.Reader (runReader) import Control.State.Transition.Extended (TRC (TRC)) +import Data.Default (def) +import qualified Data.Map.Strict as Map +import Data.Maybe.Strict import qualified Shelley.Spec.Ledger.API as API import qualified Shelley.Spec.Ledger.BaseTypes as Shelley +import Shelley.Spec.Ledger.Delegation.Certificates +import Shelley.Spec.Ledger.EpochBoundary +import Shelley.Spec.Ledger.Genesis (genesisUTxO, sgGenDelegs, sgMaxLovelaceSupply, sgProtocolParams) +import Shelley.Spec.Ledger.Keys (GenDelegs (GenDelegs)) import Shelley.Spec.Ledger.LedgerState - ( DPState (..), - DState (..), - PState (..), - ) import Shelley.Spec.Ledger.Metadata (validMetadatum) import qualified Shelley.Spec.Ledger.STS.Epoch as Shelley import Shelley.Spec.Ledger.STS.Ledger @@ -85,6 +91,7 @@ import qualified Shelley.Spec.Ledger.STS.Tick as Shelley import qualified Shelley.Spec.Ledger.STS.Upec as Shelley import Shelley.Spec.Ledger.STS.Utxow (UtxowPredicateFailure (UtxoFailure)) import qualified Shelley.Spec.Ledger.Tx as Shelley +import Shelley.Spec.Ledger.UTxO (balance) -- ===================================================== @@ -153,9 +160,40 @@ instance ) => API.CanStartFromGenesis (AlonzoEra c) where - -- type AdditionalGenesisConfig era = () - -- initialState :: ShelleyGenesis era -> AdditionalGenesisConfig era -> NewEpochState era - initialState _ _ = error "TODO: implement initialState" + type AdditionalGenesisConfig (AlonzoEra c) = AlonzoGenesis + + initialState sg ag = + NewEpochState + initialEpochNo + (BlocksMade Map.empty) + (BlocksMade Map.empty) + ( EpochState + (AccountState (Coin 0) reserves) + emptySnapShots + ( LedgerState + ( UTxOState + initialUtxo + (Coin 0) + (Coin 0) + def + ) + (DPState (def {_genDelegs = GenDelegs genDelegs}) def) + ) + (extendPPWithGenesis pp ag) + (extendPPWithGenesis pp ag) + def + ) + SNothing + (PoolDistr Map.empty) + where + initialEpochNo = 0 + initialUtxo = genesisUTxO sg + reserves = + coin $ + inject (word64ToCoin (sgMaxLovelaceSupply sg)) + <-> balance initialUtxo + genDelegs = sgGenDelegs sg + pp = sgProtocolParams sg instance (CC.Crypto c) => UsesTxOut (AlonzoEra c) where makeTxOut _proxy addr val = TxOut addr val Shelley.SNothing diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs new file mode 100644 index 00000000000..c1af737f292 --- /dev/null +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/Genesis.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NamedFieldPuns #-} + +module Cardano.Ledger.Alonzo.Genesis + ( AlonzoGenesis (..), + extendPPWithGenesis, + ) +where + +import Cardano.Binary +import Cardano.Ledger.Alonzo.Language (Language) +import Cardano.Ledger.Alonzo.PParams +import Cardano.Ledger.Alonzo.Scripts +import Cardano.Ledger.Coin +import Data.Coders +import Data.Functor.Identity +import Data.Map.Strict +import GHC.Generics (Generic) +import NoThunks.Class (NoThunks) +import Numeric.Natural +import qualified Shelley.Spec.Ledger.PParams as Shelley + +data AlonzoGenesis = AlonzoGenesis + { adaPerUTxOWord :: Coin, + costmdls :: Map Language CostModel, + prices :: Prices, + maxTxExUnits :: ExUnits, + maxBlockExUnits :: ExUnits, + maxValSize :: Natural, + collateralPercentage :: Natural, + maxCollateralInputs :: Natural + } + deriving (Eq, Generic, NoThunks) + +-- | Given the missing pieces turn a Shelley.PParams' into an Params' +extendPPWithGenesis :: + Shelley.PParams' Identity era1 -> + AlonzoGenesis -> + PParams' Identity era2 +extendPPWithGenesis + pp + AlonzoGenesis + { adaPerUTxOWord, + costmdls, + prices, + maxTxExUnits, + maxBlockExUnits, + maxValSize, + collateralPercentage, + maxCollateralInputs + } = + extendPP + pp + adaPerUTxOWord + costmdls + prices + maxTxExUnits + maxBlockExUnits + maxValSize + collateralPercentage + maxCollateralInputs + +-------------------------------------------------------------------------------- +-- Serialisation +-------------------------------------------------------------------------------- + +instance FromCBOR AlonzoGenesis where + fromCBOR = + decode $ + RecD AlonzoGenesis + To adaPerUTxOWord + !> To costmdls + !> To prices + !> To maxTxExUnits + !> To maxBlockExUnits + !> To maxValSize + !> To collateralPercentage + !> To maxCollateralInputs diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs index 10e6bfaa341..7d5791cb964 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/PParams.hs @@ -117,10 +117,6 @@ import Shelley.Spec.Ledger.Serialization ) import Shelley.Spec.Ledger.Slot (EpochNo (..)) --- ================================================================ --- TODO make type families for PParams and PParamsUpdate - --- How to handle this alonzo-specific type? type PParamsUpdate era = PParams' StrictMaybe era -- | Protocol parameters. diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs index d9f58884238..508be70cbdf 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs +++ b/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs @@ -20,9 +20,8 @@ import Cardano.Binary serialize, ) import Cardano.Ledger.Alonzo (AlonzoEra) -import Cardano.Ledger.Alonzo.Language (Language) +import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..), extendPPWithGenesis) import Cardano.Ledger.Alonzo.PParams (PParams, PParamsUpdate, extendPP) -import Cardano.Ledger.Alonzo.Scripts (CostModel, ExUnits, Prices) import Cardano.Ledger.Alonzo.Tx (IsValidating (..), ValidatedTx (..)) import Cardano.Ledger.Alonzo.TxBody (TxOut (..)) import qualified Cardano.Ledger.Core as Core @@ -38,11 +37,7 @@ import Cardano.Ledger.Mary (MaryEra) import qualified Cardano.Ledger.Tx as LTX import Control.Monad.Except (Except, throwError) import Data.Coders -import Data.Map.Strict (Map) import Data.Text (Text) -import GHC.Generics (Generic) -import NoThunks.Class (NoThunks) -import Numeric.Natural (Natural) import Shelley.Spec.Ledger.API ( EpochState (..), NewEpochState (..), @@ -68,18 +63,6 @@ import qualified Shelley.Spec.Ledger.TxBody as Shelley -- being total. Do not change it! -------------------------------------------------------------------------------- -data AlonzoGenesis = AlonzoGenesis - { adaPerUTxOWord :: API.Coin, - costmdls :: Map Language CostModel, - prices :: Prices, - maxTxExUnits :: ExUnits, - maxBlockExUnits :: ExUnits, - maxValSize :: Natural, - collateralPercentage :: Natural, - maxCollateralInputs :: Natural - } - deriving (Eq, Generic, NoThunks) - type instance PreviousEra (AlonzoEra c) = MaryEra c type instance TranslationContext (AlonzoEra c) = AlonzoGenesis @@ -219,50 +202,9 @@ translateTxOut (Shelley.TxOutCompact addr value) = translatePParams :: AlonzoGenesis -> Shelley.PParams (MaryEra c) -> PParams (AlonzoEra c) -translatePParams (AlonzoGenesis ada cost price mxTx mxBl mxV c mxC) pp = - extendPP pp ada cost price mxTx mxBl mxV c mxC +translatePParams = flip extendPPWithGenesis translatePParamsUpdate :: Shelley.PParamsUpdate (MaryEra c) -> PParamsUpdate (AlonzoEra c) translatePParamsUpdate pp = extendPP pp SNothing SNothing SNothing SNothing SNothing SNothing SNothing SNothing - --------------------------------------------------------------------------------- --- Serialisation --------------------------------------------------------------------------------- - -instance FromCBOR AlonzoGenesis where - fromCBOR = - decode $ - RecD AlonzoGenesis - To adaPerUTxOWord - !> To costmdls - !> To prices - !> To maxTxExUnits - !> To maxBlockExUnits - !> To maxValSize - !> To collateralPercentage - !> To maxCollateralInputs diff --git a/alonzo/test/test/Test/Cardano/Ledger/Alonzo/Translation.hs b/alonzo/test/test/Test/Cardano/Ledger/Alonzo/Translation.hs index 138fdb3400b..0000f3115f0 100644 --- a/alonzo/test/test/Test/Cardano/Ledger/Alonzo/Translation.hs +++ b/alonzo/test/test/Test/Cardano/Ledger/Alonzo/Translation.hs @@ -13,7 +13,8 @@ import Cardano.Binary ) import Cardano.Ledger.Alonzo (AlonzoEra) import Cardano.Ledger.Alonzo.Data (AuxiliaryData) -import Cardano.Ledger.Alonzo.Translation (AlonzoGenesis (..)) +import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..)) +import Cardano.Ledger.Alonzo.Translation () import Cardano.Ledger.Alonzo.TxBody (TxBody) import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Era (TranslateEra (..))