{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TemplateHaskell #-}

module Cardano.Chain.Genesis.Initializer
  ( GenesisInitializer (..),
    TestnetBalanceOptions (..),
    FakeAvvmOptions (..),
  )
where

import Cardano.Chain.Common (Lovelace)
import Cardano.Prelude

-- | Options determining generated genesis stakes, balances, and delegation
data GenesisInitializer = GenesisInitializer
  { GenesisInitializer -> TestnetBalanceOptions
giTestBalance :: !TestnetBalanceOptions,
    GenesisInitializer -> FakeAvvmOptions
giFakeAvvmBalance :: !FakeAvvmOptions,
    -- | Avvm balances will be multiplied by this factor
    GenesisInitializer -> Rational
giAvvmBalanceFactor :: !Rational,
    -- | Whether to use heavyweight delegation for genesis keys
    GenesisInitializer -> Bool
giUseHeavyDlg :: !Bool
  }
  deriving (GenesisInitializer -> GenesisInitializer -> Bool
(GenesisInitializer -> GenesisInitializer -> Bool)
-> (GenesisInitializer -> GenesisInitializer -> Bool)
-> Eq GenesisInitializer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenesisInitializer -> GenesisInitializer -> Bool
$c/= :: GenesisInitializer -> GenesisInitializer -> Bool
== :: GenesisInitializer -> GenesisInitializer -> Bool
$c== :: GenesisInitializer -> GenesisInitializer -> Bool
Eq, Int -> GenesisInitializer -> ShowS
[GenesisInitializer] -> ShowS
GenesisInitializer -> String
(Int -> GenesisInitializer -> ShowS)
-> (GenesisInitializer -> String)
-> ([GenesisInitializer] -> ShowS)
-> Show GenesisInitializer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisInitializer] -> ShowS
$cshowList :: [GenesisInitializer] -> ShowS
show :: GenesisInitializer -> String
$cshow :: GenesisInitializer -> String
showsPrec :: Int -> GenesisInitializer -> ShowS
$cshowsPrec :: Int -> GenesisInitializer -> ShowS
Show)

-- | These options determine balances of nodes specific for testnet
data TestnetBalanceOptions = TestnetBalanceOptions
  { -- | Number of poor nodes (with small balance).
    TestnetBalanceOptions -> Word
tboPoors :: !Word,
    -- | Number of rich nodes (with huge balance).
    TestnetBalanceOptions -> Word
tboRichmen :: !Word,
    -- | Total balance owned by these nodes.
    TestnetBalanceOptions -> Lovelace
tboTotalBalance :: !Lovelace,
    -- | Portion of stake owned by all richmen together.
    TestnetBalanceOptions -> Rational
tboRichmenShare :: !Rational
  }
  deriving (TestnetBalanceOptions -> TestnetBalanceOptions -> Bool
(TestnetBalanceOptions -> TestnetBalanceOptions -> Bool)
-> (TestnetBalanceOptions -> TestnetBalanceOptions -> Bool)
-> Eq TestnetBalanceOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestnetBalanceOptions -> TestnetBalanceOptions -> Bool
$c/= :: TestnetBalanceOptions -> TestnetBalanceOptions -> Bool
== :: TestnetBalanceOptions -> TestnetBalanceOptions -> Bool
$c== :: TestnetBalanceOptions -> TestnetBalanceOptions -> Bool
Eq, Int -> TestnetBalanceOptions -> ShowS
[TestnetBalanceOptions] -> ShowS
TestnetBalanceOptions -> String
(Int -> TestnetBalanceOptions -> ShowS)
-> (TestnetBalanceOptions -> String)
-> ([TestnetBalanceOptions] -> ShowS)
-> Show TestnetBalanceOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestnetBalanceOptions] -> ShowS
$cshowList :: [TestnetBalanceOptions] -> ShowS
show :: TestnetBalanceOptions -> String
$cshow :: TestnetBalanceOptions -> String
showsPrec :: Int -> TestnetBalanceOptions -> ShowS
$cshowsPrec :: Int -> TestnetBalanceOptions -> ShowS
Show)

-- | These options determines balances of fake AVVM nodes which didn't really go
--   through vending, but pretend they did
data FakeAvvmOptions = FakeAvvmOptions
  { FakeAvvmOptions -> Word
faoCount :: !Word,
    FakeAvvmOptions -> Lovelace
faoOneBalance :: !Lovelace
  }
  deriving (FakeAvvmOptions -> FakeAvvmOptions -> Bool
(FakeAvvmOptions -> FakeAvvmOptions -> Bool)
-> (FakeAvvmOptions -> FakeAvvmOptions -> Bool)
-> Eq FakeAvvmOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FakeAvvmOptions -> FakeAvvmOptions -> Bool
$c/= :: FakeAvvmOptions -> FakeAvvmOptions -> Bool
== :: FakeAvvmOptions -> FakeAvvmOptions -> Bool
$c== :: FakeAvvmOptions -> FakeAvvmOptions -> Bool
Eq, Int -> FakeAvvmOptions -> ShowS
[FakeAvvmOptions] -> ShowS
FakeAvvmOptions -> String
(Int -> FakeAvvmOptions -> ShowS)
-> (FakeAvvmOptions -> String)
-> ([FakeAvvmOptions] -> ShowS)
-> Show FakeAvvmOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FakeAvvmOptions] -> ShowS
$cshowList :: [FakeAvvmOptions] -> ShowS
show :: FakeAvvmOptions -> String
$cshow :: FakeAvvmOptions -> String
showsPrec :: Int -> FakeAvvmOptions -> ShowS
$cshowsPrec :: Int -> FakeAvvmOptions -> ShowS
Show, (forall x. FakeAvvmOptions -> Rep FakeAvvmOptions x)
-> (forall x. Rep FakeAvvmOptions x -> FakeAvvmOptions)
-> Generic FakeAvvmOptions
forall x. Rep FakeAvvmOptions x -> FakeAvvmOptions
forall x. FakeAvvmOptions -> Rep FakeAvvmOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FakeAvvmOptions x -> FakeAvvmOptions
$cfrom :: forall x. FakeAvvmOptions -> Rep FakeAvvmOptions x
Generic)