module Test.Cardano.Chain.Genesis.Gen (
  genCanonicalGenesisData,
  genCanonicalGenesisDelegation,
  genGenesisData,
  genGenesisHash,
  genConfig,
  genFakeAvvmOptions,
  genGenesisAvvmBalances,
  genGenesisDelegation,
  genGenesisInitializer,
  genGenesisNonAvvmBalances,
  genGenesisSpec,
  genGenesisKeyHashes,
  genSignatureEpochNumber,
  genTestnetBalanceOptions,
)
where

import Cardano.Chain.Common (BlockCount (..))
import Cardano.Chain.Genesis (
  Config (..),
  FakeAvvmOptions (..),
  GenesisAvvmBalances (..),
  GenesisData (..),
  GenesisDelegation (..),
  GenesisHash (..),
  GenesisInitializer (..),
  GenesisKeyHashes (..),
  GenesisNonAvvmBalances (..),
  GenesisSpec (..),
  TestnetBalanceOptions (..),
  mkGenesisDelegation,
  mkGenesisSpec,
 )
import Cardano.Chain.Slotting (EpochNumber)
import Cardano.Crypto (ProtocolMagicId, Signature (..))
import qualified Cardano.Crypto.Wallet as CC
import Cardano.Prelude
import Data.Coerce (coerce)
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import Data.Time (Day (..), UTCTime (..), secondsToDiffTime)
import Formatting (build, sformat)
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Chain.Common.Gen (
  genAddress,
  genBlockCount,
  genKeyHash,
  genLovelace,
 )
import Test.Cardano.Chain.Delegation.Gen (
  genCanonicalCertificateDistinctList,
  genCertificateDistinctList,
 )
import Test.Cardano.Chain.UTxO.Gen (genUTxOConfiguration)
import Test.Cardano.Chain.Update.Gen (
  genCanonicalProtocolParameters,
  genProtocolParameters,
 )
import Test.Cardano.Crypto.Gen (
  genCompactRedeemVerificationKey,
  genProtocolMagic,
  genProtocolMagicId,
  genRequiresNetworkMagic,
  genTextHash,
 )

genConfig :: ProtocolMagicId -> Gen Config
genConfig :: ProtocolMagicId -> Gen Config
genConfig ProtocolMagicId
pm =
  GenesisData
-> GenesisHash
-> RequiresNetworkMagic
-> UTxOConfiguration
-> Config
Config
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> Gen GenesisData
genGenesisData ProtocolMagicId
pm
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen GenesisHash
genGenesisHash
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen RequiresNetworkMagic
genRequiresNetworkMagic
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UTxOConfiguration
genUTxOConfiguration

genCanonicalGenesisData :: ProtocolMagicId -> Gen GenesisData
genCanonicalGenesisData :: ProtocolMagicId -> Gen GenesisData
genCanonicalGenesisData ProtocolMagicId
pm =
  GenesisKeyHashes
-> GenesisDelegation
-> UTCTime
-> GenesisNonAvvmBalances
-> ProtocolParameters
-> BlockCount
-> ProtocolMagicId
-> GenesisAvvmBalances
-> GenesisData
GenesisData
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen GenesisKeyHashes
genGenesisKeyHashes
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> Gen GenesisDelegation
genCanonicalGenesisDelegation ProtocolMagicId
pm
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UTCTime
genUTCTime
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen GenesisNonAvvmBalances
genGenesisNonAvvmBalances
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ProtocolParameters
genCanonicalProtocolParameters
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen BlockCount
genBlockCount'
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ProtocolMagicId
genProtocolMagicId
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen GenesisAvvmBalances
genGenesisAvvmBalances
  where
    genBlockCount' :: Gen BlockCount
    genBlockCount' :: Gen BlockCount
genBlockCount' = Word64 -> BlockCount
BlockCount forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Word64 -> m Word64
Gen.word64 (forall a. Integral a => a -> a -> Range a
Range.linear Word64
0 Word64
1000000000)

genCanonicalGenesisDelegation :: ProtocolMagicId -> Gen GenesisDelegation
genCanonicalGenesisDelegation :: ProtocolMagicId -> Gen GenesisDelegation
genCanonicalGenesisDelegation ProtocolMagicId
pm =
  [Certificate] -> GenesisDelegation
mkGenesisDelegation' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> Gen [Certificate]
genCanonicalCertificateDistinctList ProtocolMagicId
pm
  where
    mkGenesisDelegation' :: [Certificate] -> GenesisDelegation
mkGenesisDelegation' =
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => Text -> a
panic forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Format Text a -> a
sformat forall a r. Buildable a => Format r (a -> r)
build) forall (cat :: * -> * -> *) a. Category cat => cat a a
identity forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *).
MonadError GenesisDelegationError m =>
[Certificate] -> m GenesisDelegation
mkGenesisDelegation

genGenesisData :: ProtocolMagicId -> Gen GenesisData
genGenesisData :: ProtocolMagicId -> Gen GenesisData
genGenesisData ProtocolMagicId
pm =
  GenesisKeyHashes
-> GenesisDelegation
-> UTCTime
-> GenesisNonAvvmBalances
-> ProtocolParameters
-> BlockCount
-> ProtocolMagicId
-> GenesisAvvmBalances
-> GenesisData
GenesisData
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen GenesisKeyHashes
genGenesisKeyHashes
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> Gen GenesisDelegation
genGenesisDelegation ProtocolMagicId
pm
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen UTCTime
genUTCTime
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen GenesisNonAvvmBalances
genGenesisNonAvvmBalances
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ProtocolParameters
genProtocolParameters
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen BlockCount
genBlockCount
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ProtocolMagicId
genProtocolMagicId
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen GenesisAvvmBalances
genGenesisAvvmBalances

genGenesisHash :: Gen GenesisHash
genGenesisHash :: Gen GenesisHash
genGenesisHash = Hash Raw -> GenesisHash
GenesisHash forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash Text)
genTextHash

genFakeAvvmOptions :: Gen FakeAvvmOptions
genFakeAvvmOptions :: Gen FakeAvvmOptions
genFakeAvvmOptions =
  Word -> Lovelace -> FakeAvvmOptions
FakeAvvmOptions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Word -> m Word
Gen.word forall a. (Bounded a, Num a) => Range a
Range.constantBounded forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Lovelace
genLovelace

genGenesisDelegation :: ProtocolMagicId -> Gen GenesisDelegation
genGenesisDelegation :: ProtocolMagicId -> Gen GenesisDelegation
genGenesisDelegation ProtocolMagicId
pm = [Certificate] -> GenesisDelegation
mkGenesisDelegation' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtocolMagicId -> Gen [Certificate]
genCertificateDistinctList ProtocolMagicId
pm
  where
    mkGenesisDelegation' :: [Certificate] -> GenesisDelegation
mkGenesisDelegation' =
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => Text -> a
panic forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Format Text a -> a
sformat forall a r. Buildable a => Format r (a -> r)
build) forall (cat :: * -> * -> *) a. Category cat => cat a a
identity forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *).
MonadError GenesisDelegationError m =>
[Certificate] -> m GenesisDelegation
mkGenesisDelegation

genGenesisInitializer :: Gen GenesisInitializer
genGenesisInitializer :: Gen GenesisInitializer
genGenesisInitializer =
  TestnetBalanceOptions
-> FakeAvvmOptions -> Rational -> Bool -> GenesisInitializer
GenesisInitializer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TestnetBalanceOptions
genTestnetBalanceOptions
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen FakeAvvmOptions
genFakeAvvmOptions
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Double -> m Double
Gen.double (forall a. a -> a -> Range a
Range.constant Double
0 Double
1))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => m Bool
Gen.bool

genGenesisNonAvvmBalances :: Gen GenesisNonAvvmBalances
genGenesisNonAvvmBalances :: Gen GenesisNonAvvmBalances
genGenesisNonAvvmBalances =
  Map Address Lovelace -> GenesisNonAvvmBalances
GenesisNonAvvmBalances
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list
      (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
10)
      ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Address
genAddress forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Lovelace
genLovelace)

genGenesisSpec :: ProtocolMagicId -> Gen GenesisSpec
genGenesisSpec :: ProtocolMagicId -> Gen GenesisSpec
genGenesisSpec ProtocolMagicId
pm = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => Text -> a
panic forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. ConvertText a b => a -> b
toS) forall (cat :: * -> * -> *) a. Category cat => cat a a
identity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity (Either Text GenesisSpec)
mkGenSpec
  where
    mkGenSpec :: GenT Identity (Either Text GenesisSpec)
mkGenSpec =
      GenesisAvvmBalances
-> GenesisDelegation
-> ProtocolParameters
-> BlockCount
-> ProtocolMagic
-> GenesisInitializer
-> Either Text GenesisSpec
mkGenesisSpec
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen GenesisAvvmBalances
genGenesisAvvmBalances
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtocolMagicId -> Gen GenesisDelegation
genGenesisDelegation ProtocolMagicId
pm
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ProtocolParameters
genProtocolParameters
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen BlockCount
genBlockCount
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ProtocolMagic
genProtocolMagic
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen GenesisInitializer
genGenesisInitializer

genTestnetBalanceOptions :: Gen TestnetBalanceOptions
genTestnetBalanceOptions :: Gen TestnetBalanceOptions
genTestnetBalanceOptions =
  Word -> Word -> Lovelace -> Rational -> TestnetBalanceOptions
TestnetBalanceOptions
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Word -> m Word
Gen.word forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGen m => Range Word -> m Word
Gen.word forall a. (Bounded a, Num a) => Range a
Range.constantBounded
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Lovelace
genLovelace
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a b. (Real a, Fractional b) => a -> b
realToFrac forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGen m => Range Double -> m Double
Gen.double (forall a. a -> a -> Range a
Range.constant Double
0 Double
1))

genGenesisAvvmBalances :: Gen GenesisAvvmBalances
genGenesisAvvmBalances :: Gen GenesisAvvmBalances
genGenesisAvvmBalances =
  Map CompactRedeemVerificationKey Lovelace -> GenesisAvvmBalances
GenesisAvvmBalances
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
customMapGen Gen CompactRedeemVerificationKey
genCompactRedeemVerificationKey Gen Lovelace
genLovelace

genGenesisKeyHashes :: Gen GenesisKeyHashes
genGenesisKeyHashes :: Gen GenesisKeyHashes
genGenesisKeyHashes =
  Set KeyHash -> GenesisKeyHashes
GenesisKeyHashes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(MonadGen m, Ord a) =>
Range Int -> m a -> m (Set a)
Gen.set (forall a. a -> a -> Range a
Range.constant Int
10 Int
25) Gen KeyHash
genKeyHash

genSignatureEpochNumber :: Gen (Signature EpochNumber)
genSignatureEpochNumber :: Gen (Signature EpochNumber)
genSignatureEpochNumber =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => Text -> a
panic forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
T.pack) forall a. XSignature -> Signature a
Signature
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either String XSignature
CC.xsignature
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadGen m =>
Range Int -> m Char -> m ByteString
Gen.utf8 (forall a. a -> a -> Range a
Range.constant Int
64 Int
64) forall (m :: * -> *). MonadGen m => m Char
Gen.hexit

genUTCTime :: Gen UTCTime
genUTCTime :: Gen UTCTime
genUTCTime =
  ( \Integer
jday Integer
seconds ->
      Day -> DiffTime -> UTCTime
UTCTime (Integer -> Day
ModifiedJulianDay Integer
jday) (Integer -> DiffTime
secondsToDiffTime Integer
seconds)
  )
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
1000000)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral (forall a. Integral a => a -> a -> Range a
Range.linear Integer
0 Integer
86401)

--------------------------------------------------------------------------------
-- Helper Generators
--------------------------------------------------------------------------------

customMapGen :: Ord k => Gen k -> Gen v -> Gen (Map k v)
customMapGen :: forall k v. Ord k => Gen k -> Gen v -> Gen (Map k v)
customMapGen Gen k
keyGen Gen v
valGen =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
10) ((,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen k
keyGen forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen v
valGen)