{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Allegra
  ( AllegraEra,
    Self,
    TxOut,
    TxBody,
    Value,
    Script,
    AuxiliaryData,
    PParams,
    PParamsDelta,
    Tx,
    Witnesses,
  )
where

import Cardano.Ledger.BaseTypes (BlocksMade (..))
import Cardano.Ledger.Crypto (Crypto)
import qualified Cardano.Ledger.Crypto as CC
import qualified Cardano.Ledger.Era as E (Era (Crypto))
import Cardano.Ledger.Shelley.API hiding (PParams, Tx, TxBody, TxOut, WitnessSet)
import Cardano.Ledger.Shelley.EpochBoundary (emptySnapShots)
import Cardano.Ledger.Shelley.LedgerState (minfee)
import qualified Cardano.Ledger.Shelley.PParams as Shelley (PParamsUpdate)
import Cardano.Ledger.Shelley.Tx (WitnessSet)
import Cardano.Ledger.ShelleyMA
import Cardano.Ledger.ShelleyMA.Rules.EraMapping ()
import Cardano.Ledger.ShelleyMA.Rules.Utxo (consumed)
import Cardano.Ledger.ShelleyMA.Timelocks (Timelock)
import Cardano.Ledger.ShelleyMA.TxBody ()
import Cardano.Ledger.Val (Val ((<->)))
import Data.Default.Class (def)
import qualified Data.Map.Strict as Map

type AllegraEra = ShelleyMAEra 'Allegra

instance ShelleyEraCrypto c => ApplyTx (AllegraEra c)

instance ShelleyEraCrypto c => ApplyBlock (AllegraEra c)

instance
  ( Crypto c
  ) =>
  CanStartFromGenesis (AllegraEra c)
  where
  initialState :: ShelleyGenesis (AllegraEra c)
-> AdditionalGenesisConfig (AllegraEra c)
-> NewEpochState (AllegraEra c)
initialState ShelleyGenesis (AllegraEra c)
sg () =
    EpochNo
-> BlocksMade (Crypto (AllegraEra c))
-> BlocksMade (Crypto (AllegraEra c))
-> EpochState (AllegraEra c)
-> StrictMaybe (PulsingRewUpdate (Crypto (AllegraEra c)))
-> PoolDistr (Crypto (AllegraEra c))
-> StashedAVVMAddresses (AllegraEra c)
-> NewEpochState (AllegraEra c)
forall era.
EpochNo
-> BlocksMade (Crypto era)
-> BlocksMade (Crypto era)
-> EpochState era
-> StrictMaybe (PulsingRewUpdate (Crypto era))
-> PoolDistr (Crypto era)
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState
      EpochNo
initialEpochNo
      (Map (KeyHash 'StakePool c) Natural -> BlocksMade c
forall crypto.
Map (KeyHash 'StakePool crypto) Natural -> BlocksMade crypto
BlocksMade Map (KeyHash 'StakePool c) Natural
forall k a. Map k a
Map.empty)
      (Map (KeyHash 'StakePool c) Natural -> BlocksMade c
forall crypto.
Map (KeyHash 'StakePool crypto) Natural -> BlocksMade crypto
BlocksMade Map (KeyHash 'StakePool c) Natural
forall k a. Map k a
Map.empty)
      ( AccountState
-> SnapShots (Crypto (AllegraEra c))
-> LedgerState (AllegraEra c)
-> PParams (AllegraEra c)
-> PParams (AllegraEra c)
-> NonMyopic (Crypto (AllegraEra c))
-> EpochState (AllegraEra c)
forall era.
AccountState
-> SnapShots (Crypto era)
-> LedgerState era
-> PParams era
-> PParams era
-> NonMyopic (Crypto era)
-> EpochState era
EpochState
          (Coin -> Coin -> AccountState
AccountState (Integer -> Coin
Coin Integer
0) Coin
reserves)
          SnapShots (Crypto (AllegraEra c))
forall crypto. SnapShots crypto
emptySnapShots
          ( UTxOState (AllegraEra c)
-> DPState (Crypto (AllegraEra c)) -> LedgerState (AllegraEra c)
forall era.
UTxOState era -> DPState (Crypto era) -> LedgerState era
LedgerState
              ( UTxO (AllegraEra c)
-> Coin
-> Coin
-> State (EraRule "PPUP" (AllegraEra c))
-> IncrementalStake (Crypto (AllegraEra c))
-> UTxOState (AllegraEra c)
forall era.
UTxO era
-> Coin
-> Coin
-> State (EraRule "PPUP" era)
-> IncrementalStake (Crypto era)
-> UTxOState era
UTxOState
                  UTxO (AllegraEra c)
initialUtxo
                  (Integer -> Coin
Coin Integer
0)
                  (Integer -> Coin
Coin Integer
0)
                  State (EraRule "PPUP" (AllegraEra c))
forall a. Default a => a
def
                  (Map (Credential 'Staking c) Coin
-> Map Ptr Coin -> IncrementalStake c
forall crypto.
Map (Credential 'Staking crypto) Coin
-> Map Ptr Coin -> IncrementalStake crypto
IStake Map (Credential 'Staking c) Coin
forall a. Monoid a => a
mempty Map Ptr Coin
forall a. Monoid a => a
mempty)
              )
              (DState c -> PState c -> DPState c
forall crypto. DState crypto -> PState crypto -> DPState crypto
DPState (DState c
forall a. Default a => a
def {_genDelegs :: GenDelegs c
_genDelegs = Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
forall crypto.
Map (KeyHash 'Genesis crypto) (GenDelegPair crypto)
-> GenDelegs crypto
GenDelegs Map (KeyHash 'Genesis c) (GenDelegPair c)
genDelegs}) PState c
forall a. Default a => a
def)
          )
          PParams (AllegraEra c)
PParams (AllegraEra c)
pp
          PParams (AllegraEra c)
PParams (AllegraEra c)
pp
          NonMyopic (Crypto (AllegraEra c))
forall a. Default a => a
def
      )
      StrictMaybe (PulsingRewUpdate (Crypto (AllegraEra c)))
forall a. StrictMaybe a
SNothing
      (Map (KeyHash 'StakePool c) (IndividualPoolStake c) -> PoolDistr c
forall crypto.
Map (KeyHash 'StakePool crypto) (IndividualPoolStake crypto)
-> PoolDistr crypto
PoolDistr Map (KeyHash 'StakePool c) (IndividualPoolStake c)
forall k a. Map k a
Map.empty)
      ()
    where
      initialEpochNo :: EpochNo
initialEpochNo = EpochNo
0
      initialUtxo :: UTxO (AllegraEra c)
initialUtxo = ShelleyGenesis (AllegraEra c) -> UTxO (AllegraEra c)
forall era.
(Era era, UsesTxOut era) =>
ShelleyGenesis era -> UTxO era
genesisUTxO ShelleyGenesis (AllegraEra c)
sg
      reserves :: Coin
reserves =
        Word64 -> Coin
word64ToCoin (ShelleyGenesis (AllegraEra c) -> Word64
forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply ShelleyGenesis (AllegraEra c)
sg)
          Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> UTxO (AllegraEra c) -> Value (AllegraEra c)
forall era. Era era => UTxO era -> Value era
balance UTxO (AllegraEra c)
initialUtxo
      genDelegs :: Map
  (KeyHash 'Genesis (Crypto (AllegraEra c)))
  (GenDelegPair (Crypto (AllegraEra c)))
genDelegs = ShelleyGenesis (AllegraEra c)
-> Map
     (KeyHash 'Genesis (Crypto (AllegraEra c)))
     (GenDelegPair (Crypto (AllegraEra c)))
forall era.
ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
sgGenDelegs ShelleyGenesis (AllegraEra c)
sg
      pp :: PParams (AllegraEra c)
pp = ShelleyGenesis (AllegraEra c) -> PParams (AllegraEra c)
forall era. ShelleyGenesis era -> PParams era
sgProtocolParams ShelleyGenesis (AllegraEra c)
sg

instance ShelleyEraCrypto c => ShelleyBasedEra (AllegraEra c)

instance CC.Crypto c => CLI (AllegraEra c) where
  evaluateMinFee :: PParams (AllegraEra c) -> Tx (AllegraEra c) -> Coin
evaluateMinFee = PParams (AllegraEra c) -> Tx (AllegraEra c) -> Coin
forall pp tx.
(HasField "_minfeeA" pp Natural, HasField "_minfeeB" pp Natural,
 HasField "txsize" tx Integer) =>
pp -> tx -> Coin
minfee

  evaluateConsumed :: PParams (AllegraEra c)
-> UTxO (AllegraEra c)
-> TxBody (AllegraEra c)
-> Value (AllegraEra c)
evaluateConsumed = PParams (AllegraEra c)
-> UTxO (AllegraEra c)
-> TxBody (AllegraEra c)
-> Value (AllegraEra c)
forall era.
(Era era,
 HasField "certs" (TxBody era) (StrictSeq (DCert (Crypto era))),
 HasField "inputs" (TxBody era) (Set (TxIn (Crypto era))),
 HasField "mint" (TxBody era) (Value era),
 HasField "wdrls" (TxBody era) (Wdrl (Crypto era)),
 HasField "_keyDeposit" (PParams era) Coin) =>
PParams era -> UTxO era -> TxBody era -> Value era
consumed

  addKeyWitnesses :: Tx (AllegraEra c)
-> Set (WitVKey 'Witness (Crypto (AllegraEra c)))
-> Tx (AllegraEra c)
addKeyWitnesses = Tx (AllegraEra c)
-> Set (WitVKey 'Witness (Crypto (AllegraEra c)))
-> Tx (AllegraEra c)
forall era.
(Era era, Witnesses era ~ WitnessSet era,
 AnnotatedData (Script era), ToCBOR (AuxiliaryData era),
 ToCBOR (TxBody era)) =>
Tx era -> Set (WitVKey 'Witness (Crypto era)) -> Tx era
addShelleyKeyWitnesses

  evaluateMinLovelaceOutput :: PParams (AllegraEra c) -> TxOut (AllegraEra c) -> Coin
evaluateMinLovelaceOutput PParams (AllegraEra c)
pp TxOut (AllegraEra c)
_out = PParams' Identity (AllegraEra c) -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minUTxOValue PParams (AllegraEra c)
PParams' Identity (AllegraEra c)
pp

-- Self-Describing type synomyms

type Self c = ShelleyMAEra 'Allegra c

type Script era = Timelock (E.Crypto era)

type Value era = Coin

type Witnesses era = WitnessSet (E.Crypto era)

type PParamsDelta era = Shelley.PParamsUpdate era