{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}

module Cardano.Ledger.Shelley.API.Genesis where

import Cardano.Ledger.BaseTypes (BlocksMade (..), EpochNo (EpochNo))
import Cardano.Ledger.Crypto (Crypto)
import Cardano.Ledger.EpochBoundary (emptySnapShots)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.API.Types (
  AccountState (AccountState),
  CertState (CertState),
  Coin (Coin),
  DState (..),
  EpochState (EpochState),
  GenDelegs (GenDelegs),
  LedgerState (LedgerState),
  NewEpochState (NewEpochState),
  PoolDistr (PoolDistr),
  ShelleyGenesis (sgGenDelegs, sgMaxLovelaceSupply, sgProtocolParams),
  StrictMaybe (SNothing),
  genesisUTxO,
  word64ToCoin,
 )
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  StashedAVVMAddresses,
  smartUTxOState,
 )
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.UTxO (coinBalance)
import Cardano.Ledger.Val (Val (..))
import Data.Default.Class (Default, def)
import Data.Kind (Type)
import qualified Data.Map.Strict as Map
import Lens.Micro ((&), (.~))

-- | Indicates that this era may be bootstrapped from 'ShelleyGenesis'.
class
  ( EraTxOut era
  , Default (StashedAVVMAddresses era)
  , EraGov era
  ) =>
  CanStartFromGenesis era
  where
  -- | Additional genesis configuration necessary for this era.
  type AdditionalGenesisConfig era :: Type

  type AdditionalGenesisConfig era = ()

  -- | Upgrade `PParams` from `ShelleyEra` all the way to the current one.
  fromShelleyPParams ::
    AdditionalGenesisConfig era ->
    PParams (ShelleyEra (EraCrypto era)) ->
    PParams era

  -- | Construct an initial state given a 'ShelleyGenesis' and any appropriate
  -- 'AdditionalGenesisConfig' for the era.
  initialState ::
    ShelleyGenesis (EraCrypto era) ->
    AdditionalGenesisConfig era ->
    NewEpochState era
  initialState = forall era.
CanStartFromGenesis era =>
ShelleyGenesis (EraCrypto era)
-> AdditionalGenesisConfig era -> NewEpochState era
initialStateFromGenesis

{-# DEPRECATED CanStartFromGenesis "Use `Cardano.Ledger.Shelley.Transition.EraTransition` instead" #-}
{-# DEPRECATED fromShelleyPParams "Use `Cardano.Ledger.Shelley.Transition.tcInitialPParamsG` instead" #-}
{-# DEPRECATED initialState "Use `Cardano.Ledger.Shelley.Transition.createInitialState` instead" #-}

instance
  Crypto c =>
  CanStartFromGenesis (ShelleyEra c)
  where
  fromShelleyPParams :: AdditionalGenesisConfig (ShelleyEra c)
-> PParams (ShelleyEra (EraCrypto (ShelleyEra c)))
-> PParams (ShelleyEra c)
fromShelleyPParams AdditionalGenesisConfig (ShelleyEra c)
_ = forall a. a -> a
id

-- | Helper function for constructing the initial state for any era
initialStateFromGenesis ::
  forall era.
  CanStartFromGenesis era =>
  -- | Genesis type
  ShelleyGenesis (EraCrypto era) ->
  AdditionalGenesisConfig era ->
  NewEpochState era
initialStateFromGenesis :: forall era.
CanStartFromGenesis era =>
ShelleyGenesis (EraCrypto era)
-> AdditionalGenesisConfig era -> NewEpochState era
initialStateFromGenesis ShelleyGenesis (EraCrypto era)
sg AdditionalGenesisConfig era
ag =
  forall era.
EpochNo
-> BlocksMade (EraCrypto era)
-> BlocksMade (EraCrypto era)
-> EpochState era
-> StrictMaybe (PulsingRewUpdate (EraCrypto era))
-> PoolDistr (EraCrypto era)
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState
    EpochNo
initialEpochNo
    (forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade forall k a. Map k a
Map.empty)
    (forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade forall k a. Map k a
Map.empty)
    ( forall era.
AccountState
-> LedgerState era
-> SnapShots (EraCrypto era)
-> NonMyopic (EraCrypto era)
-> EpochState era
EpochState
        (Coin -> Coin -> AccountState
AccountState (Integer -> Coin
Coin Integer
0) Coin
reserves)
        ( forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState
            (forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era.
CanStartFromGenesis era =>
AdditionalGenesisConfig era
-> PParams (ShelleyEra (EraCrypto era)) -> PParams era
fromShelleyPParams AdditionalGenesisConfig era
ag PParams (ShelleyEra (EraCrypto era))
pp) UTxO era
initialUtxo (Integer -> Coin
Coin Integer
0) (Integer -> Coin
Coin Integer
0) GovState era
govSt forall t. Val t => t
zero)
            (forall era. VState era -> PState era -> DState era -> CertState era
CertState forall a. Default a => a
def forall a. Default a => a
def DState era
dState)
        )
        forall c. SnapShots c
emptySnapShots
        forall a. Default a => a
def
    )
    forall a. StrictMaybe a
SNothing
    (forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr forall k a. Map k a
Map.empty forall a. Monoid a => a
mempty)
    forall a. Default a => a
def
  where
    initialEpochNo :: EpochNo
initialEpochNo = Word64 -> EpochNo
EpochNo Word64
0
    initialUtxo :: UTxO era
initialUtxo = forall era.
EraTxOut era =>
ShelleyGenesis (EraCrypto era) -> UTxO era
genesisUTxO ShelleyGenesis (EraCrypto era)
sg
    reserves :: Coin
reserves = Word64 -> Coin
word64ToCoin (forall c. ShelleyGenesis c -> Word64
sgMaxLovelaceSupply ShelleyGenesis (EraCrypto era)
sg) forall t. Val t => t -> t -> t
<-> forall era. EraTxOut era => UTxO era -> Coin
coinBalance UTxO era
initialUtxo
    genDelegs :: Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs = forall c.
ShelleyGenesis c -> Map (KeyHash 'Genesis c) (GenDelegPair c)
sgGenDelegs ShelleyGenesis (EraCrypto era)
sg
    pp :: PParams (ShelleyEra (EraCrypto era))
pp = forall c. ShelleyGenesis c -> PParams (ShelleyEra c)
sgProtocolParams ShelleyGenesis (EraCrypto era)
sg
    govSt :: GovState era
govSt =
      forall a. Default a => a
def
        forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (GovState era) (PParams era)
curPParamsGovStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
CanStartFromGenesis era =>
AdditionalGenesisConfig era
-> PParams (ShelleyEra (EraCrypto era)) -> PParams era
fromShelleyPParams AdditionalGenesisConfig era
ag PParams (ShelleyEra (EraCrypto era))
pp
        forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (GovState era) (PParams era)
prevPParamsGovStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era.
CanStartFromGenesis era =>
AdditionalGenesisConfig era
-> PParams (ShelleyEra (EraCrypto era)) -> PParams era
fromShelleyPParams AdditionalGenesisConfig era
ag PParams (ShelleyEra (EraCrypto era))
pp

    dState :: DState era
    dState :: DState era
dState =
      DState
        { dsUnified :: UMap (EraCrypto era)
dsUnified = forall c. UMap c
UM.empty
        , dsFutureGenDelegs :: Map (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
dsFutureGenDelegs = forall k a. Map k a
Map.empty
        , dsGenDelegs :: GenDelegs (EraCrypto era)
dsGenDelegs = forall c. Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
GenDelegs Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs
        , dsIRewards :: InstantaneousRewards (EraCrypto era)
dsIRewards = forall a. Default a => a
def
        }