{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Test.Cardano.Ledger.Shelley.Examples.Init
-- Description : Initial State for Shelley ledger examples
--
-- The initial state for Shelley Ledger Examples.
module Test.Cardano.Ledger.Shelley.Examples.Init (
  ppEx,
  initSt,
  nonce0,
  lastByronHeaderHash,
) where

import Cardano.Ledger.BaseTypes (EpochInterval (..), Nonce (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (StashedAVVMAddresses)
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Slot (
  BlockNo (..),
  EpochNo (..),
  SlotNo (..),
 )
import Cardano.Ledger.Val ((<->))
import Cardano.Protocol.TPraos.BHeader (
  HashHeader (..),
  LastAppliedBlock (..),
  hashHeaderToNonce,
 )
import Cardano.Slotting.Slot (WithOrigin (..))
import Data.Default
import Lens.Micro
import Test.Cardano.Ledger.Shelley.Examples.Federation (genDelegs)
import Test.Cardano.Ledger.Shelley.Rules.Chain (
  ChainState (..),
  initialShelleyState,
 )
import Test.Cardano.Ledger.Shelley.Utils (maxLLSupply, mkHash, unsafeBoundRational)

-- | Initial Protocol Parameters
ppEx :: (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) => PParams era
ppEx :: forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx =
  PParams era
forall era. EraPParams era => PParams era
emptyPParams
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxBBSizeL ((Word32 -> Identity Word32)
 -> PParams era -> Identity (PParams era))
-> Word32 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
50000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams era) Word16
ppMaxBHSizeL ((Word16 -> Identity Word16)
 -> PParams era -> Identity (PParams era))
-> Word16 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16
10000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams era) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams era -> Identity (PParams era))
-> Word32 -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
10000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppEMaxL ((EpochInterval -> Identity EpochInterval)
 -> PParams era -> Identity (PParams era))
-> EpochInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
10000
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppKeyDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
7
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppPoolDepositL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
250
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams era -> Identity (PParams era)
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
Lens' (PParams era) UnitInterval
ppDL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.5
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams era) UnitInterval
ppTauL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.2
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams era -> Identity (PParams era)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams era) UnitInterval
ppRhoL ((UnitInterval -> Identity UnitInterval)
 -> PParams era -> Identity (PParams era))
-> UnitInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.0021
    PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> PParams era -> Identity (PParams era)
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinUTxOValueL ((Coin -> Identity Coin) -> PParams era -> Identity (PParams era))
-> Coin -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
100

-- | === The hash of the last Bryon Header
--
-- The first block of the Shelley era will point back to the
-- last block of the Byron era.
-- For our purposes in the examples we can bootstrap the chain
-- by just coercing the value.
-- When this transition actually occurs,
-- the consensus layer will do the work of making
-- sure that the hash gets translated across the fork.
lastByronHeaderHash :: HashHeader
lastByronHeaderHash :: HashHeader
lastByronHeaderHash = Hash HASH EraIndependentBlockHeader -> HashHeader
HashHeader (Hash HASH EraIndependentBlockHeader -> HashHeader)
-> Hash HASH EraIndependentBlockHeader -> HashHeader
forall a b. (a -> b) -> a -> b
$ Int -> Hash HASH EraIndependentBlockHeader
forall a h. HashAlgorithm h => Int -> Hash h a
mkHash Int
0

-- | === Initial Nonce
nonce0 :: Nonce
nonce0 :: Nonce
nonce0 = HashHeader -> Nonce
hashHeaderToNonce HashHeader
lastByronHeaderHash

-- | === Initial Chain State
--
-- The initial state for the examples uses the function
-- 'initialShelleyState' with the genesis delegation
-- 'genDelegs' and any given starting 'UTxO' set.
initSt ::
  forall era.
  ( EraTxOut era
  , EraGov era
  , EraStake era
  , EraCertState era
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  , Default (StashedAVVMAddresses era)
  ) =>
  UTxO era ->
  ChainState era
initSt :: forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era)) =>
UTxO era -> ChainState era
initSt UTxO era
utxo =
  WithOrigin LastAppliedBlock
-> EpochNo
-> UTxO era
-> Coin
-> Map (KeyHash 'Genesis) GenDelegPair
-> PParams era
-> Nonce
-> ChainState era
forall era.
(EraGov era, EraStake era, EraCertState era,
 Default (StashedAVVMAddresses era)) =>
WithOrigin LastAppliedBlock
-> EpochNo
-> UTxO era
-> Coin
-> Map (KeyHash 'Genesis) GenDelegPair
-> PParams era
-> Nonce
-> ChainState era
initialShelleyState
    (LastAppliedBlock -> WithOrigin LastAppliedBlock
forall t. t -> WithOrigin t
At (LastAppliedBlock -> WithOrigin LastAppliedBlock)
-> LastAppliedBlock -> WithOrigin LastAppliedBlock
forall a b. (a -> b) -> a -> b
$ BlockNo -> SlotNo -> HashHeader -> LastAppliedBlock
LastAppliedBlock (Word64 -> BlockNo
BlockNo Word64
0) (Word64 -> SlotNo
SlotNo Word64
0) HashHeader
lastByronHeaderHash)
    (Word64 -> EpochNo
EpochNo Word64
0)
    UTxO era
utxo
    (Coin
maxLLSupply Coin -> Coin -> Coin
forall t. Val t => t -> t -> t
<-> UTxO era -> Coin
forall era. EraTxOut era => UTxO era -> Coin
sumCoinUTxO UTxO era
utxo)
    Map (KeyHash 'Genesis) GenDelegPair
genDelegs
    (forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx @era)
    Nonce
nonce0