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

{-# OPTIONS_GHC -Wno-orphans #-}

module Bcc.Api.Sophie.Genesis
  ( SophieGenesis(..)
  , sophieGenesisDefaults
  ) where

import           Prelude

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

import           Bcc.Ledger.BaseTypes as Ledger
import           Bcc.Slotting.Slot (EpochSize (..))

import           Shardagnostic.Consensus.Sophie.Node (SophieGenesis (..), emptyGenesisStaking)

import           Sophie.Spec.Ledger.PParams as Ledger (PParams' (..), emptyPParams)


-- | Some reasonable starting defaults for constructing a 'SophieGenesis'.
--
-- 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
-- * 'sgMaxEntropicSupply' must be at least the sum of the 'sgInitialFunds'
--   but more if you want to allow for rewards.
--
sophieGenesisDefaults :: SophieGenesis crypto
sophieGenesisDefaults :: SophieGenesis crypto
sophieGenesisDefaults =
  SophieGenesis :: forall era.
UTCTime
-> Word32
-> Network
-> PositiveUnitInterval
-> Word64
-> Word64
-> EpochSize
-> Word64
-> Word64
-> NominalDiffTime
-> Word64
-> Word64
-> PParams era
-> Map (KeyHash 'Genesis (Crypto era)) (GenDelegPair (Crypto era))
-> Map
     (KeyHash 'Vested (Crypto era)) (VestedDelegPair (Crypto era))
-> Map (Addr (Crypto era)) Coin
-> SophieGenesisStaking (Crypto era)
-> SophieGenesis era
SophieGenesis
    {
      -- 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]
"sophieGenesisDefaults: 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
    , sgVestMultiple :: Word64
sgVestMultiple            = Word64
1
    , 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
    , sgVestedDelegs :: Map
  (KeyHash 'Vested (Crypto crypto)) (VestedDelegPair (Crypto crypto))
sgVestedDelegs           = Map
  (KeyHash 'Vested (Crypto crypto)) (VestedDelegPair (Crypto crypto))
forall k a. Map k a
Map.empty
    , sgStaking :: SophieGenesisStaking (Crypto crypto)
sgStaking               = SophieGenesisStaking (Crypto crypto)
forall crypto. SophieGenesisStaking crypto
emptyGenesisStaking
    , sgInitialFunds :: Map (Addr (Crypto crypto)) Coin
sgInitialFunds          = Map (Addr (Crypto crypto)) Coin
forall k a. Map k a
Map.empty
    , sgMaxEntropicSupply :: Word64
sgMaxEntropicSupply     = 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