Implement 'CanStartFromGenesis' for Alonzo.

We do a little bit of shuffling in order to make this easier. Otherwise nothing much to see.
IntersectMBO · May 19, 2021 · c2a1165 · c2a1165
1 parent 6fb462c
commit c2a1165
Show file tree

Hide file tree

Showing 5 changed files with 153 additions and 74 deletions.
diff --git 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
@@ -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
@@ -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
+        <! From
+        <! From
+        <! From
+        <! From
+        <! From
+        <! From
+        <! From
+        <! From
+
+instance ToCBOR AlonzoGenesis where
+  toCBOR
+    AlonzoGenesis
+      { adaPerUTxOWord,
+        costmdls,
+        prices,
+        maxTxExUnits,
+        maxBlockExUnits,
+        maxValSize,
+        collateralPercentage,
+        maxCollateralInputs
+      } =
+      encode $
+        Rec 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
@@ -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
@@ -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
-        <! From
-        <! From
-        <! From
-        <! From
-        <! From
-        <! From
-        <! From
-        <! From
-
-instance ToCBOR AlonzoGenesis where
-  toCBOR
-    AlonzoGenesis
-      { adaPerUTxOWord,
-        costmdls,
-        prices,
-        maxTxExUnits,
-        maxBlockExUnits,
-        maxValSize,
-        collateralPercentage,
-        maxCollateralInputs
-      } =
-      encode $
-        Rec AlonzoGenesis
-          !> To adaPerUTxOWord
-          !> To costmdls
-          !> To prices
-          !> To maxTxExUnits
-          !> To maxBlockExUnits
-          !> To maxValSize
-          !> To collateralPercentage
-          !> To maxCollateralInputs