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

{-# OPTIONS_GHC -Wno-orphans #-}

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

import           Cardano.Prelude

import qualified Data.Map.Strict as Map
import qualified Data.Time as Time

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

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

import           Shelley.Spec.Ledger.BaseTypes as Ledger
import           Shelley.Spec.Ledger.PParams as Ledger (PParams' (..), emptyPParams)


-- | 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
-> Rational
-> Word64
-> EpochSize
-> Word64
-> Word64
-> NominalDiffTime
-> Word64
-> Word64
-> PParams era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Map (Addr era) Coin
-> ShelleyGenesisStaking 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 :: Rational
sgActiveSlotsCoeff      = 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 =
              Ratio Word64 -> UnitInterval
Ledger.truncateUnitInterval
            (Ratio Word64 -> UnitInterval)
-> (Double -> Ratio Word64) -> Double -> UnitInterval
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Double -> Ratio Word64
forall a b. (Real a, Fractional b) => a -> b
realToFrac
            (Double -> UnitInterval) -> Double -> UnitInterval
forall a b. (a -> b) -> a -> b
$ (Double
1 :: Double)
        , _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
        }

      -- 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
sgStaking               = ShelleyGenesisStaking crypto
forall era. ShelleyGenesisStaking era
emptyGenesisStaking
    , sgInitialFunds :: Map (Addr crypto) Coin
sgInitialFunds          = Map (Addr 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