{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Cardano.Chain.Genesis.Generate
( GeneratedSecrets(..)
, gsSigningKeys
, gsSigningKeysPoor
, PoorSecret(..)
, generateGenesisData
, generateGenesisDataWithEntropy
, generateGenesisConfig
, generateGenesisConfigWithEntropy
, GenesisDataGenerationError(..)
)
where
import Cardano.Prelude
import qualified Crypto.Random as Crypto (MonadRandom)
import qualified Data.Map.Strict as M
import qualified Data.Set as Set
import Data.Time (UTCTime)
import Data.Coerce (coerce)
import Formatting (build, bprint, int, stext)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))
import Cardano.Chain.Common
( Address
, Lovelace
, LovelaceError
, addLovelace
, divLovelace
, makeVerKeyAddress
, mkKnownLovelace
, hashKey
, modLovelace
, scaleLovelace
, scaleLovelaceRational
, subLovelace
, sumLovelace
)
import Cardano.Chain.Common.NetworkMagic (makeNetworkMagic)
import qualified Cardano.Chain.Delegation.Certificate as Delegation
import Cardano.Chain.Genesis.AvvmBalances (GenesisAvvmBalances(..))
import Cardano.Chain.Genesis.Data (GenesisData(..))
import Cardano.Chain.Genesis.Delegation
(GenesisDelegation(..), GenesisDelegationError, mkGenesisDelegation)
import Cardano.Chain.Genesis.Hash (GenesisHash(..))
import Cardano.Chain.Genesis.Initializer
(FakeAvvmOptions(..), GenesisInitializer(..), TestnetBalanceOptions(..))
import Cardano.Chain.Genesis.NonAvvmBalances (GenesisNonAvvmBalances(..))
import Cardano.Chain.Genesis.Spec (GenesisSpec(..))
import Cardano.Chain.Genesis.Config (Config(..))
import Cardano.Chain.UTxO.UTxOConfiguration (defaultUTxOConfiguration)
import Cardano.Chain.Genesis.KeyHashes (GenesisKeyHashes(..))
import Cardano.Crypto as Crypto
( SigningKey
, runSecureRandom
, getProtocolMagicId
, getRequiresNetworkMagic
, keyGen
, noPassSafeSigner
, toVerification
, RedeemSigningKey
, redeemKeyGen
, redeemToVerification
, toCompactRedeemVerificationKey
, serializeCborHash
)
newtype PoorSecret = PoorSecret { PoorSecret -> SigningKey
poorSecretToKey :: SigningKey }
deriving ((forall x. PoorSecret -> Rep PoorSecret x)
-> (forall x. Rep PoorSecret x -> PoorSecret) -> Generic PoorSecret
forall x. Rep PoorSecret x -> PoorSecret
forall x. PoorSecret -> Rep PoorSecret x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PoorSecret x -> PoorSecret
$cfrom :: forall x. PoorSecret -> Rep PoorSecret x
Generic, Context -> PoorSecret -> IO (Maybe ThunkInfo)
Proxy PoorSecret -> String
(Context -> PoorSecret -> IO (Maybe ThunkInfo))
-> (Context -> PoorSecret -> IO (Maybe ThunkInfo))
-> (Proxy PoorSecret -> String)
-> NoThunks PoorSecret
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy PoorSecret -> String
$cshowTypeOf :: Proxy PoorSecret -> String
wNoThunks :: Context -> PoorSecret -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> PoorSecret -> IO (Maybe ThunkInfo)
noThunks :: Context -> PoorSecret -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> PoorSecret -> IO (Maybe ThunkInfo)
NoThunks)
data GeneratedSecrets = GeneratedSecrets
{ :: ![SigningKey]
, GeneratedSecrets -> [SigningKey]
gsRichSecrets :: ![SigningKey]
, GeneratedSecrets -> [PoorSecret]
gsPoorSecrets :: ![PoorSecret]
, GeneratedSecrets -> [RedeemSigningKey]
gsFakeAvvmSecrets :: ![RedeemSigningKey]
}
deriving ((forall x. GeneratedSecrets -> Rep GeneratedSecrets x)
-> (forall x. Rep GeneratedSecrets x -> GeneratedSecrets)
-> Generic GeneratedSecrets
forall x. Rep GeneratedSecrets x -> GeneratedSecrets
forall x. GeneratedSecrets -> Rep GeneratedSecrets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GeneratedSecrets x -> GeneratedSecrets
$cfrom :: forall x. GeneratedSecrets -> Rep GeneratedSecrets x
Generic, Context -> GeneratedSecrets -> IO (Maybe ThunkInfo)
Proxy GeneratedSecrets -> String
(Context -> GeneratedSecrets -> IO (Maybe ThunkInfo))
-> (Context -> GeneratedSecrets -> IO (Maybe ThunkInfo))
-> (Proxy GeneratedSecrets -> String)
-> NoThunks GeneratedSecrets
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy GeneratedSecrets -> String
$cshowTypeOf :: Proxy GeneratedSecrets -> String
wNoThunks :: Context -> GeneratedSecrets -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> GeneratedSecrets -> IO (Maybe ThunkInfo)
noThunks :: Context -> GeneratedSecrets -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> GeneratedSecrets -> IO (Maybe ThunkInfo)
NoThunks)
gsSigningKeys :: GeneratedSecrets -> [SigningKey]
gsSigningKeys :: GeneratedSecrets -> [SigningKey]
gsSigningKeys GeneratedSecrets
gs = GeneratedSecrets -> [SigningKey]
gsRichSecrets GeneratedSecrets
gs [SigningKey] -> [SigningKey] -> [SigningKey]
forall a. Semigroup a => a -> a -> a
<> GeneratedSecrets -> [SigningKey]
gsSigningKeysPoor GeneratedSecrets
gs
gsSigningKeysPoor :: GeneratedSecrets -> [SigningKey]
gsSigningKeysPoor :: GeneratedSecrets -> [SigningKey]
gsSigningKeysPoor = (PoorSecret -> SigningKey) -> [PoorSecret] -> [SigningKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map PoorSecret -> SigningKey
poorSecretToKey ([PoorSecret] -> [SigningKey])
-> (GeneratedSecrets -> [PoorSecret])
-> GeneratedSecrets
-> [SigningKey]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. GeneratedSecrets -> [PoorSecret]
gsPoorSecrets
data GenesisDataGenerationError
= GenesisDataAddressBalanceMismatch Text Int Int
| GenesisDataGenerationDelegationError GenesisDelegationError
| GenesisDataGenerationDistributionMismatch Lovelace Lovelace
| GenesisDataGenerationLovelaceError LovelaceError
| GenesisDataGenerationPassPhraseMismatch
| GenesisDataGenerationRedeemKeyGen
deriving (GenesisDataGenerationError -> GenesisDataGenerationError -> Bool
(GenesisDataGenerationError -> GenesisDataGenerationError -> Bool)
-> (GenesisDataGenerationError
-> GenesisDataGenerationError -> Bool)
-> Eq GenesisDataGenerationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenesisDataGenerationError -> GenesisDataGenerationError -> Bool
$c/= :: GenesisDataGenerationError -> GenesisDataGenerationError -> Bool
== :: GenesisDataGenerationError -> GenesisDataGenerationError -> Bool
$c== :: GenesisDataGenerationError -> GenesisDataGenerationError -> Bool
Eq, Int -> GenesisDataGenerationError -> ShowS
[GenesisDataGenerationError] -> ShowS
GenesisDataGenerationError -> String
(Int -> GenesisDataGenerationError -> ShowS)
-> (GenesisDataGenerationError -> String)
-> ([GenesisDataGenerationError] -> ShowS)
-> Show GenesisDataGenerationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisDataGenerationError] -> ShowS
$cshowList :: [GenesisDataGenerationError] -> ShowS
show :: GenesisDataGenerationError -> String
$cshow :: GenesisDataGenerationError -> String
showsPrec :: Int -> GenesisDataGenerationError -> ShowS
$cshowsPrec :: Int -> GenesisDataGenerationError -> ShowS
Show)
instance B.Buildable GenesisDataGenerationError where
build :: GenesisDataGenerationError -> Builder
build = \case
GenesisDataAddressBalanceMismatch Text
distr Int
addresses Int
balances ->
Format Builder (Text -> Int -> Int -> Builder)
-> Text -> Int -> Int -> Builder
forall a. Format Builder a -> a
bprint (Format
(Text -> Int -> Int -> Builder) (Text -> Int -> Int -> Builder)
"GenesisData address balance mismatch, Distribution: "
Format
(Text -> Int -> Int -> Builder) (Text -> Int -> Int -> Builder)
-> Format Builder (Text -> Int -> Int -> Builder)
-> Format Builder (Text -> Int -> Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Int -> Builder) (Text -> Int -> Int -> Builder)
forall r. Format r (Text -> r)
stext
Format (Int -> Int -> Builder) (Text -> Int -> Int -> Builder)
-> Format Builder (Int -> Int -> Builder)
-> Format Builder (Text -> Int -> Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Int -> Builder) (Int -> Int -> Builder)
" Addresses list length: "
Format (Int -> Int -> Builder) (Int -> Int -> Builder)
-> Format Builder (Int -> Int -> Builder)
-> Format Builder (Int -> Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Builder) (Int -> Int -> Builder)
forall a r. Integral a => Format r (a -> r)
int
Format (Int -> Builder) (Int -> Int -> Builder)
-> Format Builder (Int -> Builder)
-> Format Builder (Int -> Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Int -> Builder) (Int -> Builder)
" Balances list length: "
Format (Int -> Builder) (Int -> Builder)
-> Format Builder (Int -> Builder)
-> Format Builder (Int -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Int -> Builder)
forall a r. Integral a => Format r (a -> r)
int
)
Text
distr
Int
addresses
Int
balances
GenesisDataGenerationDelegationError GenesisDelegationError
genesisDelegError ->
Format Builder (GenesisDelegationError -> Builder)
-> GenesisDelegationError -> Builder
forall a. Format Builder a -> a
bprint (Format
(GenesisDelegationError -> Builder)
(GenesisDelegationError -> Builder)
"GenesisDataGenerationDelegationError: "
Format
(GenesisDelegationError -> Builder)
(GenesisDelegationError -> Builder)
-> Format Builder (GenesisDelegationError -> Builder)
-> Format Builder (GenesisDelegationError -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (GenesisDelegationError -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
)
GenesisDelegationError
genesisDelegError
GenesisDataGenerationDistributionMismatch Lovelace
testBalance Lovelace
totalBalance ->
Format Builder (Lovelace -> Lovelace -> Builder)
-> Lovelace -> Lovelace -> Builder
forall a. Format Builder a -> a
bprint (Format
(Lovelace -> Lovelace -> Builder) (Lovelace -> Lovelace -> Builder)
"GenesisDataGenerationDistributionMismatch: Test balance: "
Format
(Lovelace -> Lovelace -> Builder) (Lovelace -> Lovelace -> Builder)
-> Format Builder (Lovelace -> Lovelace -> Builder)
-> Format Builder (Lovelace -> Lovelace -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Lovelace -> Builder) (Lovelace -> Lovelace -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
Format (Lovelace -> Builder) (Lovelace -> Lovelace -> Builder)
-> Format Builder (Lovelace -> Builder)
-> Format Builder (Lovelace -> Lovelace -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Lovelace -> Builder) (Lovelace -> Builder)
" Total balance: "
Format (Lovelace -> Builder) (Lovelace -> Builder)
-> Format Builder (Lovelace -> Builder)
-> Format Builder (Lovelace -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Lovelace -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
)
Lovelace
testBalance
Lovelace
totalBalance
GenesisDataGenerationLovelaceError LovelaceError
lovelaceErr ->
Format Builder (LovelaceError -> Builder)
-> LovelaceError -> Builder
forall a. Format Builder a -> a
bprint (Format (LovelaceError -> Builder) (LovelaceError -> Builder)
"GenesisDataGenerationLovelaceError: "
Format (LovelaceError -> Builder) (LovelaceError -> Builder)
-> Format Builder (LovelaceError -> Builder)
-> Format Builder (LovelaceError -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (LovelaceError -> Builder)
forall a r. Buildable a => Format r (a -> r)
build
)
LovelaceError
lovelaceErr
GenesisDataGenerationError
GenesisDataGenerationPassPhraseMismatch ->
Format Builder Builder -> Builder
forall a. Format Builder a -> a
bprint Format Builder Builder
"GenesisDataGenerationPassPhraseMismatch"
GenesisDataGenerationError
GenesisDataGenerationRedeemKeyGen ->
Format Builder Builder -> Builder
forall a. Format Builder a -> a
bprint Format Builder Builder
"GenesisDataGenerationRedeemKeyGen"
generateGenesisData
:: UTCTime
-> GenesisSpec
-> ExceptT GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
generateGenesisData :: UTCTime
-> GenesisSpec
-> ExceptT
GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
generateGenesisData UTCTime
startTime GenesisSpec
genesisSpec =
(SecureRandom
(Either GenesisDataGenerationError (GenesisData, GeneratedSecrets))
-> IO
(Either
GenesisDataGenerationError (GenesisData, GeneratedSecrets)))
-> ExceptT
GenesisDataGenerationError
SecureRandom
(GenesisData, GeneratedSecrets)
-> ExceptT
GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT SecureRandom
(Either GenesisDataGenerationError (GenesisData, GeneratedSecrets))
-> IO
(Either GenesisDataGenerationError (GenesisData, GeneratedSecrets))
forall a. SecureRandom a -> IO a
Crypto.runSecureRandom (ExceptT
GenesisDataGenerationError
SecureRandom
(GenesisData, GeneratedSecrets)
-> ExceptT
GenesisDataGenerationError IO (GenesisData, GeneratedSecrets))
-> ExceptT
GenesisDataGenerationError
SecureRandom
(GenesisData, GeneratedSecrets)
-> ExceptT
GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
forall a b. (a -> b) -> a -> b
$
UTCTime
-> GenesisSpec
-> ExceptT
GenesisDataGenerationError
SecureRandom
(GenesisData, GeneratedSecrets)
forall (m :: * -> *).
MonadRandom m =>
UTCTime
-> GenesisSpec
-> ExceptT
GenesisDataGenerationError m (GenesisData, GeneratedSecrets)
generateGenesisDataWithEntropy UTCTime
startTime GenesisSpec
genesisSpec
generateGenesisDataWithEntropy
:: Crypto.MonadRandom m
=> UTCTime
-> GenesisSpec
-> ExceptT GenesisDataGenerationError m (GenesisData, GeneratedSecrets)
generateGenesisDataWithEntropy :: UTCTime
-> GenesisSpec
-> ExceptT
GenesisDataGenerationError m (GenesisData, GeneratedSecrets)
generateGenesisDataWithEntropy UTCTime
startTime GenesisSpec
genesisSpec = do
let
pm :: ProtocolMagic
pm = GenesisSpec -> ProtocolMagic
gsProtocolMagic GenesisSpec
genesisSpec
nm :: NetworkMagic
nm = ProtocolMagic -> NetworkMagic
forall a. AProtocolMagic a -> NetworkMagic
makeNetworkMagic ProtocolMagic
pm
gi :: GenesisInitializer
gi = GenesisSpec -> GenesisInitializer
gsInitializer GenesisSpec
genesisSpec
fao :: FakeAvvmOptions
fao = GenesisInitializer -> FakeAvvmOptions
giFakeAvvmBalance GenesisInitializer
gi
tbo :: TestnetBalanceOptions
tbo = GenesisInitializer -> TestnetBalanceOptions
giTestBalance GenesisInitializer
gi
GeneratedSecrets
generatedSecrets <- m GeneratedSecrets
-> ExceptT GenesisDataGenerationError m GeneratedSecrets
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m GeneratedSecrets
-> ExceptT GenesisDataGenerationError m GeneratedSecrets)
-> m GeneratedSecrets
-> ExceptT GenesisDataGenerationError m GeneratedSecrets
forall a b. (a -> b) -> a -> b
$ GenesisInitializer -> m GeneratedSecrets
forall (m :: * -> *).
MonadRandom m =>
GenesisInitializer -> m GeneratedSecrets
generateSecrets GenesisInitializer
gi
let
dlgIssuersSecrets :: [SigningKey]
dlgIssuersSecrets = GeneratedSecrets -> [SigningKey]
gsDlgIssuersSecrets GeneratedSecrets
generatedSecrets
richSecrets :: [SigningKey]
richSecrets = GeneratedSecrets -> [SigningKey]
gsRichSecrets GeneratedSecrets
generatedSecrets
poorSecrets :: [PoorSecret]
poorSecrets = GeneratedSecrets -> [PoorSecret]
gsPoorSecrets GeneratedSecrets
generatedSecrets
let
genesisSecrets :: [SigningKey]
genesisSecrets =
if GenesisInitializer -> Bool
giUseHeavyDlg GenesisInitializer
gi then [SigningKey]
dlgIssuersSecrets else [SigningKey]
richSecrets
genesisKeyHashes :: GenesisKeyHashes
genesisKeyHashes :: GenesisKeyHashes
genesisKeyHashes =
Set KeyHash -> GenesisKeyHashes
GenesisKeyHashes
(Set KeyHash -> GenesisKeyHashes)
-> ([KeyHash] -> Set KeyHash) -> [KeyHash] -> GenesisKeyHashes
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [KeyHash] -> Set KeyHash
forall a. Ord a => [a] -> Set a
Set.fromList
([KeyHash] -> GenesisKeyHashes) -> [KeyHash] -> GenesisKeyHashes
forall a b. (a -> b) -> a -> b
$ VerificationKey -> KeyHash
hashKey
(VerificationKey -> KeyHash)
-> (SigningKey -> VerificationKey) -> SigningKey -> KeyHash
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SigningKey -> VerificationKey
toVerification
(SigningKey -> KeyHash) -> [SigningKey] -> [KeyHash]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigningKey]
genesisSecrets
let
genesisDlgList :: [Delegation.Certificate]
genesisDlgList :: [Certificate]
genesisDlgList =
(\(SigningKey
issuerSK, SigningKey
delegateSK) -> ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
Delegation.signCertificate
(ProtocolMagic -> ProtocolMagicId
forall a. AProtocolMagic a -> ProtocolMagicId
getProtocolMagicId ProtocolMagic
pm)
(SigningKey -> VerificationKey
toVerification SigningKey
delegateSK)
EpochNumber
0
(SigningKey -> SafeSigner
noPassSafeSigner SigningKey
issuerSK)
)
((SigningKey, SigningKey) -> Certificate)
-> [(SigningKey, SigningKey)] -> [Certificate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigningKey] -> [SigningKey] -> [(SigningKey, SigningKey)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SigningKey]
dlgIssuersSecrets [SigningKey]
richSecrets
GenesisDelegation
genesisDlg <-
[Certificate] -> Either GenesisDelegationError GenesisDelegation
forall (m :: * -> *).
MonadError GenesisDelegationError m =>
[Certificate] -> m GenesisDelegation
mkGenesisDelegation
( Map KeyHash Certificate -> [Certificate]
forall k a. Map k a -> [a]
M.elems (GenesisDelegation -> Map KeyHash Certificate
unGenesisDelegation (GenesisDelegation -> Map KeyHash Certificate)
-> GenesisDelegation -> Map KeyHash Certificate
forall a b. (a -> b) -> a -> b
$ GenesisSpec -> GenesisDelegation
gsHeavyDelegation GenesisSpec
genesisSpec)
[Certificate] -> [Certificate] -> [Certificate]
forall a. Semigroup a => a -> a -> a
<> [Certificate]
genesisDlgList
)
Either GenesisDelegationError GenesisDelegation
-> (GenesisDelegationError -> GenesisDataGenerationError)
-> ExceptT GenesisDataGenerationError m GenesisDelegation
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` GenesisDelegationError -> GenesisDataGenerationError
GenesisDataGenerationDelegationError
let
applyAvvmBalanceFactor :: Map k Lovelace -> Map k Lovelace
applyAvvmBalanceFactor :: Map k Lovelace -> Map k Lovelace
applyAvvmBalanceFactor =
(Lovelace -> Lovelace) -> Map k Lovelace -> Map k Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Lovelace -> Rational -> Lovelace)
-> Rational -> Lovelace -> Lovelace
forall a b c. (a -> b -> c) -> b -> a -> c
flip Lovelace -> Rational -> Lovelace
scaleLovelaceRational (GenesisInitializer -> Rational
giAvvmBalanceFactor GenesisInitializer
gi))
realAvvmMultiplied :: GenesisAvvmBalances
realAvvmMultiplied :: GenesisAvvmBalances
realAvvmMultiplied = Map CompactRedeemVerificationKey Lovelace -> GenesisAvvmBalances
GenesisAvvmBalances
(Map CompactRedeemVerificationKey Lovelace -> GenesisAvvmBalances)
-> (GenesisSpec -> Map CompactRedeemVerificationKey Lovelace)
-> GenesisSpec
-> GenesisAvvmBalances
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Map CompactRedeemVerificationKey Lovelace
-> Map CompactRedeemVerificationKey Lovelace
forall k. Map k Lovelace -> Map k Lovelace
applyAvvmBalanceFactor
(Map CompactRedeemVerificationKey Lovelace
-> Map CompactRedeemVerificationKey Lovelace)
-> (GenesisSpec -> Map CompactRedeemVerificationKey Lovelace)
-> GenesisSpec
-> Map CompactRedeemVerificationKey Lovelace
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. GenesisAvvmBalances -> Map CompactRedeemVerificationKey Lovelace
unGenesisAvvmBalances
(GenesisAvvmBalances -> Map CompactRedeemVerificationKey Lovelace)
-> (GenesisSpec -> GenesisAvvmBalances)
-> GenesisSpec
-> Map CompactRedeemVerificationKey Lovelace
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. GenesisSpec -> GenesisAvvmBalances
gsAvvmDistr
(GenesisSpec -> GenesisAvvmBalances)
-> GenesisSpec -> GenesisAvvmBalances
forall a b. (a -> b) -> a -> b
$ GenesisSpec
genesisSpec
let
fakeAvvmVerificationKeys :: [CompactRedeemVerificationKey]
fakeAvvmVerificationKeys =
(RedeemSigningKey -> CompactRedeemVerificationKey)
-> [RedeemSigningKey] -> [CompactRedeemVerificationKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (RedeemVerificationKey -> CompactRedeemVerificationKey
toCompactRedeemVerificationKey (RedeemVerificationKey -> CompactRedeemVerificationKey)
-> (RedeemSigningKey -> RedeemVerificationKey)
-> RedeemSigningKey
-> CompactRedeemVerificationKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RedeemSigningKey -> RedeemVerificationKey
redeemToVerification)
(GeneratedSecrets -> [RedeemSigningKey]
gsFakeAvvmSecrets GeneratedSecrets
generatedSecrets)
fakeAvvmDistr :: GenesisAvvmBalances
fakeAvvmDistr = Map CompactRedeemVerificationKey Lovelace -> GenesisAvvmBalances
GenesisAvvmBalances (Map CompactRedeemVerificationKey Lovelace -> GenesisAvvmBalances)
-> ([(CompactRedeemVerificationKey, Lovelace)]
-> Map CompactRedeemVerificationKey Lovelace)
-> [(CompactRedeemVerificationKey, Lovelace)]
-> GenesisAvvmBalances
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(CompactRedeemVerificationKey, Lovelace)]
-> Map CompactRedeemVerificationKey Lovelace
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(CompactRedeemVerificationKey, Lovelace)] -> GenesisAvvmBalances)
-> [(CompactRedeemVerificationKey, Lovelace)]
-> GenesisAvvmBalances
forall a b. (a -> b) -> a -> b
$ (CompactRedeemVerificationKey
-> (CompactRedeemVerificationKey, Lovelace))
-> [CompactRedeemVerificationKey]
-> [(CompactRedeemVerificationKey, Lovelace)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map
(, FakeAvvmOptions -> Lovelace
faoOneBalance FakeAvvmOptions
fao)
[CompactRedeemVerificationKey]
fakeAvvmVerificationKeys
let
createAddressPoor
:: MonadError GenesisDataGenerationError m => PoorSecret -> m Address
createAddressPoor :: PoorSecret -> m Address
createAddressPoor (PoorSecret SigningKey
secret) =
Address -> m Address
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Address -> m Address) -> Address -> m Address
forall a b. (a -> b) -> a -> b
$ NetworkMagic -> VerificationKey -> Address
makeVerKeyAddress NetworkMagic
nm (SigningKey -> VerificationKey
toVerification SigningKey
secret)
let richAddresses :: [Address]
richAddresses = (SigningKey -> Address) -> [SigningKey] -> [Address]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (NetworkMagic -> VerificationKey -> Address
makeVerKeyAddress NetworkMagic
nm (VerificationKey -> Address)
-> (SigningKey -> VerificationKey) -> SigningKey -> Address
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SigningKey -> VerificationKey
toVerification) [SigningKey]
richSecrets
[Address]
poorAddresses <- (PoorSecret -> ExceptT GenesisDataGenerationError m Address)
-> [PoorSecret] -> ExceptT GenesisDataGenerationError m [Address]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PoorSecret -> ExceptT GenesisDataGenerationError m Address
forall (m :: * -> *).
MonadError GenesisDataGenerationError m =>
PoorSecret -> m Address
createAddressPoor [PoorSecret]
poorSecrets
Lovelace
totalFakeAvvmBalance <-
Lovelace -> Word -> Either LovelaceError Lovelace
forall b.
Integral b =>
Lovelace -> b -> Either LovelaceError Lovelace
scaleLovelace (FakeAvvmOptions -> Lovelace
faoOneBalance FakeAvvmOptions
fao) (FakeAvvmOptions -> Word
faoCount FakeAvvmOptions
fao)
Either LovelaceError Lovelace
-> (LovelaceError -> GenesisDataGenerationError)
-> ExceptT GenesisDataGenerationError m Lovelace
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` LovelaceError -> GenesisDataGenerationError
GenesisDataGenerationLovelaceError
Lovelace
avvmSum <-
Map CompactRedeemVerificationKey Lovelace
-> Either LovelaceError Lovelace
forall (t :: * -> *).
(Foldable t, Functor t) =>
t Lovelace -> Either LovelaceError Lovelace
sumLovelace (GenesisAvvmBalances -> Map CompactRedeemVerificationKey Lovelace
unGenesisAvvmBalances GenesisAvvmBalances
realAvvmMultiplied)
Either LovelaceError Lovelace
-> (LovelaceError -> GenesisDataGenerationError)
-> ExceptT GenesisDataGenerationError m Lovelace
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` LovelaceError -> GenesisDataGenerationError
GenesisDataGenerationLovelaceError
Lovelace
maxTnBalance <-
Lovelace -> Lovelace -> Either LovelaceError Lovelace
subLovelace Lovelace
forall a. Bounded a => a
maxBound Lovelace
avvmSum Either LovelaceError Lovelace
-> (LovelaceError -> GenesisDataGenerationError)
-> ExceptT GenesisDataGenerationError m Lovelace
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` LovelaceError -> GenesisDataGenerationError
GenesisDataGenerationLovelaceError
let tnBalance :: Lovelace
tnBalance = Lovelace -> Lovelace -> Lovelace
forall a. Ord a => a -> a -> a
min Lovelace
maxTnBalance (TestnetBalanceOptions -> Lovelace
tboTotalBalance TestnetBalanceOptions
tbo)
let
safeZip
:: MonadError GenesisDataGenerationError m
=> Text
-> [a]
-> [b]
-> m [(a, b)]
safeZip :: Text -> [a] -> [b] -> m [(a, b)]
safeZip Text
s [a]
a [b]
b = if [a] -> Int
forall a. HasLength a => a -> Int
length [a]
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [b] -> Int
forall a. HasLength a => a -> Int
length [b]
b
then GenesisDataGenerationError -> m [(a, b)]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(GenesisDataGenerationError -> m [(a, b)])
-> GenesisDataGenerationError -> m [(a, b)]
forall a b. (a -> b) -> a -> b
$ Text -> Int -> Int -> GenesisDataGenerationError
GenesisDataAddressBalanceMismatch Text
s ([a] -> Int
forall a. HasLength a => a -> Int
length [a]
a) ([b] -> Int
forall a. HasLength a => a -> Int
length [b]
b)
else [(a, b)] -> m [(a, b)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(a, b)] -> m [(a, b)]) -> [(a, b)] -> m [(a, b)]
forall a b. (a -> b) -> a -> b
$ [a] -> [b] -> [(a, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
a [b]
b
Lovelace
nonAvvmBalance <-
Lovelace -> Lovelace -> Either LovelaceError Lovelace
subLovelace Lovelace
tnBalance Lovelace
totalFakeAvvmBalance
Either LovelaceError Lovelace
-> (LovelaceError -> GenesisDataGenerationError)
-> ExceptT GenesisDataGenerationError m Lovelace
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` LovelaceError -> GenesisDataGenerationError
GenesisDataGenerationLovelaceError
([Lovelace]
richBals, [Lovelace]
poorBals) <- TestnetBalanceOptions
-> Lovelace
-> ExceptT GenesisDataGenerationError m ([Lovelace], [Lovelace])
forall (m :: * -> *).
MonadError GenesisDataGenerationError m =>
TestnetBalanceOptions -> Lovelace -> m ([Lovelace], [Lovelace])
genTestnetDistribution TestnetBalanceOptions
tbo Lovelace
nonAvvmBalance
[(Address, Lovelace)]
richDistr <- Text
-> [Address]
-> [Lovelace]
-> ExceptT GenesisDataGenerationError m [(Address, Lovelace)]
forall (m :: * -> *) a b.
MonadError GenesisDataGenerationError m =>
Text -> [a] -> [b] -> m [(a, b)]
safeZip Text
"richDistr" [Address]
richAddresses [Lovelace]
richBals
[(Address, Lovelace)]
poorDistr <- Text
-> [Address]
-> [Lovelace]
-> ExceptT GenesisDataGenerationError m [(Address, Lovelace)]
forall (m :: * -> *) a b.
MonadError GenesisDataGenerationError m =>
Text -> [a] -> [b] -> m [(a, b)]
safeZip Text
"poorDistr" [Address]
poorAddresses [Lovelace]
poorBals
let
nonAvvmDistr :: GenesisNonAvvmBalances
nonAvvmDistr = Map Address Lovelace -> GenesisNonAvvmBalances
GenesisNonAvvmBalances (Map Address Lovelace -> GenesisNonAvvmBalances)
-> ([(Address, Lovelace)] -> Map Address Lovelace)
-> [(Address, Lovelace)]
-> GenesisNonAvvmBalances
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(Address, Lovelace)] -> Map Address Lovelace
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Address, Lovelace)] -> GenesisNonAvvmBalances)
-> [(Address, Lovelace)] -> GenesisNonAvvmBalances
forall a b. (a -> b) -> a -> b
$ [(Address, Lovelace)]
richDistr [(Address, Lovelace)]
-> [(Address, Lovelace)] -> [(Address, Lovelace)]
forall a. [a] -> [a] -> [a]
++ [(Address, Lovelace)]
poorDistr
let
genesisData :: GenesisData
genesisData = GenesisData :: GenesisKeyHashes
-> GenesisDelegation
-> UTCTime
-> GenesisNonAvvmBalances
-> ProtocolParameters
-> BlockCount
-> ProtocolMagicId
-> GenesisAvvmBalances
-> GenesisData
GenesisData
{ gdGenesisKeyHashes :: GenesisKeyHashes
gdGenesisKeyHashes = GenesisKeyHashes
genesisKeyHashes
, gdHeavyDelegation :: GenesisDelegation
gdHeavyDelegation = GenesisDelegation
genesisDlg
, gdStartTime :: UTCTime
gdStartTime = UTCTime
startTime
, gdNonAvvmBalances :: GenesisNonAvvmBalances
gdNonAvvmBalances = GenesisNonAvvmBalances
nonAvvmDistr
, gdProtocolParameters :: ProtocolParameters
gdProtocolParameters = GenesisSpec -> ProtocolParameters
gsProtocolParameters GenesisSpec
genesisSpec
, gdK :: BlockCount
gdK = GenesisSpec -> BlockCount
gsK GenesisSpec
genesisSpec
, gdProtocolMagicId :: ProtocolMagicId
gdProtocolMagicId = ProtocolMagic -> ProtocolMagicId
forall a. AProtocolMagic a -> ProtocolMagicId
getProtocolMagicId ProtocolMagic
pm
, gdAvvmDistr :: GenesisAvvmBalances
gdAvvmDistr = GenesisAvvmBalances
fakeAvvmDistr GenesisAvvmBalances -> GenesisAvvmBalances -> GenesisAvvmBalances
forall a. Semigroup a => a -> a -> a
<> GenesisAvvmBalances
realAvvmMultiplied
}
(GenesisData, GeneratedSecrets)
-> ExceptT
GenesisDataGenerationError m (GenesisData, GeneratedSecrets)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenesisData
genesisData, GeneratedSecrets
generatedSecrets)
generateSecrets :: Crypto.MonadRandom m
=> GenesisInitializer -> m GeneratedSecrets
generateSecrets :: GenesisInitializer -> m GeneratedSecrets
generateSecrets GenesisInitializer
gi = do
[RedeemSigningKey]
fakeAvvmSecrets <- Int -> m RedeemSigningKey -> m [RedeemSigningKey]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ FakeAvvmOptions -> Word
faoCount FakeAvvmOptions
fao)
((RedeemVerificationKey, RedeemSigningKey) -> RedeemSigningKey
forall a b. (a, b) -> b
snd ((RedeemVerificationKey, RedeemSigningKey) -> RedeemSigningKey)
-> m (RedeemVerificationKey, RedeemSigningKey)
-> m RedeemSigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (RedeemVerificationKey, RedeemSigningKey)
forall (m :: * -> *).
MonadRandom m =>
m (RedeemVerificationKey, RedeemSigningKey)
redeemKeyGen)
[SigningKey]
dlgIssuersSecrets <- if GenesisInitializer -> Bool
giUseHeavyDlg GenesisInitializer
gi
then m SigningKey -> m [SigningKey]
forall (m :: * -> *) a. Applicative m => m a -> m [a]
replicateRich ((VerificationKey, SigningKey) -> SigningKey
forall a b. (a, b) -> b
snd ((VerificationKey, SigningKey) -> SigningKey)
-> m (VerificationKey, SigningKey) -> m SigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (VerificationKey, SigningKey)
forall (m :: * -> *).
MonadRandom m =>
m (VerificationKey, SigningKey)
keyGen)
else [SigningKey] -> m [SigningKey]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
[SigningKey]
richSecrets <- m SigningKey -> m [SigningKey]
forall (m :: * -> *) a. Applicative m => m a -> m [a]
replicateRich ((VerificationKey, SigningKey) -> SigningKey
forall a b. (a, b) -> b
snd ((VerificationKey, SigningKey) -> SigningKey)
-> m (VerificationKey, SigningKey) -> m SigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (VerificationKey, SigningKey)
forall (m :: * -> *).
MonadRandom m =>
m (VerificationKey, SigningKey)
keyGen)
[PoorSecret]
poorSecrets <- Int -> m PoorSecret -> m [PoorSecret]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ TestnetBalanceOptions -> Word
tboPoors TestnetBalanceOptions
tbo) m PoorSecret
forall (m :: * -> *). MonadRandom m => m PoorSecret
genPoorSecret
GeneratedSecrets -> m GeneratedSecrets
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneratedSecrets -> m GeneratedSecrets)
-> GeneratedSecrets -> m GeneratedSecrets
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets :: [SigningKey]
-> [SigningKey]
-> [PoorSecret]
-> [RedeemSigningKey]
-> GeneratedSecrets
GeneratedSecrets
{ gsDlgIssuersSecrets :: [SigningKey]
gsDlgIssuersSecrets = [SigningKey]
dlgIssuersSecrets
, gsRichSecrets :: [SigningKey]
gsRichSecrets = [SigningKey]
richSecrets
, gsPoorSecrets :: [PoorSecret]
gsPoorSecrets = [PoorSecret]
poorSecrets
, gsFakeAvvmSecrets :: [RedeemSigningKey]
gsFakeAvvmSecrets = [RedeemSigningKey]
fakeAvvmSecrets
}
where
fao :: FakeAvvmOptions
fao = GenesisInitializer -> FakeAvvmOptions
giFakeAvvmBalance GenesisInitializer
gi
tbo :: TestnetBalanceOptions
tbo = GenesisInitializer -> TestnetBalanceOptions
giTestBalance GenesisInitializer
gi
replicateRich :: Applicative m => m a -> m [a]
replicateRich :: m a -> m [a]
replicateRich = Int -> m a -> m [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Int) -> Word -> Int
forall a b. (a -> b) -> a -> b
$ TestnetBalanceOptions -> Word
tboRichmen TestnetBalanceOptions
tbo)
genPoorSecret :: Crypto.MonadRandom m => m PoorSecret
genPoorSecret :: m PoorSecret
genPoorSecret = SigningKey -> PoorSecret
PoorSecret (SigningKey -> PoorSecret)
-> ((VerificationKey, SigningKey) -> SigningKey)
-> (VerificationKey, SigningKey)
-> PoorSecret
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (VerificationKey, SigningKey) -> SigningKey
forall a b. (a, b) -> b
snd ((VerificationKey, SigningKey) -> PoorSecret)
-> m (VerificationKey, SigningKey) -> m PoorSecret
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (VerificationKey, SigningKey)
forall (m :: * -> *).
MonadRandom m =>
m (VerificationKey, SigningKey)
keyGen
generateGenesisConfig
:: UTCTime
-> GenesisSpec
-> ExceptT GenesisDataGenerationError IO (Config, GeneratedSecrets)
generateGenesisConfig :: UTCTime
-> GenesisSpec
-> ExceptT GenesisDataGenerationError IO (Config, GeneratedSecrets)
generateGenesisConfig UTCTime
startTime GenesisSpec
genesisSpec =
(SecureRandom
(Either GenesisDataGenerationError (Config, GeneratedSecrets))
-> IO
(Either GenesisDataGenerationError (Config, GeneratedSecrets)))
-> ExceptT
GenesisDataGenerationError SecureRandom (Config, GeneratedSecrets)
-> ExceptT GenesisDataGenerationError IO (Config, GeneratedSecrets)
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT SecureRandom
(Either GenesisDataGenerationError (Config, GeneratedSecrets))
-> IO
(Either GenesisDataGenerationError (Config, GeneratedSecrets))
forall a. SecureRandom a -> IO a
Crypto.runSecureRandom (ExceptT
GenesisDataGenerationError SecureRandom (Config, GeneratedSecrets)
-> ExceptT
GenesisDataGenerationError IO (Config, GeneratedSecrets))
-> ExceptT
GenesisDataGenerationError SecureRandom (Config, GeneratedSecrets)
-> ExceptT GenesisDataGenerationError IO (Config, GeneratedSecrets)
forall a b. (a -> b) -> a -> b
$
UTCTime
-> GenesisSpec
-> ExceptT
GenesisDataGenerationError SecureRandom (Config, GeneratedSecrets)
forall (m :: * -> *).
MonadRandom m =>
UTCTime
-> GenesisSpec
-> ExceptT GenesisDataGenerationError m (Config, GeneratedSecrets)
generateGenesisConfigWithEntropy UTCTime
startTime GenesisSpec
genesisSpec
generateGenesisConfigWithEntropy
:: Crypto.MonadRandom m
=> UTCTime
-> GenesisSpec
-> ExceptT GenesisDataGenerationError m (Config, GeneratedSecrets)
generateGenesisConfigWithEntropy :: UTCTime
-> GenesisSpec
-> ExceptT GenesisDataGenerationError m (Config, GeneratedSecrets)
generateGenesisConfigWithEntropy UTCTime
startTime GenesisSpec
genesisSpec = do
(GenesisData
genesisData, GeneratedSecrets
generatedSecrets) <-
UTCTime
-> GenesisSpec
-> ExceptT
GenesisDataGenerationError m (GenesisData, GeneratedSecrets)
forall (m :: * -> *).
MonadRandom m =>
UTCTime
-> GenesisSpec
-> ExceptT
GenesisDataGenerationError m (GenesisData, GeneratedSecrets)
generateGenesisDataWithEntropy UTCTime
startTime GenesisSpec
genesisSpec
let config :: Config
config = Config :: GenesisData
-> GenesisHash
-> RequiresNetworkMagic
-> UTxOConfiguration
-> Config
Config
{ configGenesisData :: GenesisData
configGenesisData = GenesisData
genesisData
, configGenesisHash :: GenesisHash
configGenesisHash = GenesisHash
genesisHash
, configReqNetMagic :: RequiresNetworkMagic
configReqNetMagic = ProtocolMagic -> RequiresNetworkMagic
forall a. AProtocolMagic a -> RequiresNetworkMagic
getRequiresNetworkMagic
(GenesisSpec -> ProtocolMagic
gsProtocolMagic GenesisSpec
genesisSpec)
, configUTxOConfiguration :: UTxOConfiguration
configUTxOConfiguration = UTxOConfiguration
defaultUTxOConfiguration
}
(Config, GeneratedSecrets)
-> ExceptT GenesisDataGenerationError m (Config, GeneratedSecrets)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
config, GeneratedSecrets
generatedSecrets)
where
genesisHash :: GenesisHash
genesisHash = Hash Raw -> GenesisHash
GenesisHash (Hash Raw -> GenesisHash) -> Hash Raw -> GenesisHash
forall a b. (a -> b) -> a -> b
$ Hash Text -> Hash Raw
coerce (Hash Text -> Hash Raw) -> Hash Text -> Hash Raw
forall a b. (a -> b) -> a -> b
$ Text -> Hash Text
forall a. ToCBOR a => a -> Hash a
serializeCborHash (Text
"patak" :: Text)
genTestnetDistribution
:: MonadError GenesisDataGenerationError m
=> TestnetBalanceOptions
-> Lovelace
-> m ([Lovelace], [Lovelace])
genTestnetDistribution :: TestnetBalanceOptions -> Lovelace -> m ([Lovelace], [Lovelace])
genTestnetDistribution TestnetBalanceOptions
tbo Lovelace
testBalance = do
([Lovelace]
richBalances, [Lovelace]
poorBalances, Lovelace
totalBalance) <-
(Either LovelaceError ([Lovelace], [Lovelace], Lovelace)
-> (LovelaceError -> GenesisDataGenerationError)
-> m ([Lovelace], [Lovelace], Lovelace)
forall e' (m :: * -> *) e a.
MonadError e' m =>
Either e a -> (e -> e') -> m a
`wrapError` LovelaceError -> GenesisDataGenerationError
GenesisDataGenerationLovelaceError) (Either LovelaceError ([Lovelace], [Lovelace], Lovelace)
-> m ([Lovelace], [Lovelace], Lovelace))
-> Either LovelaceError ([Lovelace], [Lovelace], Lovelace)
-> m ([Lovelace], [Lovelace], Lovelace)
forall a b. (a -> b) -> a -> b
$ do
Lovelace
richmanBalance <- Lovelace -> Word -> Either LovelaceError Lovelace
forall b.
Integral b =>
Lovelace -> b -> Either LovelaceError Lovelace
divLovelace Lovelace
desiredRichBalance Word
tboRichmen
Lovelace
richmanBalanceExtra <- Lovelace -> Word -> Either LovelaceError Lovelace
forall b.
Integral b =>
Lovelace -> b -> Either LovelaceError Lovelace
modLovelace Lovelace
desiredRichBalance Word
tboRichmen
Lovelace
richmanBalance' <- if Word
tboRichmen Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
then Lovelace -> Either LovelaceError Lovelace
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lovelace -> Either LovelaceError Lovelace)
-> Lovelace -> Either LovelaceError Lovelace
forall a b. (a -> b) -> a -> b
$ (KnownNat 0, 0 <= 45000000000000000) => Lovelace
forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @0
else Lovelace -> Lovelace -> Either LovelaceError Lovelace
addLovelace
Lovelace
richmanBalance
(if Lovelace
richmanBalanceExtra Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
> (KnownNat 0, 0 <= 45000000000000000) => Lovelace
forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @0
then (KnownNat 1, 1 <= 45000000000000000) => Lovelace
forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @1
else (KnownNat 0, 0 <= 45000000000000000) => Lovelace
forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @0
)
Lovelace
totalRichBalance <- Lovelace -> Word -> Either LovelaceError Lovelace
forall b.
Integral b =>
Lovelace -> b -> Either LovelaceError Lovelace
scaleLovelace Lovelace
richmanBalance' Word
tboRichmen
Lovelace
desiredPoorsBalance <- Lovelace -> Lovelace -> Either LovelaceError Lovelace
subLovelace Lovelace
testBalance Lovelace
totalRichBalance
Lovelace
poorBalance <- if Word
tboPoors Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
then Lovelace -> Either LovelaceError Lovelace
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Lovelace -> Either LovelaceError Lovelace)
-> Lovelace -> Either LovelaceError Lovelace
forall a b. (a -> b) -> a -> b
$ (KnownNat 0, 0 <= 45000000000000000) => Lovelace
forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace @0
else Lovelace -> Word -> Either LovelaceError Lovelace
forall b.
Integral b =>
Lovelace -> b -> Either LovelaceError Lovelace
divLovelace Lovelace
desiredPoorsBalance Word
tboPoors
Lovelace
totalPoorBalance <- Lovelace -> Word -> Either LovelaceError Lovelace
forall b.
Integral b =>
Lovelace -> b -> Either LovelaceError Lovelace
scaleLovelace Lovelace
poorBalance Word
tboPoors
Lovelace
totalBalance <- Lovelace -> Lovelace -> Either LovelaceError Lovelace
addLovelace Lovelace
totalRichBalance Lovelace
totalPoorBalance
([Lovelace], [Lovelace], Lovelace)
-> Either LovelaceError ([Lovelace], [Lovelace], Lovelace)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( Int -> Lovelace -> [Lovelace]
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
tboRichmen) Lovelace
richmanBalance'
, Int -> Lovelace -> [Lovelace]
forall a. Int -> a -> [a]
replicate (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
tboPoors) Lovelace
poorBalance
, Lovelace
totalBalance
)
if Lovelace
totalBalance Lovelace -> Lovelace -> Bool
forall a. Ord a => a -> a -> Bool
<= Lovelace
testBalance
then ([Lovelace], [Lovelace]) -> m ([Lovelace], [Lovelace])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Lovelace]
richBalances, [Lovelace]
poorBalances)
else GenesisDataGenerationError -> m ([Lovelace], [Lovelace])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(GenesisDataGenerationError -> m ([Lovelace], [Lovelace]))
-> GenesisDataGenerationError -> m ([Lovelace], [Lovelace])
forall a b. (a -> b) -> a -> b
$ Lovelace -> Lovelace -> GenesisDataGenerationError
GenesisDataGenerationDistributionMismatch Lovelace
testBalance Lovelace
totalBalance
where
TestnetBalanceOptions { Word
tboPoors :: Word
tboPoors :: TestnetBalanceOptions -> Word
tboPoors, Word
tboRichmen :: Word
tboRichmen :: TestnetBalanceOptions -> Word
tboRichmen } = TestnetBalanceOptions
tbo
desiredRichBalance :: Lovelace
desiredRichBalance = Lovelace -> Rational -> Lovelace
scaleLovelaceRational Lovelace
testBalance (TestnetBalanceOptions -> Rational
tboRichmenShare TestnetBalanceOptions
tbo)