{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module Cardano.Chain.Genesis.Spec (
GenesisSpec (..),
mkGenesisSpec,
) where
import Cardano.Chain.Common (BlockCount)
import Cardano.Chain.Genesis.AvvmBalances (GenesisAvvmBalances (..))
import Cardano.Chain.Genesis.Delegation (GenesisDelegation (..))
import Cardano.Chain.Genesis.Initializer (GenesisInitializer (..))
import Cardano.Chain.Update.ProtocolParameters (ProtocolParameters)
import Cardano.Crypto (ProtocolMagic)
import Cardano.Prelude
import Data.List (nub)
import qualified Data.Map.Strict as M
data GenesisSpec = UnsafeGenesisSpec
{ GenesisSpec -> GenesisAvvmBalances
gsAvvmDistr :: !GenesisAvvmBalances
, GenesisSpec -> GenesisDelegation
gsHeavyDelegation :: !GenesisDelegation
, GenesisSpec -> ProtocolParameters
gsProtocolParameters :: !ProtocolParameters
, GenesisSpec -> BlockCount
gsK :: !BlockCount
, GenesisSpec -> ProtocolMagic
gsProtocolMagic :: !ProtocolMagic
, GenesisSpec -> GenesisInitializer
gsInitializer :: !GenesisInitializer
}
deriving (GenesisSpec -> GenesisSpec -> Bool
(GenesisSpec -> GenesisSpec -> Bool)
-> (GenesisSpec -> GenesisSpec -> Bool) -> Eq GenesisSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisSpec -> GenesisSpec -> Bool
== :: GenesisSpec -> GenesisSpec -> Bool
$c/= :: GenesisSpec -> GenesisSpec -> Bool
/= :: GenesisSpec -> GenesisSpec -> Bool
Eq, Int -> GenesisSpec -> ShowS
[GenesisSpec] -> ShowS
GenesisSpec -> String
(Int -> GenesisSpec -> ShowS)
-> (GenesisSpec -> String)
-> ([GenesisSpec] -> ShowS)
-> Show GenesisSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisSpec -> ShowS
showsPrec :: Int -> GenesisSpec -> ShowS
$cshow :: GenesisSpec -> String
show :: GenesisSpec -> String
$cshowList :: [GenesisSpec] -> ShowS
showList :: [GenesisSpec] -> ShowS
Show, (forall x. GenesisSpec -> Rep GenesisSpec x)
-> (forall x. Rep GenesisSpec x -> GenesisSpec)
-> Generic GenesisSpec
forall x. Rep GenesisSpec x -> GenesisSpec
forall x. GenesisSpec -> Rep GenesisSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GenesisSpec -> Rep GenesisSpec x
from :: forall x. GenesisSpec -> Rep GenesisSpec x
$cto :: forall x. Rep GenesisSpec x -> GenesisSpec
to :: forall x. Rep GenesisSpec x -> GenesisSpec
Generic)
mkGenesisSpec ::
GenesisAvvmBalances ->
GenesisDelegation ->
ProtocolParameters ->
BlockCount ->
ProtocolMagic ->
GenesisInitializer ->
Either Text GenesisSpec
mkGenesisSpec :: GenesisAvvmBalances
-> GenesisDelegation
-> ProtocolParameters
-> BlockCount
-> ProtocolMagic
-> GenesisInitializer
-> Either Text GenesisSpec
mkGenesisSpec GenesisAvvmBalances
avvmDistr GenesisDelegation
delega ProtocolParameters
bvd BlockCount
k ProtocolMagic
pm GenesisInitializer
specType = do
let avvmKeys :: [CompactRedeemVerificationKey]
avvmKeys = Map CompactRedeemVerificationKey Lovelace
-> [CompactRedeemVerificationKey]
forall k a. Map k a -> [k]
M.keys (Map CompactRedeemVerificationKey Lovelace
-> [CompactRedeemVerificationKey])
-> Map CompactRedeemVerificationKey Lovelace
-> [CompactRedeemVerificationKey]
forall a b. (a -> b) -> a -> b
$ GenesisAvvmBalances -> Map CompactRedeemVerificationKey Lovelace
unGenesisAvvmBalances GenesisAvvmBalances
avvmDistr
([CompactRedeemVerificationKey] -> Int
forall a. HasLength a => a -> Int
length ([CompactRedeemVerificationKey] -> [CompactRedeemVerificationKey]
forall a. Eq a => [a] -> [a]
nub [CompactRedeemVerificationKey]
avvmKeys) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [CompactRedeemVerificationKey] -> Int
forall a. HasLength a => a -> Int
length [CompactRedeemVerificationKey]
avvmKeys)
Bool -> Text -> Either Text ()
forall e (m :: * -> *). MonadError e m => Bool -> e -> m ()
`orThrowError` Text
"mkGenesisSpec: there are duplicates in avvm balances"
GenesisSpec -> Either Text GenesisSpec
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenesisSpec -> Either Text GenesisSpec)
-> GenesisSpec -> Either Text GenesisSpec
forall a b. (a -> b) -> a -> b
$ GenesisAvvmBalances
-> GenesisDelegation
-> ProtocolParameters
-> BlockCount
-> ProtocolMagic
-> GenesisInitializer
-> GenesisSpec
UnsafeGenesisSpec GenesisAvvmBalances
avvmDistr GenesisDelegation
delega ProtocolParameters
bvd BlockCount
k ProtocolMagic
pm GenesisInitializer
specType