{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Protocol.TPraos.Examples (
  ledgerExamplesShelley,
  ledgerExamplesAllegra,
  ledgerExamplesMary,
  ledgerExamplesAlonzo,
  ledgerExamplesTPraos,
  mkProtocolLedgerExamples,
  ProtocolLedgerExamples (..),
  LedgerExamples (..),
) where

import Cardano.Crypto.Hash as Hash
import Cardano.Crypto.KES as KES
import qualified Cardano.Crypto.VRF as VRF
import Cardano.Ledger.Allegra (AllegraEra)
import Cardano.Ledger.Alonzo (AlonzoEra)
import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Block (Block (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Keys (coerceKeyRole)
import Cardano.Ledger.Mary (MaryEra)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.State (EraGov, InstantStake)
import Cardano.Protocol.Crypto (Crypto, StandardCrypto, VRF)
import Cardano.Protocol.TPraos.API
import Cardano.Protocol.TPraos.BHeader
import Cardano.Protocol.TPraos.OCert
import Cardano.Protocol.TPraos.Rules.Prtcl
import Cardano.Protocol.TPraos.Rules.Tickn
import Data.Coerce (Coercible, coerce)
import Data.Functor.Identity (Identity)
import qualified Data.List.NonEmpty as NE
import qualified Data.Map.Strict as Map
import Data.Proxy
import qualified Data.Sequence.Strict as StrictSeq
import Data.Word (Word64, Word8)
import Lens.Micro
import qualified Test.Cardano.Ledger.Allegra.Examples as Allegra (ledgerExamples)
import qualified Test.Cardano.Ledger.Alonzo.Examples as Alonzo (ledgerExamples)
import Test.Cardano.Ledger.Binary.Random (mkDummyHash)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
import qualified Test.Cardano.Ledger.Mary.Examples as Mary (ledgerExamples)
import Test.Cardano.Ledger.Shelley.Arbitrary (RawSeed (..))
import Test.Cardano.Ledger.Shelley.Examples (
  LedgerExamples (..),
  mkDSIGNKeyPair,
  mkKeyHash,
  seedFromByte,
  seedFromWords,
 )
import qualified Test.Cardano.Ledger.Shelley.Examples as Shelley (ledgerExamples)
import Test.Cardano.Protocol.TPraos.Create (
  AllIssuerKeys (..),
  KESKeyPair (..),
  VRFKeyPair (..),
  kesSignKey,
  mkOCert,
 )

data ProtocolLedgerExamples bh era = ProtocolLedgerExamples
  { forall bh era. ProtocolLedgerExamples bh era -> HashHeader
pleHashHeader :: HashHeader
  , forall bh era. ProtocolLedgerExamples bh era -> bh
pleBlockHeader :: bh
  , forall bh era. ProtocolLedgerExamples bh era -> ChainDepState
pleChainDepState :: ChainDepState
  , forall bh era. ProtocolLedgerExamples bh era -> LedgerExamples era
pleLedgerExamples :: LedgerExamples era
  , forall bh era. ProtocolLedgerExamples bh era -> Block bh era
pleBlock :: Block bh era
  }

deriving instance
  ( EraTx era
  , Eq bh
  , Eq (PParamsHKD Identity era)
  , Eq (PParamsHKD StrictMaybe era)
  , EraGov era
  , Eq (BlockBody era)
  , Eq (PredicateFailure (EraRule "LEDGER" era))
  , Eq (StashedAVVMAddresses era)
  , Eq (TranslationContext era)
  , Eq (CertState era)
  , Eq (InstantStake era)
  ) =>
  Eq (ProtocolLedgerExamples bh era)

ledgerExamplesShelley :: ProtocolLedgerExamples (BHeader StandardCrypto) ShelleyEra
ledgerExamplesShelley :: ProtocolLedgerExamples (BHeader StandardCrypto) ShelleyEra
ledgerExamplesShelley = LedgerExamples ShelleyEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) ShelleyEra
forall era.
EraBlockBody era =>
LedgerExamples era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
ledgerExamplesTPraos LedgerExamples ShelleyEra
Shelley.ledgerExamples

ledgerExamplesAllegra :: ProtocolLedgerExamples (BHeader StandardCrypto) AllegraEra
ledgerExamplesAllegra :: ProtocolLedgerExamples (BHeader StandardCrypto) AllegraEra
ledgerExamplesAllegra = LedgerExamples AllegraEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) AllegraEra
forall era.
EraBlockBody era =>
LedgerExamples era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
ledgerExamplesTPraos LedgerExamples AllegraEra
Allegra.ledgerExamples

ledgerExamplesMary :: ProtocolLedgerExamples (BHeader StandardCrypto) MaryEra
ledgerExamplesMary :: ProtocolLedgerExamples (BHeader StandardCrypto) MaryEra
ledgerExamplesMary = LedgerExamples MaryEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) MaryEra
forall era.
EraBlockBody era =>
LedgerExamples era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
ledgerExamplesTPraos LedgerExamples MaryEra
Mary.ledgerExamples

ledgerExamplesAlonzo :: ProtocolLedgerExamples (BHeader StandardCrypto) AlonzoEra
ledgerExamplesAlonzo :: ProtocolLedgerExamples (BHeader StandardCrypto) AlonzoEra
ledgerExamplesAlonzo = LedgerExamples AlonzoEra
-> ProtocolLedgerExamples (BHeader StandardCrypto) AlonzoEra
forall era.
EraBlockBody era =>
LedgerExamples era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
ledgerExamplesTPraos LedgerExamples AlonzoEra
Alonzo.ledgerExamples

ledgerExamplesTPraos ::
  forall era.
  EraBlockBody era =>
  LedgerExamples era ->
  ProtocolLedgerExamples (BHeader StandardCrypto) era
ledgerExamplesTPraos :: forall era.
EraBlockBody era =>
LedgerExamples era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
ledgerExamplesTPraos =
  HashHeader
-> (Hash HASH EraIndependentBlockBody -> BHeader StandardCrypto)
-> ChainDepState
-> LedgerExamples era
-> ProtocolLedgerExamples (BHeader StandardCrypto) era
forall era bh.
EraBlockBody era =>
HashHeader
-> (Hash HASH EraIndependentBlockBody -> bh)
-> ChainDepState
-> LedgerExamples era
-> ProtocolLedgerExamples bh era
mkProtocolLedgerExamples
    HashHeader
exampleHashHeader
    (forall era.
EraBlockBody era =>
Hash HASH EraIndependentBlockBody -> BHeader StandardCrypto
exampleBlockHeader @era)
    (Word64 -> ChainDepState
exampleChainDepState Word64
1)

exampleHashHeader :: HashHeader
exampleHashHeader :: HashHeader
exampleHashHeader = Hash HASH Any -> HashHeader
forall a b. Coercible a b => a -> b
coerce (Hash HASH Any -> HashHeader) -> Hash HASH Any -> HashHeader
forall a b. (a -> b) -> a -> b
$ forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @HASH (Int
0 :: Int)

exampleBlockHeader ::
  forall era.
  EraBlockBody era =>
  Hash HASH EraIndependentBlockBody ->
  BHeader StandardCrypto
exampleBlockHeader :: forall era.
EraBlockBody era =>
Hash HASH EraIndependentBlockBody -> BHeader StandardCrypto
exampleBlockHeader Hash HASH EraIndependentBlockBody
blockBodyHash = BHBody StandardCrypto
-> SignedKES (KES StandardCrypto) (BHBody StandardCrypto)
-> BHeader StandardCrypto
forall c.
Crypto c =>
BHBody c -> SignedKES (KES c) (BHBody c) -> BHeader c
BHeader BHBody StandardCrypto
blockHeaderBody (ContextKES (Sum6KES Ed25519DSIGN HASH)
-> Period
-> BHBody StandardCrypto
-> UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN HASH)
-> SignedKES (Sum6KES Ed25519DSIGN HASH) (BHBody StandardCrypto)
forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v
-> Period -> a -> UnsoundPureSignKeyKES v -> SignedKES v a
unsoundPureSignedKES () Period
0 BHBody StandardCrypto
blockHeaderBody UnsoundPureSignKeyKES (Sum6KES Ed25519DSIGN HASH)
hotKey)
  where
    hotKey :: UnsoundPureSignKeyKES (KES StandardCrypto)
hotKey = KESKeyPair StandardCrypto
-> UnsoundPureSignKeyKES (KES StandardCrypto)
forall c. KESKeyPair c -> UnsoundPureSignKeyKES (KES c)
kesSignKey (KESKeyPair StandardCrypto
 -> UnsoundPureSignKeyKES (KES StandardCrypto))
-> KESKeyPair StandardCrypto
-> UnsoundPureSignKeyKES (KES StandardCrypto)
forall a b. (a -> b) -> a -> b
$ (KESPeriod, KESKeyPair StandardCrypto) -> KESKeyPair StandardCrypto
forall a b. (a, b) -> b
snd ((KESPeriod, KESKeyPair StandardCrypto)
 -> KESKeyPair StandardCrypto)
-> (KESPeriod, KESKeyPair StandardCrypto)
-> KESKeyPair StandardCrypto
forall a b. (a -> b) -> a -> b
$ NonEmpty (KESPeriod, KESKeyPair StandardCrypto)
-> (KESPeriod, KESKeyPair StandardCrypto)
forall a. NonEmpty a -> a
NE.head (NonEmpty (KESPeriod, KESKeyPair StandardCrypto)
 -> (KESPeriod, KESKeyPair StandardCrypto))
-> NonEmpty (KESPeriod, KESKeyPair StandardCrypto)
-> (KESPeriod, KESKeyPair StandardCrypto)
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys StandardCrypto Any
-> NonEmpty (KESPeriod, KESKeyPair StandardCrypto)
forall c (r :: KeyRole).
AllIssuerKeys c r -> NonEmpty (KESPeriod, KESKeyPair c)
aikHot AllIssuerKeys StandardCrypto Any
forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys
    KeyPair VKey r
vKeyCold SignKeyDSIGN Ed25519DSIGN
_ = AllIssuerKeys StandardCrypto r -> KeyPair r
forall c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys StandardCrypto r
forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys

    blockHeaderBody :: BHBody StandardCrypto
    blockHeaderBody :: BHBody StandardCrypto
blockHeaderBody =
      BHBody
        { bheaderBlockNo :: BlockNo
bheaderBlockNo = Word64 -> BlockNo
BlockNo Word64
3
        , bheaderSlotNo :: SlotNo
bheaderSlotNo = Word64 -> SlotNo
SlotNo Word64
9
        , bheaderPrev :: PrevHash
bheaderPrev = HashHeader -> PrevHash
BlockHash (Hash HASH EraIndependentBlockHeader -> HashHeader
HashHeader (Int -> Hash HASH EraIndependentBlockHeader
forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash (Int
2 :: Int)))
        , bheaderVk :: VKey 'BlockIssuer
bheaderVk = VKey Any -> VKey 'BlockIssuer
forall (r :: KeyRole) (r' :: KeyRole). VKey r -> VKey r'
forall (a :: KeyRole -> *) (r :: KeyRole) (r' :: KeyRole).
HasKeyRole a =>
a r -> a r'
coerceKeyRole VKey Any
forall {r :: KeyRole}. VKey r
vKeyCold
        , bheaderVrfVk :: VerKeyVRF (VRF StandardCrypto)
bheaderVrfVk = VRFKeyPair StandardCrypto -> VerKeyVRF (VRF StandardCrypto)
forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey (VRFKeyPair StandardCrypto -> VerKeyVRF (VRF StandardCrypto))
-> VRFKeyPair StandardCrypto -> VerKeyVRF (VRF StandardCrypto)
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys StandardCrypto Any -> VRFKeyPair StandardCrypto
forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys StandardCrypto Any
forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys
        , bheaderEta :: CertifiedVRF (VRF StandardCrypto) Nonce
bheaderEta = Seed -> SignKeyVRF PraosVRF -> CertifiedVRF PraosVRF Nonce
forall v a b.
(Signable v a, VRFAlgorithm v, ContextVRF v ~ (),
 Coercible b (CertifiedVRF v a)) =>
a -> SignKeyVRF v -> b
mkCertifiedVRF (Int -> Seed
mkBytes Int
0) (VRFKeyPair StandardCrypto -> SignKeyVRF (VRF StandardCrypto)
forall c. VRFKeyPair c -> SignKeyVRF (VRF c)
vrfSignKey (VRFKeyPair StandardCrypto -> SignKeyVRF (VRF StandardCrypto))
-> VRFKeyPair StandardCrypto -> SignKeyVRF (VRF StandardCrypto)
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys StandardCrypto Any -> VRFKeyPair StandardCrypto
forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys StandardCrypto Any
forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys)
        , bheaderL :: CertifiedVRF (VRF StandardCrypto) Natural
bheaderL = Seed -> SignKeyVRF PraosVRF -> CertifiedVRF PraosVRF Natural
forall v a b.
(Signable v a, VRFAlgorithm v, ContextVRF v ~ (),
 Coercible b (CertifiedVRF v a)) =>
a -> SignKeyVRF v -> b
mkCertifiedVRF (Int -> Seed
mkBytes Int
1) (VRFKeyPair StandardCrypto -> SignKeyVRF (VRF StandardCrypto)
forall c. VRFKeyPair c -> SignKeyVRF (VRF c)
vrfSignKey (VRFKeyPair StandardCrypto -> SignKeyVRF (VRF StandardCrypto))
-> VRFKeyPair StandardCrypto -> SignKeyVRF (VRF StandardCrypto)
forall a b. (a -> b) -> a -> b
$ AllIssuerKeys StandardCrypto Any -> VRFKeyPair StandardCrypto
forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys StandardCrypto Any
forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys)
        , bsize :: Word32
bsize = Word32
2345
        , bhash :: Hash HASH EraIndependentBlockBody
bhash = Hash HASH EraIndependentBlockBody
blockBodyHash
        , bheaderOCert :: OCert StandardCrypto
bheaderOCert = AllIssuerKeys StandardCrypto Any
-> Word64 -> KESPeriod -> OCert StandardCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert AllIssuerKeys StandardCrypto Any
forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys Word64
0 (Period -> KESPeriod
KESPeriod Period
0)
        , bprotver :: ProtVer
bprotver = Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural).
(KnownNat v, MinVersion <= v, v <= MaxVersion) =>
Version
natVersion @2) Natural
0
        }
    mkBytes :: Int -> Cardano.Ledger.BaseTypes.Seed
    mkBytes :: Int -> Seed
mkBytes = Hash HASH Seed -> Seed
Seed (Hash HASH Seed -> Seed) -> (Int -> Hash HASH Seed) -> Int -> Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @Blake2b_256

exampleChainDepState :: Word64 -> ChainDepState
exampleChainDepState :: Word64 -> ChainDepState
exampleChainDepState Word64
seed =
  ChainDepState
    { csProtocol :: PrtclState
csProtocol =
        Map (KeyHash 'BlockIssuer) Word64 -> Nonce -> Nonce -> PrtclState
PrtclState
          ( [(KeyHash 'BlockIssuer, Word64)]
-> Map (KeyHash 'BlockIssuer) Word64
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
              [ (Int -> KeyHash 'BlockIssuer
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
1, Word64
1)
              , (Int -> KeyHash 'BlockIssuer
forall (discriminator :: KeyRole). Int -> KeyHash discriminator
mkKeyHash Int
2, Word64
2)
              ]
          )
          (Word64 -> Nonce
mkNonceFromNumber Word64
seed)
          (Word64 -> Nonce
mkNonceFromNumber Word64
seed)
    , csTickn :: TicknState
csTickn =
        Nonce -> Nonce -> TicknState
TicknState
          Nonce
NeutralNonce
          (Word64 -> Nonce
mkNonceFromNumber Word64
seed)
    , csLabNonce :: Nonce
csLabNonce =
        Word64 -> Nonce
mkNonceFromNumber Word64
seed
    }

exampleKeys :: AllIssuerKeys StandardCrypto r
exampleKeys :: forall (r :: KeyRole). AllIssuerKeys StandardCrypto r
exampleKeys =
  KeyPair r
-> VRFKeyPair StandardCrypto
-> NonEmpty (KESPeriod, KESKeyPair StandardCrypto)
-> KeyHash r
-> AllIssuerKeys StandardCrypto r
forall c (r :: KeyRole).
KeyPair r
-> VRFKeyPair c
-> NonEmpty (KESPeriod, KESKeyPair c)
-> KeyHash r
-> AllIssuerKeys c r
AllIssuerKeys
    KeyPair r
forall {kd :: KeyRole}. KeyPair kd
coldKey
    (Proxy StandardCrypto -> Word8 -> VRFKeyPair StandardCrypto
forall c. Crypto c => Proxy c -> Word8 -> VRFKeyPair c
mkVRFKeyPair (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @StandardCrypto) Word8
1)
    ((Period -> KESPeriod
KESPeriod Period
0, RawSeed -> KESKeyPair StandardCrypto
forall c. Crypto c => RawSeed -> KESKeyPair c
mkKESKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
0 Word64
0 Word64
0 Word64
3)) (KESPeriod, KESKeyPair StandardCrypto)
-> [(KESPeriod, KESKeyPair StandardCrypto)]
-> NonEmpty (KESPeriod, KESKeyPair StandardCrypto)
forall a. a -> [a] -> NonEmpty a
NE.:| [])
    (VKey r -> KeyHash r
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (KeyPair r -> VKey r
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair r
forall {kd :: KeyRole}. KeyPair kd
coldKey))
  where
    coldKey :: KeyPair kd
coldKey = Word8 -> KeyPair kd
forall (kd :: KeyRole). Word8 -> KeyPair kd
mkDSIGNKeyPair Word8
1

mkProtocolLedgerExamples ::
  EraBlockBody era =>
  HashHeader ->
  (Hash HASH EraIndependentBlockBody -> bh) ->
  ChainDepState ->
  LedgerExamples era ->
  ProtocolLedgerExamples bh era
mkProtocolLedgerExamples :: forall era bh.
EraBlockBody era =>
HashHeader
-> (Hash HASH EraIndependentBlockBody -> bh)
-> ChainDepState
-> LedgerExamples era
-> ProtocolLedgerExamples bh era
mkProtocolLedgerExamples HashHeader
pleHashHeader Hash HASH EraIndependentBlockBody -> bh
toBlockHeader ChainDepState
pleChainDepState LedgerExamples era
pleLedgerExamples =
  ProtocolLedgerExamples {bh
HashHeader
Block bh era
LedgerExamples era
ChainDepState
pleHashHeader :: HashHeader
pleBlockHeader :: bh
pleChainDepState :: ChainDepState
pleLedgerExamples :: LedgerExamples era
pleBlock :: Block bh era
pleHashHeader :: HashHeader
pleChainDepState :: ChainDepState
pleLedgerExamples :: LedgerExamples era
pleBlockHeader :: bh
pleBlock :: Block bh era
..}
  where
    pleBlockHeader :: bh
pleBlockHeader = Hash HASH EraIndependentBlockBody -> bh
toBlockHeader Hash HASH EraIndependentBlockBody
blockBodyHash
    pleBlock :: Block bh era
pleBlock = bh -> BlockBody era -> Block bh era
forall h era. h -> BlockBody era -> Block h era
Block bh
pleBlockHeader BlockBody era
blockBody
    blockBody :: BlockBody era
blockBody = BlockBody era
forall era. EraBlockBody era => BlockBody era
mkBasicBlockBody BlockBody era -> (BlockBody era -> BlockBody era) -> BlockBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (Tx era) -> Identity (StrictSeq (Tx era)))
-> BlockBody era -> Identity (BlockBody era)
forall era.
EraBlockBody era =>
Lens' (BlockBody era) (StrictSeq (Tx era))
Lens' (BlockBody era) (StrictSeq (Tx era))
txSeqBlockBodyL ((StrictSeq (Tx era) -> Identity (StrictSeq (Tx era)))
 -> BlockBody era -> Identity (BlockBody era))
-> StrictSeq (Tx era) -> BlockBody era -> BlockBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Tx era] -> StrictSeq (Tx era)
forall a. [a] -> StrictSeq a
StrictSeq.fromList [Tx era]
txs
    blockBodyHash :: Hash HASH EraIndependentBlockBody
blockBodyHash = BlockBody era -> Hash HASH EraIndependentBlockBody
forall era.
EraBlockBody era =>
BlockBody era -> Hash HASH EraIndependentBlockBody
hashBlockBody BlockBody era
blockBody
    txs :: [Tx era]
txs = [LedgerExamples era -> Tx era
forall era. LedgerExamples era -> Tx era
leTx LedgerExamples era
pleLedgerExamples]

mkVRFKeyPair ::
  forall c.
  Crypto c =>
  Proxy c ->
  Word8 ->
  VRFKeyPair c
mkVRFKeyPair :: forall c. Crypto c => Proxy c -> Word8 -> VRFKeyPair c
mkVRFKeyPair Proxy c
_ Word8
byte = SignKeyVRF (VRF c) -> VerKeyVRF (VRF c) -> VRFKeyPair c
forall c. SignKeyVRF (VRF c) -> VerKeyVRF (VRF c) -> VRFKeyPair c
VRFKeyPair SignKeyVRF (VRF c)
sk (SignKeyVRF (VRF c) -> VerKeyVRF (VRF c)
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
VRF.deriveVerKeyVRF SignKeyVRF (VRF c)
sk)
  where
    sk :: SignKeyVRF (VRF c)
sk = Seed -> SignKeyVRF (VRF c)
forall v. VRFAlgorithm v => Seed -> SignKeyVRF v
VRF.genKeyVRF (Seed -> SignKeyVRF (VRF c)) -> Seed -> SignKeyVRF (VRF c)
forall a b. (a -> b) -> a -> b
$ Word8 -> Int -> Seed
seedFromByte Word8
byte Int
size
    size :: Int
size = Period -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Period -> Int) -> Period -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (VRF c) -> Period
forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Period
forall (proxy :: * -> *). proxy (VRF c) -> Period
VRF.seedSizeVRF (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(VRF c))

mkKESKeyPair :: Crypto c => RawSeed -> KESKeyPair c
mkKESKeyPair :: forall c. Crypto c => RawSeed -> KESKeyPair c
mkKESKeyPair RawSeed
seed =
  let sk :: UnsoundPureSignKeyKES (KES c)
sk = Seed -> UnsoundPureSignKeyKES (KES c)
forall v.
UnsoundPureKESAlgorithm v =>
Seed -> UnsoundPureSignKeyKES v
unsoundPureGenKeyKES (RawSeed -> Seed
seedFromWords RawSeed
seed)
      vk :: VerKeyKES (KES c)
vk = UnsoundPureSignKeyKES (KES c) -> VerKeyKES (KES c)
forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> VerKeyKES v
unsoundPureDeriveVerKeyKES UnsoundPureSignKeyKES (KES c)
sk
   in KESKeyPair
        { kesSignKey :: UnsoundPureSignKeyKES (KES c)
kesSignKey = UnsoundPureSignKeyKES (KES c)
sk
        , kesVerKey :: VerKeyKES (KES c)
kesVerKey = VerKeyKES (KES c)
vk
        }

mkCertifiedVRF ::
  ( VRF.Signable v a
  , VRF.VRFAlgorithm v
  , VRF.ContextVRF v ~ ()
  , Coercible b (VRF.CertifiedVRF v a)
  ) =>
  a ->
  VRF.SignKeyVRF v ->
  b
mkCertifiedVRF :: forall v a b.
(Signable v a, VRFAlgorithm v, ContextVRF v ~ (),
 Coercible b (CertifiedVRF v a)) =>
a -> SignKeyVRF v -> b
mkCertifiedVRF a
a SignKeyVRF v
sk =
  CertifiedVRF v a -> b
forall a b. Coercible a b => a -> b
coerce (CertifiedVRF v a -> b) -> CertifiedVRF v a -> b
forall a b. (a -> b) -> a -> b
$ ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
forall v a.
(VRFAlgorithm v, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> CertifiedVRF v a
VRF.evalCertified () a
a SignKeyVRF v
sk