{-# 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           Prelude

import           Data.Time (NominalDiffTime, UTCTime)

import           Cardano.Slotting.Slot (EpochSize (..))

import qualified Cardano.Ledger.BaseTypes as Ledger
import qualified Cardano.Ledger.Shelley.Genesis as Shelley

import           Cardano.Api.NetworkId
import           Cardano.Api.ProtocolParameters
import           Cardano.Api.Value


-- ----------------------------------------------------------------------------
-- Genesis parameters
--

data GenesisParameters =
     GenesisParameters {

       -- | The reference time the system started. The time of slot zero.
       -- The time epoch against which all Ouroboros time slots are measured.
       --
       GenesisParameters -> UTCTime
protocolParamSystemStart :: UTCTime,

       -- | The network identifier for this blockchain instance. This
       -- distinguishes the mainnet from testnets, and different testnets from
       -- each other.
       --
       GenesisParameters -> NetworkId
protocolParamNetworkId :: NetworkId,

       -- | The Ouroboros Praos active slot coefficient, aka @f@.
       --
       GenesisParameters -> Rational
protocolParamActiveSlotsCoefficient :: Rational,

       -- | 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.
       --
       GenesisParameters -> Int
protocolParamSecurity :: Int,

       -- | The number of Ouroboros time slots in an Ouroboros epoch.
       --
       GenesisParameters -> EpochSize
protocolParamEpochLength :: EpochSize,

       -- | The time duration of a slot.
       --
       GenesisParameters -> NominalDiffTime
protocolParamSlotLength :: NominalDiffTime,

       -- | For Ouroboros Praos, the length of a KES period as a number of time
       -- slots. The KES keys get evolved once per KES period.
       --
       GenesisParameters -> Int
protocolParamSlotsPerKESPeriod :: 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.
       --
       GenesisParameters -> Int
protocolParamMaxKESEvolutions ::  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.
       --
       GenesisParameters -> Int
protocolParamUpdateQuorum ::  Int,

       -- | The maximum supply for Lovelace. This determines the initial value
       -- of the reserves.
       --
       GenesisParameters -> Lovelace
protocolParamMaxLovelaceSupply :: Lovelace,

       -- | The initial values of the updateable 'ProtocolParameters'.
       --
       GenesisParameters -> ProtocolParameters
protocolInitialUpdateableProtocolParameters :: ProtocolParameters
     }


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

fromShelleyGenesis :: Shelley.ShelleyGenesis era -> GenesisParameters
fromShelleyGenesis :: ShelleyGenesis era -> GenesisParameters
fromShelleyGenesis
    Shelley.ShelleyGenesis {
      UTCTime
sgSystemStart :: forall era. ShelleyGenesis era -> UTCTime
sgSystemStart :: UTCTime
Shelley.sgSystemStart
    , Word32
sgNetworkMagic :: forall era. ShelleyGenesis era -> Word32
sgNetworkMagic :: Word32
Shelley.sgNetworkMagic
    , Network
sgNetworkId :: forall era. ShelleyGenesis era -> Network
sgNetworkId :: Network
Shelley.sgNetworkId
    , PositiveUnitInterval
sgActiveSlotsCoeff :: forall era. ShelleyGenesis era -> PositiveUnitInterval
sgActiveSlotsCoeff :: PositiveUnitInterval
Shelley.sgActiveSlotsCoeff
    , Word64
sgSecurityParam :: forall era. ShelleyGenesis era -> Word64
sgSecurityParam :: Word64
Shelley.sgSecurityParam
    , EpochSize
sgEpochLength :: forall era. ShelleyGenesis era -> EpochSize
sgEpochLength :: EpochSize
Shelley.sgEpochLength
    , Word64
sgSlotsPerKESPeriod :: forall era. ShelleyGenesis era -> Word64
sgSlotsPerKESPeriod :: Word64
Shelley.sgSlotsPerKESPeriod
    , Word64
sgMaxKESEvolutions :: forall era. ShelleyGenesis era -> Word64
sgMaxKESEvolutions :: Word64
Shelley.sgMaxKESEvolutions
    , NominalDiffTime
sgSlotLength :: forall era. ShelleyGenesis era -> NominalDiffTime
sgSlotLength :: NominalDiffTime
Shelley.sgSlotLength
    , Word64
sgUpdateQuorum :: forall era. ShelleyGenesis era -> Word64
sgUpdateQuorum :: Word64
Shelley.sgUpdateQuorum
    , Word64
sgMaxLovelaceSupply :: forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply :: Word64
Shelley.sgMaxLovelaceSupply
    , PParams era
sgProtocolParams :: forall era. ShelleyGenesis era -> PParams era
sgProtocolParams :: PParams era
Shelley.sgProtocolParams
    , sgGenDelegs :: forall era.
ShelleyGenesis era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
Shelley.sgGenDelegs    = Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
_  -- unused, might be of interest
    , sgInitialFunds :: forall era. ShelleyGenesis era -> Map (Addr (Crypto era)) Coin
Shelley.sgInitialFunds = Map (Addr (Crypto era)) Coin
_  -- unused, not retained by the node
    , sgStaking :: forall era.
ShelleyGenesis era -> ShelleyGenesisStaking (Crypto era)
Shelley.sgStaking      = ShelleyGenesisStaking (Crypto era)
_  -- unused, not retained by the node
    } =
    GenesisParameters :: UTCTime
-> NetworkId
-> Rational
-> Int
-> EpochSize
-> NominalDiffTime
-> Int
-> Int
-> Int
-> Lovelace
-> ProtocolParameters
-> GenesisParameters
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             = NominalDiffTime
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 :: Lovelace
protocolParamMaxLovelaceSupply      = Integer -> Lovelace
Lovelace
                                              (Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sgMaxLovelaceSupply)
    , protocolInitialUpdateableProtocolParameters :: ProtocolParameters
protocolInitialUpdateableProtocolParameters = PParams era -> ProtocolParameters
forall ledgerera. PParams ledgerera -> ProtocolParameters
fromShelleyPParams
                                                      PParams era
sgProtocolParams
    }