{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

module Test.Ouroboros.Consensus.Protocol.Praos.Header (
    GeneratorContext (..)
  , MutatedHeader (..)
  , Mutation (..)
  , Sample (..)
  , expectedError
  , genContext
  , genMutatedHeader
  , genSample
  , generateSamples
  ) where

import           Cardano.Crypto.DSIGN
                     (DSIGNAlgorithm (SignKeyDSIGN, genKeyDSIGN, rawSerialiseSignKeyDSIGN),
                     Ed25519DSIGN, deriveVerKeyDSIGN,
                     rawDeserialiseSignKeyDSIGN)
import           Cardano.Crypto.Hash (Blake2b_256, Hash, hashFromBytes,
                     hashToBytes, hashWith)
import qualified Cardano.Crypto.KES as KES
import           Cardano.Crypto.KES.Class (genKeyKES, rawDeserialiseSignKeyKES,
                     rawSerialiseSignKeyKES)
import           Cardano.Crypto.Seed (mkSeedFromBytes)
import           Cardano.Crypto.VRF (deriveVerKeyVRF, hashVerKeyVRF,
                     rawDeserialiseSignKeyVRF, rawSerialiseSignKeyVRF)
import qualified Cardano.Crypto.VRF as VRF
import           Cardano.Crypto.VRF.Praos (skToBatchCompat)
import qualified Cardano.Crypto.VRF.Praos as VRF
import           Cardano.Ledger.BaseTypes (ActiveSlotCoeff, Nonce (..),
                     PositiveUnitInterval, ProtVer (..), Version, activeSlotVal,
                     boundRational, mkActiveSlotCoeff, natVersion)
import           Cardano.Ledger.Binary (MaxVersion, decCBOR,
                     decodeFullAnnotator, serialize')
import           Cardano.Ledger.Keys (KeyHash, KeyRole (BlockIssuer), VKey (..),
                     hashKey, signedDSIGN)
import           Cardano.Protocol.TPraos.BHeader (HashHeader (..),
                     PrevHash (..), checkLeaderNatValue)
import           Cardano.Protocol.TPraos.OCert (KESPeriod (..), OCert (..),
                     OCertSignable (..))
import           Cardano.Slotting.Block (BlockNo (..))
import           Cardano.Slotting.Slot (SlotNo (..))
import           Data.Aeson (defaultOptions, (.:), (.=))
import qualified Data.Aeson as Json
import           Data.Bifunctor (second)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Lazy as LBS
import           Data.Coerce (coerce)
import           Data.Foldable (toList)
import qualified Data.Map as Map
import           Data.Maybe (fromJust, fromMaybe)
import           Data.Proxy (Proxy (..))
import           Data.Ratio ((%))
import           Data.Text.Encoding (decodeUtf8, encodeUtf8)
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import           Ouroboros.Consensus.Protocol.Praos (PraosValidationErr (..))
import           Ouroboros.Consensus.Protocol.Praos.Header (Header,
                     HeaderBody (..), pattern Header)
import           Ouroboros.Consensus.Protocol.Praos.VRF (InputVRF, mkInputVRF,
                     vrfLeaderValue)
import           Ouroboros.Consensus.Protocol.TPraos (StandardCrypto)
import           Test.QuickCheck (Gen, arbitrary, choose, frequency, generate,
                     getPositive, resize, sized, suchThat, vectorOf)

-- * Test Vectors

generateSamples :: Int -> IO Sample
generateSamples :: Int -> IO Sample
generateSamples Int
n = Gen Sample -> IO Sample
forall a. Gen a -> IO a
generate (Int -> Gen Sample -> Gen Sample
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
n Gen Sample
genSample)

-- FIXME: Should be defined according to some Era
testVersion :: Version
testVersion :: Version
testVersion = forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @MaxVersion

newtype Sample = Sample {Sample -> [(GeneratorContext, MutatedHeader)]
sample :: [(GeneratorContext, MutatedHeader)]}
    deriving (Int -> Sample -> ShowS
[Sample] -> ShowS
Sample -> String
(Int -> Sample -> ShowS)
-> (Sample -> String) -> ([Sample] -> ShowS) -> Show Sample
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sample -> ShowS
showsPrec :: Int -> Sample -> ShowS
$cshow :: Sample -> String
show :: Sample -> String
$cshowList :: [Sample] -> ShowS
showList :: [Sample] -> ShowS
Show, Sample -> Sample -> Bool
(Sample -> Sample -> Bool)
-> (Sample -> Sample -> Bool) -> Eq Sample
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sample -> Sample -> Bool
== :: Sample -> Sample -> Bool
$c/= :: Sample -> Sample -> Bool
/= :: Sample -> Sample -> Bool
Eq)

instance Json.ToJSON Sample where
    toJSON :: Sample -> Value
toJSON Sample{[(GeneratorContext, MutatedHeader)]
sample :: Sample -> [(GeneratorContext, MutatedHeader)]
sample :: [(GeneratorContext, MutatedHeader)]
sample} = [(GeneratorContext, MutatedHeader)] -> Value
forall a. ToJSON a => a -> Value
Json.toJSON [(GeneratorContext, MutatedHeader)]
sample

instance Json.FromJSON Sample where
    parseJSON :: Value -> Parser Sample
parseJSON = String -> (Array -> Parser Sample) -> Value -> Parser Sample
forall a. String -> (Array -> Parser a) -> Value -> Parser a
Json.withArray String
"Sample" ((Array -> Parser Sample) -> Value -> Parser Sample)
-> (Array -> Parser Sample) -> Value -> Parser Sample
forall a b. (a -> b) -> a -> b
$ \Array
arr -> do
        [(GeneratorContext, MutatedHeader)] -> Sample
Sample ([(GeneratorContext, MutatedHeader)] -> Sample)
-> (Vector (GeneratorContext, MutatedHeader)
    -> [(GeneratorContext, MutatedHeader)])
-> Vector (GeneratorContext, MutatedHeader)
-> Sample
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (GeneratorContext, MutatedHeader)
-> [(GeneratorContext, MutatedHeader)]
forall a. Vector a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Vector (GeneratorContext, MutatedHeader) -> Sample)
-> Parser (Vector (GeneratorContext, MutatedHeader))
-> Parser Sample
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser (GeneratorContext, MutatedHeader))
-> Array -> Parser (Vector (GeneratorContext, MutatedHeader))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser (GeneratorContext, MutatedHeader)
forall a. FromJSON a => Value -> Parser a
Json.parseJSON Array
arr

genSample :: Gen Sample
genSample :: Gen Sample
genSample = do
    GeneratorContext
context <- Gen GeneratorContext
genContext
    [(GeneratorContext, MutatedHeader)]
sample <- (Int -> Gen [(GeneratorContext, MutatedHeader)])
-> Gen [(GeneratorContext, MutatedHeader)]
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen [(GeneratorContext, MutatedHeader)])
 -> Gen [(GeneratorContext, MutatedHeader)])
-> (Int -> Gen [(GeneratorContext, MutatedHeader)])
-> Gen [(GeneratorContext, MutatedHeader)]
forall a b. (a -> b) -> a -> b
$ \Int
n -> Int
-> Gen (GeneratorContext, MutatedHeader)
-> Gen [(GeneratorContext, MutatedHeader)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (Gen (GeneratorContext, MutatedHeader)
 -> Gen [(GeneratorContext, MutatedHeader)])
-> Gen (GeneratorContext, MutatedHeader)
-> Gen [(GeneratorContext, MutatedHeader)]
forall a b. (a -> b) -> a -> b
$ GeneratorContext -> Gen (GeneratorContext, MutatedHeader)
genMutatedHeader GeneratorContext
context
    Sample -> Gen Sample
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sample -> Gen Sample) -> Sample -> Gen Sample
forall a b. (a -> b) -> a -> b
$ Sample{[(GeneratorContext, MutatedHeader)]
sample :: [(GeneratorContext, MutatedHeader)]
sample :: [(GeneratorContext, MutatedHeader)]
sample}

genMutatedHeader :: GeneratorContext -> Gen (GeneratorContext, MutatedHeader)
genMutatedHeader :: GeneratorContext -> Gen (GeneratorContext, MutatedHeader)
genMutatedHeader GeneratorContext
context = do
    Header StandardCrypto
header <- GeneratorContext -> Gen (Header StandardCrypto)
genHeader GeneratorContext
context
    Mutation
mutation <- Header StandardCrypto -> Gen Mutation
genMutation Header StandardCrypto
header
    GeneratorContext
-> Header StandardCrypto
-> Mutation
-> Gen (GeneratorContext, MutatedHeader)
mutate GeneratorContext
context Header StandardCrypto
header Mutation
mutation

mutate :: GeneratorContext -> Header StandardCrypto -> Mutation -> Gen (GeneratorContext, MutatedHeader)
mutate :: GeneratorContext
-> Header StandardCrypto
-> Mutation
-> Gen (GeneratorContext, MutatedHeader)
mutate GeneratorContext
context Header StandardCrypto
header Mutation
mutation =
    (Header StandardCrypto -> MutatedHeader)
-> (GeneratorContext, Header StandardCrypto)
-> (GeneratorContext, MutatedHeader)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (\Header StandardCrypto
h -> MutatedHeader{header :: Header StandardCrypto
header = Header StandardCrypto
h, Mutation
mutation :: Mutation
mutation :: Mutation
mutation}) ((GeneratorContext, Header StandardCrypto)
 -> (GeneratorContext, MutatedHeader))
-> Gen (GeneratorContext, Header StandardCrypto)
-> Gen (GeneratorContext, MutatedHeader)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (GeneratorContext, Header StandardCrypto)
mutated
  where
    mutated :: Gen (GeneratorContext, Header StandardCrypto)
mutated =
        case Mutation
mutation of
            Mutation
NoMutation -> (GeneratorContext, Header StandardCrypto)
-> Gen (GeneratorContext, Header StandardCrypto)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneratorContext
context, Header StandardCrypto
header)
            Mutation
MutateKESKey -> do
                let Header HeaderBody StandardCrypto
body SignedKES StandardCrypto (HeaderBody StandardCrypto)
_ = Header StandardCrypto
header
                KESKey
newKESSignKey <- ByteString -> KESKey
newKESSigningKey (ByteString -> KESKey) -> Gen ByteString -> Gen KESKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
gen32Bytes
                KESPeriod Word
kesPeriod <- SlotNo -> Word64 -> Gen KESPeriod
genValidKESPeriod (HeaderBody StandardCrypto -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo HeaderBody StandardCrypto
body) Word64
praosSlotsPerKESPeriod
                let sig' :: SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
sig' = ContextKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Word
-> HeaderBody StandardCrypto
-> KESKey
-> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Word -> a -> SignKeyKES v -> SigKES v
forall a.
(Signable (Sum6KES Ed25519DSIGN Blake2b_256) a, HasCallStack) =>
ContextKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Word -> a -> KESKey -> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
KES.signKES () Word
kesPeriod HeaderBody StandardCrypto
body KESKey
newKESSignKey
                (GeneratorContext, Header StandardCrypto)
-> Gen (GeneratorContext, Header StandardCrypto)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneratorContext
context, HeaderBody StandardCrypto
-> SignedKES StandardCrypto (HeaderBody StandardCrypto)
-> Header StandardCrypto
forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> Header crypto
Header HeaderBody StandardCrypto
body (SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> SignedKES
     (Sum6KES Ed25519DSIGN Blake2b_256) (HeaderBody StandardCrypto)
forall v a. SigKES v -> SignedKES v a
KES.SignedKES SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
sig'))
            Mutation
MutateColdKey -> do
                let Header HeaderBody StandardCrypto
body SignedKES StandardCrypto (HeaderBody StandardCrypto)
_ = Header StandardCrypto
header
                SignKeyDSIGN Ed25519DSIGN
newColdSignKey <- Seed -> SignKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN (Seed -> SignKeyDSIGN Ed25519DSIGN)
-> (ByteString -> Seed) -> ByteString -> SignKeyDSIGN Ed25519DSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Seed
mkSeedFromBytes (ByteString -> SignKeyDSIGN Ed25519DSIGN)
-> Gen ByteString -> Gen (SignKeyDSIGN Ed25519DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
gen32Bytes
                (OCert StandardCrypto
hbOCert, KESPeriod Word
kesPeriod) <- SlotNo -> GeneratorContext -> Gen (OCert StandardCrypto, KESPeriod)
genCert (HeaderBody StandardCrypto -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo HeaderBody StandardCrypto
body) GeneratorContext
context{coldSignKey = newColdSignKey}
                let newBody :: HeaderBody StandardCrypto
newBody = HeaderBody StandardCrypto
body{hbOCert}
                let sig' :: SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
sig' = ContextKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Word
-> HeaderBody StandardCrypto
-> KESKey
-> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Word -> a -> SignKeyKES v -> SigKES v
forall a.
(Signable (Sum6KES Ed25519DSIGN Blake2b_256) a, HasCallStack) =>
ContextKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Word -> a -> KESKey -> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
KES.signKES () Word
kesPeriod HeaderBody StandardCrypto
newBody KESKey
kesSignKey
                (GeneratorContext, Header StandardCrypto)
-> Gen (GeneratorContext, Header StandardCrypto)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneratorContext
context, HeaderBody StandardCrypto
-> SignedKES StandardCrypto (HeaderBody StandardCrypto)
-> Header StandardCrypto
forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> Header crypto
Header HeaderBody StandardCrypto
newBody (SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> SignedKES
     (Sum6KES Ed25519DSIGN Blake2b_256) (HeaderBody StandardCrypto)
forall v a. SigKES v -> SignedKES v a
KES.SignedKES SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
sig'))
            Mutation
MutateKESPeriod -> do
                let Header HeaderBody StandardCrypto
body SignedKES StandardCrypto (HeaderBody StandardCrypto)
_ = Header StandardCrypto
header
                KESPeriod Word
kesPeriod' <- SlotNo -> Word64 -> Gen KESPeriod
genKESPeriodAfterLimit (HeaderBody StandardCrypto -> SlotNo
forall crypto. HeaderBody crypto -> SlotNo
hbSlotNo HeaderBody StandardCrypto
body) Word64
praosSlotsPerKESPeriod
                let newKESPeriod :: KESPeriod
newKESPeriod = Word -> KESPeriod
KESPeriod Word
kesPeriod'
                let oldOCert :: OCert StandardCrypto
oldOCert@OCert{VerKeyKES StandardCrypto
ocertVkHot :: VerKeyKES StandardCrypto
ocertVkHot :: forall c. OCert c -> VerKeyKES c
ocertVkHot, Word64
ocertN :: Word64
ocertN :: forall c. OCert c -> Word64
ocertN} = HeaderBody StandardCrypto -> OCert StandardCrypto
forall crypto. HeaderBody crypto -> OCert crypto
hbOCert HeaderBody StandardCrypto
body
                let newBody :: HeaderBody StandardCrypto
newBody =
                        HeaderBody StandardCrypto
body
                            { hbOCert =
                                oldOCert
                                    { ocertKESPeriod = newKESPeriod
                                    , ocertSigma = signedDSIGN @StandardCrypto coldSignKey (OCertSignable ocertVkHot ocertN newKESPeriod)
                                    }
                            }
                let sig' :: SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
sig' = ContextKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Word
-> HeaderBody StandardCrypto
-> KESKey
-> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Word -> a -> SignKeyKES v -> SigKES v
forall a.
(Signable (Sum6KES Ed25519DSIGN Blake2b_256) a, HasCallStack) =>
ContextKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Word -> a -> KESKey -> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
KES.signKES () Word
kesPeriod' HeaderBody StandardCrypto
newBody KESKey
kesSignKey
                (GeneratorContext, Header StandardCrypto)
-> Gen (GeneratorContext, Header StandardCrypto)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneratorContext
context, HeaderBody StandardCrypto
-> SignedKES StandardCrypto (HeaderBody StandardCrypto)
-> Header StandardCrypto
forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> Header crypto
Header HeaderBody StandardCrypto
newBody (SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> SignedKES
     (Sum6KES Ed25519DSIGN Blake2b_256) (HeaderBody StandardCrypto)
forall v a. SigKES v -> SignedKES v a
KES.SignedKES SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
sig'))
            Mutation
MutateKESPeriodBefore -> do
                let Header HeaderBody StandardCrypto
body SignedKES StandardCrypto (HeaderBody StandardCrypto)
_ = Header StandardCrypto
header
                    OCert{ocertKESPeriod :: forall c. OCert c -> KESPeriod
ocertKESPeriod = KESPeriod Word
kesPeriod} = HeaderBody StandardCrypto -> OCert StandardCrypto
forall crypto. HeaderBody crypto -> OCert crypto
hbOCert HeaderBody StandardCrypto
body
                SlotNo
newSlotNo <- Word64 -> Word64 -> Word64 -> Gen SlotNo
genSlotAfterKESPeriod (Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
kesPeriod) Word64
praosMaxKESEvo Word64
praosSlotsPerKESPeriod
                let rho' :: InputVRF
rho' = SlotNo -> Nonce -> InputVRF
mkInputVRF SlotNo
newSlotNo Nonce
nonce
                    period' :: Word64
period' = SlotNo -> Word64
unSlotNo SlotNo
newSlotNo Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
praosSlotsPerKESPeriod
                    hbVrfRes :: CertifiedVRF PraosVRF InputVRF
hbVrfRes = ContextVRF PraosVRF
-> InputVRF
-> SignKeyVRF PraosVRF
-> CertifiedVRF PraosVRF InputVRF
forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified () InputVRF
rho' SignKeyVRF PraosVRF
vrfSignKey
                    newBody :: HeaderBody StandardCrypto
newBody = HeaderBody StandardCrypto
body{hbSlotNo = newSlotNo, hbVrfRes}
                    sig' :: SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
sig' = ContextKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Word
-> HeaderBody StandardCrypto
-> KESKey
-> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Word -> a -> SignKeyKES v -> SigKES v
forall a.
(Signable (Sum6KES Ed25519DSIGN Blake2b_256) a, HasCallStack) =>
ContextKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Word -> a -> KESKey -> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
KES.signKES () (Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
period' Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
kesPeriod) HeaderBody StandardCrypto
newBody KESKey
kesSignKey
                (GeneratorContext, Header StandardCrypto)
-> Gen (GeneratorContext, Header StandardCrypto)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneratorContext
context, HeaderBody StandardCrypto
-> SignedKES StandardCrypto (HeaderBody StandardCrypto)
-> Header StandardCrypto
forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> Header crypto
Header HeaderBody StandardCrypto
newBody (SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> SignedKES
     (Sum6KES Ed25519DSIGN Blake2b_256) (HeaderBody StandardCrypto)
forall v a. SigKES v -> SignedKES v a
KES.SignedKES SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
sig'))
            Mutation
MutateCounterOver1 -> do
                let poolId :: KeyHash 'BlockIssuer StandardCrypto
poolId = KeyHash Any StandardCrypto -> KeyHash 'BlockIssuer StandardCrypto
forall a b. Coercible a b => a -> b
coerce (KeyHash Any StandardCrypto -> KeyHash 'BlockIssuer StandardCrypto)
-> KeyHash Any StandardCrypto
-> KeyHash 'BlockIssuer StandardCrypto
forall a b. (a -> b) -> a -> b
$ VKey Any StandardCrypto -> KeyHash Any StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey (VKey Any StandardCrypto -> KeyHash Any StandardCrypto)
-> VKey Any StandardCrypto -> KeyHash Any StandardCrypto
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
VKey (VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto)
-> VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
coldSignKey
                    Header HeaderBody StandardCrypto
body SignedKES StandardCrypto (HeaderBody StandardCrypto)
_ = Header StandardCrypto
header
                    OCert{Word64
ocertN :: forall c. OCert c -> Word64
ocertN :: Word64
ocertN} = HeaderBody StandardCrypto -> OCert StandardCrypto
forall crypto. HeaderBody crypto -> OCert crypto
hbOCert HeaderBody StandardCrypto
body
                Word64
newCounter <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
ocertN Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
2)
                let context' :: GeneratorContext
context' = GeneratorContext
context{ocertCounters = Map.insert poolId newCounter (ocertCounters context)}
                (GeneratorContext, Header StandardCrypto)
-> Gen (GeneratorContext, Header StandardCrypto)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneratorContext
context', Header StandardCrypto
header)
            Mutation
MutateCounterUnder -> do
                let poolId :: KeyHash 'BlockIssuer StandardCrypto
poolId = KeyHash Any StandardCrypto -> KeyHash 'BlockIssuer StandardCrypto
forall a b. Coercible a b => a -> b
coerce (KeyHash Any StandardCrypto -> KeyHash 'BlockIssuer StandardCrypto)
-> KeyHash Any StandardCrypto
-> KeyHash 'BlockIssuer StandardCrypto
forall a b. (a -> b) -> a -> b
$ VKey Any StandardCrypto -> KeyHash Any StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey (VKey Any StandardCrypto -> KeyHash Any StandardCrypto)
-> VKey Any StandardCrypto -> KeyHash Any StandardCrypto
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
VKey (VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto)
-> VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
coldSignKey
                    oldCounter :: Word64
oldCounter = Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 (Maybe Word64 -> Word64) -> Maybe Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ KeyHash 'BlockIssuer StandardCrypto
-> Map (KeyHash 'BlockIssuer StandardCrypto) Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'BlockIssuer StandardCrypto
poolId (GeneratorContext
-> Map (KeyHash 'BlockIssuer StandardCrypto) Word64
ocertCounters GeneratorContext
context)
                Word64
newCounter <- Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen Word64 -> (Word64 -> Bool) -> Gen Word64
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
oldCounter)
                let context' :: GeneratorContext
context' = GeneratorContext
context{ocertCounters = Map.insert poolId newCounter (ocertCounters context)}
                (GeneratorContext, Header StandardCrypto)
-> Gen (GeneratorContext, Header StandardCrypto)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneratorContext
context', Header StandardCrypto
header)
    GeneratorContext{Word64
praosSlotsPerKESPeriod :: Word64
praosSlotsPerKESPeriod :: GeneratorContext -> Word64
praosSlotsPerKESPeriod, Word64
praosMaxKESEvo :: Word64
praosMaxKESEvo :: GeneratorContext -> Word64
praosMaxKESEvo, KESKey
kesSignKey :: KESKey
kesSignKey :: GeneratorContext -> KESKey
kesSignKey, SignKeyVRF PraosVRF
vrfSignKey :: SignKeyVRF PraosVRF
vrfSignKey :: GeneratorContext -> SignKeyVRF PraosVRF
vrfSignKey, SignKeyDSIGN Ed25519DSIGN
coldSignKey :: GeneratorContext -> SignKeyDSIGN Ed25519DSIGN
coldSignKey :: SignKeyDSIGN Ed25519DSIGN
coldSignKey, Nonce
nonce :: Nonce
nonce :: GeneratorContext -> Nonce
nonce} = GeneratorContext
context

data Mutation
    = -- | No mutation
      NoMutation
    | -- | Mutate the KES key, ie. sign the header with a different KES key.
      MutateKESKey
    | -- | Mutate the cold key, ie. sign the operational certificate with a different cold key.
      MutateColdKey
    | -- | Mutate the KES period in the operational certificate to be
      -- after the start of the KES period.
      MutateKESPeriod
    | -- | Mutate KES period to be before the current KES period
      MutateKESPeriodBefore
    | -- | Mutate certificate counter to be greater than expected
      MutateCounterOver1
    | -- | Mutate certificate counter to be lower than expected
      MutateCounterUnder
    deriving (Mutation -> Mutation -> Bool
(Mutation -> Mutation -> Bool)
-> (Mutation -> Mutation -> Bool) -> Eq Mutation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mutation -> Mutation -> Bool
== :: Mutation -> Mutation -> Bool
$c/= :: Mutation -> Mutation -> Bool
/= :: Mutation -> Mutation -> Bool
Eq, Int -> Mutation -> ShowS
[Mutation] -> ShowS
Mutation -> String
(Int -> Mutation -> ShowS)
-> (Mutation -> String) -> ([Mutation] -> ShowS) -> Show Mutation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mutation -> ShowS
showsPrec :: Int -> Mutation -> ShowS
$cshow :: Mutation -> String
show :: Mutation -> String
$cshowList :: [Mutation] -> ShowS
showList :: [Mutation] -> ShowS
Show, (forall x. Mutation -> Rep Mutation x)
-> (forall x. Rep Mutation x -> Mutation) -> Generic Mutation
forall x. Rep Mutation x -> Mutation
forall x. Mutation -> Rep Mutation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Mutation -> Rep Mutation x
from :: forall x. Mutation -> Rep Mutation x
$cto :: forall x. Rep Mutation x -> Mutation
to :: forall x. Rep Mutation x -> Mutation
Generic)

instance Json.ToJSON Mutation where
    toEncoding :: Mutation -> Encoding
toEncoding = Options -> Mutation -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Json.genericToEncoding Options
defaultOptions

instance Json.FromJSON Mutation

expectedError :: Mutation -> PraosValidationErr StandardCrypto -> Bool
expectedError :: Mutation -> PraosValidationErr StandardCrypto -> Bool
expectedError = \case
    Mutation
NoMutation -> Bool -> PraosValidationErr StandardCrypto -> Bool
forall a b. a -> b -> a
const Bool
False
    Mutation
MutateKESKey -> \case
        InvalidKesSignatureOCERT{} -> Bool
True
        PraosValidationErr StandardCrypto
_ -> Bool
False
    Mutation
MutateColdKey -> \case
        InvalidSignatureOCERT{} -> Bool
True
        PraosValidationErr StandardCrypto
_ -> Bool
False
    Mutation
MutateKESPeriod -> \case
        KESBeforeStartOCERT{} -> Bool
True
        PraosValidationErr StandardCrypto
_ -> Bool
False
    Mutation
MutateKESPeriodBefore -> \case
        KESAfterEndOCERT{} -> Bool
True
        PraosValidationErr StandardCrypto
_ -> Bool
False
    Mutation
MutateCounterOver1 -> \case
        CounterOverIncrementedOCERT{} -> Bool
True
        PraosValidationErr StandardCrypto
_ -> Bool
False
    Mutation
MutateCounterUnder -> \case
        CounterTooSmallOCERT{} -> Bool
True
        PraosValidationErr StandardCrypto
_ -> Bool
False

genMutation :: Header StandardCrypto -> Gen Mutation
genMutation :: Header StandardCrypto -> Gen Mutation
genMutation Header StandardCrypto
header =
    [(Int, Gen Mutation)] -> Gen Mutation
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency ([(Int, Gen Mutation)] -> Gen Mutation)
-> [(Int, Gen Mutation)] -> Gen Mutation
forall a b. (a -> b) -> a -> b
$
        [ (Int
4, Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutation
NoMutation)
        , (Int
1, Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutation
MutateKESKey)
        , (Int
1, Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutation
MutateColdKey)
        , (Int
1, Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutation
MutateKESPeriod)
        , (Int
1, Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutation
MutateKESPeriodBefore)
        , (Int
1, Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutation
MutateCounterUnder)
        ]
            [(Int, Gen Mutation)]
-> [(Int, Gen Mutation)] -> [(Int, Gen Mutation)]
forall a. Semigroup a => a -> a -> a
<> [(Int, Gen Mutation)]
maybeCounterOver1
  where
    Header HeaderBody StandardCrypto
body SignedKES StandardCrypto (HeaderBody StandardCrypto)
_ = Header StandardCrypto
header
    OCert{Word64
ocertN :: forall c. OCert c -> Word64
ocertN :: Word64
ocertN} = HeaderBody StandardCrypto -> OCert StandardCrypto
forall crypto. HeaderBody crypto -> OCert crypto
hbOCert HeaderBody StandardCrypto
body
    maybeCounterOver1 :: [(Int, Gen Mutation)]
maybeCounterOver1 =
        if Word64
ocertN Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
10
            then [(Int
1, Mutation -> Gen Mutation
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Mutation
MutateCounterOver1)]
            else []

data MutatedHeader = MutatedHeader
    { MutatedHeader -> Header StandardCrypto
header   :: !(Header StandardCrypto)
    , MutatedHeader -> Mutation
mutation :: !Mutation
    }
    deriving (Int -> MutatedHeader -> ShowS
[MutatedHeader] -> ShowS
MutatedHeader -> String
(Int -> MutatedHeader -> ShowS)
-> (MutatedHeader -> String)
-> ([MutatedHeader] -> ShowS)
-> Show MutatedHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MutatedHeader -> ShowS
showsPrec :: Int -> MutatedHeader -> ShowS
$cshow :: MutatedHeader -> String
show :: MutatedHeader -> String
$cshowList :: [MutatedHeader] -> ShowS
showList :: [MutatedHeader] -> ShowS
Show, MutatedHeader -> MutatedHeader -> Bool
(MutatedHeader -> MutatedHeader -> Bool)
-> (MutatedHeader -> MutatedHeader -> Bool) -> Eq MutatedHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MutatedHeader -> MutatedHeader -> Bool
== :: MutatedHeader -> MutatedHeader -> Bool
$c/= :: MutatedHeader -> MutatedHeader -> Bool
/= :: MutatedHeader -> MutatedHeader -> Bool
Eq)

instance Json.ToJSON MutatedHeader where
    toJSON :: MutatedHeader -> Value
toJSON MutatedHeader{Header StandardCrypto
header :: MutatedHeader -> Header StandardCrypto
header :: Header StandardCrypto
header, Mutation
mutation :: MutatedHeader -> Mutation
mutation :: Mutation
mutation} =
        [Pair] -> Value
Json.object
            [ Key
"header" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
cborHeader
            , Key
"mutation" Key -> Mutation -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Mutation
mutation
            ]
      where
        cborHeader :: Text
cborHeader = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Version -> Header StandardCrypto -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
testVersion Header StandardCrypto
header

instance Json.FromJSON MutatedHeader where
    parseJSON :: Value -> Parser MutatedHeader
parseJSON = String
-> (Object -> Parser MutatedHeader)
-> Value
-> Parser MutatedHeader
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"MutatedHeader" ((Object -> Parser MutatedHeader) -> Value -> Parser MutatedHeader)
-> (Object -> Parser MutatedHeader)
-> Value
-> Parser MutatedHeader
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        Text
cborHeader <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"header"
        Mutation
mutation <- Object
obj Object -> Key -> Parser Mutation
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"mutation"
        Header StandardCrypto
header <- Text -> Parser (Header StandardCrypto)
forall {f :: * -> *}.
MonadFail f =>
Text -> f (Header StandardCrypto)
parseHeader Text
cborHeader
        MutatedHeader -> Parser MutatedHeader
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MutatedHeader{Header StandardCrypto
header :: Header StandardCrypto
header :: Header StandardCrypto
header, Mutation
mutation :: Mutation
mutation :: Mutation
mutation}
      where
        parseHeader :: Text -> f (Header StandardCrypto)
parseHeader Text
cborHeader = do
            let headerBytes :: ByteString
headerBytes = ByteString -> ByteString
Base16.decodeLenient (Text -> ByteString
encodeUtf8 Text
cborHeader)
            (DecoderError -> f (Header StandardCrypto))
-> (Header StandardCrypto -> f (Header StandardCrypto))
-> Either DecoderError (Header StandardCrypto)
-> f (Header StandardCrypto)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> f (Header StandardCrypto)
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> f (Header StandardCrypto))
-> (DecoderError -> String)
-> DecoderError
-> f (Header StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecoderError -> String
forall a. Show a => a -> String
show) Header StandardCrypto -> f (Header StandardCrypto)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either DecoderError (Header StandardCrypto)
 -> f (Header StandardCrypto))
-> Either DecoderError (Header StandardCrypto)
-> f (Header StandardCrypto)
forall a b. (a -> b) -> a -> b
$ forall a.
Version
-> Text
-> (forall s. Decoder s (Annotator a))
-> ByteString
-> Either DecoderError a
decodeFullAnnotator @(Header StandardCrypto) Version
testVersion Text
"Header" Decoder s (Annotator (Header StandardCrypto))
forall s. Decoder s (Annotator (Header StandardCrypto))
forall a s. DecCBOR a => Decoder s a
decCBOR (ByteString -> Either DecoderError (Header StandardCrypto))
-> ByteString -> Either DecoderError (Header StandardCrypto)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.fromStrict ByteString
headerBytes

-- * Generators
type KESKey = KES.SignKeyKES (KES.Sum6KES Ed25519DSIGN Blake2b_256)

newVRFSigningKey :: ByteString -> (VRF.SignKeyVRF VRF.PraosVRF, VRF.VerKeyVRF VRF.PraosVRF)
newVRFSigningKey :: ByteString -> (SignKeyVRF PraosVRF, VerKeyVRF PraosVRF)
newVRFSigningKey = Seed -> (SignKeyVRF PraosVRF, VerKeyVRF PraosVRF)
forall v. VRFAlgorithm v => Seed -> (SignKeyVRF v, VerKeyVRF v)
VRF.genKeyPairVRF (Seed -> (SignKeyVRF PraosVRF, VerKeyVRF PraosVRF))
-> (ByteString -> Seed)
-> ByteString
-> (SignKeyVRF PraosVRF, VerKeyVRF PraosVRF)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Seed
mkSeedFromBytes

newKESSigningKey :: ByteString -> KESKey
newKESSigningKey :: ByteString -> KESKey
newKESSigningKey = Seed -> KESKey
forall v. KESAlgorithm v => Seed -> SignKeyKES v
genKeyKES (Seed -> KESKey) -> (ByteString -> Seed) -> ByteString -> KESKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Seed
mkSeedFromBytes

data GeneratorContext = GeneratorContext
    { GeneratorContext -> Word64
praosSlotsPerKESPeriod :: !Word64
    , GeneratorContext -> Word64
praosMaxKESEvo :: !Word64
    , GeneratorContext -> KESKey
kesSignKey :: !KESKey
    , GeneratorContext -> SignKeyDSIGN Ed25519DSIGN
coldSignKey :: !(SignKeyDSIGN Ed25519DSIGN)
    , GeneratorContext -> SignKeyVRF PraosVRF
vrfSignKey :: !(VRF.SignKeyVRF VRF.PraosVRF)
    , GeneratorContext -> Nonce
nonce :: !Nonce
    , GeneratorContext
-> Map (KeyHash 'BlockIssuer StandardCrypto) Word64
ocertCounters :: !(Map.Map (KeyHash BlockIssuer StandardCrypto) Word64)
    , GeneratorContext -> ActiveSlotCoeff
activeSlotCoeff :: !ActiveSlotCoeff
    }
    deriving (Int -> GeneratorContext -> ShowS
[GeneratorContext] -> ShowS
GeneratorContext -> String
(Int -> GeneratorContext -> ShowS)
-> (GeneratorContext -> String)
-> ([GeneratorContext] -> ShowS)
-> Show GeneratorContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeneratorContext -> ShowS
showsPrec :: Int -> GeneratorContext -> ShowS
$cshow :: GeneratorContext -> String
show :: GeneratorContext -> String
$cshowList :: [GeneratorContext] -> ShowS
showList :: [GeneratorContext] -> ShowS
Show)

instance Eq GeneratorContext where
    GeneratorContext
a == :: GeneratorContext -> GeneratorContext -> Bool
== GeneratorContext
b =
        GeneratorContext -> Word64
praosSlotsPerKESPeriod GeneratorContext
a Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== GeneratorContext -> Word64
praosSlotsPerKESPeriod GeneratorContext
b
            Bool -> Bool -> Bool
&& GeneratorContext -> Word64
praosMaxKESEvo GeneratorContext
a Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== GeneratorContext -> Word64
praosMaxKESEvo GeneratorContext
b
            Bool -> Bool -> Bool
&& Version -> KESKey -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
testVersion (GeneratorContext -> KESKey
kesSignKey GeneratorContext
a) ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> KESKey -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
testVersion (GeneratorContext -> KESKey
kesSignKey GeneratorContext
b)
            Bool -> Bool -> Bool
&& GeneratorContext -> SignKeyDSIGN Ed25519DSIGN
coldSignKey GeneratorContext
a SignKeyDSIGN Ed25519DSIGN -> SignKeyDSIGN Ed25519DSIGN -> Bool
forall a. Eq a => a -> a -> Bool
== GeneratorContext -> SignKeyDSIGN Ed25519DSIGN
coldSignKey GeneratorContext
b
            Bool -> Bool -> Bool
&& GeneratorContext -> SignKeyVRF PraosVRF
vrfSignKey GeneratorContext
a SignKeyVRF PraosVRF -> SignKeyVRF PraosVRF -> Bool
forall a. Eq a => a -> a -> Bool
== GeneratorContext -> SignKeyVRF PraosVRF
vrfSignKey GeneratorContext
b
            Bool -> Bool -> Bool
&& GeneratorContext -> Nonce
nonce GeneratorContext
a Nonce -> Nonce -> Bool
forall a. Eq a => a -> a -> Bool
== GeneratorContext -> Nonce
nonce GeneratorContext
b

instance Json.ToJSON GeneratorContext where
    toJSON :: GeneratorContext -> Value
toJSON GeneratorContext{Word64
Map (KeyHash 'BlockIssuer StandardCrypto) Word64
SignKeyDSIGN Ed25519DSIGN
KESKey
SignKeyVRF PraosVRF
ActiveSlotCoeff
Nonce
coldSignKey :: GeneratorContext -> SignKeyDSIGN Ed25519DSIGN
ocertCounters :: GeneratorContext
-> Map (KeyHash 'BlockIssuer StandardCrypto) Word64
praosSlotsPerKESPeriod :: GeneratorContext -> Word64
praosMaxKESEvo :: GeneratorContext -> Word64
kesSignKey :: GeneratorContext -> KESKey
vrfSignKey :: GeneratorContext -> SignKeyVRF PraosVRF
nonce :: GeneratorContext -> Nonce
activeSlotCoeff :: GeneratorContext -> ActiveSlotCoeff
praosSlotsPerKESPeriod :: Word64
praosMaxKESEvo :: Word64
kesSignKey :: KESKey
coldSignKey :: SignKeyDSIGN Ed25519DSIGN
vrfSignKey :: SignKeyVRF PraosVRF
nonce :: Nonce
ocertCounters :: Map (KeyHash 'BlockIssuer StandardCrypto) Word64
activeSlotCoeff :: ActiveSlotCoeff
..} =
        [Pair] -> Value
Json.object
            [ Key
"praosSlotsPerKESPeriod" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
praosSlotsPerKESPeriod
            , Key
"praosMaxKESEvo" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
praosMaxKESEvo
            , Key
"kesSignKey" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
rawKesSignKey
            , Key
"coldSignKey" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
rawColdSignKey
            , Key
"vrfSignKey" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
rawVrfSignKey
            , Key
"vrfVKeyHash" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
rawVrVKeyHash
            , Key
"nonce" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
rawNonce
            , Key
"ocertCounters" Key -> Map (KeyHash 'BlockIssuer StandardCrypto) Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Map (KeyHash 'BlockIssuer StandardCrypto) Word64
ocertCounters
            , Key
"activeSlotCoeff" Key -> PositiveUnitInterval -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ActiveSlotCoeff -> PositiveUnitInterval
activeSlotVal ActiveSlotCoeff
activeSlotCoeff
            ]
      where
        rawKesSignKey :: Text
rawKesSignKey = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ KESKey -> ByteString
forall v. KESAlgorithm v => SignKeyKES v -> ByteString
rawSerialiseSignKeyKES KESKey
kesSignKey
        rawColdSignKey :: Text
rawColdSignKey = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
rawSerialiseSignKeyDSIGN SignKeyDSIGN Ed25519DSIGN
coldSignKey
        rawVrfSignKey :: Text
rawVrfSignKey = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ SignKeyVRF PraosBatchCompatVRF -> ByteString
forall v. VRFAlgorithm v => SignKeyVRF v -> ByteString
rawSerialiseSignKeyVRF (SignKeyVRF PraosBatchCompatVRF -> ByteString)
-> SignKeyVRF PraosBatchCompatVRF -> ByteString
forall a b. (a -> b) -> a -> b
$ SignKeyVRF PraosVRF -> SignKeyVRF PraosBatchCompatVRF
skToBatchCompat SignKeyVRF PraosVRF
vrfSignKey
        rawVrVKeyHash :: Text
rawVrVKeyHash = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Hash Blake2b_256 (VerKeyVRF PraosVRF) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash Blake2b_256 (VerKeyVRF PraosVRF) -> ByteString)
-> Hash Blake2b_256 (VerKeyVRF PraosVRF) -> ByteString
forall a b. (a -> b) -> a -> b
$ forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
hashVerKeyVRF @_ @Blake2b_256 (VerKeyVRF PraosVRF -> Hash Blake2b_256 (VerKeyVRF PraosVRF))
-> VerKeyVRF PraosVRF -> Hash Blake2b_256 (VerKeyVRF PraosVRF)
forall a b. (a -> b) -> a -> b
$ SignKeyVRF PraosVRF -> VerKeyVRF PraosVRF
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF SignKeyVRF PraosVRF
vrfSignKey
        rawNonce :: Text
rawNonce = case Nonce
nonce of
            Nonce
NeutralNonce -> ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
32 Word8
0
            Nonce Hash Blake2b_256 Nonce
hashNonce -> ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Hash Blake2b_256 Nonce -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash Blake2b_256 Nonce
hashNonce

instance Json.FromJSON GeneratorContext where
    parseJSON :: Value -> Parser GeneratorContext
parseJSON = String
-> (Object -> Parser GeneratorContext)
-> Value
-> Parser GeneratorContext
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Json.withObject String
"GeneratorContext" ((Object -> Parser GeneratorContext)
 -> Value -> Parser GeneratorContext)
-> (Object -> Parser GeneratorContext)
-> Value
-> Parser GeneratorContext
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        Word64
praosSlotsPerKESPeriod <- Object
obj Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"praosSlotsPerKESPeriod"
        Word64
praosMaxKESEvo <- Object
obj Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"praosMaxKESEvo"
        Text
rawKesSignKey <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"kesSignKey"
        Text
rawColdSignKey <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"coldSignKey"
        Text
rawVrfSignKey <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vrfSignKey"
        Text
cborNonce <- Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nonce"
        Map (KeyHash 'BlockIssuer StandardCrypto) Word64
ocertCounters <- Object
obj Object
-> Key -> Parser (Map (KeyHash 'BlockIssuer StandardCrypto) Word64)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ocertCounters"
        KESKey
kesSignKey <- Text -> Parser KESKey
forall {m :: * -> *} {v}.
(MonadFail m, KESAlgorithm v) =>
Text -> m (SignKeyKES v)
parseKesSignKey Text
rawKesSignKey
        SignKeyDSIGN Ed25519DSIGN
coldSignKey <- Text -> Parser (SignKeyDSIGN Ed25519DSIGN)
forall {m :: * -> *} {v}.
(MonadFail m, DSIGNAlgorithm v) =>
Text -> m (SignKeyDSIGN v)
parseColdSignKey Text
rawColdSignKey
        SignKeyVRF PraosVRF
vrfSignKey <- Text -> Parser (SignKeyVRF PraosVRF)
forall {m :: * -> *} {v}.
(MonadFail m, VRFAlgorithm v) =>
Text -> m (SignKeyVRF v)
parseVrfSignKey Text
rawVrfSignKey
        Nonce
nonce <- Text -> Parser Nonce
forall {f :: * -> *}. MonadFail f => Text -> f Nonce
parseNonce Text
cborNonce
        ActiveSlotCoeff
activeSlotCoeff <- PositiveUnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff (PositiveUnitInterval -> ActiveSlotCoeff)
-> Parser PositiveUnitInterval -> Parser ActiveSlotCoeff
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser PositiveUnitInterval
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"activeSlotCoeff"
        GeneratorContext -> Parser GeneratorContext
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GeneratorContext{Word64
Map (KeyHash 'BlockIssuer StandardCrypto) Word64
SignKeyDSIGN Ed25519DSIGN
KESKey
SignKeyVRF PraosVRF
ActiveSlotCoeff
Nonce
coldSignKey :: SignKeyDSIGN Ed25519DSIGN
ocertCounters :: Map (KeyHash 'BlockIssuer StandardCrypto) Word64
praosSlotsPerKESPeriod :: Word64
praosMaxKESEvo :: Word64
kesSignKey :: KESKey
vrfSignKey :: SignKeyVRF PraosVRF
nonce :: Nonce
activeSlotCoeff :: ActiveSlotCoeff
praosSlotsPerKESPeriod :: Word64
praosMaxKESEvo :: Word64
ocertCounters :: Map (KeyHash 'BlockIssuer StandardCrypto) Word64
kesSignKey :: KESKey
coldSignKey :: SignKeyDSIGN Ed25519DSIGN
vrfSignKey :: SignKeyVRF PraosVRF
nonce :: Nonce
activeSlotCoeff :: ActiveSlotCoeff
..}
      where
        parseNonce :: Text -> f Nonce
parseNonce Text
rawNonce =
            case ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
encodeUtf8 Text
rawNonce) of
                Left String
_ -> Nonce -> f Nonce
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Nonce
NeutralNonce
                Right ByteString
nonceBytes -> Hash Blake2b_256 Nonce -> Nonce
Nonce (Hash Blake2b_256 Nonce -> Nonce)
-> f (Hash Blake2b_256 Nonce) -> f Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Hash Blake2b_256 Nonce)
-> (Hash Blake2b_256 Nonce -> f (Hash Blake2b_256 Nonce))
-> Maybe (Hash Blake2b_256 Nonce)
-> f (Hash Blake2b_256 Nonce)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> f (Hash Blake2b_256 Nonce)
forall a. String -> f a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid bytes for hash") Hash Blake2b_256 Nonce -> f (Hash Blake2b_256 Nonce)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe (Hash Blake2b_256 Nonce)
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
hashFromBytes ByteString
nonceBytes)
        parseColdSignKey :: Text -> m (SignKeyDSIGN v)
parseColdSignKey Text
rawKey = do
            case ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
encodeUtf8 Text
rawKey) of
                Left String
err -> String -> m (SignKeyDSIGN v)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
                Right ByteString
keyBytes ->
                    case ByteString -> Maybe (SignKeyDSIGN v)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN ByteString
keyBytes of
                        Maybe (SignKeyDSIGN v)
Nothing -> String -> m (SignKeyDSIGN v)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (SignKeyDSIGN v)) -> String -> m (SignKeyDSIGN v)
forall a b. (a -> b) -> a -> b
$ String
"Invalid cold key bytes: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
rawKey
                        Just SignKeyDSIGN v
key -> SignKeyDSIGN v -> m (SignKeyDSIGN v)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignKeyDSIGN v
key
        parseKesSignKey :: Text -> m (SignKeyKES v)
parseKesSignKey Text
rawKey = do
            case ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
encodeUtf8 Text
rawKey) of
                Left String
err -> String -> m (SignKeyKES v)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
                Right ByteString
keyBytes ->
                    case ByteString -> Maybe (SignKeyKES v)
forall v. KESAlgorithm v => ByteString -> Maybe (SignKeyKES v)
rawDeserialiseSignKeyKES ByteString
keyBytes of
                        Maybe (SignKeyKES v)
Nothing -> String -> m (SignKeyKES v)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (SignKeyKES v)) -> String -> m (SignKeyKES v)
forall a b. (a -> b) -> a -> b
$ String
"Invalid KES key bytes: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
rawKey
                        Just SignKeyKES v
key -> SignKeyKES v -> m (SignKeyKES v)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignKeyKES v
key
        parseVrfSignKey :: Text -> m (SignKeyVRF v)
parseVrfSignKey Text
rawKey = do
            case ByteString -> Either String ByteString
Base16.decode (Text -> ByteString
encodeUtf8 Text
rawKey) of
                Left String
err -> String -> m (SignKeyVRF v)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
                Right ByteString
keyBytes ->
                    case ByteString -> Maybe (SignKeyVRF v)
forall v. VRFAlgorithm v => ByteString -> Maybe (SignKeyVRF v)
rawDeserialiseSignKeyVRF ByteString
keyBytes of
                        Maybe (SignKeyVRF v)
Nothing -> String -> m (SignKeyVRF v)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m (SignKeyVRF v)) -> String -> m (SignKeyVRF v)
forall a b. (a -> b) -> a -> b
$ String
"Invalid VRF key bytes: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
rawKey
                        Just SignKeyVRF v
key -> SignKeyVRF v -> m (SignKeyVRF v)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SignKeyVRF v
key

genContext :: Gen GeneratorContext
genContext :: Gen GeneratorContext
genContext = do
    Word64
praosSlotsPerKESPeriod <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
100, Word64
10000)
    Word64
praosMaxKESEvo <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
10, Word64
1000)
    Word64
ocertCounter <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
10, Word64
100)
    KESKey
kesSignKey <- ByteString -> KESKey
newKESSigningKey (ByteString -> KESKey) -> Gen ByteString -> Gen KESKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
gen32Bytes
    SignKeyDSIGN (DSIGN StandardCrypto)
coldSignKey <- Seed -> SignKeyDSIGN (DSIGN StandardCrypto)
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN (Seed -> SignKeyDSIGN (DSIGN StandardCrypto))
-> (ByteString -> Seed)
-> ByteString
-> SignKeyDSIGN (DSIGN StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Seed
mkSeedFromBytes (ByteString -> SignKeyDSIGN (DSIGN StandardCrypto))
-> Gen ByteString -> Gen (SignKeyDSIGN (DSIGN StandardCrypto))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
gen32Bytes
    SignKeyVRF PraosVRF
vrfSignKey <- (SignKeyVRF PraosVRF, VerKeyVRF PraosVRF) -> SignKeyVRF PraosVRF
forall a b. (a, b) -> a
fst ((SignKeyVRF PraosVRF, VerKeyVRF PraosVRF) -> SignKeyVRF PraosVRF)
-> (ByteString -> (SignKeyVRF PraosVRF, VerKeyVRF PraosVRF))
-> ByteString
-> SignKeyVRF PraosVRF
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> (SignKeyVRF PraosVRF, VerKeyVRF PraosVRF)
newVRFSigningKey (ByteString -> SignKeyVRF PraosVRF)
-> Gen ByteString -> Gen (SignKeyVRF PraosVRF)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
gen32Bytes
    Nonce
nonce <- Hash Blake2b_256 Nonce -> Nonce
Nonce (Hash Blake2b_256 Nonce -> Nonce)
-> Gen (Hash Blake2b_256 Nonce) -> Gen Nonce
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash Blake2b_256 Nonce)
forall a. Gen (Hash Blake2b_256 a)
genHash
    let poolId :: KeyHash 'BlockIssuer StandardCrypto
poolId = KeyHash Any StandardCrypto -> KeyHash 'BlockIssuer StandardCrypto
forall a b. Coercible a b => a -> b
coerce (KeyHash Any StandardCrypto -> KeyHash 'BlockIssuer StandardCrypto)
-> KeyHash Any StandardCrypto
-> KeyHash 'BlockIssuer StandardCrypto
forall a b. (a -> b) -> a -> b
$ VKey Any StandardCrypto -> KeyHash Any StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey (VKey Any StandardCrypto -> KeyHash Any StandardCrypto)
-> VKey Any StandardCrypto -> KeyHash Any StandardCrypto
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
VKey (VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto)
-> VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN (DSIGN StandardCrypto)
-> VerKeyDSIGN (DSIGN StandardCrypto)
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN (DSIGN StandardCrypto)
coldSignKey
        ocertCounters :: Map (KeyHash 'BlockIssuer StandardCrypto) Word64
ocertCounters = [(KeyHash 'BlockIssuer StandardCrypto, Word64)]
-> Map (KeyHash 'BlockIssuer StandardCrypto) Word64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(KeyHash 'BlockIssuer StandardCrypto
poolId, Word64
ocertCounter)]
    ActiveSlotCoeff
activeSlotCoeff <- Gen ActiveSlotCoeff
genActiveSlotCoeff
    GeneratorContext -> Gen GeneratorContext
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GeneratorContext -> Gen GeneratorContext)
-> GeneratorContext -> Gen GeneratorContext
forall a b. (a -> b) -> a -> b
$ GeneratorContext{Word64
Map (KeyHash 'BlockIssuer StandardCrypto) Word64
SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN (DSIGN StandardCrypto)
KESKey
SignKeyVRF PraosVRF
ActiveSlotCoeff
Nonce
coldSignKey :: SignKeyDSIGN Ed25519DSIGN
ocertCounters :: Map (KeyHash 'BlockIssuer StandardCrypto) Word64
praosSlotsPerKESPeriod :: Word64
praosMaxKESEvo :: Word64
kesSignKey :: KESKey
vrfSignKey :: SignKeyVRF PraosVRF
nonce :: Nonce
activeSlotCoeff :: ActiveSlotCoeff
praosSlotsPerKESPeriod :: Word64
praosMaxKESEvo :: Word64
kesSignKey :: KESKey
coldSignKey :: SignKeyDSIGN (DSIGN StandardCrypto)
vrfSignKey :: SignKeyVRF PraosVRF
nonce :: Nonce
ocertCounters :: Map (KeyHash 'BlockIssuer StandardCrypto) Word64
activeSlotCoeff :: ActiveSlotCoeff
..}

genActiveSlotCoeff :: Gen ActiveSlotCoeff
genActiveSlotCoeff :: Gen ActiveSlotCoeff
genActiveSlotCoeff = do
    (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
100) Gen Integer
-> (Integer -> Gen ActiveSlotCoeff) -> Gen ActiveSlotCoeff
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
n -> ActiveSlotCoeff -> Gen ActiveSlotCoeff
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActiveSlotCoeff -> Gen ActiveSlotCoeff)
-> ActiveSlotCoeff -> Gen ActiveSlotCoeff
forall a b. (a -> b) -> a -> b
$ Rational -> ActiveSlotCoeff
activeSlotCoeff (Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
100)
  where
    activeSlotCoeff :: Rational -> ActiveSlotCoeff
activeSlotCoeff = PositiveUnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff (PositiveUnitInterval -> ActiveSlotCoeff)
-> (Rational -> PositiveUnitInterval)
-> Rational
-> ActiveSlotCoeff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe PositiveUnitInterval -> PositiveUnitInterval
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe PositiveUnitInterval -> PositiveUnitInterval)
-> (Rational -> Maybe PositiveUnitInterval)
-> Rational
-> PositiveUnitInterval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. BoundedRational r => Rational -> Maybe r
boundRational @PositiveUnitInterval

{- | Generate a well-formed header

The header is signed with the KES key, and all the signing keys
generated for the purpose of producing the header are returned.
-}
genHeader :: GeneratorContext -> Gen (Header StandardCrypto)
genHeader :: GeneratorContext -> Gen (Header StandardCrypto)
genHeader GeneratorContext
context = do
    (HeaderBody StandardCrypto
body, KESPeriod Word
kesPeriod) <- GeneratorContext -> Gen (HeaderBody StandardCrypto, KESPeriod)
genHeaderBody GeneratorContext
context
    let sign :: SignedKES (Sum6KES Ed25519DSIGN Blake2b_256) a
sign = SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> SignedKES (Sum6KES Ed25519DSIGN Blake2b_256) a
forall v a. SigKES v -> SignedKES v a
KES.SignedKES (SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
 -> SignedKES (Sum6KES Ed25519DSIGN Blake2b_256) a)
-> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> SignedKES (Sum6KES Ed25519DSIGN Blake2b_256) a
forall a b. (a -> b) -> a -> b
$ ContextKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Word
-> HeaderBody StandardCrypto
-> KESKey
-> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
forall v a.
(KESAlgorithm v, Signable v a, HasCallStack) =>
ContextKES v -> Word -> a -> SignKeyKES v -> SigKES v
forall a.
(Signable (Sum6KES Ed25519DSIGN Blake2b_256) a, HasCallStack) =>
ContextKES (Sum6KES Ed25519DSIGN Blake2b_256)
-> Word -> a -> KESKey -> SigKES (Sum6KES Ed25519DSIGN Blake2b_256)
KES.signKES () Word
kesPeriod HeaderBody StandardCrypto
body KESKey
kesSignKey
    Header StandardCrypto -> Gen (Header StandardCrypto)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Header StandardCrypto -> Gen (Header StandardCrypto))
-> Header StandardCrypto -> Gen (Header StandardCrypto)
forall a b. (a -> b) -> a -> b
$ (HeaderBody StandardCrypto
-> SignedKES StandardCrypto (HeaderBody StandardCrypto)
-> Header StandardCrypto
forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES crypto (HeaderBody crypto) -> Header crypto
Header HeaderBody StandardCrypto
body SignedKES
  (Sum6KES Ed25519DSIGN Blake2b_256) (HeaderBody StandardCrypto)
SignedKES StandardCrypto (HeaderBody StandardCrypto)
forall {a}. SignedKES (Sum6KES Ed25519DSIGN Blake2b_256) a
sign)
  where
    GeneratorContext{KESKey
kesSignKey :: GeneratorContext -> KESKey
kesSignKey :: KESKey
kesSignKey} = GeneratorContext
context

genHeaderBody :: GeneratorContext -> Gen (HeaderBody StandardCrypto, KESPeriod)
genHeaderBody :: GeneratorContext -> Gen (HeaderBody StandardCrypto, KESPeriod)
genHeaderBody GeneratorContext
context = do
    BlockNo
hbBlockNo <- Word64 -> BlockNo
BlockNo (Word64 -> BlockNo) -> Gen Word64 -> Gen BlockNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
    (SlotNo
hbSlotNo, CertifiedVRF PraosVRF InputVRF
hbVrfRes, VerKeyVRF PraosVRF
hbVrfVk) <- GeneratorContext
-> Gen (SlotNo, CertifiedVRF PraosVRF InputVRF, VerKeyVRF PraosVRF)
genLeadingSlot GeneratorContext
context
    PrevHash StandardCrypto
hbPrev <- HashHeader StandardCrypto -> PrevHash StandardCrypto
forall c. HashHeader c -> PrevHash c
BlockHash (HashHeader StandardCrypto -> PrevHash StandardCrypto)
-> (Hash StandardCrypto EraIndependentBlockHeader
    -> HashHeader StandardCrypto)
-> Hash StandardCrypto EraIndependentBlockHeader
-> PrevHash StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash StandardCrypto EraIndependentBlockHeader
-> HashHeader StandardCrypto
forall c. Hash c EraIndependentBlockHeader -> HashHeader c
HashHeader (Hash StandardCrypto EraIndependentBlockHeader
 -> PrevHash StandardCrypto)
-> Gen (Hash StandardCrypto EraIndependentBlockHeader)
-> Gen (PrevHash StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash Blake2b_256 EraIndependentBlockHeader)
Gen (Hash StandardCrypto EraIndependentBlockHeader)
forall a. Gen (Hash Blake2b_256 a)
genHash
    let hbVk :: VKey kd StandardCrypto
hbVk = VerKeyDSIGN (DSIGN StandardCrypto) -> VKey kd StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
VKey (VerKeyDSIGN (DSIGN StandardCrypto) -> VKey kd StandardCrypto)
-> VerKeyDSIGN (DSIGN StandardCrypto) -> VKey kd StandardCrypto
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
coldSignKey
    Word32
hbBodySize <- (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
1000, Word32
90000)
    Hash Blake2b_256 EraIndependentBlockBody
hbBodyHash <- Gen (Hash Blake2b_256 EraIndependentBlockBody)
forall a. Gen (Hash Blake2b_256 a)
genHash
    (OCert StandardCrypto
hbOCert, KESPeriod
kesPeriod) <- SlotNo -> GeneratorContext -> Gen (OCert StandardCrypto, KESPeriod)
genCert SlotNo
hbSlotNo GeneratorContext
context
    let hbProtVer :: ProtVer
hbProtVer = ProtVer
protocolVersionZero
        headerBody :: HeaderBody StandardCrypto
headerBody = HeaderBody{Word32
Hash Blake2b_256 EraIndependentBlockBody
Hash StandardCrypto EraIndependentBlockBody
CertifiedVRF PraosVRF InputVRF
CertifiedVRF (VRF StandardCrypto) InputVRF
VerKeyVRF PraosVRF
VerKeyVRF (VRF StandardCrypto)
BlockNo
SlotNo
VKey 'BlockIssuer StandardCrypto
ProtVer
OCert StandardCrypto
PrevHash StandardCrypto
forall {kd :: KeyRole}. VKey kd StandardCrypto
hbSlotNo :: SlotNo
hbOCert :: OCert StandardCrypto
hbVrfRes :: CertifiedVRF (VRF StandardCrypto) InputVRF
hbBlockNo :: BlockNo
hbSlotNo :: SlotNo
hbVrfRes :: CertifiedVRF PraosVRF InputVRF
hbVrfVk :: VerKeyVRF PraosVRF
hbPrev :: PrevHash StandardCrypto
hbVk :: forall {kd :: KeyRole}. VKey kd StandardCrypto
hbBodySize :: Word32
hbBodyHash :: Hash Blake2b_256 EraIndependentBlockBody
hbOCert :: OCert StandardCrypto
hbProtVer :: ProtVer
hbBlockNo :: BlockNo
hbPrev :: PrevHash StandardCrypto
hbVk :: VKey 'BlockIssuer StandardCrypto
hbVrfVk :: VerKeyVRF (VRF StandardCrypto)
hbBodySize :: Word32
hbBodyHash :: Hash StandardCrypto EraIndependentBlockBody
hbProtVer :: ProtVer
..}
    (HeaderBody StandardCrypto, KESPeriod)
-> Gen (HeaderBody StandardCrypto, KESPeriod)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((HeaderBody StandardCrypto, KESPeriod)
 -> Gen (HeaderBody StandardCrypto, KESPeriod))
-> (HeaderBody StandardCrypto, KESPeriod)
-> Gen (HeaderBody StandardCrypto, KESPeriod)
forall a b. (a -> b) -> a -> b
$ (HeaderBody StandardCrypto
headerBody, KESPeriod
kesPeriod)
  where
    GeneratorContext{SignKeyDSIGN Ed25519DSIGN
coldSignKey :: GeneratorContext -> SignKeyDSIGN Ed25519DSIGN
coldSignKey :: SignKeyDSIGN Ed25519DSIGN
coldSignKey} = GeneratorContext
context

genLeadingSlot :: GeneratorContext -> Gen (SlotNo, VRF.CertifiedVRF VRF.PraosVRF InputVRF, VRF.VerKeyVRF VRF.PraosVRF)
genLeadingSlot :: GeneratorContext
-> Gen (SlotNo, CertifiedVRF PraosVRF InputVRF, VerKeyVRF PraosVRF)
genLeadingSlot GeneratorContext
context = do
    SlotNo
slotNo <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo)
-> (Positive Word64 -> Word64) -> Positive Word64 -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Word64 -> Word64
forall a. Positive a -> a
getPositive (Positive Word64 -> SlotNo) -> Gen (Positive Word64) -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Positive Word64)
forall a. Arbitrary a => Gen a
arbitrary Gen (Positive Word64)
-> (Positive Word64 -> Bool) -> Gen (Positive Word64)
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Positive Word64 -> Bool
isLeader
    let rho' :: InputVRF
rho' = SlotNo -> Nonce -> InputVRF
mkInputVRF SlotNo
slotNo Nonce
nonce
        hbVrfRes :: CertifiedVRF PraosVRF InputVRF
hbVrfRes = ContextVRF PraosVRF
-> InputVRF
-> SignKeyVRF PraosVRF
-> CertifiedVRF PraosVRF InputVRF
forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified () InputVRF
rho' SignKeyVRF PraosVRF
vrfSignKey
        hbVrfVk :: VerKeyVRF PraosVRF
hbVrfVk = SignKeyVRF PraosVRF -> VerKeyVRF PraosVRF
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF SignKeyVRF PraosVRF
vrfSignKey
    (SlotNo, CertifiedVRF PraosVRF InputVRF, VerKeyVRF PraosVRF)
-> Gen (SlotNo, CertifiedVRF PraosVRF InputVRF, VerKeyVRF PraosVRF)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlotNo
slotNo, CertifiedVRF PraosVRF InputVRF
hbVrfRes, VerKeyVRF PraosVRF
hbVrfVk)
  where
    isLeader :: Positive Word64 -> Bool
isLeader Positive Word64
n =
        let slotNo :: SlotNo
slotNo = Word64 -> SlotNo
SlotNo (Word64 -> SlotNo)
-> (Positive Word64 -> Word64) -> Positive Word64 -> SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Positive Word64 -> Word64
forall a. Positive a -> a
getPositive (Positive Word64 -> SlotNo) -> Positive Word64 -> SlotNo
forall a b. (a -> b) -> a -> b
$ Positive Word64
n
            rho' :: InputVRF
rho' = SlotNo -> Nonce -> InputVRF
mkInputVRF SlotNo
slotNo Nonce
nonce
            certified :: CertifiedVRF PraosVRF InputVRF
certified = ContextVRF PraosVRF
-> InputVRF
-> SignKeyVRF PraosVRF
-> CertifiedVRF PraosVRF InputVRF
forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified () InputVRF
rho' SignKeyVRF PraosVRF
vrfSignKey
         in BoundedNatural -> Rational -> ActiveSlotCoeff -> Bool
checkLeaderNatValue (Proxy StandardCrypto
-> CertifiedVRF (VRF StandardCrypto) InputVRF -> BoundedNatural
forall c (proxy :: * -> *).
Crypto c =>
proxy c -> CertifiedVRF (VRF c) InputVRF -> BoundedNatural
vrfLeaderValue (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @StandardCrypto) CertifiedVRF PraosVRF InputVRF
CertifiedVRF (VRF StandardCrypto) InputVRF
certified) Rational
sigma ActiveSlotCoeff
activeSlotCoeff
    sigma :: Rational
sigma = Rational
1
    GeneratorContext{SignKeyVRF PraosVRF
vrfSignKey :: GeneratorContext -> SignKeyVRF PraosVRF
vrfSignKey :: SignKeyVRF PraosVRF
vrfSignKey, Nonce
nonce :: GeneratorContext -> Nonce
nonce :: Nonce
nonce, ActiveSlotCoeff
activeSlotCoeff :: GeneratorContext -> ActiveSlotCoeff
activeSlotCoeff :: ActiveSlotCoeff
activeSlotCoeff} = GeneratorContext
context

protocolVersionZero :: ProtVer
protocolVersionZero :: ProtVer
protocolVersionZero = Version -> Natural -> ProtVer
ProtVer Version
versionZero Natural
0
  where
    versionZero :: Version
    versionZero :: Version
versionZero = forall (v :: Natural).
(KnownNat v, 0 <= v, v <= MaxVersion) =>
Version
natVersion @0

genCert :: SlotNo -> GeneratorContext -> Gen (OCert StandardCrypto, KESPeriod)
genCert :: SlotNo -> GeneratorContext -> Gen (OCert StandardCrypto, KESPeriod)
genCert SlotNo
slotNo GeneratorContext
context = do
    let ocertVkHot :: VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
ocertVkHot = KESKey -> VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
forall v. KESAlgorithm v => SignKeyKES v -> VerKeyKES v
KES.deriveVerKeyKES KESKey
kesSignKey
        poolId :: KeyHash 'BlockIssuer StandardCrypto
poolId = KeyHash Any StandardCrypto -> KeyHash 'BlockIssuer StandardCrypto
forall a b. Coercible a b => a -> b
coerce (KeyHash Any StandardCrypto -> KeyHash 'BlockIssuer StandardCrypto)
-> KeyHash Any StandardCrypto
-> KeyHash 'BlockIssuer StandardCrypto
forall a b. (a -> b) -> a -> b
$ VKey Any StandardCrypto -> KeyHash Any StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey (VKey Any StandardCrypto -> KeyHash Any StandardCrypto)
-> VKey Any StandardCrypto -> KeyHash Any StandardCrypto
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
VKey (VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto)
-> VerKeyDSIGN (DSIGN StandardCrypto) -> VKey Any StandardCrypto
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
coldSignKey
        ocertN :: Word64
ocertN = Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
0 (Maybe Word64 -> Word64) -> Maybe Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ KeyHash 'BlockIssuer StandardCrypto
-> Map (KeyHash 'BlockIssuer StandardCrypto) Word64 -> Maybe Word64
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash 'BlockIssuer StandardCrypto
poolId Map (KeyHash 'BlockIssuer StandardCrypto) Word64
ocertCounters
    KESPeriod
ocertKESPeriod <- SlotNo -> Word64 -> Gen KESPeriod
genValidKESPeriod SlotNo
slotNo Word64
praosSlotsPerKESPeriod
    let ocertSigma :: SignedDSIGN (DSIGN StandardCrypto) (OCertSignable StandardCrypto)
ocertSigma = forall c a.
(Crypto c, Signable (DSIGN c) a) =>
SignKeyDSIGN (DSIGN c) -> a -> SignedDSIGN c a
signedDSIGN @StandardCrypto SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN (DSIGN StandardCrypto)
coldSignKey (VerKeyKES StandardCrypto
-> Word64 -> KESPeriod -> OCertSignable StandardCrypto
forall c. VerKeyKES c -> Word64 -> KESPeriod -> OCertSignable c
OCertSignable VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
VerKeyKES StandardCrypto
ocertVkHot Word64
ocertN KESPeriod
ocertKESPeriod)
    (OCert StandardCrypto, KESPeriod)
-> Gen (OCert StandardCrypto, KESPeriod)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OCert{Word64
SignedDSIGN Ed25519DSIGN (OCertSignable StandardCrypto)
SignedDSIGN (DSIGN StandardCrypto) (OCertSignable StandardCrypto)
VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
VerKeyKES StandardCrypto
KESPeriod
ocertVkHot :: VerKeyKES StandardCrypto
ocertN :: Word64
ocertKESPeriod :: KESPeriod
ocertSigma :: SignedDSIGN (DSIGN StandardCrypto) (OCertSignable StandardCrypto)
ocertVkHot :: VerKeyKES (Sum6KES Ed25519DSIGN Blake2b_256)
ocertN :: Word64
ocertKESPeriod :: KESPeriod
ocertSigma :: SignedDSIGN Ed25519DSIGN (OCertSignable StandardCrypto)
..}, KESPeriod
ocertKESPeriod)
  where
    GeneratorContext{KESKey
kesSignKey :: GeneratorContext -> KESKey
kesSignKey :: KESKey
kesSignKey, Word64
praosSlotsPerKESPeriod :: GeneratorContext -> Word64
praosSlotsPerKESPeriod :: Word64
praosSlotsPerKESPeriod, SignKeyDSIGN Ed25519DSIGN
coldSignKey :: GeneratorContext -> SignKeyDSIGN Ed25519DSIGN
coldSignKey :: SignKeyDSIGN Ed25519DSIGN
coldSignKey, Map (KeyHash 'BlockIssuer StandardCrypto) Word64
ocertCounters :: GeneratorContext
-> Map (KeyHash 'BlockIssuer StandardCrypto) Word64
ocertCounters :: Map (KeyHash 'BlockIssuer StandardCrypto) Word64
ocertCounters} = GeneratorContext
context

genValidKESPeriod :: SlotNo -> Word64 -> Gen KESPeriod
genValidKESPeriod :: SlotNo -> Word64 -> Gen KESPeriod
genValidKESPeriod SlotNo
slotNo Word64
praosSlotsPerKESPeriod =
    KESPeriod -> Gen KESPeriod
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (KESPeriod -> Gen KESPeriod) -> KESPeriod -> Gen KESPeriod
forall a b. (a -> b) -> a -> b
$ Word -> KESPeriod
KESPeriod (Word -> KESPeriod) -> Word -> KESPeriod
forall a b. (a -> b) -> a -> b
$ Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Word64 -> Word
forall a b. (a -> b) -> a -> b
$ SlotNo -> Word64
unSlotNo SlotNo
slotNo Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
praosSlotsPerKESPeriod

genKESPeriodAfterLimit :: SlotNo -> Word64 -> Gen KESPeriod
genKESPeriodAfterLimit :: SlotNo -> Word64 -> Gen KESPeriod
genKESPeriodAfterLimit SlotNo
slotNo Word64
praosSlotsPerKESPeriod =
    Word -> KESPeriod
KESPeriod (Word -> KESPeriod) -> (Word64 -> Word) -> Word64 -> KESPeriod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> KESPeriod) -> Gen Word64 -> Gen KESPeriod
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen Word64 -> (Word64 -> Bool) -> Gen Word64
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
currentKESPeriod)
  where
    currentKESPeriod :: Word64
currentKESPeriod = SlotNo -> Word64
unSlotNo SlotNo
slotNo Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
praosSlotsPerKESPeriod

genSlotAfterKESPeriod :: Word64 -> Word64 -> Word64 -> Gen SlotNo
genSlotAfterKESPeriod :: Word64 -> Word64 -> Word64 -> Gen SlotNo
genSlotAfterKESPeriod Word64
ocertKESPeriod Word64
praosMaxKESEvo Word64
praosSlotsPerKESPeriod = do
    -- kp_ < c0_ +  praosMaxKESEvo
    -- ! =>
    -- kp >=  c0_ +  praosMaxKESEvo
    -- c0 <=  kp -  praosMaxKESEvo
    Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen Word64 -> (Word64 -> Bool) -> Gen Word64
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
threshold)
  where
    threshold :: Word64
threshold = (Word64
ocertKESPeriod Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
praosMaxKESEvo Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
praosSlotsPerKESPeriod

genHash :: Gen (Hash Blake2b_256 a)
genHash :: forall a. Gen (Hash Blake2b_256 a)
genHash = Hash Blake2b_256 ByteString -> Hash Blake2b_256 a
forall a b. Coercible a b => a -> b
coerce (Hash Blake2b_256 ByteString -> Hash Blake2b_256 a)
-> (ByteString -> Hash Blake2b_256 ByteString)
-> ByteString
-> Hash Blake2b_256 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith ByteString -> ByteString
forall a. a -> a
id (ByteString -> Hash Blake2b_256 a)
-> Gen ByteString -> Gen (Hash Blake2b_256 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
gen32Bytes

gen32Bytes :: Gen ByteString
gen32Bytes :: Gen ByteString
gen32Bytes = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary