{-# 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

-- | Specification how to generate full 'GenesisData'
data GenesisSpec = UnsafeGenesisSpec
  { -- | Genesis data describes avvm utxo
    GenesisSpec -> GenesisAvvmBalances
gsAvvmDistr :: !GenesisAvvmBalances,
    -- | Genesis state of heavyweight delegation. Will be concatenated with
    --   delegation genesis keyHashes if 'tiUseHeavyDlg' is 'True'
    GenesisSpec -> GenesisDelegation
gsHeavyDelegation :: !GenesisDelegation,
    -- | Genesis 'ProtocolParameters'
    GenesisSpec -> ProtocolParameters
gsProtocolParameters :: !ProtocolParameters,
    -- | The security parameter of the Ouroboros protocol
    GenesisSpec -> BlockCount
gsK :: !BlockCount,
    -- | The magic number unique to any instance of Cardano
    GenesisSpec -> ProtocolMagic
gsProtocolMagic :: !ProtocolMagic,
    -- | Other data which depend on genesis type
    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
/= :: GenesisSpec -> GenesisSpec -> Bool
$c/= :: GenesisSpec -> GenesisSpec -> Bool
== :: GenesisSpec -> GenesisSpec -> Bool
$c== :: 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
showList :: [GenesisSpec] -> ShowS
$cshowList :: [GenesisSpec] -> ShowS
show :: GenesisSpec -> String
$cshow :: GenesisSpec -> String
showsPrec :: Int -> GenesisSpec -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep GenesisSpec x -> GenesisSpec
$cfrom :: forall x. GenesisSpec -> Rep GenesisSpec x
Generic)

-- | Safe constructor for 'GenesisSpec'. Throws error if something
-- goes wrong.
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"
  -- All checks passed
  GenesisSpec -> Either Text GenesisSpec
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