{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.Api.Shelley.Genesis
  ( ShelleyGenesis(..)
  , shelleyGenesisDefaults
  ) where

import           Prelude

import qualified Data.Map.Strict as Map
import           Data.Maybe (fromMaybe)
import qualified Data.Time as Time

import           Cardano.Ledger.BaseTypes as Ledger
import           Cardano.Ledger.Shelley.PParams as Ledger (PParams' (..), emptyPParams)
import           Cardano.Slotting.Slot (EpochSize (..))

import           Ouroboros.Consensus.Shelley.Node (ShelleyGenesis (..), emptyGenesisStaking)


-- | Some reasonable starting defaults for constructing a 'ShelleyGenesis'.
--
-- You must override at least the following fields for this to be useful:
--
-- * 'sgSystemStart' the time of the first block
-- * 'sgNetworkMagic' to a suitable testnet or mainnet network magic number.
-- * 'sgGenDelegs' to have some initial nodes
-- * 'sgInitialFunds' to have any money in the system
-- * 'sgMaxLovelaceSupply' must be at least the sum of the 'sgInitialFunds'
--   but more if you want to allow for rewards.
--
shelleyGenesisDefaults :: ShelleyGenesis crypto
shelleyGenesisDefaults :: ShelleyGenesis crypto
shelleyGenesisDefaults =
  ShelleyGenesis :: forall era.
UTCTime
-> Word32
-> Network
-> PositiveUnitInterval
-> Word64
-> EpochSize
-> Word64
-> Word64
-> NominalDiffTime
-> Word64
-> Word64
-> PParams era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Map (Addr (Crypto era)) Coin
-> ShelleyGenesisStaking (Crypto era)
-> ShelleyGenesis era
ShelleyGenesis
    {
      -- parameters for this specific chain
      sgSystemStart :: UTCTime
sgSystemStart           = UTCTime
zeroTime
    , sgNetworkMagic :: Word32
sgNetworkMagic          = Word32
42
    , sgNetworkId :: Network
sgNetworkId             = Network
Ledger.Testnet

      -- consensus protocol parameters
    , sgSlotLength :: NominalDiffTime
sgSlotLength            = NominalDiffTime
1.0 :: Time.NominalDiffTime -- 1s slots
    , sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff      = PositiveUnitInterval
-> Maybe PositiveUnitInterval -> PositiveUnitInterval
forall a. a -> Maybe a -> a
fromMaybe
                                  ([Char] -> PositiveUnitInterval
forall a. HasCallStack => [Char] -> a
error [Char]
"shelleyGenesisDefaults: impossible")
                                  (Rational -> Maybe PositiveUnitInterval
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
20))  -- 20s block times on average
    , sgSecurityParam :: Word64
sgSecurityParam         = Word64
k
    , sgEpochLength :: EpochSize
sgEpochLength           = Word64 -> EpochSize
EpochSize (Word64
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
20) -- 10k/f
    , sgSlotsPerKESPeriod :: Word64
sgSlotsPerKESPeriod     = Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
36        -- 1.5 days with 1s slots
    , sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions      = Word64
60                  -- 90 days
    , sgUpdateQuorum :: Word64
sgUpdateQuorum          = Word64
5                   -- assuming 7 genesis keys

    -- ledger protocol parameters
    , sgProtocolParams :: PParams crypto
sgProtocolParams        =
        PParams Any
forall era. PParams era
Ledger.emptyPParams
        { _d :: HKD Identity UnitInterval
Ledger._d = HKD Identity UnitInterval
forall a. Bounded a => a
maxBound
        , _maxBHSize :: HKD Identity Natural
Ledger._maxBHSize = HKD Identity Natural
1100                  -- TODO: compute from crypto
        , _maxBBSize :: HKD Identity Natural
Ledger._maxBBSize = Natural
64 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
1024             -- max 64kb blocks
        , _maxTxSize :: HKD Identity Natural
Ledger._maxTxSize = Natural
16 Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
* Natural
1024             -- max 16kb txs
        , _eMax :: HKD Identity EpochNo
Ledger._eMax      = HKD Identity EpochNo
18
        , _minfeeA :: HKD Identity Natural
Ledger._minfeeA   = HKD Identity Natural
1                     -- The linear factor for the minimum fee calculation
        , _minfeeB :: HKD Identity Natural
Ledger._minfeeB   = HKD Identity Natural
0                     -- The constant factor for the minimum fee calculation
        }

      -- genesis keys and initial funds
    , sgGenDelegs :: Map
  (KeyHash 'Genesis (Crypto crypto)) (GenDelegPair (Crypto crypto))
sgGenDelegs             = Map
  (KeyHash 'Genesis (Crypto crypto)) (GenDelegPair (Crypto crypto))
forall k a. Map k a
Map.empty
    , sgStaking :: ShelleyGenesisStaking (Crypto crypto)
sgStaking               = ShelleyGenesisStaking (Crypto crypto)
forall crypto. ShelleyGenesisStaking crypto
emptyGenesisStaking
    , sgInitialFunds :: Map (Addr (Crypto crypto)) Coin
sgInitialFunds          = Map (Addr (Crypto crypto)) Coin
forall k a. Map k a
Map.empty
    , sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply     = Word64
0
    }
  where
    k :: Word64
k = Word64
2160
    zeroTime :: UTCTime
zeroTime = Day -> DiffTime -> UTCTime
Time.UTCTime (Integer -> Int -> Int -> Day
Time.fromGregorian Integer
1970 Int
1 Int
1) DiffTime
0 -- tradition