{-# 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.
  EraGen era =>
  Proxy era ->
  Constants ->
  GenEnv era
genEnv :: forall era. EraGen era => Proxy era -> Constants -> GenEnv era
genEnv Proxy era
_ Constants
constants =
  forall era.
KeySpace era -> ScriptSpace era -> Constants -> GenEnv era
GenEnv
    (forall era. EraGen era => Constants -> KeySpace 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 =
  forall era.
[TwoPhase3ArgInfo era]
-> [TwoPhase2ArgInfo era]
-> Map ScriptHash (TwoPhase3ArgInfo era)
-> Map ScriptHash (TwoPhase2ArgInfo era)
-> ScriptSpace era
ScriptSpace
    [TwoPhase3ArgInfo era]
scripts3
    [TwoPhase2ArgInfo era]
scripts2
    (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(forall era. EraScript era => Script era -> ScriptHash
hashScript @era (forall era. TwoPhase3ArgInfo era -> Script era
getScript3 TwoPhase3ArgInfo era
s), TwoPhase3ArgInfo era
s) | TwoPhase3ArgInfo era
s <- [TwoPhase3ArgInfo era]
scripts3])
    (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(forall era. EraScript era => Script era -> ScriptHash
hashScript @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.
  EraGen era =>
  Constants ->
  KeySpace era
keySpace :: forall era. EraGen era => Constants -> KeySpace era
keySpace Constants
c =
  forall era.
ScriptClass era =>
[(GenesisKeyPair MockCrypto,
  AllIssuerKeys MockCrypto 'GenesisDelegate)]
-> [AllIssuerKeys MockCrypto 'GenesisDelegate]
-> [AllIssuerKeys MockCrypto 'StakePool]
-> KeyPairs
-> [(Script era, Script era)]
-> KeySpace era
KeySpace
    (forall c.
Crypto c =>
Constants
-> [(GenesisKeyPair MockCrypto, AllIssuerKeys c 'GenesisDelegate)]
coreNodeKeys Constants
c)
    (forall c.
Crypto c =>
Constants -> [AllIssuerKeys c 'GenesisDelegate]
genesisDelegates Constants
c)
    (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 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
coreNodeKeys :: forall c.
Crypto c =>
Constants
-> [(GenesisKeyPair MockCrypto, AllIssuerKeys c 'GenesisDelegate)]
coreNodeKeys = forall a. Int -> Int -> Gen a -> a
runGen Int
1000 Int
30 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Crypto c =>
Constants
-> Gen
     [(GenesisKeyPair MockCrypto, AllIssuerKeys c 'GenesisDelegate)]
genCoreNodeKeys

genCoreNodeKeys ::
  Crypto c =>
  Constants ->
  Gen [(KeyPair 'Genesis, AllIssuerKeys c 'GenesisDelegate)]
genCoreNodeKeys :: forall c.
Crypto c =>
Constants
-> Gen
     [(GenesisKeyPair MockCrypto, AllIssuerKeys c 'GenesisDelegate)]
genCoreNodeKeys c :: Constants
c@Constants {Word64
numCoreNodes :: Constants -> Word64
numCoreNodes :: Word64
numCoreNodes} =
  forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
numCoreNodes) forall a b. (a -> b) -> a -> b
$ (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> 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 =
  [ 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 =
  [ 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 =
  forall a. Int -> Int -> Gen a -> a
runGen (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x) Int
30 forall a b. (a -> b) -> a -> b
$ forall n a. Integral n => n -> Gen a -> Gen a
variant Word64
ns (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 :: Constants -> Int
maxSlotTrace :: Int
maxSlotTrace} =
  forall c (r :: KeyRole).
Crypto c =>
Int -> Word64 -> Word64 -> Gen (AllIssuerKeys c r)
genAllIssuerKeys Int
maxSlotTrace Word64
maxKESIterations Word64
slotsPerKESIteration

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