{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Pre-generated items to use in traces.
--
--   Functions in this module make specific assumptions about the sets of keys
--   involved, and thus cannot be used as generic generators.
module Test.Cardano.Ledger.Shelley.Generator.Presets (
  genCoreNodeKeys,
  genIssuerKeys,
  coreNodeKeys,
  keySpace,
  genEnv,
  genesisDelegs0,
  someKeyPairs,
  keyPairs,
  scriptSpace,
) where

import Cardano.Ledger.Core (EraScript, hashScript)
import Cardano.Ledger.Keys (
  GenDelegPair (..),
  KeyHash,
  KeyRole (..),
  coerceKeyRole,
  hashKey,
 )
import Cardano.Protocol.Crypto (Crypto, hashVerKeyVRF)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy (Proxy (..))
import Data.Word (Word64)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
import Test.Cardano.Ledger.Shelley.Generator.Core
import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen (..), allScripts, someKeyPairs)
import Test.Cardano.Ledger.Shelley.Generator.ScriptClass (keyPairs)
import Test.Cardano.Ledger.Shelley.Utils (maxKESIterations, slotsPerKESIteration)
import Test.Cardano.Protocol.TPraos.Create (genAllIssuerKeys)

-- =================================================================

-- | Example generator environment, consisting of default constants and an
-- corresponding keyspace.
genEnv ::
  forall era c.
  ( EraGen era
  , Crypto c
  ) =>
  Proxy era ->
  Constants ->
  GenEnv c era
genEnv :: forall era c.
(EraGen era, Crypto c) =>
Proxy era -> Constants -> GenEnv c era
genEnv Proxy era
_ Constants
constants =
  KeySpace c era -> ScriptSpace era -> Constants -> GenEnv c era
forall c era.
KeySpace c era -> ScriptSpace era -> Constants -> GenEnv c era
GenEnv
    (Constants -> KeySpace c era
forall era c. (EraGen era, Crypto c) => Constants -> KeySpace c era
keySpace Constants
constants)
    (forall era.
EraScript era =>
[TwoPhase3ArgInfo era] -> [TwoPhase2ArgInfo era] -> ScriptSpace era
scriptSpace @era (forall era. EraGen era => [TwoPhase3ArgInfo era]
genEraTwoPhase3Arg @era) (forall era. EraGen era => [TwoPhase2ArgInfo era]
genEraTwoPhase2Arg @era))
    Constants
constants

-- | An Example Script space for use in Trace generators
scriptSpace ::
  forall era.
  EraScript era =>
  [TwoPhase3ArgInfo era] ->
  [TwoPhase2ArgInfo era] ->
  ScriptSpace era
scriptSpace :: forall era.
EraScript era =>
[TwoPhase3ArgInfo era] -> [TwoPhase2ArgInfo era] -> ScriptSpace era
scriptSpace [TwoPhase3ArgInfo era]
scripts3 [TwoPhase2ArgInfo era]
scripts2 =
  [TwoPhase3ArgInfo era]
-> [TwoPhase2ArgInfo era]
-> Map ScriptHash (TwoPhase3ArgInfo era)
-> Map ScriptHash (TwoPhase2ArgInfo era)
-> ScriptSpace era
forall era.
[TwoPhase3ArgInfo era]
-> [TwoPhase2ArgInfo era]
-> Map ScriptHash (TwoPhase3ArgInfo era)
-> Map ScriptHash (TwoPhase2ArgInfo era)
-> ScriptSpace era
ScriptSpace
    [TwoPhase3ArgInfo era]
scripts3
    [TwoPhase2ArgInfo era]
scripts2
    ([(ScriptHash, TwoPhase3ArgInfo era)]
-> Map ScriptHash (TwoPhase3ArgInfo era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(forall era. EraScript era => Script era -> ScriptHash
hashScript @era (TwoPhase3ArgInfo era -> Script era
forall era. TwoPhase3ArgInfo era -> Script era
getScript3 TwoPhase3ArgInfo era
s), TwoPhase3ArgInfo era
s) | TwoPhase3ArgInfo era
s <- [TwoPhase3ArgInfo era]
scripts3])
    ([(ScriptHash, TwoPhase2ArgInfo era)]
-> Map ScriptHash (TwoPhase2ArgInfo era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(forall era. EraScript era => Script era -> ScriptHash
hashScript @era (TwoPhase2ArgInfo era -> Script era
forall era. TwoPhase2ArgInfo era -> Script era
getScript2 TwoPhase2ArgInfo era
s), TwoPhase2ArgInfo era
s) | TwoPhase2ArgInfo era
s <- [TwoPhase2ArgInfo era]
scripts2])

-- | Example keyspace for use in generators
keySpace ::
  forall era c.
  ( EraGen era
  , Crypto c
  ) =>
  Constants ->
  KeySpace c era
keySpace :: forall era c. (EraGen era, Crypto c) => Constants -> KeySpace c era
keySpace Constants
c =
  [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
-> [AllIssuerKeys c GenesisDelegate]
-> [AllIssuerKeys c StakePool]
-> KeyPairs
-> [(Script era, Script era)]
-> KeySpace c era
forall c era.
ScriptClass era =>
[(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
-> [AllIssuerKeys c GenesisDelegate]
-> [AllIssuerKeys c StakePool]
-> KeyPairs
-> [(Script era, Script era)]
-> KeySpace c era
KeySpace
    (Constants -> [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
forall c.
Crypto c =>
Constants -> [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
coreNodeKeys Constants
c)
    (Constants -> [AllIssuerKeys c GenesisDelegate]
forall c.
Crypto c =>
Constants -> [AllIssuerKeys c GenesisDelegate]
genesisDelegates Constants
c)
    (Constants -> [AllIssuerKeys c StakePool]
forall c. Crypto c => Constants -> [AllIssuerKeys c StakePool]
stakePoolKeys Constants
c)
    (Constants -> KeyPairs
keyPairs Constants
c)
    (forall era. EraGen era => Constants -> [(Script era, Script era)]
allScripts @era Constants
c)

-- Pairs of (genesis key, node keys)
--
-- NOTE: we use a seed range in the [1000...] range
-- to create keys that don't overlap with any of the other generated keys
coreNodeKeys ::
  Crypto c =>
  Constants ->
  [(KeyPair GenesisRole, AllIssuerKeys c GenesisDelegate)]
coreNodeKeys :: forall c.
Crypto c =>
Constants -> [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
coreNodeKeys = Int
-> Int
-> Gen [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
-> [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
forall a. Int -> Int -> Gen a -> a
runGen Int
1000 Int
30 (Gen [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
 -> [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)])
-> (Constants
    -> Gen [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)])
-> Constants
-> [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Constants
-> Gen [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
forall c.
Crypto c =>
Constants
-> Gen [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
genCoreNodeKeys

genCoreNodeKeys ::
  Crypto c =>
  Constants ->
  Gen [(KeyPair GenesisRole, AllIssuerKeys c GenesisDelegate)]
genCoreNodeKeys :: forall c.
Crypto c =>
Constants
-> Gen [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
genCoreNodeKeys c :: Constants
c@Constants {Word64
numCoreNodes :: Word64
numCoreNodes :: Constants -> Word64
numCoreNodes} =
  Int
-> Gen (GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)
-> Gen [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
numCoreNodes) (Gen (GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)
 -> Gen [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)])
-> Gen (GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)
-> Gen [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
forall a b. (a -> b) -> a -> b
$ (,) (GenesisKeyPair c
 -> AllIssuerKeys c GenesisDelegate
 -> (GenesisKeyPair c, AllIssuerKeys c GenesisDelegate))
-> Gen (GenesisKeyPair c)
-> Gen
     (AllIssuerKeys c GenesisDelegate
      -> (GenesisKeyPair c, AllIssuerKeys c GenesisDelegate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (GenesisKeyPair c)
forall a. Arbitrary a => Gen a
arbitrary Gen
  (AllIssuerKeys c GenesisDelegate
   -> (GenesisKeyPair c, AllIssuerKeys c GenesisDelegate))
-> Gen (AllIssuerKeys c GenesisDelegate)
-> Gen (GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Constants -> Gen (AllIssuerKeys c GenesisDelegate)
forall c (r :: KeyRole).
Crypto c =>
Constants -> Gen (AllIssuerKeys c r)
genIssuerKeys Constants
c

-- Pre-generate a set of keys to use for genesis delegates.
genesisDelegates :: Crypto c => Constants -> [AllIssuerKeys c GenesisDelegate]
genesisDelegates :: forall c.
Crypto c =>
Constants -> [AllIssuerKeys c GenesisDelegate]
genesisDelegates Constants
c =
  [ Constants -> Word64 -> Word64 -> AllIssuerKeys c GenesisDelegate
forall c (r :: KeyRole).
Crypto c =>
Constants -> Word64 -> Word64 -> AllIssuerKeys c r
issuerKeys Constants
c Word64
20 Word64
x
  | Word64
x <- [Word64
0 .. Word64
50]
  ]

-- Pre-generate a set of keys to use for stake pools.
stakePoolKeys :: Crypto c => Constants -> [AllIssuerKeys c StakePool]
stakePoolKeys :: forall c. Crypto c => Constants -> [AllIssuerKeys c StakePool]
stakePoolKeys Constants
c =
  [ Constants -> Word64 -> Word64 -> AllIssuerKeys c StakePool
forall c (r :: KeyRole).
Crypto c =>
Constants -> Word64 -> Word64 -> AllIssuerKeys c r
issuerKeys Constants
c Word64
10 Word64
x
  | Word64
x <- [Word64
0 .. Word64
50]
  ]

-- | Generate all keys for any entity which will be issuing blocks.
issuerKeys ::
  Crypto c =>
  Constants ->
  -- | Namespace parameter. Can be used to differentiate between different
  --   "types" of issuer.
  Word64 ->
  Word64 ->
  AllIssuerKeys c r
issuerKeys :: forall c (r :: KeyRole).
Crypto c =>
Constants -> Word64 -> Word64 -> AllIssuerKeys c r
issuerKeys Constants
c Word64
ns Word64
x =
  Int -> Int -> Gen (AllIssuerKeys c r) -> AllIssuerKeys c r
forall a. Int -> Int -> Gen a -> a
runGen (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x) Int
30 (Gen (AllIssuerKeys c r) -> AllIssuerKeys c r)
-> Gen (AllIssuerKeys c r) -> AllIssuerKeys c r
forall a b. (a -> b) -> a -> b
$ Word64 -> Gen (AllIssuerKeys c r) -> Gen (AllIssuerKeys c r)
forall n a. Integral n => n -> Gen a -> Gen a
variant Word64
ns (Constants -> Gen (AllIssuerKeys c r)
forall c (r :: KeyRole).
Crypto c =>
Constants -> Gen (AllIssuerKeys c r)
genIssuerKeys Constants
c)

genIssuerKeys :: Crypto c => Constants -> Gen (AllIssuerKeys c r)
genIssuerKeys :: forall c (r :: KeyRole).
Crypto c =>
Constants -> Gen (AllIssuerKeys c r)
genIssuerKeys Constants {Int
maxSlotTrace :: Int
maxSlotTrace :: Constants -> Int
maxSlotTrace} =
  Int -> Word64 -> Word64 -> Gen (AllIssuerKeys c r)
forall c (r :: KeyRole).
Crypto c =>
Int -> Word64 -> Word64 -> Gen (AllIssuerKeys c r)
genAllIssuerKeys Int
maxSlotTrace Word64
maxKESIterations Word64
slotsPerKESIteration

genesisDelegs0 ::
  Constants ->
  Map (KeyHash GenesisRole) GenDelegPair
genesisDelegs0 :: Constants -> Map (KeyHash GenesisRole) GenDelegPair
genesisDelegs0 Constants
c =
  [(KeyHash GenesisRole, GenDelegPair)]
-> Map (KeyHash GenesisRole) GenDelegPair
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [ ( GenesisKeyPair c -> KeyHash GenesisRole
forall {kd :: KeyRole}. KeyPair kd -> KeyHash kd
hashVKey GenesisKeyPair c
gkey
      , KeyHash GenesisDelegate
-> VRFVerKeyHash GenDelegVRF -> GenDelegPair
GenDelegPair
          (KeyHash GenesisDelegate -> KeyHash GenesisDelegate
forall (r :: KeyRole) (r' :: KeyRole). KeyHash r -> KeyHash r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole (KeyHash GenesisDelegate -> KeyHash GenesisDelegate)
-> (KeyPair GenesisDelegate -> KeyHash GenesisDelegate)
-> KeyPair GenesisDelegate
-> KeyHash GenesisDelegate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair GenesisDelegate -> KeyHash GenesisDelegate
forall {kd :: KeyRole}. KeyPair kd -> KeyHash kd
hashVKey (KeyPair GenesisDelegate -> KeyHash GenesisDelegate)
-> KeyPair GenesisDelegate -> KeyHash GenesisDelegate
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys MockCrypto GenesisDelegate -> KeyPair GenesisDelegate
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys MockCrypto GenesisDelegate
pkeys)
          (forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @MockCrypto (VerKeyVRF FakeVRF -> VRFVerKeyHash GenDelegVRF)
-> (VRFKeyPair MockCrypto -> VerKeyVRF FakeVRF)
-> VRFKeyPair MockCrypto
-> VRFVerKeyHash GenDelegVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VRFKeyPair MockCrypto -> VerKeyVRF (VRF MockCrypto)
VRFKeyPair MockCrypto -> VerKeyVRF FakeVRF
forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey (VRFKeyPair MockCrypto -> VRFVerKeyHash GenDelegVRF)
-> VRFKeyPair MockCrypto -> VRFVerKeyHash GenDelegVRF
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys MockCrypto GenesisDelegate -> VRFKeyPair MockCrypto
forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys MockCrypto GenesisDelegate
pkeys)
      )
    | (GenesisKeyPair c
gkey, AllIssuerKeys MockCrypto GenesisDelegate
pkeys) <- forall c.
Crypto c =>
Constants -> [(GenesisKeyPair c, AllIssuerKeys c GenesisDelegate)]
coreNodeKeys @MockCrypto Constants
c
    ]
  where
    hashVKey :: KeyPair kd -> KeyHash kd
hashVKey = VKey kd -> KeyHash kd
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey kd -> KeyHash kd)
-> (KeyPair kd -> VKey kd) -> KeyPair kd -> KeyHash kd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair kd -> VKey kd
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey