{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | Parameters fixed in the genesis file: 'GenesisParameters'
module Cardano.Api.GenesisParameters
  ( -- * Protocol parameters fixed in the genesis file
    GenesisParameters (..)
  , EpochSize (..)

    -- * Internal conversion functions
  , fromShelleyGenesis
  )
where

import           Cardano.Api.Eon.ShelleyBasedEra
import           Cardano.Api.Eras
import           Cardano.Api.NetworkId
import qualified Cardano.Api.ReexposeLedger as Ledger

import qualified Cardano.Ledger.Coin as L
import qualified Cardano.Ledger.Shelley.Genesis as Shelley
import           Cardano.Slotting.Slot (EpochSize (..))

import           Data.Time (NominalDiffTime, UTCTime)

-- ----------------------------------------------------------------------------
-- Genesis parameters
--
-- TODO: Conway era - remove GenesisParameters and use ledger types directly
data GenesisParameters era
  = GenesisParameters
  { forall era. GenesisParameters era -> UTCTime
protocolParamSystemStart :: UTCTime
  -- ^ The reference time the system started. The time of slot zero.
  -- The time epoch against which all Ouroboros time slots are measured.
  , forall era. GenesisParameters era -> NetworkId
protocolParamNetworkId :: NetworkId
  -- ^ The network identifier for this blockchain instance. This
  -- distinguishes the mainnet from testnets, and different testnets from
  -- each other.
  , forall era. GenesisParameters era -> Rational
protocolParamActiveSlotsCoefficient :: Rational
  -- ^ The Ouroboros Praos active slot coefficient, aka @f@.
  , forall era. GenesisParameters era -> Int
protocolParamSecurity :: Int
  -- ^ The Ouroboros security parameters, aka @k@. This is the maximum
  -- number of blocks the node would ever be prepared to roll back by.
  --
  -- Clients of the node following the chain should be prepared to handle
  -- the node switching forks up to this long.
  , forall era. GenesisParameters era -> EpochSize
protocolParamEpochLength :: EpochSize
  -- ^ The number of Ouroboros time slots in an Ouroboros epoch.
  , forall era. GenesisParameters era -> NominalDiffTime
protocolParamSlotLength :: NominalDiffTime
  -- ^ The time duration of a slot.
  , forall era. GenesisParameters era -> Int
protocolParamSlotsPerKESPeriod :: Int
  -- ^ For Ouroboros Praos, the length of a KES period as a number of time
  -- slots. The KES keys get evolved once per KES period.
  , forall era. GenesisParameters era -> Int
protocolParamMaxKESEvolutions :: Int
  -- ^ The maximum number of times a KES key can be evolved before it is
  -- no longer considered valid. This can be less than the maximum number
  -- of times given the KES key size. For example the mainnet KES key size
  -- would allow 64 evolutions, but the max KES evolutions param is 62.
  , forall era. GenesisParameters era -> Int
protocolParamUpdateQuorum :: Int
  -- ^ In the Shelley era, prior to decentralised governance, this is the
  -- number of genesis key delegates that need to agree for an update
  -- proposal to be enacted.
  , forall era. GenesisParameters era -> Coin
protocolParamMaxLovelaceSupply :: L.Coin
  -- ^ The maximum supply for Lovelace. This determines the initial value
  -- of the reserves.
  , forall era. GenesisParameters era -> PParams (ShelleyLedgerEra era)
protocolInitialUpdateableProtocolParameters :: Ledger.PParams (ShelleyLedgerEra era)
  -- ^ The initial values of the updateable 'ProtocolParameters'.
  }

-- ----------------------------------------------------------------------------
-- Conversion functions
--

fromShelleyGenesis :: Shelley.ShelleyGenesis Ledger.StandardCrypto -> GenesisParameters ShelleyEra
fromShelleyGenesis :: ShelleyGenesis StandardCrypto -> GenesisParameters ShelleyEra
fromShelleyGenesis
  sg :: ShelleyGenesis StandardCrypto
sg@Shelley.ShelleyGenesis
    { UTCTime
sgSystemStart :: UTCTime
sgSystemStart :: forall c. ShelleyGenesis c -> UTCTime
Shelley.sgSystemStart
    , Word32
sgNetworkMagic :: Word32
sgNetworkMagic :: forall c. ShelleyGenesis c -> Word32
Shelley.sgNetworkMagic
    , Network
sgNetworkId :: Network
sgNetworkId :: forall c. ShelleyGenesis c -> Network
Shelley.sgNetworkId
    , PositiveUnitInterval
sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff :: forall c. ShelleyGenesis c -> PositiveUnitInterval
Shelley.sgActiveSlotsCoeff
    , Word64
sgSecurityParam :: Word64
sgSecurityParam :: forall c. ShelleyGenesis c -> Word64
Shelley.sgSecurityParam
    , EpochSize
sgEpochLength :: EpochSize
sgEpochLength :: forall c. ShelleyGenesis c -> EpochSize
Shelley.sgEpochLength
    , Word64
sgSlotsPerKESPeriod :: Word64
sgSlotsPerKESPeriod :: forall c. ShelleyGenesis c -> Word64
Shelley.sgSlotsPerKESPeriod
    , Word64
sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions :: forall c. ShelleyGenesis c -> Word64
Shelley.sgMaxKESEvolutions
    , NominalDiffTimeMicro
sgSlotLength :: NominalDiffTimeMicro
sgSlotLength :: forall c. ShelleyGenesis c -> NominalDiffTimeMicro
Shelley.sgSlotLength
    , Word64
sgUpdateQuorum :: Word64
sgUpdateQuorum :: forall c. ShelleyGenesis c -> Word64
Shelley.sgUpdateQuorum
    , Word64
sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply :: forall c. ShelleyGenesis c -> Word64
Shelley.sgMaxLovelaceSupply
    , sgGenDelegs :: forall c.
ShelleyGenesis c -> Map (KeyHash 'Genesis c) (GenDelegPair c)
Shelley.sgGenDelegs = Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
_ -- unused, might be of interest
    , sgInitialFunds :: forall c. ShelleyGenesis c -> ListMap (Addr c) Coin
Shelley.sgInitialFunds = ListMap (Addr StandardCrypto) Coin
_ -- unused, not retained by the node
    , sgStaking :: forall c. ShelleyGenesis c -> ShelleyGenesisStaking c
Shelley.sgStaking = ShelleyGenesisStaking StandardCrypto
_ -- unused, not retained by the node
    } =
    GenesisParameters
      { protocolParamSystemStart :: UTCTime
protocolParamSystemStart = UTCTime
sgSystemStart
      , protocolParamNetworkId :: NetworkId
protocolParamNetworkId =
          Network -> NetworkMagic -> NetworkId
fromShelleyNetwork
            Network
sgNetworkId
            (Word32 -> NetworkMagic
NetworkMagic Word32
sgNetworkMagic)
      , protocolParamActiveSlotsCoefficient :: Rational
protocolParamActiveSlotsCoefficient =
          PositiveUnitInterval -> Rational
forall r. BoundedRational r => r -> Rational
Ledger.unboundRational
            PositiveUnitInterval
sgActiveSlotsCoeff
      , protocolParamSecurity :: Int
protocolParamSecurity = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sgSecurityParam
      , protocolParamEpochLength :: EpochSize
protocolParamEpochLength = EpochSize
sgEpochLength
      , protocolParamSlotLength :: NominalDiffTime
protocolParamSlotLength = NominalDiffTimeMicro -> NominalDiffTime
Shelley.fromNominalDiffTimeMicro NominalDiffTimeMicro
sgSlotLength
      , protocolParamSlotsPerKESPeriod :: Int
protocolParamSlotsPerKESPeriod = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sgSlotsPerKESPeriod
      , protocolParamMaxKESEvolutions :: Int
protocolParamMaxKESEvolutions = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sgMaxKESEvolutions
      , protocolParamUpdateQuorum :: Int
protocolParamUpdateQuorum = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sgUpdateQuorum
      , protocolParamMaxLovelaceSupply :: Coin
protocolParamMaxLovelaceSupply = Integer -> Coin
L.Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sgMaxLovelaceSupply
      , protocolInitialUpdateableProtocolParameters :: PParams (ShelleyLedgerEra ShelleyEra)
protocolInitialUpdateableProtocolParameters = ShelleyGenesis StandardCrypto
-> PParams (ShelleyEra StandardCrypto)
forall c. ShelleyGenesis c -> PParams (ShelleyEra c)
Shelley.sgProtocolParams ShelleyGenesis StandardCrypto
sg
      }