{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Ledger.Core.KeyPair (
  MakeCredential (..),
  MakeStakeReference (..),
  mkAddr,
  mkScriptAddr,
  mkCred,
  KeyPair (..),
  KeyPairs,
  mkWitnessVKey,
  mkWitnessesVKey,
  makeWitnessesFromScriptKeys,
  mkKeyHashWitFunPair,
  mkVKeyRewardAccount,
  mkKeyPair,
  mkKeyPairWithSeed,
  mkKeyHash,
  ByronKeyPair (..),
  mkBootKeyPairWithSeed,
  genByronVKeyAddr,
  genByronAddrFromVKey,
) where

import qualified Cardano.Chain.Common as Byron
import qualified Cardano.Crypto.DSIGN as DSIGN
import Cardano.Crypto.Hash (hashToBytes)
import qualified Cardano.Crypto.Hash as Hash
import Cardano.Crypto.Seed (mkSeedFromBytes)
import qualified Cardano.Crypto.Signing as Byron (
  SigningKey,
  VerificationKey (..),
  deterministicKeyGen,
 )
import Cardano.Ledger.Address
import Cardano.Ledger.BaseTypes (Network (Testnet))
import Cardano.Ledger.Binary (EncCBOR (encCBOR))
import Cardano.Ledger.Binary.Coders (Encode (..), encode, (!>))
import qualified Cardano.Ledger.Binary.Coders as Coders
import qualified Cardano.Ledger.Binary.Plain as Plain
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (
  Credential (..),
  Ptr,
  StakeReference (..),
 )
import Cardano.Ledger.Keys (
  DSIGN,
  HasKeyRole,
  VKey (..),
  asWitness,
  signedDSIGN,
 )
import Cardano.Ledger.Keys.WitVKey
import Control.DeepSeq (NFData)
import qualified Data.ByteString as BS
import Data.Coerce (coerce)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.TreeDiff as Tree (Expr (..))
import Data.Typeable
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import System.Random.Stateful
import qualified Test.Cardano.Chain.Common.Gen as Byron
import qualified Test.Cardano.Crypto.Gen as Byron
import Test.Cardano.Ledger.Binary.Random (QC (..))
import Test.Cardano.Ledger.Common (ToExpr (..))
import Test.Cardano.Ledger.TreeDiff ()
import Test.QuickCheck
import Test.QuickCheck.Hedgehog (hedgehog)

data KeyPair (kd :: KeyRole) = KeyPair
  { forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey :: !(VKey kd)
  , forall (kd :: KeyRole). KeyPair kd -> SignKeyDSIGN DSIGN
sKey :: !(DSIGN.SignKeyDSIGN DSIGN)
  }
  deriving ((forall x. KeyPair kd -> Rep (KeyPair kd) x)
-> (forall x. Rep (KeyPair kd) x -> KeyPair kd)
-> Generic (KeyPair kd)
forall x. Rep (KeyPair kd) x -> KeyPair kd
forall x. KeyPair kd -> Rep (KeyPair kd) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (kd :: KeyRole) x. Rep (KeyPair kd) x -> KeyPair kd
forall (kd :: KeyRole) x. KeyPair kd -> Rep (KeyPair kd) x
$cfrom :: forall (kd :: KeyRole) x. KeyPair kd -> Rep (KeyPair kd) x
from :: forall x. KeyPair kd -> Rep (KeyPair kd) x
$cto :: forall (kd :: KeyRole) x. Rep (KeyPair kd) x -> KeyPair kd
to :: forall x. Rep (KeyPair kd) x -> KeyPair kd
Generic, Int -> KeyPair kd -> ShowS
[KeyPair kd] -> ShowS
KeyPair kd -> String
(Int -> KeyPair kd -> ShowS)
-> (KeyPair kd -> String)
-> ([KeyPair kd] -> ShowS)
-> Show (KeyPair kd)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (kd :: KeyRole). Int -> KeyPair kd -> ShowS
forall (kd :: KeyRole). [KeyPair kd] -> ShowS
forall (kd :: KeyRole). KeyPair kd -> String
$cshowsPrec :: forall (kd :: KeyRole). Int -> KeyPair kd -> ShowS
showsPrec :: Int -> KeyPair kd -> ShowS
$cshow :: forall (kd :: KeyRole). KeyPair kd -> String
show :: KeyPair kd -> String
$cshowList :: forall (kd :: KeyRole). [KeyPair kd] -> ShowS
showList :: [KeyPair kd] -> ShowS
Show)

-- | Representation of a list of pairs of key pairs, e.g., pay and stake keys
type KeyPairs = [(KeyPair 'Payment, KeyPair 'Staking)]

instance NFData (KeyPair kd)

instance NoThunks (KeyPair kd)

instance HasKeyRole KeyPair

instance Arbitrary (KeyPair kd) where
  arbitrary :: Gen (KeyPair kd)
arbitrary = QC -> Gen (KeyPair kd)
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
forall g (m :: * -> *). StatefulGen g m => g -> m (KeyPair kd)
uniformM QC
QC

instance Uniform (KeyPair kd) where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m (KeyPair kd)
uniformM g
g =
    ByteString -> KeyPair kd
forall (r :: KeyRole). ByteString -> KeyPair r
mkKeyPairWithSeed
      (ByteString -> KeyPair kd) -> m ByteString -> m (KeyPair kd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> g -> m ByteString
forall g (m :: * -> *). StatefulGen g m => Int -> g -> m ByteString
uniformByteStringM (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
DSIGN.seedSizeDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @DSIGN))) g
g

instance Typeable r => EncCBOR (KeyPair r) where
  encCBOR :: KeyPair r -> Encoding
encCBOR (KeyPair VKey r
x SignKeyDSIGN DSIGN
y) = Encode ('Closed 'Dense) (KeyPair r) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode ('Closed 'Dense) (KeyPair r) -> Encoding)
-> Encode ('Closed 'Dense) (KeyPair r) -> Encoding
forall a b. (a -> b) -> a -> b
$ (VKey r -> SignKeyDSIGN DSIGN -> KeyPair r)
-> Encode
     ('Closed 'Dense) (VKey r -> SignKeyDSIGN DSIGN -> KeyPair r)
forall t. t -> Encode ('Closed 'Dense) t
Coders.Rec VKey r -> SignKeyDSIGN DSIGN -> KeyPair r
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair Encode ('Closed 'Dense) (VKey r -> SignKeyDSIGN DSIGN -> KeyPair r)
-> Encode ('Closed 'Dense) (VKey r)
-> Encode ('Closed 'Dense) (SignKeyDSIGN DSIGN -> KeyPair r)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> VKey r -> Encode ('Closed 'Dense) (VKey r)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To VKey r
x Encode ('Closed 'Dense) (SignKeyDSIGN DSIGN -> KeyPair r)
-> Encode ('Closed 'Dense) (SignKeyDSIGN DSIGN)
-> Encode ('Closed 'Dense) (KeyPair r)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> SignKeyDSIGN DSIGN -> Encode ('Closed 'Dense) (SignKeyDSIGN DSIGN)
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To SignKeyDSIGN DSIGN
y

deriving instance Typeable r => Eq (KeyPair r)

instance ToExpr (KeyPair r) where
  toExpr :: KeyPair r -> Expr
toExpr (KeyPair VKey r
x SignKeyDSIGN DSIGN
y) = String -> [Expr] -> Expr
Tree.App String
"KeyPair" [VKey r -> Expr
forall a. ToExpr a => a -> Expr
toExpr VKey r
x, String -> [Expr] -> Expr
Tree.App (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
10 (SignKeyDSIGN DSIGN -> String
forall a. Show a => a -> String
show SignKeyDSIGN DSIGN
y)) []]

class MakeCredential c r where
  mkCredential :: c -> Credential r

instance MakeCredential (Credential r) r where
  mkCredential :: Credential r -> Credential r
mkCredential = Credential r -> Credential r
forall a. a -> a
id

instance MakeCredential (KeyPair r) r where
  mkCredential :: KeyPair r -> Credential r
mkCredential = KeyHash r -> Credential r
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (KeyHash r -> Credential r)
-> (KeyPair r -> KeyHash r) -> KeyPair r -> Credential r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VKey r -> KeyHash r
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey r -> KeyHash r)
-> (KeyPair r -> VKey r) -> KeyPair r -> KeyHash r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair r -> VKey r
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey

instance MakeCredential (KeyHash r) r where
  mkCredential :: KeyHash r -> Credential r
mkCredential = KeyHash r -> Credential r
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj

instance MakeCredential ScriptHash r where
  mkCredential :: ScriptHash -> Credential r
mkCredential = ScriptHash -> Credential r
forall (r :: KeyRole). ScriptHash -> Credential r
ScriptHashObj

class MakeStakeReference c where
  mkStakeRef :: c -> StakeReference
  default mkStakeRef :: MakeCredential c 'Staking => c -> StakeReference
  mkStakeRef = StakeCredential -> StakeReference
StakeRefBase (StakeCredential -> StakeReference)
-> (c -> StakeCredential) -> c -> StakeReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> StakeCredential
forall c (r :: KeyRole). MakeCredential c r => c -> Credential r
mkCredential

instance MakeStakeReference StakeReference where
  mkStakeRef :: StakeReference -> StakeReference
mkStakeRef = StakeReference -> StakeReference
forall a. a -> a
id

instance MakeStakeReference (Credential 'Staking)

instance MakeStakeReference (KeyPair 'Staking)

instance MakeStakeReference (KeyHash 'Staking)

instance MakeStakeReference ScriptHash

instance MakeStakeReference Ptr where
  mkStakeRef :: Ptr -> StakeReference
mkStakeRef = Ptr -> StakeReference
StakeRefPtr

instance MakeStakeReference (Maybe StakeReference) where
  mkStakeRef :: Maybe StakeReference -> StakeReference
mkStakeRef = Maybe StakeReference -> StakeReference
forall c. MakeStakeReference c => Maybe c -> StakeReference
mkStakeRefMaybe

instance MakeStakeReference (Maybe (Credential 'Staking)) where
  mkStakeRef :: Maybe StakeCredential -> StakeReference
mkStakeRef = Maybe StakeCredential -> StakeReference
forall c. MakeStakeReference c => Maybe c -> StakeReference
mkStakeRefMaybe

instance MakeStakeReference (Maybe (KeyPair 'Staking)) where
  mkStakeRef :: Maybe (KeyPair 'Staking) -> StakeReference
mkStakeRef = Maybe (KeyPair 'Staking) -> StakeReference
forall c. MakeStakeReference c => Maybe c -> StakeReference
mkStakeRefMaybe

instance MakeStakeReference (Maybe (KeyHash 'Staking)) where
  mkStakeRef :: Maybe (KeyHash 'Staking) -> StakeReference
mkStakeRef = Maybe (KeyHash 'Staking) -> StakeReference
forall c. MakeStakeReference c => Maybe c -> StakeReference
mkStakeRefMaybe

instance MakeStakeReference (Maybe ScriptHash) where
  mkStakeRef :: Maybe ScriptHash -> StakeReference
mkStakeRef = Maybe ScriptHash -> StakeReference
forall c. MakeStakeReference c => Maybe c -> StakeReference
mkStakeRefMaybe

mkStakeRefMaybe :: MakeStakeReference c => Maybe c -> StakeReference
mkStakeRefMaybe :: forall c. MakeStakeReference c => Maybe c -> StakeReference
mkStakeRefMaybe = \case
  Maybe c
Nothing -> StakeReference
StakeRefNull
  Just c
c -> c -> StakeReference
forall c. MakeStakeReference c => c -> StakeReference
mkStakeRef c
c

-- | Construct a `Testnet` address from payment and staking components
mkAddr :: (MakeCredential p 'Payment, MakeStakeReference s) => p -> s -> Addr
mkAddr :: forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr p
pay s
stake = Network -> PaymentCredential -> StakeReference -> Addr
Addr Network
Testnet (p -> PaymentCredential
forall c (r :: KeyRole). MakeCredential c r => c -> Credential r
mkCredential p
pay) (s -> StakeReference
forall c. MakeStakeReference c => c -> StakeReference
mkStakeRef s
stake)

mkCred :: KeyPair kr -> Credential kr
mkCred :: forall (r :: KeyRole). KeyPair r -> Credential r
mkCred = KeyPair kr -> Credential kr
forall c (r :: KeyRole). MakeCredential c r => c -> Credential r
mkCredential
{-# DEPRECATED mkCred "In favor of `mkCredential`" #-}

mkScriptAddr :: ScriptHash -> KeyPair 'Staking -> Addr
mkScriptAddr :: ScriptHash -> KeyPair 'Staking -> Addr
mkScriptAddr = ScriptHash -> KeyPair 'Staking -> Addr
forall p s.
(MakeCredential p 'Payment, MakeStakeReference s) =>
p -> s -> Addr
mkAddr
{-# DEPRECATED mkScriptAddr "In favor of `mkAddr`" #-}

-- | Create a witness for transaction
mkWitnessVKey ::
  SafeHash EraIndependentTxBody ->
  KeyPair kr ->
  WitVKey 'Witness
mkWitnessVKey :: forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey SafeHash EraIndependentTxBody
safe KeyPair kr
keys =
  VKey 'Witness
-> SignedDSIGN DSIGN (Hash Blake2b_256 EraIndependentTxBody)
-> WitVKey 'Witness
forall (kr :: KeyRole).
VKey kr
-> SignedDSIGN DSIGN (Hash Blake2b_256 EraIndependentTxBody)
-> WitVKey kr
WitVKey (VKey kr -> VKey 'Witness
forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness (VKey kr -> VKey 'Witness) -> VKey kr -> VKey 'Witness
forall a b. (a -> b) -> a -> b
$ KeyPair kr -> VKey kr
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair kr
keys) (SignedDSIGN DSIGN (Hash Blake2b_256 EraIndependentTxBody)
-> SignedDSIGN DSIGN (Hash Blake2b_256 EraIndependentTxBody)
forall a b. Coercible a b => a -> b
coerce (SignedDSIGN DSIGN (Hash Blake2b_256 EraIndependentTxBody)
 -> SignedDSIGN DSIGN (Hash Blake2b_256 EraIndependentTxBody))
-> SignedDSIGN DSIGN (Hash Blake2b_256 EraIndependentTxBody)
-> SignedDSIGN DSIGN (Hash Blake2b_256 EraIndependentTxBody)
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN
-> Hash Blake2b_256 EraIndependentTxBody
-> SignedDSIGN DSIGN (Hash Blake2b_256 EraIndependentTxBody)
forall a.
Signable DSIGN a =>
SignKeyDSIGN DSIGN -> a -> SignedDSIGN DSIGN a
signedDSIGN (KeyPair kr -> SignKeyDSIGN DSIGN
forall (kd :: KeyRole). KeyPair kd -> SignKeyDSIGN DSIGN
sKey KeyPair kr
keys) (SafeHash EraIndependentTxBody
-> Hash Blake2b_256 EraIndependentTxBody
forall i. SafeHash i -> Hash Blake2b_256 i
extractHash SafeHash EraIndependentTxBody
safe))

-- | Create witnesses for transaction
mkWitnessesVKey ::
  SafeHash EraIndependentTxBody ->
  [KeyPair kr] ->
  Set (WitVKey 'Witness)
mkWitnessesVKey :: forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey SafeHash EraIndependentTxBody
safe [KeyPair kr]
xs = [WitVKey 'Witness] -> Set (WitVKey 'Witness)
forall a. Ord a => [a] -> Set a
Set.fromList ((KeyPair kr -> WitVKey 'Witness)
-> [KeyPair kr] -> [WitVKey 'Witness]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey SafeHash EraIndependentTxBody
safe) [KeyPair kr]
xs)

-- | From a list of key pairs and a set of key hashes required for a multi-sig
-- scripts, return the set of required keys.
makeWitnessesFromScriptKeys ::
  SafeHash EraIndependentTxBody ->
  Map (KeyHash kr) (KeyPair kr) ->
  Set (KeyHash kr) ->
  Set (WitVKey 'Witness)
makeWitnessesFromScriptKeys :: forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> Map (KeyHash kr) (KeyPair kr)
-> Set (KeyHash kr)
-> Set (WitVKey 'Witness)
makeWitnessesFromScriptKeys SafeHash EraIndependentTxBody
txbodyHash Map (KeyHash kr) (KeyPair kr)
hashKeyMap Set (KeyHash kr)
scriptHashes =
  let witKeys :: Map (KeyHash kr) (KeyPair kr)
witKeys = Map (KeyHash kr) (KeyPair kr)
-> Set (KeyHash kr) -> Map (KeyHash kr) (KeyPair kr)
forall k a. Ord k => Map k a -> Set k -> Map k a
Map.restrictKeys Map (KeyHash kr) (KeyPair kr)
hashKeyMap Set (KeyHash kr)
scriptHashes
   in SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey SafeHash EraIndependentTxBody
txbodyHash (Map (KeyHash kr) (KeyPair kr) -> [KeyPair kr]
forall k a. Map k a -> [a]
Map.elems Map (KeyHash kr) (KeyPair kr)
witKeys)

-- | When wrting a test which needs a KeyHash, and you will also later need a witness
--   for that function, use 'keyHashWitFunPair'. Since one cannot make a witness until
--   one has SafeHash of the TxBody that the KeyHash is embedded. The second part of the
--   pair is a (SafeHash to WitVKey) function. Use it something like this
--   do (key,witfun) <- keyHashWitFunPair
--      txbody <- ... key ...
--      let safehash = hashAnnotated txbody
--          tx = ... txbody ... (witfun safehash) ...
mkKeyHashWitFunPair ::
  forall kr.
  Gen (KeyHash kr, SafeHash EraIndependentTxBody -> WitVKey 'Witness)
mkKeyHashWitFunPair :: forall (kr :: KeyRole).
Gen (KeyHash kr, SafeHash EraIndependentTxBody -> WitVKey 'Witness)
mkKeyHashWitFunPair = do
  keyPair :: KeyPair kr
keyPair@(KeyPair VKey kr
vk SignKeyDSIGN DSIGN
_) <- forall a. Arbitrary a => Gen a
arbitrary @(KeyPair kr)
  (KeyHash kr, SafeHash EraIndependentTxBody -> WitVKey 'Witness)
-> Gen
     (KeyHash kr, SafeHash EraIndependentTxBody -> WitVKey 'Witness)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VKey kr -> KeyHash kr
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey VKey kr
vk, \SafeHash EraIndependentTxBody
safeHash -> SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey SafeHash EraIndependentTxBody
safeHash KeyPair kr
keyPair)

mkVKeyRewardAccount ::
  Network ->
  KeyPair 'Staking ->
  RewardAccount
mkVKeyRewardAccount :: Network -> KeyPair 'Staking -> RewardAccount
mkVKeyRewardAccount Network
network KeyPair 'Staking
keys = Network -> StakeCredential -> RewardAccount
RewardAccount Network
network (StakeCredential -> RewardAccount)
-> StakeCredential -> RewardAccount
forall a b. (a -> b) -> a -> b
$ KeyHash 'Staking -> StakeCredential
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey 'Staking -> KeyHash 'Staking)
-> VKey 'Staking -> KeyHash 'Staking
forall a b. (a -> b) -> a -> b
$ KeyPair 'Staking -> VKey 'Staking
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Staking
keys)

mkKeyHash :: Int -> KeyHash kd
mkKeyHash :: forall (kd :: KeyRole). Int -> KeyHash kd
mkKeyHash = VKey kd -> KeyHash kd
forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (VKey kd -> KeyHash kd) -> (Int -> VKey kd) -> Int -> KeyHash kd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair kd -> VKey kd
forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey (KeyPair kd -> VKey kd) -> (Int -> KeyPair kd) -> Int -> VKey kd
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> KeyPair kd
forall (r :: KeyRole). Int -> KeyPair r
mkKeyPair

mkKeyPair :: Int -> KeyPair r
mkKeyPair :: forall (r :: KeyRole). Int -> KeyPair r
mkKeyPair = ByteString -> KeyPair r
forall (r :: KeyRole). ByteString -> KeyPair r
mkKeyPairWithSeed (ByteString -> KeyPair r)
-> (Int -> ByteString) -> Int -> KeyPair r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString
forall a. ToCBOR a => a -> ByteString
Plain.serialize'

mkKeyPairWithSeed :: BS.ByteString -> KeyPair r
mkKeyPairWithSeed :: forall (r :: KeyRole). ByteString -> KeyPair r
mkKeyPairWithSeed ByteString
inputSeed = VKey r -> SignKeyDSIGN DSIGN -> KeyPair r
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey r
vk SignKeyDSIGN DSIGN
sk
  where
    vk :: VKey r
vk = VerKeyDSIGN DSIGN -> VKey r
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
VKey (SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
DSIGN.deriveVerKeyDSIGN SignKeyDSIGN DSIGN
sk)
    sk :: SignKeyDSIGN DSIGN
sk = Seed -> SignKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
DSIGN.genKeyDSIGN (Seed -> SignKeyDSIGN DSIGN) -> Seed -> SignKeyDSIGN DSIGN
forall a b. (a -> b) -> a -> b
$ ByteString -> Seed
mkSeedFromBytes (ByteString -> Seed) -> ByteString -> Seed
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
ensure32ByteSeed ByteString
inputSeed

data ByronKeyPair = ByronKeyPair
  { ByronKeyPair -> VerificationKey
bkpVerificationKey :: !Byron.VerificationKey
  , ByronKeyPair -> SigningKey
bkpSigningKey :: !Byron.SigningKey
  }
  deriving ((forall x. ByronKeyPair -> Rep ByronKeyPair x)
-> (forall x. Rep ByronKeyPair x -> ByronKeyPair)
-> Generic ByronKeyPair
forall x. Rep ByronKeyPair x -> ByronKeyPair
forall x. ByronKeyPair -> Rep ByronKeyPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ByronKeyPair -> Rep ByronKeyPair x
from :: forall x. ByronKeyPair -> Rep ByronKeyPair x
$cto :: forall x. Rep ByronKeyPair x -> ByronKeyPair
to :: forall x. Rep ByronKeyPair x -> ByronKeyPair
Generic, Int -> ByronKeyPair -> ShowS
[ByronKeyPair] -> ShowS
ByronKeyPair -> String
(Int -> ByronKeyPair -> ShowS)
-> (ByronKeyPair -> String)
-> ([ByronKeyPair] -> ShowS)
-> Show ByronKeyPair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronKeyPair -> ShowS
showsPrec :: Int -> ByronKeyPair -> ShowS
$cshow :: ByronKeyPair -> String
show :: ByronKeyPair -> String
$cshowList :: [ByronKeyPair] -> ShowS
showList :: [ByronKeyPair] -> ShowS
Show)

instance Arbitrary ByronKeyPair where
  arbitrary :: Gen ByronKeyPair
arbitrary = QC -> Gen ByronKeyPair
forall a g (m :: * -> *). (Uniform a, StatefulGen g m) => g -> m a
forall g (m :: * -> *). StatefulGen g m => g -> m ByronKeyPair
uniformM QC
QC

instance Uniform ByronKeyPair where
  uniformM :: forall g (m :: * -> *). StatefulGen g m => g -> m ByronKeyPair
uniformM g
g = ByteString -> ByronKeyPair
mkBootKeyPairWithSeed (ByteString -> ByronKeyPair) -> m ByteString -> m ByronKeyPair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> g -> m ByteString
forall g (m :: * -> *). StatefulGen g m => Int -> g -> m ByteString
uniformByteStringM Int
32 g
g

mkBootKeyPairWithSeed :: BS.ByteString -> ByronKeyPair
mkBootKeyPairWithSeed :: ByteString -> ByronKeyPair
mkBootKeyPairWithSeed = (VerificationKey -> SigningKey -> ByronKeyPair)
-> (VerificationKey, SigningKey) -> ByronKeyPair
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry VerificationKey -> SigningKey -> ByronKeyPair
ByronKeyPair ((VerificationKey, SigningKey) -> ByronKeyPair)
-> (ByteString -> (VerificationKey, SigningKey))
-> ByteString
-> ByronKeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (VerificationKey, SigningKey)
Byron.deterministicKeyGen (ByteString -> (VerificationKey, SigningKey))
-> (ByteString -> ByteString)
-> ByteString
-> (VerificationKey, SigningKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ensure32ByteSeed

ensure32ByteSeed :: BS.ByteString -> BS.ByteString
ensure32ByteSeed :: ByteString -> ByteString
ensure32ByteSeed ByteString
inputSeed
  | ByteString -> Int
BS.length ByteString
inputSeed Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
seedSize =
      Hash Blake2b_256 ByteString -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash Blake2b_256 ByteString -> ByteString)
-> Hash Blake2b_256 ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith @Hash.Blake2b_256 ByteString -> ByteString
forall a. a -> a
id ByteString
inputSeed
  | Bool
otherwise = ByteString
inputSeed
  where
    seedSize :: Int
seedSize = Int
32

genByronVKeyAddr :: Gen (Byron.VerificationKey, Byron.Address)
genByronVKeyAddr :: Gen (VerificationKey, Address)
genByronVKeyAddr = do
  VerificationKey
vkey <- Gen VerificationKey -> Gen VerificationKey
forall a. Gen a -> Gen a
hedgehog Gen VerificationKey
Byron.genVerificationKey
  Address
addr <- VerificationKey -> Gen Address
genByronAddrFromVKey VerificationKey
vkey
  (VerificationKey, Address) -> Gen (VerificationKey, Address)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VerificationKey
vkey, Address
addr)

genByronAddrFromVKey :: Byron.VerificationKey -> Gen Byron.Address
genByronAddrFromVKey :: VerificationKey -> Gen Address
genByronAddrFromVKey VerificationKey
vkey =
  AddrSpendingData -> AddrAttributes -> Address
Byron.makeAddress (VerificationKey -> AddrSpendingData
Byron.VerKeyASD VerificationKey
vkey) (AddrAttributes -> Address) -> Gen AddrAttributes -> Gen Address
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AddrAttributes -> Gen AddrAttributes
forall a. Gen a -> Gen a
hedgehog Gen AddrAttributes
Byron.genAddrAttributes