{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- The Shelley ledger uses promoted data kinds which we have to use, but we do
-- not export any from this API. We also use them unticked as nature intended.
{-# LANGUAGE DataKinds #-}

-- DUPLICATE -- adapted from: cardano-api/src/Cardano/Api/KeysShelley.hs

-- | Shelley key types and their 'Key' class instances
--
module Cardano.Api.KeysShelley (
    -- * Key types
    GenesisDelegateExtendedKey
  , GenesisDelegateKey
  , GenesisExtendedKey
  , GenesisKey
  , GenesisUTxOKey
  , PaymentExtendedKey
  , PaymentKey
  , StakeExtendedKey
  , StakeKey
  , StakePoolKey
    -- * Data family instances
  , AsType (..)
  , Hash (..)
  , SigningKey (..)
  , VerificationKey (..)
  ) where

import           Cardano.Api.Any
import           Cardano.Api.Key
import           Cardano.Api.SerialiseTextEnvelope
import           Cardano.Api.SerialiseUsing
import qualified Cardano.Crypto.DSIGN.Class as Crypto
import qualified Cardano.Crypto.Hash.Class as Crypto
import qualified Cardano.Crypto.Seed as Crypto
import qualified Cardano.Crypto.Wallet as Crypto.HD
import           Cardano.Ledger.Crypto (StandardCrypto)
import qualified Cardano.Ledger.Crypto as Shelley (DSIGN)
import qualified Cardano.Ledger.Keys as Shelley
import           Data.Aeson.Types (FromJSON (..), ToJSON (..), ToJSONKey (..),
                     toJSONKeyText, withText)
import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import           Data.Maybe
import           Data.String (IsString (..))
import qualified Data.Text as Text

--
-- Shelley payment keys
--

-- | Shelley-era payment keys. Used for Shelley payment addresses and witnessing
-- transactions that spend from these addresses.
--
-- This is a type level tag, used with other interfaces like 'Key'.
--
data PaymentKey

instance HasTypeProxy PaymentKey where
    data AsType PaymentKey = AsPaymentKey
    proxyToAsType :: Proxy PaymentKey -> AsType PaymentKey
proxyToAsType Proxy PaymentKey
_ = AsType PaymentKey
AsPaymentKey

instance Key PaymentKey where

    newtype VerificationKey PaymentKey =
        PaymentVerificationKey (Shelley.VKey Shelley.Payment StandardCrypto)
      deriving stock (VerificationKey PaymentKey -> VerificationKey PaymentKey -> Bool
(VerificationKey PaymentKey -> VerificationKey PaymentKey -> Bool)
-> (VerificationKey PaymentKey
    -> VerificationKey PaymentKey -> Bool)
-> Eq (VerificationKey PaymentKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey PaymentKey -> VerificationKey PaymentKey -> Bool
== :: VerificationKey PaymentKey -> VerificationKey PaymentKey -> Bool
$c/= :: VerificationKey PaymentKey -> VerificationKey PaymentKey -> Bool
/= :: VerificationKey PaymentKey -> VerificationKey PaymentKey -> Bool
Eq)
      deriving (Int -> VerificationKey PaymentKey -> ShowS
[VerificationKey PaymentKey] -> ShowS
VerificationKey PaymentKey -> String
(Int -> VerificationKey PaymentKey -> ShowS)
-> (VerificationKey PaymentKey -> String)
-> ([VerificationKey PaymentKey] -> ShowS)
-> Show (VerificationKey PaymentKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey PaymentKey -> ShowS
showsPrec :: Int -> VerificationKey PaymentKey -> ShowS
$cshow :: VerificationKey PaymentKey -> String
show :: VerificationKey PaymentKey -> String
$cshowList :: [VerificationKey PaymentKey] -> ShowS
showList :: [VerificationKey PaymentKey] -> ShowS
Show, String -> VerificationKey PaymentKey
(String -> VerificationKey PaymentKey)
-> IsString (VerificationKey PaymentKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey PaymentKey
fromString :: String -> VerificationKey PaymentKey
IsString) via UsingRawBytesHex (VerificationKey PaymentKey)
      deriving newtype (Typeable (VerificationKey PaymentKey)
Typeable (VerificationKey PaymentKey) =>
(VerificationKey PaymentKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey PaymentKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey PaymentKey] -> Size)
-> ToCBOR (VerificationKey PaymentKey)
VerificationKey PaymentKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey PaymentKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey PaymentKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: VerificationKey PaymentKey -> Encoding
toCBOR :: VerificationKey PaymentKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey PaymentKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey PaymentKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey PaymentKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey PaymentKey] -> Size
ToCBOR, Typeable (VerificationKey PaymentKey)
Typeable (VerificationKey PaymentKey) =>
(forall s. Decoder s (VerificationKey PaymentKey))
-> (Proxy (VerificationKey PaymentKey) -> Text)
-> FromCBOR (VerificationKey PaymentKey)
Proxy (VerificationKey PaymentKey) -> Text
forall s. Decoder s (VerificationKey PaymentKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (VerificationKey PaymentKey)
fromCBOR :: forall s. Decoder s (VerificationKey PaymentKey)
$clabel :: Proxy (VerificationKey PaymentKey) -> Text
label :: Proxy (VerificationKey PaymentKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (VerificationKey PaymentKey)
HasTypeProxy (VerificationKey PaymentKey) =>
(VerificationKey PaymentKey -> ByteString)
-> (AsType (VerificationKey PaymentKey)
    -> ByteString -> Either DecoderError (VerificationKey PaymentKey))
-> SerialiseAsCBOR (VerificationKey PaymentKey)
AsType (VerificationKey PaymentKey)
-> ByteString -> Either DecoderError (VerificationKey PaymentKey)
VerificationKey PaymentKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey PaymentKey -> ByteString
serialiseToCBOR :: VerificationKey PaymentKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey PaymentKey)
-> ByteString -> Either DecoderError (VerificationKey PaymentKey)
deserialiseFromCBOR :: AsType (VerificationKey PaymentKey)
-> ByteString -> Either DecoderError (VerificationKey PaymentKey)
SerialiseAsCBOR

    newtype SigningKey PaymentKey =
        PaymentSigningKey (Shelley.SignKeyDSIGN StandardCrypto)
      deriving (Int -> SigningKey PaymentKey -> ShowS
[SigningKey PaymentKey] -> ShowS
SigningKey PaymentKey -> String
(Int -> SigningKey PaymentKey -> ShowS)
-> (SigningKey PaymentKey -> String)
-> ([SigningKey PaymentKey] -> ShowS)
-> Show (SigningKey PaymentKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey PaymentKey -> ShowS
showsPrec :: Int -> SigningKey PaymentKey -> ShowS
$cshow :: SigningKey PaymentKey -> String
show :: SigningKey PaymentKey -> String
$cshowList :: [SigningKey PaymentKey] -> ShowS
showList :: [SigningKey PaymentKey] -> ShowS
Show, String -> SigningKey PaymentKey
(String -> SigningKey PaymentKey)
-> IsString (SigningKey PaymentKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey PaymentKey
fromString :: String -> SigningKey PaymentKey
IsString) via UsingRawBytesHex (SigningKey PaymentKey)
      deriving newtype (Typeable (SigningKey PaymentKey)
Typeable (SigningKey PaymentKey) =>
(SigningKey PaymentKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey PaymentKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey PaymentKey] -> Size)
-> ToCBOR (SigningKey PaymentKey)
SigningKey PaymentKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey PaymentKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey PaymentKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SigningKey PaymentKey -> Encoding
toCBOR :: SigningKey PaymentKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey PaymentKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey PaymentKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey PaymentKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey PaymentKey] -> Size
ToCBOR, Typeable (SigningKey PaymentKey)
Typeable (SigningKey PaymentKey) =>
(forall s. Decoder s (SigningKey PaymentKey))
-> (Proxy (SigningKey PaymentKey) -> Text)
-> FromCBOR (SigningKey PaymentKey)
Proxy (SigningKey PaymentKey) -> Text
forall s. Decoder s (SigningKey PaymentKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (SigningKey PaymentKey)
fromCBOR :: forall s. Decoder s (SigningKey PaymentKey)
$clabel :: Proxy (SigningKey PaymentKey) -> Text
label :: Proxy (SigningKey PaymentKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (SigningKey PaymentKey)
HasTypeProxy (SigningKey PaymentKey) =>
(SigningKey PaymentKey -> ByteString)
-> (AsType (SigningKey PaymentKey)
    -> ByteString -> Either DecoderError (SigningKey PaymentKey))
-> SerialiseAsCBOR (SigningKey PaymentKey)
AsType (SigningKey PaymentKey)
-> ByteString -> Either DecoderError (SigningKey PaymentKey)
SigningKey PaymentKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey PaymentKey -> ByteString
serialiseToCBOR :: SigningKey PaymentKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey PaymentKey)
-> ByteString -> Either DecoderError (SigningKey PaymentKey)
deserialiseFromCBOR :: AsType (SigningKey PaymentKey)
-> ByteString -> Either DecoderError (SigningKey PaymentKey)
SerialiseAsCBOR

    deterministicSigningKey :: AsType PaymentKey -> Crypto.Seed -> SigningKey PaymentKey
    deterministicSigningKey :: AsType PaymentKey -> Seed -> SigningKey PaymentKey
deterministicSigningKey AsType PaymentKey
R:AsTypePaymentKey
AsPaymentKey Seed
seed =
        SignKeyDSIGN StandardCrypto -> SigningKey PaymentKey
PaymentSigningKey (Seed -> SignKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
Crypto.genKeyDSIGN Seed
seed)

    deterministicSigningKeySeedSize :: AsType PaymentKey -> Word
    deterministicSigningKeySeedSize :: AsType PaymentKey -> Word
deterministicSigningKeySeedSize AsType PaymentKey
R:AsTypePaymentKey
AsPaymentKey =
        Proxy Ed25519DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
Crypto.seedSizeDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

    getVerificationKey :: SigningKey PaymentKey -> VerificationKey PaymentKey
    getVerificationKey :: SigningKey PaymentKey -> VerificationKey PaymentKey
getVerificationKey (PaymentSigningKey SignKeyDSIGN StandardCrypto
sk) =
        VKey 'Payment StandardCrypto -> VerificationKey PaymentKey
PaymentVerificationKey (VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Payment StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
Crypto.deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk))

    verificationKeyHash :: VerificationKey PaymentKey -> Hash PaymentKey
    verificationKeyHash :: VerificationKey PaymentKey -> Hash PaymentKey
verificationKeyHash (PaymentVerificationKey VKey 'Payment StandardCrypto
vkey) =
        KeyHash 'Payment StandardCrypto -> Hash PaymentKey
PaymentKeyHash (VKey 'Payment StandardCrypto -> KeyHash 'Payment StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
Shelley.hashKey VKey 'Payment StandardCrypto
vkey)

instance SerialiseAsRawBytes (VerificationKey PaymentKey) where
    serialiseToRawBytes :: VerificationKey PaymentKey -> ByteString
serialiseToRawBytes (PaymentVerificationKey (Shelley.VKey VerKeyDSIGN (DSIGN StandardCrypto)
vk)) =
      VerKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
Crypto.rawSerialiseVerKeyDSIGN VerKeyDSIGN Ed25519DSIGN
VerKeyDSIGN (DSIGN StandardCrypto)
vk

    deserialiseFromRawBytes :: AsType (VerificationKey PaymentKey)
-> ByteString -> Maybe (VerificationKey PaymentKey)
deserialiseFromRawBytes (AsVerificationKey AsType PaymentKey
R:AsTypePaymentKey
AsPaymentKey) ByteString
bs =
      VKey 'Payment StandardCrypto -> VerificationKey PaymentKey
PaymentVerificationKey (VKey 'Payment StandardCrypto -> VerificationKey PaymentKey)
-> (VerKeyDSIGN Ed25519DSIGN -> VKey 'Payment StandardCrypto)
-> VerKeyDSIGN Ed25519DSIGN
-> VerificationKey PaymentKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VKey 'Payment StandardCrypto
VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Payment StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (VerKeyDSIGN Ed25519DSIGN -> VerificationKey PaymentKey)
-> Maybe (VerKeyDSIGN Ed25519DSIGN)
-> Maybe (VerificationKey PaymentKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
Crypto.rawDeserialiseVerKeyDSIGN ByteString
bs

instance SerialiseAsRawBytes (SigningKey PaymentKey) where
    serialiseToRawBytes :: SigningKey PaymentKey -> ByteString
serialiseToRawBytes (PaymentSigningKey SignKeyDSIGN StandardCrypto
sk) =
      SignKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
Crypto.rawSerialiseSignKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk

    deserialiseFromRawBytes :: AsType (SigningKey PaymentKey)
-> ByteString -> Maybe (SigningKey PaymentKey)
deserialiseFromRawBytes (AsSigningKey AsType PaymentKey
R:AsTypePaymentKey
AsPaymentKey) ByteString
bs =
      SignKeyDSIGN Ed25519DSIGN -> SigningKey PaymentKey
SignKeyDSIGN StandardCrypto -> SigningKey PaymentKey
PaymentSigningKey (SignKeyDSIGN Ed25519DSIGN -> SigningKey PaymentKey)
-> Maybe (SignKeyDSIGN Ed25519DSIGN)
-> Maybe (SigningKey PaymentKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (SignKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
Crypto.rawDeserialiseSignKeyDSIGN ByteString
bs

instance SerialiseAsBech32 (VerificationKey PaymentKey) where
    bech32PrefixFor :: VerificationKey PaymentKey -> Text
bech32PrefixFor         VerificationKey PaymentKey
_ =  Text
"addr_vk"
    bech32PrefixesPermitted :: AsType (VerificationKey PaymentKey) -> [Text]
bech32PrefixesPermitted AsType (VerificationKey PaymentKey)
_ = [Text
"addr_vk"]

instance SerialiseAsBech32 (SigningKey PaymentKey) where
    bech32PrefixFor :: SigningKey PaymentKey -> Text
bech32PrefixFor         SigningKey PaymentKey
_ =  Text
"addr_sk"
    bech32PrefixesPermitted :: AsType (SigningKey PaymentKey) -> [Text]
bech32PrefixesPermitted AsType (SigningKey PaymentKey)
_ = [Text
"addr_sk"]

newtype instance Hash PaymentKey =
    PaymentKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto)
  deriving stock (Hash PaymentKey -> Hash PaymentKey -> Bool
(Hash PaymentKey -> Hash PaymentKey -> Bool)
-> (Hash PaymentKey -> Hash PaymentKey -> Bool)
-> Eq (Hash PaymentKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash PaymentKey -> Hash PaymentKey -> Bool
== :: Hash PaymentKey -> Hash PaymentKey -> Bool
$c/= :: Hash PaymentKey -> Hash PaymentKey -> Bool
/= :: Hash PaymentKey -> Hash PaymentKey -> Bool
Eq, Eq (Hash PaymentKey)
Eq (Hash PaymentKey) =>
(Hash PaymentKey -> Hash PaymentKey -> Ordering)
-> (Hash PaymentKey -> Hash PaymentKey -> Bool)
-> (Hash PaymentKey -> Hash PaymentKey -> Bool)
-> (Hash PaymentKey -> Hash PaymentKey -> Bool)
-> (Hash PaymentKey -> Hash PaymentKey -> Bool)
-> (Hash PaymentKey -> Hash PaymentKey -> Hash PaymentKey)
-> (Hash PaymentKey -> Hash PaymentKey -> Hash PaymentKey)
-> Ord (Hash PaymentKey)
Hash PaymentKey -> Hash PaymentKey -> Bool
Hash PaymentKey -> Hash PaymentKey -> Ordering
Hash PaymentKey -> Hash PaymentKey -> Hash PaymentKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash PaymentKey -> Hash PaymentKey -> Ordering
compare :: Hash PaymentKey -> Hash PaymentKey -> Ordering
$c< :: Hash PaymentKey -> Hash PaymentKey -> Bool
< :: Hash PaymentKey -> Hash PaymentKey -> Bool
$c<= :: Hash PaymentKey -> Hash PaymentKey -> Bool
<= :: Hash PaymentKey -> Hash PaymentKey -> Bool
$c> :: Hash PaymentKey -> Hash PaymentKey -> Bool
> :: Hash PaymentKey -> Hash PaymentKey -> Bool
$c>= :: Hash PaymentKey -> Hash PaymentKey -> Bool
>= :: Hash PaymentKey -> Hash PaymentKey -> Bool
$cmax :: Hash PaymentKey -> Hash PaymentKey -> Hash PaymentKey
max :: Hash PaymentKey -> Hash PaymentKey -> Hash PaymentKey
$cmin :: Hash PaymentKey -> Hash PaymentKey -> Hash PaymentKey
min :: Hash PaymentKey -> Hash PaymentKey -> Hash PaymentKey
Ord)
  deriving (Int -> Hash PaymentKey -> ShowS
[Hash PaymentKey] -> ShowS
Hash PaymentKey -> String
(Int -> Hash PaymentKey -> ShowS)
-> (Hash PaymentKey -> String)
-> ([Hash PaymentKey] -> ShowS)
-> Show (Hash PaymentKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash PaymentKey -> ShowS
showsPrec :: Int -> Hash PaymentKey -> ShowS
$cshow :: Hash PaymentKey -> String
show :: Hash PaymentKey -> String
$cshowList :: [Hash PaymentKey] -> ShowS
showList :: [Hash PaymentKey] -> ShowS
Show, String -> Hash PaymentKey
(String -> Hash PaymentKey) -> IsString (Hash PaymentKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash PaymentKey
fromString :: String -> Hash PaymentKey
IsString) via UsingRawBytesHex (Hash PaymentKey)
  deriving (Typeable (Hash PaymentKey)
Typeable (Hash PaymentKey) =>
(Hash PaymentKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash PaymentKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash PaymentKey] -> Size)
-> ToCBOR (Hash PaymentKey)
Hash PaymentKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash PaymentKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash PaymentKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Hash PaymentKey -> Encoding
toCBOR :: Hash PaymentKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash PaymentKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash PaymentKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash PaymentKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash PaymentKey] -> Size
ToCBOR, Typeable (Hash PaymentKey)
Typeable (Hash PaymentKey) =>
(forall s. Decoder s (Hash PaymentKey))
-> (Proxy (Hash PaymentKey) -> Text) -> FromCBOR (Hash PaymentKey)
Proxy (Hash PaymentKey) -> Text
forall s. Decoder s (Hash PaymentKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash PaymentKey)
fromCBOR :: forall s. Decoder s (Hash PaymentKey)
$clabel :: Proxy (Hash PaymentKey) -> Text
label :: Proxy (Hash PaymentKey) -> Text
FromCBOR) via UsingRawBytes (Hash PaymentKey)
  deriving anyclass HasTypeProxy (Hash PaymentKey)
Hash PaymentKey -> ByteString
HasTypeProxy (Hash PaymentKey) =>
(Hash PaymentKey -> ByteString)
-> (AsType (Hash PaymentKey)
    -> ByteString -> Either DecoderError (Hash PaymentKey))
-> SerialiseAsCBOR (Hash PaymentKey)
AsType (Hash PaymentKey)
-> ByteString -> Either DecoderError (Hash PaymentKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash PaymentKey -> ByteString
serialiseToCBOR :: Hash PaymentKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash PaymentKey)
-> ByteString -> Either DecoderError (Hash PaymentKey)
deserialiseFromCBOR :: AsType (Hash PaymentKey)
-> ByteString -> Either DecoderError (Hash PaymentKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash PaymentKey) where
    serialiseToRawBytes :: Hash PaymentKey -> ByteString
serialiseToRawBytes (PaymentKeyHash (Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
      Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

    deserialiseFromRawBytes :: AsType (Hash PaymentKey) -> ByteString -> Maybe (Hash PaymentKey)
deserialiseFromRawBytes (AsHash AsType PaymentKey
R:AsTypePaymentKey
AsPaymentKey) ByteString
bs =
      KeyHash 'Payment StandardCrypto -> Hash PaymentKey
PaymentKeyHash (KeyHash 'Payment StandardCrypto -> Hash PaymentKey)
-> (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
    -> KeyHash 'Payment StandardCrypto)
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> Hash PaymentKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Payment StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Payment StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> Hash PaymentKey)
-> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Maybe (Hash PaymentKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey PaymentKey) where
    textEnvelopeType :: AsType (VerificationKey PaymentKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey PaymentKey)
_ = TextEnvelopeType
"PaymentVerificationKeyShelley_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

instance HasTextEnvelope (SigningKey PaymentKey) where
    textEnvelopeType :: AsType (SigningKey PaymentKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey PaymentKey)
_ = TextEnvelopeType
"PaymentSigningKeyShelley_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy


--
-- Shelley payment extended ed25519 keys
--

-- | Shelley-era payment keys using extended ed25519 cryptographic keys.
--
-- They can be used for Shelley payment addresses and witnessing
-- transactions that spend from these addresses.
--
-- These extended keys are used by HD wallets. So this type provides
-- interoperability with HD wallets. The ITN CLI also supported this key type.
--
-- The extended verification keys can be converted (via 'castVerificationKey')
-- to ordinary keys (i.e. 'VerificationKey' 'PaymentKey') but this is /not/ the
-- case for the signing keys. The signing keys can be used to witness
-- transactions directly, with verification via their non-extended verification
-- key ('VerificationKey' 'PaymentKey').
--
-- This is a type level tag, used with other interfaces like 'Key'.
--
data PaymentExtendedKey

instance HasTypeProxy PaymentExtendedKey where
    data AsType PaymentExtendedKey = AsPaymentExtendedKey
    proxyToAsType :: Proxy PaymentExtendedKey -> AsType PaymentExtendedKey
proxyToAsType Proxy PaymentExtendedKey
_ = AsType PaymentExtendedKey
AsPaymentExtendedKey

instance Key PaymentExtendedKey where

    newtype VerificationKey PaymentExtendedKey =
        PaymentExtendedVerificationKey Crypto.HD.XPub
      deriving stock (VerificationKey PaymentExtendedKey
-> VerificationKey PaymentExtendedKey -> Bool
(VerificationKey PaymentExtendedKey
 -> VerificationKey PaymentExtendedKey -> Bool)
-> (VerificationKey PaymentExtendedKey
    -> VerificationKey PaymentExtendedKey -> Bool)
-> Eq (VerificationKey PaymentExtendedKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey PaymentExtendedKey
-> VerificationKey PaymentExtendedKey -> Bool
== :: VerificationKey PaymentExtendedKey
-> VerificationKey PaymentExtendedKey -> Bool
$c/= :: VerificationKey PaymentExtendedKey
-> VerificationKey PaymentExtendedKey -> Bool
/= :: VerificationKey PaymentExtendedKey
-> VerificationKey PaymentExtendedKey -> Bool
Eq)
      deriving anyclass HasTypeProxy (VerificationKey PaymentExtendedKey)
HasTypeProxy (VerificationKey PaymentExtendedKey) =>
(VerificationKey PaymentExtendedKey -> ByteString)
-> (AsType (VerificationKey PaymentExtendedKey)
    -> ByteString
    -> Either DecoderError (VerificationKey PaymentExtendedKey))
-> SerialiseAsCBOR (VerificationKey PaymentExtendedKey)
AsType (VerificationKey PaymentExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey PaymentExtendedKey)
VerificationKey PaymentExtendedKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey PaymentExtendedKey -> ByteString
serialiseToCBOR :: VerificationKey PaymentExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey PaymentExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey PaymentExtendedKey)
deserialiseFromCBOR :: AsType (VerificationKey PaymentExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey PaymentExtendedKey)
SerialiseAsCBOR
      deriving (Int -> VerificationKey PaymentExtendedKey -> ShowS
[VerificationKey PaymentExtendedKey] -> ShowS
VerificationKey PaymentExtendedKey -> String
(Int -> VerificationKey PaymentExtendedKey -> ShowS)
-> (VerificationKey PaymentExtendedKey -> String)
-> ([VerificationKey PaymentExtendedKey] -> ShowS)
-> Show (VerificationKey PaymentExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey PaymentExtendedKey -> ShowS
showsPrec :: Int -> VerificationKey PaymentExtendedKey -> ShowS
$cshow :: VerificationKey PaymentExtendedKey -> String
show :: VerificationKey PaymentExtendedKey -> String
$cshowList :: [VerificationKey PaymentExtendedKey] -> ShowS
showList :: [VerificationKey PaymentExtendedKey] -> ShowS
Show, String -> VerificationKey PaymentExtendedKey
(String -> VerificationKey PaymentExtendedKey)
-> IsString (VerificationKey PaymentExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey PaymentExtendedKey
fromString :: String -> VerificationKey PaymentExtendedKey
IsString) via UsingRawBytesHex (VerificationKey PaymentExtendedKey)

    newtype SigningKey PaymentExtendedKey =
        PaymentExtendedSigningKey Crypto.HD.XPrv
      deriving anyclass HasTypeProxy (SigningKey PaymentExtendedKey)
HasTypeProxy (SigningKey PaymentExtendedKey) =>
(SigningKey PaymentExtendedKey -> ByteString)
-> (AsType (SigningKey PaymentExtendedKey)
    -> ByteString
    -> Either DecoderError (SigningKey PaymentExtendedKey))
-> SerialiseAsCBOR (SigningKey PaymentExtendedKey)
AsType (SigningKey PaymentExtendedKey)
-> ByteString
-> Either DecoderError (SigningKey PaymentExtendedKey)
SigningKey PaymentExtendedKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey PaymentExtendedKey -> ByteString
serialiseToCBOR :: SigningKey PaymentExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey PaymentExtendedKey)
-> ByteString
-> Either DecoderError (SigningKey PaymentExtendedKey)
deserialiseFromCBOR :: AsType (SigningKey PaymentExtendedKey)
-> ByteString
-> Either DecoderError (SigningKey PaymentExtendedKey)
SerialiseAsCBOR
      deriving (Int -> SigningKey PaymentExtendedKey -> ShowS
[SigningKey PaymentExtendedKey] -> ShowS
SigningKey PaymentExtendedKey -> String
(Int -> SigningKey PaymentExtendedKey -> ShowS)
-> (SigningKey PaymentExtendedKey -> String)
-> ([SigningKey PaymentExtendedKey] -> ShowS)
-> Show (SigningKey PaymentExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey PaymentExtendedKey -> ShowS
showsPrec :: Int -> SigningKey PaymentExtendedKey -> ShowS
$cshow :: SigningKey PaymentExtendedKey -> String
show :: SigningKey PaymentExtendedKey -> String
$cshowList :: [SigningKey PaymentExtendedKey] -> ShowS
showList :: [SigningKey PaymentExtendedKey] -> ShowS
Show, String -> SigningKey PaymentExtendedKey
(String -> SigningKey PaymentExtendedKey)
-> IsString (SigningKey PaymentExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey PaymentExtendedKey
fromString :: String -> SigningKey PaymentExtendedKey
IsString) via UsingRawBytesHex (SigningKey PaymentExtendedKey)

    deterministicSigningKey :: AsType PaymentExtendedKey
                            -> Crypto.Seed
                            -> SigningKey PaymentExtendedKey
    deterministicSigningKey :: AsType PaymentExtendedKey -> Seed -> SigningKey PaymentExtendedKey
deterministicSigningKey AsType PaymentExtendedKey
R:AsTypePaymentExtendedKey
AsPaymentExtendedKey Seed
seed =
        XPrv -> SigningKey PaymentExtendedKey
PaymentExtendedSigningKey
          (ByteString -> ByteString -> XPrv
forall passPhrase seed.
(ByteArrayAccess passPhrase, ByteArrayAccess seed) =>
seed -> passPhrase -> XPrv
Crypto.HD.generate ByteString
seedbs ByteString
BS.empty)
      where
       (ByteString
seedbs, Seed
_) = Word -> Seed -> (ByteString, Seed)
Crypto.getBytesFromSeedT Word
32 Seed
seed

    deterministicSigningKeySeedSize :: AsType PaymentExtendedKey -> Word
    deterministicSigningKeySeedSize :: AsType PaymentExtendedKey -> Word
deterministicSigningKeySeedSize AsType PaymentExtendedKey
R:AsTypePaymentExtendedKey
AsPaymentExtendedKey = Word
32

    getVerificationKey :: SigningKey PaymentExtendedKey
                       -> VerificationKey PaymentExtendedKey
    getVerificationKey :: SigningKey PaymentExtendedKey -> VerificationKey PaymentExtendedKey
getVerificationKey (PaymentExtendedSigningKey XPrv
sk) =
        XPub -> VerificationKey PaymentExtendedKey
PaymentExtendedVerificationKey (HasCallStack => XPrv -> XPub
XPrv -> XPub
Crypto.HD.toXPub XPrv
sk)

    -- | We use the hash of the normal non-extended pub key so that it is
    -- consistent with the one used in addresses and signatures.
    --
    verificationKeyHash :: VerificationKey PaymentExtendedKey
                        -> Hash PaymentExtendedKey
    verificationKeyHash :: VerificationKey PaymentExtendedKey -> Hash PaymentExtendedKey
verificationKeyHash (PaymentExtendedVerificationKey XPub
vk) =
        KeyHash 'Payment StandardCrypto -> Hash PaymentExtendedKey
PaymentExtendedKeyHash
      (KeyHash 'Payment StandardCrypto -> Hash PaymentExtendedKey)
-> (Hash Blake2b_224 XPub -> KeyHash 'Payment StandardCrypto)
-> Hash Blake2b_224 XPub
-> Hash PaymentExtendedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Payment StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Payment StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash
      (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
 -> KeyHash 'Payment StandardCrypto)
-> (Hash Blake2b_224 XPub
    -> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Hash Blake2b_224 XPub
-> KeyHash 'Payment StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 XPub
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
forall h a b. Hash h a -> Hash h b
Crypto.castHash
      (Hash Blake2b_224 XPub -> Hash PaymentExtendedKey)
-> Hash Blake2b_224 XPub -> Hash PaymentExtendedKey
forall a b. (a -> b) -> a -> b
$ (XPub -> ByteString) -> XPub -> Hash Blake2b_224 XPub
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith XPub -> ByteString
Crypto.HD.xpubPublicKey XPub
vk


instance ToCBOR (VerificationKey PaymentExtendedKey) where
    toCBOR :: VerificationKey PaymentExtendedKey -> Encoding
toCBOR (PaymentExtendedVerificationKey XPub
xpub) =
      ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (XPub -> ByteString
Crypto.HD.unXPub XPub
xpub)

instance FromCBOR (VerificationKey PaymentExtendedKey) where
    fromCBOR :: forall s. Decoder s (VerificationKey PaymentExtendedKey)
fromCBOR = do
      ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (String -> Decoder s (VerificationKey PaymentExtendedKey))
-> (XPub -> Decoder s (VerificationKey PaymentExtendedKey))
-> Either String XPub
-> Decoder s (VerificationKey PaymentExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Decoder s (VerificationKey PaymentExtendedKey)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (VerificationKey PaymentExtendedKey
-> Decoder s (VerificationKey PaymentExtendedKey)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey PaymentExtendedKey
 -> Decoder s (VerificationKey PaymentExtendedKey))
-> (XPub -> VerificationKey PaymentExtendedKey)
-> XPub
-> Decoder s (VerificationKey PaymentExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey PaymentExtendedKey
PaymentExtendedVerificationKey)
             (ByteString -> Either String XPub
Crypto.HD.xpub (ByteString
bs :: ByteString))

instance ToCBOR (SigningKey PaymentExtendedKey) where
    toCBOR :: SigningKey PaymentExtendedKey -> Encoding
toCBOR (PaymentExtendedSigningKey XPrv
xprv) =
      ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (XPrv -> ByteString
Crypto.HD.unXPrv XPrv
xprv)

instance FromCBOR (SigningKey PaymentExtendedKey) where
    fromCBOR :: forall s. Decoder s (SigningKey PaymentExtendedKey)
fromCBOR = do
      ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (String -> Decoder s (SigningKey PaymentExtendedKey))
-> (XPrv -> Decoder s (SigningKey PaymentExtendedKey))
-> Either String XPrv
-> Decoder s (SigningKey PaymentExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Decoder s (SigningKey PaymentExtendedKey)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (SigningKey PaymentExtendedKey
-> Decoder s (SigningKey PaymentExtendedKey)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SigningKey PaymentExtendedKey
 -> Decoder s (SigningKey PaymentExtendedKey))
-> (XPrv -> SigningKey PaymentExtendedKey)
-> XPrv
-> Decoder s (SigningKey PaymentExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey PaymentExtendedKey
PaymentExtendedSigningKey)
             (ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
Crypto.HD.xprv (ByteString
bs :: ByteString))

instance SerialiseAsRawBytes (VerificationKey PaymentExtendedKey) where
    serialiseToRawBytes :: VerificationKey PaymentExtendedKey -> ByteString
serialiseToRawBytes (PaymentExtendedVerificationKey XPub
xpub) =
      XPub -> ByteString
Crypto.HD.unXPub XPub
xpub

    deserialiseFromRawBytes :: AsType (VerificationKey PaymentExtendedKey)
-> ByteString -> Maybe (VerificationKey PaymentExtendedKey)
deserialiseFromRawBytes (AsVerificationKey AsType PaymentExtendedKey
R:AsTypePaymentExtendedKey
AsPaymentExtendedKey) ByteString
bs =
      (String -> Maybe (VerificationKey PaymentExtendedKey))
-> (XPub -> Maybe (VerificationKey PaymentExtendedKey))
-> Either String XPub
-> Maybe (VerificationKey PaymentExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (VerificationKey PaymentExtendedKey)
-> String -> Maybe (VerificationKey PaymentExtendedKey)
forall a b. a -> b -> a
const Maybe (VerificationKey PaymentExtendedKey)
forall a. Maybe a
Nothing) (VerificationKey PaymentExtendedKey
-> Maybe (VerificationKey PaymentExtendedKey)
forall a. a -> Maybe a
Just (VerificationKey PaymentExtendedKey
 -> Maybe (VerificationKey PaymentExtendedKey))
-> (XPub -> VerificationKey PaymentExtendedKey)
-> XPub
-> Maybe (VerificationKey PaymentExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey PaymentExtendedKey
PaymentExtendedVerificationKey)
             (ByteString -> Either String XPub
Crypto.HD.xpub ByteString
bs)

instance SerialiseAsRawBytes (SigningKey PaymentExtendedKey) where
    serialiseToRawBytes :: SigningKey PaymentExtendedKey -> ByteString
serialiseToRawBytes (PaymentExtendedSigningKey XPrv
xprv) =
      XPrv -> ByteString
Crypto.HD.unXPrv XPrv
xprv

    deserialiseFromRawBytes :: AsType (SigningKey PaymentExtendedKey)
-> ByteString -> Maybe (SigningKey PaymentExtendedKey)
deserialiseFromRawBytes (AsSigningKey AsType PaymentExtendedKey
R:AsTypePaymentExtendedKey
AsPaymentExtendedKey) ByteString
bs =
      (String -> Maybe (SigningKey PaymentExtendedKey))
-> (XPrv -> Maybe (SigningKey PaymentExtendedKey))
-> Either String XPrv
-> Maybe (SigningKey PaymentExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (SigningKey PaymentExtendedKey)
-> String -> Maybe (SigningKey PaymentExtendedKey)
forall a b. a -> b -> a
const Maybe (SigningKey PaymentExtendedKey)
forall a. Maybe a
Nothing) (SigningKey PaymentExtendedKey
-> Maybe (SigningKey PaymentExtendedKey)
forall a. a -> Maybe a
Just (SigningKey PaymentExtendedKey
 -> Maybe (SigningKey PaymentExtendedKey))
-> (XPrv -> SigningKey PaymentExtendedKey)
-> XPrv
-> Maybe (SigningKey PaymentExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey PaymentExtendedKey
PaymentExtendedSigningKey)
             (ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
Crypto.HD.xprv ByteString
bs)

instance SerialiseAsBech32 (VerificationKey PaymentExtendedKey) where
    bech32PrefixFor :: VerificationKey PaymentExtendedKey -> Text
bech32PrefixFor         VerificationKey PaymentExtendedKey
_ =  Text
"addr_xvk"
    bech32PrefixesPermitted :: AsType (VerificationKey PaymentExtendedKey) -> [Text]
bech32PrefixesPermitted AsType (VerificationKey PaymentExtendedKey)
_ = [Text
"addr_xvk"]

instance SerialiseAsBech32 (SigningKey PaymentExtendedKey) where
    bech32PrefixFor :: SigningKey PaymentExtendedKey -> Text
bech32PrefixFor         SigningKey PaymentExtendedKey
_ =  Text
"addr_xsk"
    bech32PrefixesPermitted :: AsType (SigningKey PaymentExtendedKey) -> [Text]
bech32PrefixesPermitted AsType (SigningKey PaymentExtendedKey)
_ = [Text
"addr_xsk"]


newtype instance Hash PaymentExtendedKey =
    PaymentExtendedKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto)
  deriving stock (Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
(Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool)
-> (Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool)
-> Eq (Hash PaymentExtendedKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
== :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
$c/= :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
/= :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
Eq, Eq (Hash PaymentExtendedKey)
Eq (Hash PaymentExtendedKey) =>
(Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Ordering)
-> (Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool)
-> (Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool)
-> (Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool)
-> (Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool)
-> (Hash PaymentExtendedKey
    -> Hash PaymentExtendedKey -> Hash PaymentExtendedKey)
-> (Hash PaymentExtendedKey
    -> Hash PaymentExtendedKey -> Hash PaymentExtendedKey)
-> Ord (Hash PaymentExtendedKey)
Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Ordering
Hash PaymentExtendedKey
-> Hash PaymentExtendedKey -> Hash PaymentExtendedKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Ordering
compare :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Ordering
$c< :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
< :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
$c<= :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
<= :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
$c> :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
> :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
$c>= :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
>= :: Hash PaymentExtendedKey -> Hash PaymentExtendedKey -> Bool
$cmax :: Hash PaymentExtendedKey
-> Hash PaymentExtendedKey -> Hash PaymentExtendedKey
max :: Hash PaymentExtendedKey
-> Hash PaymentExtendedKey -> Hash PaymentExtendedKey
$cmin :: Hash PaymentExtendedKey
-> Hash PaymentExtendedKey -> Hash PaymentExtendedKey
min :: Hash PaymentExtendedKey
-> Hash PaymentExtendedKey -> Hash PaymentExtendedKey
Ord)
  deriving (Int -> Hash PaymentExtendedKey -> ShowS
[Hash PaymentExtendedKey] -> ShowS
Hash PaymentExtendedKey -> String
(Int -> Hash PaymentExtendedKey -> ShowS)
-> (Hash PaymentExtendedKey -> String)
-> ([Hash PaymentExtendedKey] -> ShowS)
-> Show (Hash PaymentExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash PaymentExtendedKey -> ShowS
showsPrec :: Int -> Hash PaymentExtendedKey -> ShowS
$cshow :: Hash PaymentExtendedKey -> String
show :: Hash PaymentExtendedKey -> String
$cshowList :: [Hash PaymentExtendedKey] -> ShowS
showList :: [Hash PaymentExtendedKey] -> ShowS
Show, String -> Hash PaymentExtendedKey
(String -> Hash PaymentExtendedKey)
-> IsString (Hash PaymentExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash PaymentExtendedKey
fromString :: String -> Hash PaymentExtendedKey
IsString) via UsingRawBytesHex (Hash PaymentExtendedKey)
  deriving (Typeable (Hash PaymentExtendedKey)
Typeable (Hash PaymentExtendedKey) =>
(Hash PaymentExtendedKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash PaymentExtendedKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash PaymentExtendedKey] -> Size)
-> ToCBOR (Hash PaymentExtendedKey)
Hash PaymentExtendedKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash PaymentExtendedKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash PaymentExtendedKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Hash PaymentExtendedKey -> Encoding
toCBOR :: Hash PaymentExtendedKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash PaymentExtendedKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash PaymentExtendedKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash PaymentExtendedKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash PaymentExtendedKey] -> Size
ToCBOR, Typeable (Hash PaymentExtendedKey)
Typeable (Hash PaymentExtendedKey) =>
(forall s. Decoder s (Hash PaymentExtendedKey))
-> (Proxy (Hash PaymentExtendedKey) -> Text)
-> FromCBOR (Hash PaymentExtendedKey)
Proxy (Hash PaymentExtendedKey) -> Text
forall s. Decoder s (Hash PaymentExtendedKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash PaymentExtendedKey)
fromCBOR :: forall s. Decoder s (Hash PaymentExtendedKey)
$clabel :: Proxy (Hash PaymentExtendedKey) -> Text
label :: Proxy (Hash PaymentExtendedKey) -> Text
FromCBOR) via UsingRawBytes (Hash PaymentExtendedKey)
  deriving anyclass HasTypeProxy (Hash PaymentExtendedKey)
Hash PaymentExtendedKey -> ByteString
HasTypeProxy (Hash PaymentExtendedKey) =>
(Hash PaymentExtendedKey -> ByteString)
-> (AsType (Hash PaymentExtendedKey)
    -> ByteString -> Either DecoderError (Hash PaymentExtendedKey))
-> SerialiseAsCBOR (Hash PaymentExtendedKey)
AsType (Hash PaymentExtendedKey)
-> ByteString -> Either DecoderError (Hash PaymentExtendedKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash PaymentExtendedKey -> ByteString
serialiseToCBOR :: Hash PaymentExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash PaymentExtendedKey)
-> ByteString -> Either DecoderError (Hash PaymentExtendedKey)
deserialiseFromCBOR :: AsType (Hash PaymentExtendedKey)
-> ByteString -> Either DecoderError (Hash PaymentExtendedKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash PaymentExtendedKey) where
    serialiseToRawBytes :: Hash PaymentExtendedKey -> ByteString
serialiseToRawBytes (PaymentExtendedKeyHash (Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
      Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

    deserialiseFromRawBytes :: AsType (Hash PaymentExtendedKey)
-> ByteString -> Maybe (Hash PaymentExtendedKey)
deserialiseFromRawBytes (AsHash AsType PaymentExtendedKey
R:AsTypePaymentExtendedKey
AsPaymentExtendedKey) ByteString
bs =
      KeyHash 'Payment StandardCrypto -> Hash PaymentExtendedKey
PaymentExtendedKeyHash (KeyHash 'Payment StandardCrypto -> Hash PaymentExtendedKey)
-> (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
    -> KeyHash 'Payment StandardCrypto)
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> Hash PaymentExtendedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Payment StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Payment StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
 -> Hash PaymentExtendedKey)
-> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Maybe (Hash PaymentExtendedKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey PaymentExtendedKey) where
    textEnvelopeType :: AsType (VerificationKey PaymentExtendedKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey PaymentExtendedKey)
_ = TextEnvelopeType
"PaymentExtendedVerificationKeyShelley_ed25519_bip32"

instance HasTextEnvelope (SigningKey PaymentExtendedKey) where
    textEnvelopeType :: AsType (SigningKey PaymentExtendedKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey PaymentExtendedKey)
_ = TextEnvelopeType
"PaymentExtendedSigningKeyShelley_ed25519_bip32"

instance CastVerificationKeyRole PaymentExtendedKey PaymentKey where
    castVerificationKey :: VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey
castVerificationKey (PaymentExtendedVerificationKey XPub
vk) =
        VKey 'Payment StandardCrypto -> VerificationKey PaymentKey
PaymentVerificationKey
      (VKey 'Payment StandardCrypto -> VerificationKey PaymentKey)
-> (XPub -> VKey 'Payment StandardCrypto)
-> XPub
-> VerificationKey PaymentKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VKey 'Payment StandardCrypto
VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Payment StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey
      (VerKeyDSIGN Ed25519DSIGN -> VKey 'Payment StandardCrypto)
-> (XPub -> VerKeyDSIGN Ed25519DSIGN)
-> XPub
-> VKey 'Payment StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN
-> Maybe (VerKeyDSIGN Ed25519DSIGN) -> VerKeyDSIGN Ed25519DSIGN
forall a. a -> Maybe a -> a
fromMaybe VerKeyDSIGN Ed25519DSIGN
forall {a}. a
impossible
      (Maybe (VerKeyDSIGN Ed25519DSIGN) -> VerKeyDSIGN Ed25519DSIGN)
-> (XPub -> Maybe (VerKeyDSIGN Ed25519DSIGN))
-> XPub
-> VerKeyDSIGN Ed25519DSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
Crypto.rawDeserialiseVerKeyDSIGN
      (ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN))
-> (XPub -> ByteString) -> XPub -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
Crypto.HD.xpubPublicKey
      (XPub -> VerificationKey PaymentKey)
-> XPub -> VerificationKey PaymentKey
forall a b. (a -> b) -> a -> b
$ XPub
vk
      where
        impossible :: a
impossible =
          String -> a
forall a. HasCallStack => String -> a
error String
"castVerificationKey: byron and shelley key sizes do not match!"


--
-- Stake keys
--

data StakeKey

instance HasTypeProxy StakeKey where
    data AsType StakeKey = AsStakeKey
    proxyToAsType :: Proxy StakeKey -> AsType StakeKey
proxyToAsType Proxy StakeKey
_ = AsType StakeKey
AsStakeKey

instance Key StakeKey where

    newtype VerificationKey StakeKey =
        StakeVerificationKey (Shelley.VKey Shelley.Staking StandardCrypto)
      deriving stock (VerificationKey StakeKey -> VerificationKey StakeKey -> Bool
(VerificationKey StakeKey -> VerificationKey StakeKey -> Bool)
-> (VerificationKey StakeKey -> VerificationKey StakeKey -> Bool)
-> Eq (VerificationKey StakeKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey StakeKey -> VerificationKey StakeKey -> Bool
== :: VerificationKey StakeKey -> VerificationKey StakeKey -> Bool
$c/= :: VerificationKey StakeKey -> VerificationKey StakeKey -> Bool
/= :: VerificationKey StakeKey -> VerificationKey StakeKey -> Bool
Eq)
      deriving newtype (Typeable (VerificationKey StakeKey)
Typeable (VerificationKey StakeKey) =>
(VerificationKey StakeKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey StakeKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey StakeKey] -> Size)
-> ToCBOR (VerificationKey StakeKey)
VerificationKey StakeKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey StakeKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey StakeKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: VerificationKey StakeKey -> Encoding
toCBOR :: VerificationKey StakeKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey StakeKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey StakeKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey StakeKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey StakeKey] -> Size
ToCBOR, Typeable (VerificationKey StakeKey)
Typeable (VerificationKey StakeKey) =>
(forall s. Decoder s (VerificationKey StakeKey))
-> (Proxy (VerificationKey StakeKey) -> Text)
-> FromCBOR (VerificationKey StakeKey)
Proxy (VerificationKey StakeKey) -> Text
forall s. Decoder s (VerificationKey StakeKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (VerificationKey StakeKey)
fromCBOR :: forall s. Decoder s (VerificationKey StakeKey)
$clabel :: Proxy (VerificationKey StakeKey) -> Text
label :: Proxy (VerificationKey StakeKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (VerificationKey StakeKey)
HasTypeProxy (VerificationKey StakeKey) =>
(VerificationKey StakeKey -> ByteString)
-> (AsType (VerificationKey StakeKey)
    -> ByteString -> Either DecoderError (VerificationKey StakeKey))
-> SerialiseAsCBOR (VerificationKey StakeKey)
AsType (VerificationKey StakeKey)
-> ByteString -> Either DecoderError (VerificationKey StakeKey)
VerificationKey StakeKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey StakeKey -> ByteString
serialiseToCBOR :: VerificationKey StakeKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey StakeKey)
-> ByteString -> Either DecoderError (VerificationKey StakeKey)
deserialiseFromCBOR :: AsType (VerificationKey StakeKey)
-> ByteString -> Either DecoderError (VerificationKey StakeKey)
SerialiseAsCBOR
      deriving (Int -> VerificationKey StakeKey -> ShowS
[VerificationKey StakeKey] -> ShowS
VerificationKey StakeKey -> String
(Int -> VerificationKey StakeKey -> ShowS)
-> (VerificationKey StakeKey -> String)
-> ([VerificationKey StakeKey] -> ShowS)
-> Show (VerificationKey StakeKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey StakeKey -> ShowS
showsPrec :: Int -> VerificationKey StakeKey -> ShowS
$cshow :: VerificationKey StakeKey -> String
show :: VerificationKey StakeKey -> String
$cshowList :: [VerificationKey StakeKey] -> ShowS
showList :: [VerificationKey StakeKey] -> ShowS
Show, String -> VerificationKey StakeKey
(String -> VerificationKey StakeKey)
-> IsString (VerificationKey StakeKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey StakeKey
fromString :: String -> VerificationKey StakeKey
IsString) via UsingRawBytesHex (VerificationKey StakeKey)

    newtype SigningKey StakeKey =
        StakeSigningKey (Shelley.SignKeyDSIGN StandardCrypto)
      deriving newtype (Typeable (SigningKey StakeKey)
Typeable (SigningKey StakeKey) =>
(SigningKey StakeKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey StakeKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey StakeKey] -> Size)
-> ToCBOR (SigningKey StakeKey)
SigningKey StakeKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey StakeKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey StakeKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SigningKey StakeKey -> Encoding
toCBOR :: SigningKey StakeKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey StakeKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey StakeKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey StakeKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey StakeKey] -> Size
ToCBOR, Typeable (SigningKey StakeKey)
Typeable (SigningKey StakeKey) =>
(forall s. Decoder s (SigningKey StakeKey))
-> (Proxy (SigningKey StakeKey) -> Text)
-> FromCBOR (SigningKey StakeKey)
Proxy (SigningKey StakeKey) -> Text
forall s. Decoder s (SigningKey StakeKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (SigningKey StakeKey)
fromCBOR :: forall s. Decoder s (SigningKey StakeKey)
$clabel :: Proxy (SigningKey StakeKey) -> Text
label :: Proxy (SigningKey StakeKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (SigningKey StakeKey)
HasTypeProxy (SigningKey StakeKey) =>
(SigningKey StakeKey -> ByteString)
-> (AsType (SigningKey StakeKey)
    -> ByteString -> Either DecoderError (SigningKey StakeKey))
-> SerialiseAsCBOR (SigningKey StakeKey)
AsType (SigningKey StakeKey)
-> ByteString -> Either DecoderError (SigningKey StakeKey)
SigningKey StakeKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey StakeKey -> ByteString
serialiseToCBOR :: SigningKey StakeKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey StakeKey)
-> ByteString -> Either DecoderError (SigningKey StakeKey)
deserialiseFromCBOR :: AsType (SigningKey StakeKey)
-> ByteString -> Either DecoderError (SigningKey StakeKey)
SerialiseAsCBOR
      deriving (Int -> SigningKey StakeKey -> ShowS
[SigningKey StakeKey] -> ShowS
SigningKey StakeKey -> String
(Int -> SigningKey StakeKey -> ShowS)
-> (SigningKey StakeKey -> String)
-> ([SigningKey StakeKey] -> ShowS)
-> Show (SigningKey StakeKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey StakeKey -> ShowS
showsPrec :: Int -> SigningKey StakeKey -> ShowS
$cshow :: SigningKey StakeKey -> String
show :: SigningKey StakeKey -> String
$cshowList :: [SigningKey StakeKey] -> ShowS
showList :: [SigningKey StakeKey] -> ShowS
Show, String -> SigningKey StakeKey
(String -> SigningKey StakeKey) -> IsString (SigningKey StakeKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey StakeKey
fromString :: String -> SigningKey StakeKey
IsString) via UsingRawBytesHex (SigningKey StakeKey)

    deterministicSigningKey :: AsType StakeKey -> Crypto.Seed -> SigningKey StakeKey
    deterministicSigningKey :: AsType StakeKey -> Seed -> SigningKey StakeKey
deterministicSigningKey AsType StakeKey
R:AsTypeStakeKey
AsStakeKey Seed
seed =
        SignKeyDSIGN StandardCrypto -> SigningKey StakeKey
StakeSigningKey (Seed -> SignKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
Crypto.genKeyDSIGN Seed
seed)

    deterministicSigningKeySeedSize :: AsType StakeKey -> Word
    deterministicSigningKeySeedSize :: AsType StakeKey -> Word
deterministicSigningKeySeedSize AsType StakeKey
R:AsTypeStakeKey
AsStakeKey =
        Proxy Ed25519DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
Crypto.seedSizeDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

    getVerificationKey :: SigningKey StakeKey -> VerificationKey StakeKey
    getVerificationKey :: SigningKey StakeKey -> VerificationKey StakeKey
getVerificationKey (StakeSigningKey SignKeyDSIGN StandardCrypto
sk) =
        VKey 'Staking StandardCrypto -> VerificationKey StakeKey
StakeVerificationKey (VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Staking StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
Crypto.deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk))

    verificationKeyHash :: VerificationKey StakeKey -> Hash StakeKey
    verificationKeyHash :: VerificationKey StakeKey -> Hash StakeKey
verificationKeyHash (StakeVerificationKey VKey 'Staking StandardCrypto
vkey) =
        KeyHash 'Staking StandardCrypto -> Hash StakeKey
StakeKeyHash (VKey 'Staking StandardCrypto -> KeyHash 'Staking StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
Shelley.hashKey VKey 'Staking StandardCrypto
vkey)


instance SerialiseAsRawBytes (VerificationKey StakeKey) where
    serialiseToRawBytes :: VerificationKey StakeKey -> ByteString
serialiseToRawBytes (StakeVerificationKey (Shelley.VKey VerKeyDSIGN (DSIGN StandardCrypto)
vk)) =
      VerKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
Crypto.rawSerialiseVerKeyDSIGN VerKeyDSIGN Ed25519DSIGN
VerKeyDSIGN (DSIGN StandardCrypto)
vk

    deserialiseFromRawBytes :: AsType (VerificationKey StakeKey)
-> ByteString -> Maybe (VerificationKey StakeKey)
deserialiseFromRawBytes (AsVerificationKey AsType StakeKey
R:AsTypeStakeKey
AsStakeKey) ByteString
bs =
      VKey 'Staking StandardCrypto -> VerificationKey StakeKey
StakeVerificationKey (VKey 'Staking StandardCrypto -> VerificationKey StakeKey)
-> (VerKeyDSIGN Ed25519DSIGN -> VKey 'Staking StandardCrypto)
-> VerKeyDSIGN Ed25519DSIGN
-> VerificationKey StakeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VKey 'Staking StandardCrypto
VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Staking StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (VerKeyDSIGN Ed25519DSIGN -> VerificationKey StakeKey)
-> Maybe (VerKeyDSIGN Ed25519DSIGN)
-> Maybe (VerificationKey StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
Crypto.rawDeserialiseVerKeyDSIGN ByteString
bs

instance SerialiseAsRawBytes (SigningKey StakeKey) where
    serialiseToRawBytes :: SigningKey StakeKey -> ByteString
serialiseToRawBytes (StakeSigningKey SignKeyDSIGN StandardCrypto
sk) =
      SignKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
Crypto.rawSerialiseSignKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk

    deserialiseFromRawBytes :: AsType (SigningKey StakeKey)
-> ByteString -> Maybe (SigningKey StakeKey)
deserialiseFromRawBytes (AsSigningKey AsType StakeKey
R:AsTypeStakeKey
AsStakeKey) ByteString
bs =
      SignKeyDSIGN Ed25519DSIGN -> SigningKey StakeKey
SignKeyDSIGN StandardCrypto -> SigningKey StakeKey
StakeSigningKey (SignKeyDSIGN Ed25519DSIGN -> SigningKey StakeKey)
-> Maybe (SignKeyDSIGN Ed25519DSIGN) -> Maybe (SigningKey StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (SignKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
Crypto.rawDeserialiseSignKeyDSIGN ByteString
bs

instance SerialiseAsBech32 (VerificationKey StakeKey) where
    bech32PrefixFor :: VerificationKey StakeKey -> Text
bech32PrefixFor         VerificationKey StakeKey
_ =  Text
"stake_vk"
    bech32PrefixesPermitted :: AsType (VerificationKey StakeKey) -> [Text]
bech32PrefixesPermitted AsType (VerificationKey StakeKey)
_ = [Text
"stake_vk"]

instance SerialiseAsBech32 (SigningKey StakeKey) where
    bech32PrefixFor :: SigningKey StakeKey -> Text
bech32PrefixFor         SigningKey StakeKey
_ =  Text
"stake_sk"
    bech32PrefixesPermitted :: AsType (SigningKey StakeKey) -> [Text]
bech32PrefixesPermitted AsType (SigningKey StakeKey)
_ = [Text
"stake_sk"]


newtype instance Hash StakeKey =
    StakeKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto)
  deriving stock (Hash StakeKey -> Hash StakeKey -> Bool
(Hash StakeKey -> Hash StakeKey -> Bool)
-> (Hash StakeKey -> Hash StakeKey -> Bool) -> Eq (Hash StakeKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash StakeKey -> Hash StakeKey -> Bool
== :: Hash StakeKey -> Hash StakeKey -> Bool
$c/= :: Hash StakeKey -> Hash StakeKey -> Bool
/= :: Hash StakeKey -> Hash StakeKey -> Bool
Eq, Eq (Hash StakeKey)
Eq (Hash StakeKey) =>
(Hash StakeKey -> Hash StakeKey -> Ordering)
-> (Hash StakeKey -> Hash StakeKey -> Bool)
-> (Hash StakeKey -> Hash StakeKey -> Bool)
-> (Hash StakeKey -> Hash StakeKey -> Bool)
-> (Hash StakeKey -> Hash StakeKey -> Bool)
-> (Hash StakeKey -> Hash StakeKey -> Hash StakeKey)
-> (Hash StakeKey -> Hash StakeKey -> Hash StakeKey)
-> Ord (Hash StakeKey)
Hash StakeKey -> Hash StakeKey -> Bool
Hash StakeKey -> Hash StakeKey -> Ordering
Hash StakeKey -> Hash StakeKey -> Hash StakeKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash StakeKey -> Hash StakeKey -> Ordering
compare :: Hash StakeKey -> Hash StakeKey -> Ordering
$c< :: Hash StakeKey -> Hash StakeKey -> Bool
< :: Hash StakeKey -> Hash StakeKey -> Bool
$c<= :: Hash StakeKey -> Hash StakeKey -> Bool
<= :: Hash StakeKey -> Hash StakeKey -> Bool
$c> :: Hash StakeKey -> Hash StakeKey -> Bool
> :: Hash StakeKey -> Hash StakeKey -> Bool
$c>= :: Hash StakeKey -> Hash StakeKey -> Bool
>= :: Hash StakeKey -> Hash StakeKey -> Bool
$cmax :: Hash StakeKey -> Hash StakeKey -> Hash StakeKey
max :: Hash StakeKey -> Hash StakeKey -> Hash StakeKey
$cmin :: Hash StakeKey -> Hash StakeKey -> Hash StakeKey
min :: Hash StakeKey -> Hash StakeKey -> Hash StakeKey
Ord)
  deriving (Int -> Hash StakeKey -> ShowS
[Hash StakeKey] -> ShowS
Hash StakeKey -> String
(Int -> Hash StakeKey -> ShowS)
-> (Hash StakeKey -> String)
-> ([Hash StakeKey] -> ShowS)
-> Show (Hash StakeKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash StakeKey -> ShowS
showsPrec :: Int -> Hash StakeKey -> ShowS
$cshow :: Hash StakeKey -> String
show :: Hash StakeKey -> String
$cshowList :: [Hash StakeKey] -> ShowS
showList :: [Hash StakeKey] -> ShowS
Show, String -> Hash StakeKey
(String -> Hash StakeKey) -> IsString (Hash StakeKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash StakeKey
fromString :: String -> Hash StakeKey
IsString) via UsingRawBytesHex (Hash StakeKey)
  deriving (Typeable (Hash StakeKey)
Typeable (Hash StakeKey) =>
(Hash StakeKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash StakeKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash StakeKey] -> Size)
-> ToCBOR (Hash StakeKey)
Hash StakeKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash StakeKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash StakeKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Hash StakeKey -> Encoding
toCBOR :: Hash StakeKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash StakeKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash StakeKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash StakeKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash StakeKey] -> Size
ToCBOR, Typeable (Hash StakeKey)
Typeable (Hash StakeKey) =>
(forall s. Decoder s (Hash StakeKey))
-> (Proxy (Hash StakeKey) -> Text) -> FromCBOR (Hash StakeKey)
Proxy (Hash StakeKey) -> Text
forall s. Decoder s (Hash StakeKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash StakeKey)
fromCBOR :: forall s. Decoder s (Hash StakeKey)
$clabel :: Proxy (Hash StakeKey) -> Text
label :: Proxy (Hash StakeKey) -> Text
FromCBOR) via UsingRawBytes (Hash StakeKey)
  deriving anyclass HasTypeProxy (Hash StakeKey)
Hash StakeKey -> ByteString
HasTypeProxy (Hash StakeKey) =>
(Hash StakeKey -> ByteString)
-> (AsType (Hash StakeKey)
    -> ByteString -> Either DecoderError (Hash StakeKey))
-> SerialiseAsCBOR (Hash StakeKey)
AsType (Hash StakeKey)
-> ByteString -> Either DecoderError (Hash StakeKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash StakeKey -> ByteString
serialiseToCBOR :: Hash StakeKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash StakeKey)
-> ByteString -> Either DecoderError (Hash StakeKey)
deserialiseFromCBOR :: AsType (Hash StakeKey)
-> ByteString -> Either DecoderError (Hash StakeKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash StakeKey) where
    serialiseToRawBytes :: Hash StakeKey -> ByteString
serialiseToRawBytes (StakeKeyHash (Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
      Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

    deserialiseFromRawBytes :: AsType (Hash StakeKey) -> ByteString -> Maybe (Hash StakeKey)
deserialiseFromRawBytes (AsHash AsType StakeKey
R:AsTypeStakeKey
AsStakeKey) ByteString
bs =
      KeyHash 'Staking StandardCrypto -> Hash StakeKey
StakeKeyHash (KeyHash 'Staking StandardCrypto -> Hash StakeKey)
-> (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
    -> KeyHash 'Staking StandardCrypto)
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> Hash StakeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Staking StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Staking StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> Hash StakeKey)
-> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Maybe (Hash StakeKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey StakeKey) where
    textEnvelopeType :: AsType (VerificationKey StakeKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey StakeKey)
_ = TextEnvelopeType
"StakeVerificationKeyShelley_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

instance HasTextEnvelope (SigningKey StakeKey) where
    textEnvelopeType :: AsType (SigningKey StakeKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey StakeKey)
_ = TextEnvelopeType
"StakeSigningKeyShelley_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy


--
-- Shelley stake extended ed25519 keys
--

-- | Shelley-era stake keys using extended ed25519 cryptographic keys.
--
-- They can be used for Shelley stake addresses and witnessing transactions
-- that use stake addresses.
--
-- These extended keys are used by HD wallets. So this type provides
-- interoperability with HD wallets. The ITN CLI also supported this key type.
--
-- The extended verification keys can be converted (via 'castVerificationKey')
-- to ordinary keys (i.e. 'VerificationKey' 'StakeKey') but this is /not/ the
-- case for the signing keys. The signing keys can be used to witness
-- transactions directly, with verification via their non-extended verification
-- key ('VerificationKey' 'StakeKey').
--
-- This is a type level tag, used with other interfaces like 'Key'.
--
data StakeExtendedKey

instance HasTypeProxy StakeExtendedKey where
    data AsType StakeExtendedKey = AsStakeExtendedKey
    proxyToAsType :: Proxy StakeExtendedKey -> AsType StakeExtendedKey
proxyToAsType Proxy StakeExtendedKey
_ = AsType StakeExtendedKey
AsStakeExtendedKey

instance Key StakeExtendedKey where

    newtype VerificationKey StakeExtendedKey =
        StakeExtendedVerificationKey Crypto.HD.XPub
      deriving stock (VerificationKey StakeExtendedKey
-> VerificationKey StakeExtendedKey -> Bool
(VerificationKey StakeExtendedKey
 -> VerificationKey StakeExtendedKey -> Bool)
-> (VerificationKey StakeExtendedKey
    -> VerificationKey StakeExtendedKey -> Bool)
-> Eq (VerificationKey StakeExtendedKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey StakeExtendedKey
-> VerificationKey StakeExtendedKey -> Bool
== :: VerificationKey StakeExtendedKey
-> VerificationKey StakeExtendedKey -> Bool
$c/= :: VerificationKey StakeExtendedKey
-> VerificationKey StakeExtendedKey -> Bool
/= :: VerificationKey StakeExtendedKey
-> VerificationKey StakeExtendedKey -> Bool
Eq)
      deriving anyclass HasTypeProxy (VerificationKey StakeExtendedKey)
HasTypeProxy (VerificationKey StakeExtendedKey) =>
(VerificationKey StakeExtendedKey -> ByteString)
-> (AsType (VerificationKey StakeExtendedKey)
    -> ByteString
    -> Either DecoderError (VerificationKey StakeExtendedKey))
-> SerialiseAsCBOR (VerificationKey StakeExtendedKey)
AsType (VerificationKey StakeExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey StakeExtendedKey)
VerificationKey StakeExtendedKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey StakeExtendedKey -> ByteString
serialiseToCBOR :: VerificationKey StakeExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey StakeExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey StakeExtendedKey)
deserialiseFromCBOR :: AsType (VerificationKey StakeExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey StakeExtendedKey)
SerialiseAsCBOR
      deriving (Int -> VerificationKey StakeExtendedKey -> ShowS
[VerificationKey StakeExtendedKey] -> ShowS
VerificationKey StakeExtendedKey -> String
(Int -> VerificationKey StakeExtendedKey -> ShowS)
-> (VerificationKey StakeExtendedKey -> String)
-> ([VerificationKey StakeExtendedKey] -> ShowS)
-> Show (VerificationKey StakeExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey StakeExtendedKey -> ShowS
showsPrec :: Int -> VerificationKey StakeExtendedKey -> ShowS
$cshow :: VerificationKey StakeExtendedKey -> String
show :: VerificationKey StakeExtendedKey -> String
$cshowList :: [VerificationKey StakeExtendedKey] -> ShowS
showList :: [VerificationKey StakeExtendedKey] -> ShowS
Show, String -> VerificationKey StakeExtendedKey
(String -> VerificationKey StakeExtendedKey)
-> IsString (VerificationKey StakeExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey StakeExtendedKey
fromString :: String -> VerificationKey StakeExtendedKey
IsString) via UsingRawBytesHex (VerificationKey StakeExtendedKey)

    newtype SigningKey StakeExtendedKey =
        StakeExtendedSigningKey Crypto.HD.XPrv
      deriving anyclass HasTypeProxy (SigningKey StakeExtendedKey)
HasTypeProxy (SigningKey StakeExtendedKey) =>
(SigningKey StakeExtendedKey -> ByteString)
-> (AsType (SigningKey StakeExtendedKey)
    -> ByteString -> Either DecoderError (SigningKey StakeExtendedKey))
-> SerialiseAsCBOR (SigningKey StakeExtendedKey)
AsType (SigningKey StakeExtendedKey)
-> ByteString -> Either DecoderError (SigningKey StakeExtendedKey)
SigningKey StakeExtendedKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey StakeExtendedKey -> ByteString
serialiseToCBOR :: SigningKey StakeExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey StakeExtendedKey)
-> ByteString -> Either DecoderError (SigningKey StakeExtendedKey)
deserialiseFromCBOR :: AsType (SigningKey StakeExtendedKey)
-> ByteString -> Either DecoderError (SigningKey StakeExtendedKey)
SerialiseAsCBOR
      deriving (Int -> SigningKey StakeExtendedKey -> ShowS
[SigningKey StakeExtendedKey] -> ShowS
SigningKey StakeExtendedKey -> String
(Int -> SigningKey StakeExtendedKey -> ShowS)
-> (SigningKey StakeExtendedKey -> String)
-> ([SigningKey StakeExtendedKey] -> ShowS)
-> Show (SigningKey StakeExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey StakeExtendedKey -> ShowS
showsPrec :: Int -> SigningKey StakeExtendedKey -> ShowS
$cshow :: SigningKey StakeExtendedKey -> String
show :: SigningKey StakeExtendedKey -> String
$cshowList :: [SigningKey StakeExtendedKey] -> ShowS
showList :: [SigningKey StakeExtendedKey] -> ShowS
Show, String -> SigningKey StakeExtendedKey
(String -> SigningKey StakeExtendedKey)
-> IsString (SigningKey StakeExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey StakeExtendedKey
fromString :: String -> SigningKey StakeExtendedKey
IsString) via UsingRawBytesHex (SigningKey StakeExtendedKey)

    deterministicSigningKey :: AsType StakeExtendedKey
                            -> Crypto.Seed
                            -> SigningKey StakeExtendedKey
    deterministicSigningKey :: AsType StakeExtendedKey -> Seed -> SigningKey StakeExtendedKey
deterministicSigningKey AsType StakeExtendedKey
R:AsTypeStakeExtendedKey
AsStakeExtendedKey Seed
seed =
        XPrv -> SigningKey StakeExtendedKey
StakeExtendedSigningKey
          (ByteString -> ByteString -> XPrv
forall passPhrase seed.
(ByteArrayAccess passPhrase, ByteArrayAccess seed) =>
seed -> passPhrase -> XPrv
Crypto.HD.generate ByteString
seedbs ByteString
BS.empty)
      where
       (ByteString
seedbs, Seed
_) = Word -> Seed -> (ByteString, Seed)
Crypto.getBytesFromSeedT Word
32 Seed
seed

    deterministicSigningKeySeedSize :: AsType StakeExtendedKey -> Word
    deterministicSigningKeySeedSize :: AsType StakeExtendedKey -> Word
deterministicSigningKeySeedSize AsType StakeExtendedKey
R:AsTypeStakeExtendedKey
AsStakeExtendedKey = Word
32

    getVerificationKey :: SigningKey StakeExtendedKey
                       -> VerificationKey StakeExtendedKey
    getVerificationKey :: SigningKey StakeExtendedKey -> VerificationKey StakeExtendedKey
getVerificationKey (StakeExtendedSigningKey XPrv
sk) =
        XPub -> VerificationKey StakeExtendedKey
StakeExtendedVerificationKey (HasCallStack => XPrv -> XPub
XPrv -> XPub
Crypto.HD.toXPub XPrv
sk)

    -- | We use the hash of the normal non-extended pub key so that it is
    -- consistent with the one used in addresses and signatures.
    --
    verificationKeyHash :: VerificationKey StakeExtendedKey
                        -> Hash StakeExtendedKey
    verificationKeyHash :: VerificationKey StakeExtendedKey -> Hash StakeExtendedKey
verificationKeyHash (StakeExtendedVerificationKey XPub
vk) =
        KeyHash 'Staking StandardCrypto -> Hash StakeExtendedKey
StakeExtendedKeyHash
      (KeyHash 'Staking StandardCrypto -> Hash StakeExtendedKey)
-> (Hash Blake2b_224 XPub -> KeyHash 'Staking StandardCrypto)
-> Hash Blake2b_224 XPub
-> Hash StakeExtendedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Staking StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Staking StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash
      (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
 -> KeyHash 'Staking StandardCrypto)
-> (Hash Blake2b_224 XPub
    -> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Hash Blake2b_224 XPub
-> KeyHash 'Staking StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 XPub
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
forall h a b. Hash h a -> Hash h b
Crypto.castHash
      (Hash Blake2b_224 XPub -> Hash StakeExtendedKey)
-> Hash Blake2b_224 XPub -> Hash StakeExtendedKey
forall a b. (a -> b) -> a -> b
$ (XPub -> ByteString) -> XPub -> Hash Blake2b_224 XPub
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith XPub -> ByteString
Crypto.HD.xpubPublicKey XPub
vk


instance ToCBOR (VerificationKey StakeExtendedKey) where
    toCBOR :: VerificationKey StakeExtendedKey -> Encoding
toCBOR (StakeExtendedVerificationKey XPub
xpub) =
      ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (XPub -> ByteString
Crypto.HD.unXPub XPub
xpub)

instance FromCBOR (VerificationKey StakeExtendedKey) where
    fromCBOR :: forall s. Decoder s (VerificationKey StakeExtendedKey)
fromCBOR = do
      ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (String -> Decoder s (VerificationKey StakeExtendedKey))
-> (XPub -> Decoder s (VerificationKey StakeExtendedKey))
-> Either String XPub
-> Decoder s (VerificationKey StakeExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Decoder s (VerificationKey StakeExtendedKey)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (VerificationKey StakeExtendedKey
-> Decoder s (VerificationKey StakeExtendedKey)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey StakeExtendedKey
 -> Decoder s (VerificationKey StakeExtendedKey))
-> (XPub -> VerificationKey StakeExtendedKey)
-> XPub
-> Decoder s (VerificationKey StakeExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey StakeExtendedKey
StakeExtendedVerificationKey)
             (ByteString -> Either String XPub
Crypto.HD.xpub (ByteString
bs :: ByteString))

instance ToCBOR (SigningKey StakeExtendedKey) where
    toCBOR :: SigningKey StakeExtendedKey -> Encoding
toCBOR (StakeExtendedSigningKey XPrv
xprv) =
      ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (XPrv -> ByteString
Crypto.HD.unXPrv XPrv
xprv)

instance FromCBOR (SigningKey StakeExtendedKey) where
    fromCBOR :: forall s. Decoder s (SigningKey StakeExtendedKey)
fromCBOR = do
      ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (String -> Decoder s (SigningKey StakeExtendedKey))
-> (XPrv -> Decoder s (SigningKey StakeExtendedKey))
-> Either String XPrv
-> Decoder s (SigningKey StakeExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Decoder s (SigningKey StakeExtendedKey)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (SigningKey StakeExtendedKey
-> Decoder s (SigningKey StakeExtendedKey)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SigningKey StakeExtendedKey
 -> Decoder s (SigningKey StakeExtendedKey))
-> (XPrv -> SigningKey StakeExtendedKey)
-> XPrv
-> Decoder s (SigningKey StakeExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey StakeExtendedKey
StakeExtendedSigningKey)
             (ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
Crypto.HD.xprv (ByteString
bs :: ByteString))

instance SerialiseAsRawBytes (VerificationKey StakeExtendedKey) where
    serialiseToRawBytes :: VerificationKey StakeExtendedKey -> ByteString
serialiseToRawBytes (StakeExtendedVerificationKey XPub
xpub) =
      XPub -> ByteString
Crypto.HD.unXPub XPub
xpub

    deserialiseFromRawBytes :: AsType (VerificationKey StakeExtendedKey)
-> ByteString -> Maybe (VerificationKey StakeExtendedKey)
deserialiseFromRawBytes (AsVerificationKey AsType StakeExtendedKey
R:AsTypeStakeExtendedKey
AsStakeExtendedKey) ByteString
bs =
      (String -> Maybe (VerificationKey StakeExtendedKey))
-> (XPub -> Maybe (VerificationKey StakeExtendedKey))
-> Either String XPub
-> Maybe (VerificationKey StakeExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (VerificationKey StakeExtendedKey)
-> String -> Maybe (VerificationKey StakeExtendedKey)
forall a b. a -> b -> a
const Maybe (VerificationKey StakeExtendedKey)
forall a. Maybe a
Nothing) (VerificationKey StakeExtendedKey
-> Maybe (VerificationKey StakeExtendedKey)
forall a. a -> Maybe a
Just (VerificationKey StakeExtendedKey
 -> Maybe (VerificationKey StakeExtendedKey))
-> (XPub -> VerificationKey StakeExtendedKey)
-> XPub
-> Maybe (VerificationKey StakeExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey StakeExtendedKey
StakeExtendedVerificationKey)
             (ByteString -> Either String XPub
Crypto.HD.xpub ByteString
bs)

instance SerialiseAsRawBytes (SigningKey StakeExtendedKey) where
    serialiseToRawBytes :: SigningKey StakeExtendedKey -> ByteString
serialiseToRawBytes (StakeExtendedSigningKey XPrv
xprv) =
      XPrv -> ByteString
Crypto.HD.unXPrv XPrv
xprv

    deserialiseFromRawBytes :: AsType (SigningKey StakeExtendedKey)
-> ByteString -> Maybe (SigningKey StakeExtendedKey)
deserialiseFromRawBytes (AsSigningKey AsType StakeExtendedKey
R:AsTypeStakeExtendedKey
AsStakeExtendedKey) ByteString
bs =
      (String -> Maybe (SigningKey StakeExtendedKey))
-> (XPrv -> Maybe (SigningKey StakeExtendedKey))
-> Either String XPrv
-> Maybe (SigningKey StakeExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (SigningKey StakeExtendedKey)
-> String -> Maybe (SigningKey StakeExtendedKey)
forall a b. a -> b -> a
const Maybe (SigningKey StakeExtendedKey)
forall a. Maybe a
Nothing) (SigningKey StakeExtendedKey -> Maybe (SigningKey StakeExtendedKey)
forall a. a -> Maybe a
Just (SigningKey StakeExtendedKey
 -> Maybe (SigningKey StakeExtendedKey))
-> (XPrv -> SigningKey StakeExtendedKey)
-> XPrv
-> Maybe (SigningKey StakeExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey StakeExtendedKey
StakeExtendedSigningKey)
             (ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
Crypto.HD.xprv ByteString
bs)

instance SerialiseAsBech32 (VerificationKey StakeExtendedKey) where
    bech32PrefixFor :: VerificationKey StakeExtendedKey -> Text
bech32PrefixFor         VerificationKey StakeExtendedKey
_ =  Text
"stake_xvk"
    bech32PrefixesPermitted :: AsType (VerificationKey StakeExtendedKey) -> [Text]
bech32PrefixesPermitted AsType (VerificationKey StakeExtendedKey)
_ = [Text
"stake_xvk"]

instance SerialiseAsBech32 (SigningKey StakeExtendedKey) where
    bech32PrefixFor :: SigningKey StakeExtendedKey -> Text
bech32PrefixFor         SigningKey StakeExtendedKey
_ =  Text
"stake_xsk"
    bech32PrefixesPermitted :: AsType (SigningKey StakeExtendedKey) -> [Text]
bech32PrefixesPermitted AsType (SigningKey StakeExtendedKey)
_ = [Text
"stake_xsk"]


newtype instance Hash StakeExtendedKey =
    StakeExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto)
  deriving stock (Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
(Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool)
-> (Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool)
-> Eq (Hash StakeExtendedKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
== :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
$c/= :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
/= :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
Eq, Eq (Hash StakeExtendedKey)
Eq (Hash StakeExtendedKey) =>
(Hash StakeExtendedKey -> Hash StakeExtendedKey -> Ordering)
-> (Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool)
-> (Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool)
-> (Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool)
-> (Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool)
-> (Hash StakeExtendedKey
    -> Hash StakeExtendedKey -> Hash StakeExtendedKey)
-> (Hash StakeExtendedKey
    -> Hash StakeExtendedKey -> Hash StakeExtendedKey)
-> Ord (Hash StakeExtendedKey)
Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
Hash StakeExtendedKey -> Hash StakeExtendedKey -> Ordering
Hash StakeExtendedKey
-> Hash StakeExtendedKey -> Hash StakeExtendedKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Ordering
compare :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Ordering
$c< :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
< :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
$c<= :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
<= :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
$c> :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
> :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
$c>= :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
>= :: Hash StakeExtendedKey -> Hash StakeExtendedKey -> Bool
$cmax :: Hash StakeExtendedKey
-> Hash StakeExtendedKey -> Hash StakeExtendedKey
max :: Hash StakeExtendedKey
-> Hash StakeExtendedKey -> Hash StakeExtendedKey
$cmin :: Hash StakeExtendedKey
-> Hash StakeExtendedKey -> Hash StakeExtendedKey
min :: Hash StakeExtendedKey
-> Hash StakeExtendedKey -> Hash StakeExtendedKey
Ord)
  deriving (Int -> Hash StakeExtendedKey -> ShowS
[Hash StakeExtendedKey] -> ShowS
Hash StakeExtendedKey -> String
(Int -> Hash StakeExtendedKey -> ShowS)
-> (Hash StakeExtendedKey -> String)
-> ([Hash StakeExtendedKey] -> ShowS)
-> Show (Hash StakeExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash StakeExtendedKey -> ShowS
showsPrec :: Int -> Hash StakeExtendedKey -> ShowS
$cshow :: Hash StakeExtendedKey -> String
show :: Hash StakeExtendedKey -> String
$cshowList :: [Hash StakeExtendedKey] -> ShowS
showList :: [Hash StakeExtendedKey] -> ShowS
Show, String -> Hash StakeExtendedKey
(String -> Hash StakeExtendedKey)
-> IsString (Hash StakeExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash StakeExtendedKey
fromString :: String -> Hash StakeExtendedKey
IsString) via UsingRawBytesHex (Hash StakeExtendedKey)
  deriving (Typeable (Hash StakeExtendedKey)
Typeable (Hash StakeExtendedKey) =>
(Hash StakeExtendedKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash StakeExtendedKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash StakeExtendedKey] -> Size)
-> ToCBOR (Hash StakeExtendedKey)
Hash StakeExtendedKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash StakeExtendedKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash StakeExtendedKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Hash StakeExtendedKey -> Encoding
toCBOR :: Hash StakeExtendedKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash StakeExtendedKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash StakeExtendedKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash StakeExtendedKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash StakeExtendedKey] -> Size
ToCBOR, Typeable (Hash StakeExtendedKey)
Typeable (Hash StakeExtendedKey) =>
(forall s. Decoder s (Hash StakeExtendedKey))
-> (Proxy (Hash StakeExtendedKey) -> Text)
-> FromCBOR (Hash StakeExtendedKey)
Proxy (Hash StakeExtendedKey) -> Text
forall s. Decoder s (Hash StakeExtendedKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash StakeExtendedKey)
fromCBOR :: forall s. Decoder s (Hash StakeExtendedKey)
$clabel :: Proxy (Hash StakeExtendedKey) -> Text
label :: Proxy (Hash StakeExtendedKey) -> Text
FromCBOR) via UsingRawBytes (Hash StakeExtendedKey)
  deriving anyclass HasTypeProxy (Hash StakeExtendedKey)
Hash StakeExtendedKey -> ByteString
HasTypeProxy (Hash StakeExtendedKey) =>
(Hash StakeExtendedKey -> ByteString)
-> (AsType (Hash StakeExtendedKey)
    -> ByteString -> Either DecoderError (Hash StakeExtendedKey))
-> SerialiseAsCBOR (Hash StakeExtendedKey)
AsType (Hash StakeExtendedKey)
-> ByteString -> Either DecoderError (Hash StakeExtendedKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash StakeExtendedKey -> ByteString
serialiseToCBOR :: Hash StakeExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash StakeExtendedKey)
-> ByteString -> Either DecoderError (Hash StakeExtendedKey)
deserialiseFromCBOR :: AsType (Hash StakeExtendedKey)
-> ByteString -> Either DecoderError (Hash StakeExtendedKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash StakeExtendedKey) where
    serialiseToRawBytes :: Hash StakeExtendedKey -> ByteString
serialiseToRawBytes (StakeExtendedKeyHash (Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
      Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

    deserialiseFromRawBytes :: AsType (Hash StakeExtendedKey)
-> ByteString -> Maybe (Hash StakeExtendedKey)
deserialiseFromRawBytes (AsHash AsType StakeExtendedKey
R:AsTypeStakeExtendedKey
AsStakeExtendedKey) ByteString
bs =
      KeyHash 'Staking StandardCrypto -> Hash StakeExtendedKey
StakeExtendedKeyHash (KeyHash 'Staking StandardCrypto -> Hash StakeExtendedKey)
-> (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
    -> KeyHash 'Staking StandardCrypto)
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> Hash StakeExtendedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Staking StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Staking StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
 -> Hash StakeExtendedKey)
-> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Maybe (Hash StakeExtendedKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey StakeExtendedKey) where
    textEnvelopeType :: AsType (VerificationKey StakeExtendedKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey StakeExtendedKey)
_ = TextEnvelopeType
"StakeExtendedVerificationKeyShelley_ed25519_bip32"

instance HasTextEnvelope (SigningKey StakeExtendedKey) where
    textEnvelopeType :: AsType (SigningKey StakeExtendedKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey StakeExtendedKey)
_ = TextEnvelopeType
"StakeExtendedSigningKeyShelley_ed25519_bip32"

instance CastVerificationKeyRole StakeExtendedKey StakeKey where
    castVerificationKey :: VerificationKey StakeExtendedKey -> VerificationKey StakeKey
castVerificationKey (StakeExtendedVerificationKey XPub
vk) =
        VKey 'Staking StandardCrypto -> VerificationKey StakeKey
StakeVerificationKey
      (VKey 'Staking StandardCrypto -> VerificationKey StakeKey)
-> (XPub -> VKey 'Staking StandardCrypto)
-> XPub
-> VerificationKey StakeKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VKey 'Staking StandardCrypto
VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Staking StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey
      (VerKeyDSIGN Ed25519DSIGN -> VKey 'Staking StandardCrypto)
-> (XPub -> VerKeyDSIGN Ed25519DSIGN)
-> XPub
-> VKey 'Staking StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN
-> Maybe (VerKeyDSIGN Ed25519DSIGN) -> VerKeyDSIGN Ed25519DSIGN
forall a. a -> Maybe a -> a
fromMaybe VerKeyDSIGN Ed25519DSIGN
forall {a}. a
impossible
      (Maybe (VerKeyDSIGN Ed25519DSIGN) -> VerKeyDSIGN Ed25519DSIGN)
-> (XPub -> Maybe (VerKeyDSIGN Ed25519DSIGN))
-> XPub
-> VerKeyDSIGN Ed25519DSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
Crypto.rawDeserialiseVerKeyDSIGN
      (ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN))
-> (XPub -> ByteString) -> XPub -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
Crypto.HD.xpubPublicKey
      (XPub -> VerificationKey StakeKey)
-> XPub -> VerificationKey StakeKey
forall a b. (a -> b) -> a -> b
$ XPub
vk
      where
        impossible :: a
impossible =
          String -> a
forall a. HasCallStack => String -> a
error String
"castVerificationKey: byron and shelley key sizes do not match!"


--
-- Genesis keys
--

data GenesisKey

instance HasTypeProxy GenesisKey where
    data AsType GenesisKey = AsGenesisKey
    proxyToAsType :: Proxy GenesisKey -> AsType GenesisKey
proxyToAsType Proxy GenesisKey
_ = AsType GenesisKey
AsGenesisKey

instance Key GenesisKey where

    newtype VerificationKey GenesisKey =
        GenesisVerificationKey (Shelley.VKey Shelley.Genesis StandardCrypto)
      deriving stock (VerificationKey GenesisKey -> VerificationKey GenesisKey -> Bool
(VerificationKey GenesisKey -> VerificationKey GenesisKey -> Bool)
-> (VerificationKey GenesisKey
    -> VerificationKey GenesisKey -> Bool)
-> Eq (VerificationKey GenesisKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey GenesisKey -> VerificationKey GenesisKey -> Bool
== :: VerificationKey GenesisKey -> VerificationKey GenesisKey -> Bool
$c/= :: VerificationKey GenesisKey -> VerificationKey GenesisKey -> Bool
/= :: VerificationKey GenesisKey -> VerificationKey GenesisKey -> Bool
Eq)
      deriving (Int -> VerificationKey GenesisKey -> ShowS
[VerificationKey GenesisKey] -> ShowS
VerificationKey GenesisKey -> String
(Int -> VerificationKey GenesisKey -> ShowS)
-> (VerificationKey GenesisKey -> String)
-> ([VerificationKey GenesisKey] -> ShowS)
-> Show (VerificationKey GenesisKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey GenesisKey -> ShowS
showsPrec :: Int -> VerificationKey GenesisKey -> ShowS
$cshow :: VerificationKey GenesisKey -> String
show :: VerificationKey GenesisKey -> String
$cshowList :: [VerificationKey GenesisKey] -> ShowS
showList :: [VerificationKey GenesisKey] -> ShowS
Show, String -> VerificationKey GenesisKey
(String -> VerificationKey GenesisKey)
-> IsString (VerificationKey GenesisKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey GenesisKey
fromString :: String -> VerificationKey GenesisKey
IsString) via UsingRawBytesHex (VerificationKey GenesisKey)
      deriving newtype (Typeable (VerificationKey GenesisKey)
Typeable (VerificationKey GenesisKey) =>
(VerificationKey GenesisKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey GenesisKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey GenesisKey] -> Size)
-> ToCBOR (VerificationKey GenesisKey)
VerificationKey GenesisKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey GenesisKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey GenesisKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: VerificationKey GenesisKey -> Encoding
toCBOR :: VerificationKey GenesisKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey GenesisKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey GenesisKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey GenesisKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey GenesisKey] -> Size
ToCBOR, Typeable (VerificationKey GenesisKey)
Typeable (VerificationKey GenesisKey) =>
(forall s. Decoder s (VerificationKey GenesisKey))
-> (Proxy (VerificationKey GenesisKey) -> Text)
-> FromCBOR (VerificationKey GenesisKey)
Proxy (VerificationKey GenesisKey) -> Text
forall s. Decoder s (VerificationKey GenesisKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (VerificationKey GenesisKey)
fromCBOR :: forall s. Decoder s (VerificationKey GenesisKey)
$clabel :: Proxy (VerificationKey GenesisKey) -> Text
label :: Proxy (VerificationKey GenesisKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (VerificationKey GenesisKey)
HasTypeProxy (VerificationKey GenesisKey) =>
(VerificationKey GenesisKey -> ByteString)
-> (AsType (VerificationKey GenesisKey)
    -> ByteString -> Either DecoderError (VerificationKey GenesisKey))
-> SerialiseAsCBOR (VerificationKey GenesisKey)
AsType (VerificationKey GenesisKey)
-> ByteString -> Either DecoderError (VerificationKey GenesisKey)
VerificationKey GenesisKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey GenesisKey -> ByteString
serialiseToCBOR :: VerificationKey GenesisKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey GenesisKey)
-> ByteString -> Either DecoderError (VerificationKey GenesisKey)
deserialiseFromCBOR :: AsType (VerificationKey GenesisKey)
-> ByteString -> Either DecoderError (VerificationKey GenesisKey)
SerialiseAsCBOR

    newtype SigningKey GenesisKey =
        GenesisSigningKey (Shelley.SignKeyDSIGN StandardCrypto)
      deriving (Int -> SigningKey GenesisKey -> ShowS
[SigningKey GenesisKey] -> ShowS
SigningKey GenesisKey -> String
(Int -> SigningKey GenesisKey -> ShowS)
-> (SigningKey GenesisKey -> String)
-> ([SigningKey GenesisKey] -> ShowS)
-> Show (SigningKey GenesisKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey GenesisKey -> ShowS
showsPrec :: Int -> SigningKey GenesisKey -> ShowS
$cshow :: SigningKey GenesisKey -> String
show :: SigningKey GenesisKey -> String
$cshowList :: [SigningKey GenesisKey] -> ShowS
showList :: [SigningKey GenesisKey] -> ShowS
Show, String -> SigningKey GenesisKey
(String -> SigningKey GenesisKey)
-> IsString (SigningKey GenesisKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey GenesisKey
fromString :: String -> SigningKey GenesisKey
IsString) via UsingRawBytesHex (SigningKey GenesisKey)
      deriving newtype (Typeable (SigningKey GenesisKey)
Typeable (SigningKey GenesisKey) =>
(SigningKey GenesisKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey GenesisKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey GenesisKey] -> Size)
-> ToCBOR (SigningKey GenesisKey)
SigningKey GenesisKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey GenesisKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey GenesisKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SigningKey GenesisKey -> Encoding
toCBOR :: SigningKey GenesisKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey GenesisKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey GenesisKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey GenesisKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey GenesisKey] -> Size
ToCBOR, Typeable (SigningKey GenesisKey)
Typeable (SigningKey GenesisKey) =>
(forall s. Decoder s (SigningKey GenesisKey))
-> (Proxy (SigningKey GenesisKey) -> Text)
-> FromCBOR (SigningKey GenesisKey)
Proxy (SigningKey GenesisKey) -> Text
forall s. Decoder s (SigningKey GenesisKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (SigningKey GenesisKey)
fromCBOR :: forall s. Decoder s (SigningKey GenesisKey)
$clabel :: Proxy (SigningKey GenesisKey) -> Text
label :: Proxy (SigningKey GenesisKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (SigningKey GenesisKey)
HasTypeProxy (SigningKey GenesisKey) =>
(SigningKey GenesisKey -> ByteString)
-> (AsType (SigningKey GenesisKey)
    -> ByteString -> Either DecoderError (SigningKey GenesisKey))
-> SerialiseAsCBOR (SigningKey GenesisKey)
AsType (SigningKey GenesisKey)
-> ByteString -> Either DecoderError (SigningKey GenesisKey)
SigningKey GenesisKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey GenesisKey -> ByteString
serialiseToCBOR :: SigningKey GenesisKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey GenesisKey)
-> ByteString -> Either DecoderError (SigningKey GenesisKey)
deserialiseFromCBOR :: AsType (SigningKey GenesisKey)
-> ByteString -> Either DecoderError (SigningKey GenesisKey)
SerialiseAsCBOR

    deterministicSigningKey :: AsType GenesisKey -> Crypto.Seed -> SigningKey GenesisKey
    deterministicSigningKey :: AsType GenesisKey -> Seed -> SigningKey GenesisKey
deterministicSigningKey AsType GenesisKey
R:AsTypeGenesisKey
AsGenesisKey Seed
seed =
        SignKeyDSIGN StandardCrypto -> SigningKey GenesisKey
GenesisSigningKey (Seed -> SignKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
Crypto.genKeyDSIGN Seed
seed)

    deterministicSigningKeySeedSize :: AsType GenesisKey -> Word
    deterministicSigningKeySeedSize :: AsType GenesisKey -> Word
deterministicSigningKeySeedSize AsType GenesisKey
R:AsTypeGenesisKey
AsGenesisKey =
        Proxy Ed25519DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
Crypto.seedSizeDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

    getVerificationKey :: SigningKey GenesisKey -> VerificationKey GenesisKey
    getVerificationKey :: SigningKey GenesisKey -> VerificationKey GenesisKey
getVerificationKey (GenesisSigningKey SignKeyDSIGN StandardCrypto
sk) =
        VKey 'Genesis StandardCrypto -> VerificationKey GenesisKey
GenesisVerificationKey (VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Genesis StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
Crypto.deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk))

    verificationKeyHash :: VerificationKey GenesisKey -> Hash GenesisKey
    verificationKeyHash :: VerificationKey GenesisKey -> Hash GenesisKey
verificationKeyHash (GenesisVerificationKey VKey 'Genesis StandardCrypto
vkey) =
        KeyHash 'Genesis StandardCrypto -> Hash GenesisKey
GenesisKeyHash (VKey 'Genesis StandardCrypto -> KeyHash 'Genesis StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
Shelley.hashKey VKey 'Genesis StandardCrypto
vkey)


instance SerialiseAsRawBytes (VerificationKey GenesisKey) where
    serialiseToRawBytes :: VerificationKey GenesisKey -> ByteString
serialiseToRawBytes (GenesisVerificationKey (Shelley.VKey VerKeyDSIGN (DSIGN StandardCrypto)
vk)) =
      VerKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
Crypto.rawSerialiseVerKeyDSIGN VerKeyDSIGN Ed25519DSIGN
VerKeyDSIGN (DSIGN StandardCrypto)
vk

    deserialiseFromRawBytes :: AsType (VerificationKey GenesisKey)
-> ByteString -> Maybe (VerificationKey GenesisKey)
deserialiseFromRawBytes (AsVerificationKey AsType GenesisKey
R:AsTypeGenesisKey
AsGenesisKey) ByteString
bs =
      VKey 'Genesis StandardCrypto -> VerificationKey GenesisKey
GenesisVerificationKey (VKey 'Genesis StandardCrypto -> VerificationKey GenesisKey)
-> (VerKeyDSIGN Ed25519DSIGN -> VKey 'Genesis StandardCrypto)
-> VerKeyDSIGN Ed25519DSIGN
-> VerificationKey GenesisKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VKey 'Genesis StandardCrypto
VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Genesis StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (VerKeyDSIGN Ed25519DSIGN -> VerificationKey GenesisKey)
-> Maybe (VerKeyDSIGN Ed25519DSIGN)
-> Maybe (VerificationKey GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
Crypto.rawDeserialiseVerKeyDSIGN ByteString
bs

instance SerialiseAsRawBytes (SigningKey GenesisKey) where
    serialiseToRawBytes :: SigningKey GenesisKey -> ByteString
serialiseToRawBytes (GenesisSigningKey SignKeyDSIGN StandardCrypto
sk) =
      SignKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
Crypto.rawSerialiseSignKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk

    deserialiseFromRawBytes :: AsType (SigningKey GenesisKey)
-> ByteString -> Maybe (SigningKey GenesisKey)
deserialiseFromRawBytes (AsSigningKey AsType GenesisKey
R:AsTypeGenesisKey
AsGenesisKey) ByteString
bs =
      SignKeyDSIGN Ed25519DSIGN -> SigningKey GenesisKey
SignKeyDSIGN StandardCrypto -> SigningKey GenesisKey
GenesisSigningKey (SignKeyDSIGN Ed25519DSIGN -> SigningKey GenesisKey)
-> Maybe (SignKeyDSIGN Ed25519DSIGN)
-> Maybe (SigningKey GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (SignKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
Crypto.rawDeserialiseSignKeyDSIGN ByteString
bs


newtype instance Hash GenesisKey =
    GenesisKeyHash (Shelley.KeyHash Shelley.Genesis StandardCrypto)
  deriving stock (Hash GenesisKey -> Hash GenesisKey -> Bool
(Hash GenesisKey -> Hash GenesisKey -> Bool)
-> (Hash GenesisKey -> Hash GenesisKey -> Bool)
-> Eq (Hash GenesisKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash GenesisKey -> Hash GenesisKey -> Bool
== :: Hash GenesisKey -> Hash GenesisKey -> Bool
$c/= :: Hash GenesisKey -> Hash GenesisKey -> Bool
/= :: Hash GenesisKey -> Hash GenesisKey -> Bool
Eq, Eq (Hash GenesisKey)
Eq (Hash GenesisKey) =>
(Hash GenesisKey -> Hash GenesisKey -> Ordering)
-> (Hash GenesisKey -> Hash GenesisKey -> Bool)
-> (Hash GenesisKey -> Hash GenesisKey -> Bool)
-> (Hash GenesisKey -> Hash GenesisKey -> Bool)
-> (Hash GenesisKey -> Hash GenesisKey -> Bool)
-> (Hash GenesisKey -> Hash GenesisKey -> Hash GenesisKey)
-> (Hash GenesisKey -> Hash GenesisKey -> Hash GenesisKey)
-> Ord (Hash GenesisKey)
Hash GenesisKey -> Hash GenesisKey -> Bool
Hash GenesisKey -> Hash GenesisKey -> Ordering
Hash GenesisKey -> Hash GenesisKey -> Hash GenesisKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash GenesisKey -> Hash GenesisKey -> Ordering
compare :: Hash GenesisKey -> Hash GenesisKey -> Ordering
$c< :: Hash GenesisKey -> Hash GenesisKey -> Bool
< :: Hash GenesisKey -> Hash GenesisKey -> Bool
$c<= :: Hash GenesisKey -> Hash GenesisKey -> Bool
<= :: Hash GenesisKey -> Hash GenesisKey -> Bool
$c> :: Hash GenesisKey -> Hash GenesisKey -> Bool
> :: Hash GenesisKey -> Hash GenesisKey -> Bool
$c>= :: Hash GenesisKey -> Hash GenesisKey -> Bool
>= :: Hash GenesisKey -> Hash GenesisKey -> Bool
$cmax :: Hash GenesisKey -> Hash GenesisKey -> Hash GenesisKey
max :: Hash GenesisKey -> Hash GenesisKey -> Hash GenesisKey
$cmin :: Hash GenesisKey -> Hash GenesisKey -> Hash GenesisKey
min :: Hash GenesisKey -> Hash GenesisKey -> Hash GenesisKey
Ord)
  deriving (Int -> Hash GenesisKey -> ShowS
[Hash GenesisKey] -> ShowS
Hash GenesisKey -> String
(Int -> Hash GenesisKey -> ShowS)
-> (Hash GenesisKey -> String)
-> ([Hash GenesisKey] -> ShowS)
-> Show (Hash GenesisKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash GenesisKey -> ShowS
showsPrec :: Int -> Hash GenesisKey -> ShowS
$cshow :: Hash GenesisKey -> String
show :: Hash GenesisKey -> String
$cshowList :: [Hash GenesisKey] -> ShowS
showList :: [Hash GenesisKey] -> ShowS
Show, String -> Hash GenesisKey
(String -> Hash GenesisKey) -> IsString (Hash GenesisKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash GenesisKey
fromString :: String -> Hash GenesisKey
IsString) via UsingRawBytesHex (Hash GenesisKey)
  deriving (Typeable (Hash GenesisKey)
Typeable (Hash GenesisKey) =>
(Hash GenesisKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash GenesisKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash GenesisKey] -> Size)
-> ToCBOR (Hash GenesisKey)
Hash GenesisKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Hash GenesisKey -> Encoding
toCBOR :: Hash GenesisKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisKey] -> Size
ToCBOR, Typeable (Hash GenesisKey)
Typeable (Hash GenesisKey) =>
(forall s. Decoder s (Hash GenesisKey))
-> (Proxy (Hash GenesisKey) -> Text) -> FromCBOR (Hash GenesisKey)
Proxy (Hash GenesisKey) -> Text
forall s. Decoder s (Hash GenesisKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash GenesisKey)
fromCBOR :: forall s. Decoder s (Hash GenesisKey)
$clabel :: Proxy (Hash GenesisKey) -> Text
label :: Proxy (Hash GenesisKey) -> Text
FromCBOR) via UsingRawBytes (Hash GenesisKey)
  deriving anyclass HasTypeProxy (Hash GenesisKey)
Hash GenesisKey -> ByteString
HasTypeProxy (Hash GenesisKey) =>
(Hash GenesisKey -> ByteString)
-> (AsType (Hash GenesisKey)
    -> ByteString -> Either DecoderError (Hash GenesisKey))
-> SerialiseAsCBOR (Hash GenesisKey)
AsType (Hash GenesisKey)
-> ByteString -> Either DecoderError (Hash GenesisKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash GenesisKey -> ByteString
serialiseToCBOR :: Hash GenesisKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash GenesisKey)
-> ByteString -> Either DecoderError (Hash GenesisKey)
deserialiseFromCBOR :: AsType (Hash GenesisKey)
-> ByteString -> Either DecoderError (Hash GenesisKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash GenesisKey) where
    serialiseToRawBytes :: Hash GenesisKey -> ByteString
serialiseToRawBytes (GenesisKeyHash (Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
      Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

    deserialiseFromRawBytes :: AsType (Hash GenesisKey) -> ByteString -> Maybe (Hash GenesisKey)
deserialiseFromRawBytes (AsHash AsType GenesisKey
R:AsTypeGenesisKey
AsGenesisKey) ByteString
bs =
      KeyHash 'Genesis StandardCrypto -> Hash GenesisKey
GenesisKeyHash (KeyHash 'Genesis StandardCrypto -> Hash GenesisKey)
-> (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
    -> KeyHash 'Genesis StandardCrypto)
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> Hash GenesisKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Genesis StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Genesis StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> Hash GenesisKey)
-> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Maybe (Hash GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey GenesisKey) where
    textEnvelopeType :: AsType (VerificationKey GenesisKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey GenesisKey)
_ = TextEnvelopeType
"GenesisVerificationKey_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

instance HasTextEnvelope (SigningKey GenesisKey) where
    textEnvelopeType :: AsType (SigningKey GenesisKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey GenesisKey)
_ = TextEnvelopeType
"GenesisSigningKey_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy


--
-- Shelley genesis extended ed25519 keys
--

-- | Shelley-era genesis keys using extended ed25519 cryptographic keys.
--
-- These serve the same role as normal genesis keys, but are here to support
-- legacy Byron genesis keys which used extended keys.
--
-- The extended verification keys can be converted (via 'castVerificationKey')
-- to ordinary keys (i.e. 'VerificationKey' 'GenesisKey') but this is /not/ the
-- case for the signing keys. The signing keys can be used to witness
-- transactions directly, with verification via their non-extended verification
-- key ('VerificationKey' 'GenesisKey').
--
-- This is a type level tag, used with other interfaces like 'Key'.
--
data GenesisExtendedKey

instance HasTypeProxy GenesisExtendedKey where
    data AsType GenesisExtendedKey = AsGenesisExtendedKey
    proxyToAsType :: Proxy GenesisExtendedKey -> AsType GenesisExtendedKey
proxyToAsType Proxy GenesisExtendedKey
_ = AsType GenesisExtendedKey
AsGenesisExtendedKey

instance Key GenesisExtendedKey where

    newtype VerificationKey GenesisExtendedKey =
        GenesisExtendedVerificationKey Crypto.HD.XPub
      deriving stock (VerificationKey GenesisExtendedKey
-> VerificationKey GenesisExtendedKey -> Bool
(VerificationKey GenesisExtendedKey
 -> VerificationKey GenesisExtendedKey -> Bool)
-> (VerificationKey GenesisExtendedKey
    -> VerificationKey GenesisExtendedKey -> Bool)
-> Eq (VerificationKey GenesisExtendedKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey GenesisExtendedKey
-> VerificationKey GenesisExtendedKey -> Bool
== :: VerificationKey GenesisExtendedKey
-> VerificationKey GenesisExtendedKey -> Bool
$c/= :: VerificationKey GenesisExtendedKey
-> VerificationKey GenesisExtendedKey -> Bool
/= :: VerificationKey GenesisExtendedKey
-> VerificationKey GenesisExtendedKey -> Bool
Eq)
      deriving anyclass HasTypeProxy (VerificationKey GenesisExtendedKey)
HasTypeProxy (VerificationKey GenesisExtendedKey) =>
(VerificationKey GenesisExtendedKey -> ByteString)
-> (AsType (VerificationKey GenesisExtendedKey)
    -> ByteString
    -> Either DecoderError (VerificationKey GenesisExtendedKey))
-> SerialiseAsCBOR (VerificationKey GenesisExtendedKey)
AsType (VerificationKey GenesisExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisExtendedKey)
VerificationKey GenesisExtendedKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey GenesisExtendedKey -> ByteString
serialiseToCBOR :: VerificationKey GenesisExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey GenesisExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisExtendedKey)
deserialiseFromCBOR :: AsType (VerificationKey GenesisExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisExtendedKey)
SerialiseAsCBOR
      deriving (Int -> VerificationKey GenesisExtendedKey -> ShowS
[VerificationKey GenesisExtendedKey] -> ShowS
VerificationKey GenesisExtendedKey -> String
(Int -> VerificationKey GenesisExtendedKey -> ShowS)
-> (VerificationKey GenesisExtendedKey -> String)
-> ([VerificationKey GenesisExtendedKey] -> ShowS)
-> Show (VerificationKey GenesisExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey GenesisExtendedKey -> ShowS
showsPrec :: Int -> VerificationKey GenesisExtendedKey -> ShowS
$cshow :: VerificationKey GenesisExtendedKey -> String
show :: VerificationKey GenesisExtendedKey -> String
$cshowList :: [VerificationKey GenesisExtendedKey] -> ShowS
showList :: [VerificationKey GenesisExtendedKey] -> ShowS
Show, String -> VerificationKey GenesisExtendedKey
(String -> VerificationKey GenesisExtendedKey)
-> IsString (VerificationKey GenesisExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey GenesisExtendedKey
fromString :: String -> VerificationKey GenesisExtendedKey
IsString) via UsingRawBytesHex (VerificationKey GenesisExtendedKey)

    newtype SigningKey GenesisExtendedKey =
        GenesisExtendedSigningKey Crypto.HD.XPrv
      deriving anyclass HasTypeProxy (SigningKey GenesisExtendedKey)
HasTypeProxy (SigningKey GenesisExtendedKey) =>
(SigningKey GenesisExtendedKey -> ByteString)
-> (AsType (SigningKey GenesisExtendedKey)
    -> ByteString
    -> Either DecoderError (SigningKey GenesisExtendedKey))
-> SerialiseAsCBOR (SigningKey GenesisExtendedKey)
AsType (SigningKey GenesisExtendedKey)
-> ByteString
-> Either DecoderError (SigningKey GenesisExtendedKey)
SigningKey GenesisExtendedKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey GenesisExtendedKey -> ByteString
serialiseToCBOR :: SigningKey GenesisExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey GenesisExtendedKey)
-> ByteString
-> Either DecoderError (SigningKey GenesisExtendedKey)
deserialiseFromCBOR :: AsType (SigningKey GenesisExtendedKey)
-> ByteString
-> Either DecoderError (SigningKey GenesisExtendedKey)
SerialiseAsCBOR
      deriving (Int -> SigningKey GenesisExtendedKey -> ShowS
[SigningKey GenesisExtendedKey] -> ShowS
SigningKey GenesisExtendedKey -> String
(Int -> SigningKey GenesisExtendedKey -> ShowS)
-> (SigningKey GenesisExtendedKey -> String)
-> ([SigningKey GenesisExtendedKey] -> ShowS)
-> Show (SigningKey GenesisExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey GenesisExtendedKey -> ShowS
showsPrec :: Int -> SigningKey GenesisExtendedKey -> ShowS
$cshow :: SigningKey GenesisExtendedKey -> String
show :: SigningKey GenesisExtendedKey -> String
$cshowList :: [SigningKey GenesisExtendedKey] -> ShowS
showList :: [SigningKey GenesisExtendedKey] -> ShowS
Show, String -> SigningKey GenesisExtendedKey
(String -> SigningKey GenesisExtendedKey)
-> IsString (SigningKey GenesisExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey GenesisExtendedKey
fromString :: String -> SigningKey GenesisExtendedKey
IsString) via UsingRawBytesHex (SigningKey GenesisExtendedKey)

    deterministicSigningKey :: AsType GenesisExtendedKey
                            -> Crypto.Seed
                            -> SigningKey GenesisExtendedKey
    deterministicSigningKey :: AsType GenesisExtendedKey -> Seed -> SigningKey GenesisExtendedKey
deterministicSigningKey AsType GenesisExtendedKey
R:AsTypeGenesisExtendedKey
AsGenesisExtendedKey Seed
seed =
        XPrv -> SigningKey GenesisExtendedKey
GenesisExtendedSigningKey
          (ByteString -> ByteString -> XPrv
forall passPhrase seed.
(ByteArrayAccess passPhrase, ByteArrayAccess seed) =>
seed -> passPhrase -> XPrv
Crypto.HD.generate ByteString
seedbs ByteString
BS.empty)
      where
       (ByteString
seedbs, Seed
_) = Word -> Seed -> (ByteString, Seed)
Crypto.getBytesFromSeedT Word
32 Seed
seed

    deterministicSigningKeySeedSize :: AsType GenesisExtendedKey -> Word
    deterministicSigningKeySeedSize :: AsType GenesisExtendedKey -> Word
deterministicSigningKeySeedSize AsType GenesisExtendedKey
R:AsTypeGenesisExtendedKey
AsGenesisExtendedKey = Word
32

    getVerificationKey :: SigningKey GenesisExtendedKey
                       -> VerificationKey GenesisExtendedKey
    getVerificationKey :: SigningKey GenesisExtendedKey -> VerificationKey GenesisExtendedKey
getVerificationKey (GenesisExtendedSigningKey XPrv
sk) =
        XPub -> VerificationKey GenesisExtendedKey
GenesisExtendedVerificationKey (HasCallStack => XPrv -> XPub
XPrv -> XPub
Crypto.HD.toXPub XPrv
sk)

    -- | We use the hash of the normal non-extended pub key so that it is
    -- consistent with the one used in addresses and signatures.
    --
    verificationKeyHash :: VerificationKey GenesisExtendedKey
                        -> Hash GenesisExtendedKey
    verificationKeyHash :: VerificationKey GenesisExtendedKey -> Hash GenesisExtendedKey
verificationKeyHash (GenesisExtendedVerificationKey XPub
vk) =
        KeyHash 'Staking StandardCrypto -> Hash GenesisExtendedKey
GenesisExtendedKeyHash
      (KeyHash 'Staking StandardCrypto -> Hash GenesisExtendedKey)
-> (Hash Blake2b_224 XPub -> KeyHash 'Staking StandardCrypto)
-> Hash Blake2b_224 XPub
-> Hash GenesisExtendedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Staking StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Staking StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash
      (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
 -> KeyHash 'Staking StandardCrypto)
-> (Hash Blake2b_224 XPub
    -> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Hash Blake2b_224 XPub
-> KeyHash 'Staking StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 XPub
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
forall h a b. Hash h a -> Hash h b
Crypto.castHash
      (Hash Blake2b_224 XPub -> Hash GenesisExtendedKey)
-> Hash Blake2b_224 XPub -> Hash GenesisExtendedKey
forall a b. (a -> b) -> a -> b
$ (XPub -> ByteString) -> XPub -> Hash Blake2b_224 XPub
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith XPub -> ByteString
Crypto.HD.xpubPublicKey XPub
vk


instance ToCBOR (VerificationKey GenesisExtendedKey) where
    toCBOR :: VerificationKey GenesisExtendedKey -> Encoding
toCBOR (GenesisExtendedVerificationKey XPub
xpub) =
      ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (XPub -> ByteString
Crypto.HD.unXPub XPub
xpub)

instance FromCBOR (VerificationKey GenesisExtendedKey) where
    fromCBOR :: forall s. Decoder s (VerificationKey GenesisExtendedKey)
fromCBOR = do
      ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (String -> Decoder s (VerificationKey GenesisExtendedKey))
-> (XPub -> Decoder s (VerificationKey GenesisExtendedKey))
-> Either String XPub
-> Decoder s (VerificationKey GenesisExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Decoder s (VerificationKey GenesisExtendedKey)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (VerificationKey GenesisExtendedKey
-> Decoder s (VerificationKey GenesisExtendedKey)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey GenesisExtendedKey
 -> Decoder s (VerificationKey GenesisExtendedKey))
-> (XPub -> VerificationKey GenesisExtendedKey)
-> XPub
-> Decoder s (VerificationKey GenesisExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey GenesisExtendedKey
GenesisExtendedVerificationKey)
             (ByteString -> Either String XPub
Crypto.HD.xpub (ByteString
bs :: ByteString))

instance ToCBOR (SigningKey GenesisExtendedKey) where
    toCBOR :: SigningKey GenesisExtendedKey -> Encoding
toCBOR (GenesisExtendedSigningKey XPrv
xprv) =
      ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (XPrv -> ByteString
Crypto.HD.unXPrv XPrv
xprv)

instance FromCBOR (SigningKey GenesisExtendedKey) where
    fromCBOR :: forall s. Decoder s (SigningKey GenesisExtendedKey)
fromCBOR = do
      ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (String -> Decoder s (SigningKey GenesisExtendedKey))
-> (XPrv -> Decoder s (SigningKey GenesisExtendedKey))
-> Either String XPrv
-> Decoder s (SigningKey GenesisExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Decoder s (SigningKey GenesisExtendedKey)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (SigningKey GenesisExtendedKey
-> Decoder s (SigningKey GenesisExtendedKey)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SigningKey GenesisExtendedKey
 -> Decoder s (SigningKey GenesisExtendedKey))
-> (XPrv -> SigningKey GenesisExtendedKey)
-> XPrv
-> Decoder s (SigningKey GenesisExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey GenesisExtendedKey
GenesisExtendedSigningKey)
             (ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
Crypto.HD.xprv (ByteString
bs :: ByteString))

instance SerialiseAsRawBytes (VerificationKey GenesisExtendedKey) where
    serialiseToRawBytes :: VerificationKey GenesisExtendedKey -> ByteString
serialiseToRawBytes (GenesisExtendedVerificationKey XPub
xpub) =
      XPub -> ByteString
Crypto.HD.unXPub XPub
xpub

    deserialiseFromRawBytes :: AsType (VerificationKey GenesisExtendedKey)
-> ByteString -> Maybe (VerificationKey GenesisExtendedKey)
deserialiseFromRawBytes (AsVerificationKey AsType GenesisExtendedKey
R:AsTypeGenesisExtendedKey
AsGenesisExtendedKey) ByteString
bs =
      (String -> Maybe (VerificationKey GenesisExtendedKey))
-> (XPub -> Maybe (VerificationKey GenesisExtendedKey))
-> Either String XPub
-> Maybe (VerificationKey GenesisExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (VerificationKey GenesisExtendedKey)
-> String -> Maybe (VerificationKey GenesisExtendedKey)
forall a b. a -> b -> a
const Maybe (VerificationKey GenesisExtendedKey)
forall a. Maybe a
Nothing) (VerificationKey GenesisExtendedKey
-> Maybe (VerificationKey GenesisExtendedKey)
forall a. a -> Maybe a
Just (VerificationKey GenesisExtendedKey
 -> Maybe (VerificationKey GenesisExtendedKey))
-> (XPub -> VerificationKey GenesisExtendedKey)
-> XPub
-> Maybe (VerificationKey GenesisExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey GenesisExtendedKey
GenesisExtendedVerificationKey)
             (ByteString -> Either String XPub
Crypto.HD.xpub ByteString
bs)

instance SerialiseAsRawBytes (SigningKey GenesisExtendedKey) where
    serialiseToRawBytes :: SigningKey GenesisExtendedKey -> ByteString
serialiseToRawBytes (GenesisExtendedSigningKey XPrv
xprv) =
      XPrv -> ByteString
Crypto.HD.unXPrv XPrv
xprv

    deserialiseFromRawBytes :: AsType (SigningKey GenesisExtendedKey)
-> ByteString -> Maybe (SigningKey GenesisExtendedKey)
deserialiseFromRawBytes (AsSigningKey AsType GenesisExtendedKey
R:AsTypeGenesisExtendedKey
AsGenesisExtendedKey) ByteString
bs =
      (String -> Maybe (SigningKey GenesisExtendedKey))
-> (XPrv -> Maybe (SigningKey GenesisExtendedKey))
-> Either String XPrv
-> Maybe (SigningKey GenesisExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (SigningKey GenesisExtendedKey)
-> String -> Maybe (SigningKey GenesisExtendedKey)
forall a b. a -> b -> a
const Maybe (SigningKey GenesisExtendedKey)
forall a. Maybe a
Nothing) (SigningKey GenesisExtendedKey
-> Maybe (SigningKey GenesisExtendedKey)
forall a. a -> Maybe a
Just (SigningKey GenesisExtendedKey
 -> Maybe (SigningKey GenesisExtendedKey))
-> (XPrv -> SigningKey GenesisExtendedKey)
-> XPrv
-> Maybe (SigningKey GenesisExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey GenesisExtendedKey
GenesisExtendedSigningKey)
             (ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
Crypto.HD.xprv ByteString
bs)


newtype instance Hash GenesisExtendedKey =
    GenesisExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto)
  deriving stock (Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
(Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool)
-> (Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool)
-> Eq (Hash GenesisExtendedKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
== :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
$c/= :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
/= :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
Eq, Eq (Hash GenesisExtendedKey)
Eq (Hash GenesisExtendedKey) =>
(Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Ordering)
-> (Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool)
-> (Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool)
-> (Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool)
-> (Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool)
-> (Hash GenesisExtendedKey
    -> Hash GenesisExtendedKey -> Hash GenesisExtendedKey)
-> (Hash GenesisExtendedKey
    -> Hash GenesisExtendedKey -> Hash GenesisExtendedKey)
-> Ord (Hash GenesisExtendedKey)
Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Ordering
Hash GenesisExtendedKey
-> Hash GenesisExtendedKey -> Hash GenesisExtendedKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Ordering
compare :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Ordering
$c< :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
< :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
$c<= :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
<= :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
$c> :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
> :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
$c>= :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
>= :: Hash GenesisExtendedKey -> Hash GenesisExtendedKey -> Bool
$cmax :: Hash GenesisExtendedKey
-> Hash GenesisExtendedKey -> Hash GenesisExtendedKey
max :: Hash GenesisExtendedKey
-> Hash GenesisExtendedKey -> Hash GenesisExtendedKey
$cmin :: Hash GenesisExtendedKey
-> Hash GenesisExtendedKey -> Hash GenesisExtendedKey
min :: Hash GenesisExtendedKey
-> Hash GenesisExtendedKey -> Hash GenesisExtendedKey
Ord)
  deriving (Int -> Hash GenesisExtendedKey -> ShowS
[Hash GenesisExtendedKey] -> ShowS
Hash GenesisExtendedKey -> String
(Int -> Hash GenesisExtendedKey -> ShowS)
-> (Hash GenesisExtendedKey -> String)
-> ([Hash GenesisExtendedKey] -> ShowS)
-> Show (Hash GenesisExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash GenesisExtendedKey -> ShowS
showsPrec :: Int -> Hash GenesisExtendedKey -> ShowS
$cshow :: Hash GenesisExtendedKey -> String
show :: Hash GenesisExtendedKey -> String
$cshowList :: [Hash GenesisExtendedKey] -> ShowS
showList :: [Hash GenesisExtendedKey] -> ShowS
Show, String -> Hash GenesisExtendedKey
(String -> Hash GenesisExtendedKey)
-> IsString (Hash GenesisExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash GenesisExtendedKey
fromString :: String -> Hash GenesisExtendedKey
IsString) via UsingRawBytesHex (Hash GenesisExtendedKey)
  deriving (Typeable (Hash GenesisExtendedKey)
Typeable (Hash GenesisExtendedKey) =>
(Hash GenesisExtendedKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash GenesisExtendedKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash GenesisExtendedKey] -> Size)
-> ToCBOR (Hash GenesisExtendedKey)
Hash GenesisExtendedKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisExtendedKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisExtendedKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Hash GenesisExtendedKey -> Encoding
toCBOR :: Hash GenesisExtendedKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisExtendedKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisExtendedKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisExtendedKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisExtendedKey] -> Size
ToCBOR, Typeable (Hash GenesisExtendedKey)
Typeable (Hash GenesisExtendedKey) =>
(forall s. Decoder s (Hash GenesisExtendedKey))
-> (Proxy (Hash GenesisExtendedKey) -> Text)
-> FromCBOR (Hash GenesisExtendedKey)
Proxy (Hash GenesisExtendedKey) -> Text
forall s. Decoder s (Hash GenesisExtendedKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash GenesisExtendedKey)
fromCBOR :: forall s. Decoder s (Hash GenesisExtendedKey)
$clabel :: Proxy (Hash GenesisExtendedKey) -> Text
label :: Proxy (Hash GenesisExtendedKey) -> Text
FromCBOR) via UsingRawBytes (Hash GenesisExtendedKey)
  deriving anyclass HasTypeProxy (Hash GenesisExtendedKey)
Hash GenesisExtendedKey -> ByteString
HasTypeProxy (Hash GenesisExtendedKey) =>
(Hash GenesisExtendedKey -> ByteString)
-> (AsType (Hash GenesisExtendedKey)
    -> ByteString -> Either DecoderError (Hash GenesisExtendedKey))
-> SerialiseAsCBOR (Hash GenesisExtendedKey)
AsType (Hash GenesisExtendedKey)
-> ByteString -> Either DecoderError (Hash GenesisExtendedKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash GenesisExtendedKey -> ByteString
serialiseToCBOR :: Hash GenesisExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash GenesisExtendedKey)
-> ByteString -> Either DecoderError (Hash GenesisExtendedKey)
deserialiseFromCBOR :: AsType (Hash GenesisExtendedKey)
-> ByteString -> Either DecoderError (Hash GenesisExtendedKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash GenesisExtendedKey) where
    serialiseToRawBytes :: Hash GenesisExtendedKey -> ByteString
serialiseToRawBytes (GenesisExtendedKeyHash (Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
      Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

    deserialiseFromRawBytes :: AsType (Hash GenesisExtendedKey)
-> ByteString -> Maybe (Hash GenesisExtendedKey)
deserialiseFromRawBytes (AsHash AsType GenesisExtendedKey
R:AsTypeGenesisExtendedKey
AsGenesisExtendedKey) ByteString
bs =
      KeyHash 'Staking StandardCrypto -> Hash GenesisExtendedKey
GenesisExtendedKeyHash (KeyHash 'Staking StandardCrypto -> Hash GenesisExtendedKey)
-> (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
    -> KeyHash 'Staking StandardCrypto)
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> Hash GenesisExtendedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Staking StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Staking StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
 -> Hash GenesisExtendedKey)
-> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Maybe (Hash GenesisExtendedKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey GenesisExtendedKey) where
    textEnvelopeType :: AsType (VerificationKey GenesisExtendedKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey GenesisExtendedKey)
_ = TextEnvelopeType
"GenesisExtendedVerificationKey_ed25519_bip32"

instance HasTextEnvelope (SigningKey GenesisExtendedKey) where
    textEnvelopeType :: AsType (SigningKey GenesisExtendedKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey GenesisExtendedKey)
_ = TextEnvelopeType
"GenesisExtendedSigningKey_ed25519_bip32"

instance CastVerificationKeyRole GenesisExtendedKey GenesisKey where
    castVerificationKey :: VerificationKey GenesisExtendedKey -> VerificationKey GenesisKey
castVerificationKey (GenesisExtendedVerificationKey XPub
vk) =
        VKey 'Genesis StandardCrypto -> VerificationKey GenesisKey
GenesisVerificationKey
      (VKey 'Genesis StandardCrypto -> VerificationKey GenesisKey)
-> (XPub -> VKey 'Genesis StandardCrypto)
-> XPub
-> VerificationKey GenesisKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VKey 'Genesis StandardCrypto
VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Genesis StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey
      (VerKeyDSIGN Ed25519DSIGN -> VKey 'Genesis StandardCrypto)
-> (XPub -> VerKeyDSIGN Ed25519DSIGN)
-> XPub
-> VKey 'Genesis StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN
-> Maybe (VerKeyDSIGN Ed25519DSIGN) -> VerKeyDSIGN Ed25519DSIGN
forall a. a -> Maybe a -> a
fromMaybe VerKeyDSIGN Ed25519DSIGN
forall {a}. a
impossible
      (Maybe (VerKeyDSIGN Ed25519DSIGN) -> VerKeyDSIGN Ed25519DSIGN)
-> (XPub -> Maybe (VerKeyDSIGN Ed25519DSIGN))
-> XPub
-> VerKeyDSIGN Ed25519DSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
Crypto.rawDeserialiseVerKeyDSIGN
      (ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN))
-> (XPub -> ByteString) -> XPub -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
Crypto.HD.xpubPublicKey
      (XPub -> VerificationKey GenesisKey)
-> XPub -> VerificationKey GenesisKey
forall a b. (a -> b) -> a -> b
$ XPub
vk
      where
        impossible :: a
impossible =
          String -> a
forall a. HasCallStack => String -> a
error String
"castVerificationKey: byron and shelley key sizes do not match!"


--
-- Genesis delegate keys
--

data GenesisDelegateKey

instance HasTypeProxy GenesisDelegateKey where
    data AsType GenesisDelegateKey = AsGenesisDelegateKey
    proxyToAsType :: Proxy GenesisDelegateKey -> AsType GenesisDelegateKey
proxyToAsType Proxy GenesisDelegateKey
_ = AsType GenesisDelegateKey
AsGenesisDelegateKey


instance Key GenesisDelegateKey where

    newtype VerificationKey GenesisDelegateKey =
        GenesisDelegateVerificationKey (Shelley.VKey Shelley.GenesisDelegate StandardCrypto)
      deriving stock (VerificationKey GenesisDelegateKey
-> VerificationKey GenesisDelegateKey -> Bool
(VerificationKey GenesisDelegateKey
 -> VerificationKey GenesisDelegateKey -> Bool)
-> (VerificationKey GenesisDelegateKey
    -> VerificationKey GenesisDelegateKey -> Bool)
-> Eq (VerificationKey GenesisDelegateKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey GenesisDelegateKey
-> VerificationKey GenesisDelegateKey -> Bool
== :: VerificationKey GenesisDelegateKey
-> VerificationKey GenesisDelegateKey -> Bool
$c/= :: VerificationKey GenesisDelegateKey
-> VerificationKey GenesisDelegateKey -> Bool
/= :: VerificationKey GenesisDelegateKey
-> VerificationKey GenesisDelegateKey -> Bool
Eq)
      deriving (Int -> VerificationKey GenesisDelegateKey -> ShowS
[VerificationKey GenesisDelegateKey] -> ShowS
VerificationKey GenesisDelegateKey -> String
(Int -> VerificationKey GenesisDelegateKey -> ShowS)
-> (VerificationKey GenesisDelegateKey -> String)
-> ([VerificationKey GenesisDelegateKey] -> ShowS)
-> Show (VerificationKey GenesisDelegateKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey GenesisDelegateKey -> ShowS
showsPrec :: Int -> VerificationKey GenesisDelegateKey -> ShowS
$cshow :: VerificationKey GenesisDelegateKey -> String
show :: VerificationKey GenesisDelegateKey -> String
$cshowList :: [VerificationKey GenesisDelegateKey] -> ShowS
showList :: [VerificationKey GenesisDelegateKey] -> ShowS
Show, String -> VerificationKey GenesisDelegateKey
(String -> VerificationKey GenesisDelegateKey)
-> IsString (VerificationKey GenesisDelegateKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey GenesisDelegateKey
fromString :: String -> VerificationKey GenesisDelegateKey
IsString) via UsingRawBytesHex (VerificationKey GenesisDelegateKey)
      deriving newtype (Typeable (VerificationKey GenesisDelegateKey)
Typeable (VerificationKey GenesisDelegateKey) =>
(VerificationKey GenesisDelegateKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey GenesisDelegateKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey GenesisDelegateKey] -> Size)
-> ToCBOR (VerificationKey GenesisDelegateKey)
VerificationKey GenesisDelegateKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey GenesisDelegateKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey GenesisDelegateKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: VerificationKey GenesisDelegateKey -> Encoding
toCBOR :: VerificationKey GenesisDelegateKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey GenesisDelegateKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey GenesisDelegateKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey GenesisDelegateKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey GenesisDelegateKey] -> Size
ToCBOR, Typeable (VerificationKey GenesisDelegateKey)
Typeable (VerificationKey GenesisDelegateKey) =>
(forall s. Decoder s (VerificationKey GenesisDelegateKey))
-> (Proxy (VerificationKey GenesisDelegateKey) -> Text)
-> FromCBOR (VerificationKey GenesisDelegateKey)
Proxy (VerificationKey GenesisDelegateKey) -> Text
forall s. Decoder s (VerificationKey GenesisDelegateKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (VerificationKey GenesisDelegateKey)
fromCBOR :: forall s. Decoder s (VerificationKey GenesisDelegateKey)
$clabel :: Proxy (VerificationKey GenesisDelegateKey) -> Text
label :: Proxy (VerificationKey GenesisDelegateKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (VerificationKey GenesisDelegateKey)
HasTypeProxy (VerificationKey GenesisDelegateKey) =>
(VerificationKey GenesisDelegateKey -> ByteString)
-> (AsType (VerificationKey GenesisDelegateKey)
    -> ByteString
    -> Either DecoderError (VerificationKey GenesisDelegateKey))
-> SerialiseAsCBOR (VerificationKey GenesisDelegateKey)
AsType (VerificationKey GenesisDelegateKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisDelegateKey)
VerificationKey GenesisDelegateKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey GenesisDelegateKey -> ByteString
serialiseToCBOR :: VerificationKey GenesisDelegateKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey GenesisDelegateKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisDelegateKey)
deserialiseFromCBOR :: AsType (VerificationKey GenesisDelegateKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisDelegateKey)
SerialiseAsCBOR

    newtype SigningKey GenesisDelegateKey =
        GenesisDelegateSigningKey (Shelley.SignKeyDSIGN StandardCrypto)
      deriving (Int -> SigningKey GenesisDelegateKey -> ShowS
[SigningKey GenesisDelegateKey] -> ShowS
SigningKey GenesisDelegateKey -> String
(Int -> SigningKey GenesisDelegateKey -> ShowS)
-> (SigningKey GenesisDelegateKey -> String)
-> ([SigningKey GenesisDelegateKey] -> ShowS)
-> Show (SigningKey GenesisDelegateKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey GenesisDelegateKey -> ShowS
showsPrec :: Int -> SigningKey GenesisDelegateKey -> ShowS
$cshow :: SigningKey GenesisDelegateKey -> String
show :: SigningKey GenesisDelegateKey -> String
$cshowList :: [SigningKey GenesisDelegateKey] -> ShowS
showList :: [SigningKey GenesisDelegateKey] -> ShowS
Show, String -> SigningKey GenesisDelegateKey
(String -> SigningKey GenesisDelegateKey)
-> IsString (SigningKey GenesisDelegateKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey GenesisDelegateKey
fromString :: String -> SigningKey GenesisDelegateKey
IsString) via UsingRawBytesHex (SigningKey GenesisDelegateKey)
      deriving newtype (Typeable (SigningKey GenesisDelegateKey)
Typeable (SigningKey GenesisDelegateKey) =>
(SigningKey GenesisDelegateKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey GenesisDelegateKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey GenesisDelegateKey] -> Size)
-> ToCBOR (SigningKey GenesisDelegateKey)
SigningKey GenesisDelegateKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey GenesisDelegateKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey GenesisDelegateKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SigningKey GenesisDelegateKey -> Encoding
toCBOR :: SigningKey GenesisDelegateKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey GenesisDelegateKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey GenesisDelegateKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey GenesisDelegateKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey GenesisDelegateKey] -> Size
ToCBOR, Typeable (SigningKey GenesisDelegateKey)
Typeable (SigningKey GenesisDelegateKey) =>
(forall s. Decoder s (SigningKey GenesisDelegateKey))
-> (Proxy (SigningKey GenesisDelegateKey) -> Text)
-> FromCBOR (SigningKey GenesisDelegateKey)
Proxy (SigningKey GenesisDelegateKey) -> Text
forall s. Decoder s (SigningKey GenesisDelegateKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (SigningKey GenesisDelegateKey)
fromCBOR :: forall s. Decoder s (SigningKey GenesisDelegateKey)
$clabel :: Proxy (SigningKey GenesisDelegateKey) -> Text
label :: Proxy (SigningKey GenesisDelegateKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (SigningKey GenesisDelegateKey)
HasTypeProxy (SigningKey GenesisDelegateKey) =>
(SigningKey GenesisDelegateKey -> ByteString)
-> (AsType (SigningKey GenesisDelegateKey)
    -> ByteString
    -> Either DecoderError (SigningKey GenesisDelegateKey))
-> SerialiseAsCBOR (SigningKey GenesisDelegateKey)
AsType (SigningKey GenesisDelegateKey)
-> ByteString
-> Either DecoderError (SigningKey GenesisDelegateKey)
SigningKey GenesisDelegateKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey GenesisDelegateKey -> ByteString
serialiseToCBOR :: SigningKey GenesisDelegateKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey GenesisDelegateKey)
-> ByteString
-> Either DecoderError (SigningKey GenesisDelegateKey)
deserialiseFromCBOR :: AsType (SigningKey GenesisDelegateKey)
-> ByteString
-> Either DecoderError (SigningKey GenesisDelegateKey)
SerialiseAsCBOR

    deterministicSigningKey :: AsType GenesisDelegateKey -> Crypto.Seed -> SigningKey GenesisDelegateKey
    deterministicSigningKey :: AsType GenesisDelegateKey -> Seed -> SigningKey GenesisDelegateKey
deterministicSigningKey AsType GenesisDelegateKey
R:AsTypeGenesisDelegateKey
AsGenesisDelegateKey Seed
seed =
        SignKeyDSIGN StandardCrypto -> SigningKey GenesisDelegateKey
GenesisDelegateSigningKey (Seed -> SignKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
Crypto.genKeyDSIGN Seed
seed)

    deterministicSigningKeySeedSize :: AsType GenesisDelegateKey -> Word
    deterministicSigningKeySeedSize :: AsType GenesisDelegateKey -> Word
deterministicSigningKeySeedSize AsType GenesisDelegateKey
R:AsTypeGenesisDelegateKey
AsGenesisDelegateKey =
        Proxy Ed25519DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
Crypto.seedSizeDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

    getVerificationKey :: SigningKey GenesisDelegateKey -> VerificationKey GenesisDelegateKey
    getVerificationKey :: SigningKey GenesisDelegateKey -> VerificationKey GenesisDelegateKey
getVerificationKey (GenesisDelegateSigningKey SignKeyDSIGN StandardCrypto
sk) =
        VKey 'GenesisDelegate StandardCrypto
-> VerificationKey GenesisDelegateKey
GenesisDelegateVerificationKey (VerKeyDSIGN (DSIGN StandardCrypto)
-> VKey 'GenesisDelegate StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
Crypto.deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk))

    verificationKeyHash :: VerificationKey GenesisDelegateKey -> Hash GenesisDelegateKey
    verificationKeyHash :: VerificationKey GenesisDelegateKey -> Hash GenesisDelegateKey
verificationKeyHash (GenesisDelegateVerificationKey VKey 'GenesisDelegate StandardCrypto
vkey) =
        KeyHash 'GenesisDelegate StandardCrypto -> Hash GenesisDelegateKey
GenesisDelegateKeyHash (VKey 'GenesisDelegate StandardCrypto
-> KeyHash 'GenesisDelegate StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
Shelley.hashKey VKey 'GenesisDelegate StandardCrypto
vkey)


instance SerialiseAsRawBytes (VerificationKey GenesisDelegateKey) where
    serialiseToRawBytes :: VerificationKey GenesisDelegateKey -> ByteString
serialiseToRawBytes (GenesisDelegateVerificationKey (Shelley.VKey VerKeyDSIGN (DSIGN StandardCrypto)
vk)) =
      VerKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
Crypto.rawSerialiseVerKeyDSIGN VerKeyDSIGN Ed25519DSIGN
VerKeyDSIGN (DSIGN StandardCrypto)
vk

    deserialiseFromRawBytes :: AsType (VerificationKey GenesisDelegateKey)
-> ByteString -> Maybe (VerificationKey GenesisDelegateKey)
deserialiseFromRawBytes (AsVerificationKey AsType GenesisDelegateKey
R:AsTypeGenesisDelegateKey
AsGenesisDelegateKey) ByteString
bs =
      VKey 'GenesisDelegate StandardCrypto
-> VerificationKey GenesisDelegateKey
GenesisDelegateVerificationKey (VKey 'GenesisDelegate StandardCrypto
 -> VerificationKey GenesisDelegateKey)
-> (VerKeyDSIGN Ed25519DSIGN
    -> VKey 'GenesisDelegate StandardCrypto)
-> VerKeyDSIGN Ed25519DSIGN
-> VerificationKey GenesisDelegateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VKey 'GenesisDelegate StandardCrypto
VerKeyDSIGN (DSIGN StandardCrypto)
-> VKey 'GenesisDelegate StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (VerKeyDSIGN Ed25519DSIGN -> VerificationKey GenesisDelegateKey)
-> Maybe (VerKeyDSIGN Ed25519DSIGN)
-> Maybe (VerificationKey GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
Crypto.rawDeserialiseVerKeyDSIGN ByteString
bs

instance SerialiseAsRawBytes (SigningKey GenesisDelegateKey) where
    serialiseToRawBytes :: SigningKey GenesisDelegateKey -> ByteString
serialiseToRawBytes (GenesisDelegateSigningKey SignKeyDSIGN StandardCrypto
sk) =
      SignKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
Crypto.rawSerialiseSignKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk

    deserialiseFromRawBytes :: AsType (SigningKey GenesisDelegateKey)
-> ByteString -> Maybe (SigningKey GenesisDelegateKey)
deserialiseFromRawBytes (AsSigningKey AsType GenesisDelegateKey
R:AsTypeGenesisDelegateKey
AsGenesisDelegateKey) ByteString
bs =
      SignKeyDSIGN Ed25519DSIGN -> SigningKey GenesisDelegateKey
SignKeyDSIGN StandardCrypto -> SigningKey GenesisDelegateKey
GenesisDelegateSigningKey (SignKeyDSIGN Ed25519DSIGN -> SigningKey GenesisDelegateKey)
-> Maybe (SignKeyDSIGN Ed25519DSIGN)
-> Maybe (SigningKey GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (SignKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
Crypto.rawDeserialiseSignKeyDSIGN ByteString
bs


newtype instance Hash GenesisDelegateKey =
    GenesisDelegateKeyHash (Shelley.KeyHash Shelley.GenesisDelegate StandardCrypto)
  deriving stock (Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
(Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool)
-> (Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool)
-> Eq (Hash GenesisDelegateKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
== :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
$c/= :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
/= :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
Eq, Eq (Hash GenesisDelegateKey)
Eq (Hash GenesisDelegateKey) =>
(Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Ordering)
-> (Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool)
-> (Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool)
-> (Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool)
-> (Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool)
-> (Hash GenesisDelegateKey
    -> Hash GenesisDelegateKey -> Hash GenesisDelegateKey)
-> (Hash GenesisDelegateKey
    -> Hash GenesisDelegateKey -> Hash GenesisDelegateKey)
-> Ord (Hash GenesisDelegateKey)
Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Ordering
Hash GenesisDelegateKey
-> Hash GenesisDelegateKey -> Hash GenesisDelegateKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Ordering
compare :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Ordering
$c< :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
< :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
$c<= :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
<= :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
$c> :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
> :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
$c>= :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
>= :: Hash GenesisDelegateKey -> Hash GenesisDelegateKey -> Bool
$cmax :: Hash GenesisDelegateKey
-> Hash GenesisDelegateKey -> Hash GenesisDelegateKey
max :: Hash GenesisDelegateKey
-> Hash GenesisDelegateKey -> Hash GenesisDelegateKey
$cmin :: Hash GenesisDelegateKey
-> Hash GenesisDelegateKey -> Hash GenesisDelegateKey
min :: Hash GenesisDelegateKey
-> Hash GenesisDelegateKey -> Hash GenesisDelegateKey
Ord)
  deriving (Int -> Hash GenesisDelegateKey -> ShowS
[Hash GenesisDelegateKey] -> ShowS
Hash GenesisDelegateKey -> String
(Int -> Hash GenesisDelegateKey -> ShowS)
-> (Hash GenesisDelegateKey -> String)
-> ([Hash GenesisDelegateKey] -> ShowS)
-> Show (Hash GenesisDelegateKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash GenesisDelegateKey -> ShowS
showsPrec :: Int -> Hash GenesisDelegateKey -> ShowS
$cshow :: Hash GenesisDelegateKey -> String
show :: Hash GenesisDelegateKey -> String
$cshowList :: [Hash GenesisDelegateKey] -> ShowS
showList :: [Hash GenesisDelegateKey] -> ShowS
Show, String -> Hash GenesisDelegateKey
(String -> Hash GenesisDelegateKey)
-> IsString (Hash GenesisDelegateKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash GenesisDelegateKey
fromString :: String -> Hash GenesisDelegateKey
IsString) via UsingRawBytesHex (Hash GenesisDelegateKey)
  deriving (Typeable (Hash GenesisDelegateKey)
Typeable (Hash GenesisDelegateKey) =>
(Hash GenesisDelegateKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash GenesisDelegateKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash GenesisDelegateKey] -> Size)
-> ToCBOR (Hash GenesisDelegateKey)
Hash GenesisDelegateKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisDelegateKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisDelegateKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Hash GenesisDelegateKey -> Encoding
toCBOR :: Hash GenesisDelegateKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisDelegateKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisDelegateKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisDelegateKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisDelegateKey] -> Size
ToCBOR, Typeable (Hash GenesisDelegateKey)
Typeable (Hash GenesisDelegateKey) =>
(forall s. Decoder s (Hash GenesisDelegateKey))
-> (Proxy (Hash GenesisDelegateKey) -> Text)
-> FromCBOR (Hash GenesisDelegateKey)
Proxy (Hash GenesisDelegateKey) -> Text
forall s. Decoder s (Hash GenesisDelegateKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash GenesisDelegateKey)
fromCBOR :: forall s. Decoder s (Hash GenesisDelegateKey)
$clabel :: Proxy (Hash GenesisDelegateKey) -> Text
label :: Proxy (Hash GenesisDelegateKey) -> Text
FromCBOR) via UsingRawBytes (Hash GenesisDelegateKey)
  deriving anyclass HasTypeProxy (Hash GenesisDelegateKey)
Hash GenesisDelegateKey -> ByteString
HasTypeProxy (Hash GenesisDelegateKey) =>
(Hash GenesisDelegateKey -> ByteString)
-> (AsType (Hash GenesisDelegateKey)
    -> ByteString -> Either DecoderError (Hash GenesisDelegateKey))
-> SerialiseAsCBOR (Hash GenesisDelegateKey)
AsType (Hash GenesisDelegateKey)
-> ByteString -> Either DecoderError (Hash GenesisDelegateKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash GenesisDelegateKey -> ByteString
serialiseToCBOR :: Hash GenesisDelegateKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash GenesisDelegateKey)
-> ByteString -> Either DecoderError (Hash GenesisDelegateKey)
deserialiseFromCBOR :: AsType (Hash GenesisDelegateKey)
-> ByteString -> Either DecoderError (Hash GenesisDelegateKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash GenesisDelegateKey) where
    serialiseToRawBytes :: Hash GenesisDelegateKey -> ByteString
serialiseToRawBytes (GenesisDelegateKeyHash (Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
      Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

    deserialiseFromRawBytes :: AsType (Hash GenesisDelegateKey)
-> ByteString -> Maybe (Hash GenesisDelegateKey)
deserialiseFromRawBytes (AsHash AsType GenesisDelegateKey
R:AsTypeGenesisDelegateKey
AsGenesisDelegateKey) ByteString
bs =
      KeyHash 'GenesisDelegate StandardCrypto -> Hash GenesisDelegateKey
GenesisDelegateKeyHash (KeyHash 'GenesisDelegate StandardCrypto
 -> Hash GenesisDelegateKey)
-> (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
    -> KeyHash 'GenesisDelegate StandardCrypto)
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> Hash GenesisDelegateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'GenesisDelegate StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'GenesisDelegate StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
 -> Hash GenesisDelegateKey)
-> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Maybe (Hash GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey GenesisDelegateKey) where
    textEnvelopeType :: AsType (VerificationKey GenesisDelegateKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey GenesisDelegateKey)
_ = TextEnvelopeType
"GenesisDelegateVerificationKey_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

instance HasTextEnvelope (SigningKey GenesisDelegateKey) where
    textEnvelopeType :: AsType (SigningKey GenesisDelegateKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey GenesisDelegateKey)
_ = TextEnvelopeType
"GenesisDelegateSigningKey_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

instance CastVerificationKeyRole GenesisDelegateKey StakePoolKey where
    castVerificationKey :: VerificationKey GenesisDelegateKey -> VerificationKey StakePoolKey
castVerificationKey (GenesisDelegateVerificationKey (Shelley.VKey VerKeyDSIGN (DSIGN StandardCrypto)
vkey)) =
      VKey 'StakePool StandardCrypto -> VerificationKey StakePoolKey
StakePoolVerificationKey (VerKeyDSIGN (DSIGN StandardCrypto)
-> VKey 'StakePool StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey VerKeyDSIGN (DSIGN StandardCrypto)
vkey)

instance CastSigningKeyRole GenesisDelegateKey StakePoolKey where
    castSigningKey :: SigningKey GenesisDelegateKey -> SigningKey StakePoolKey
castSigningKey (GenesisDelegateSigningKey SignKeyDSIGN StandardCrypto
skey) =
      SignKeyDSIGN StandardCrypto -> SigningKey StakePoolKey
StakePoolSigningKey SignKeyDSIGN StandardCrypto
skey


--
-- Shelley genesis delegate extended ed25519 keys
--

-- | Shelley-era genesis keys using extended ed25519 cryptographic keys.
--
-- These serve the same role as normal genesis keys, but are here to support
-- legacy Byron genesis keys which used extended keys.
--
-- The extended verification keys can be converted (via 'castVerificationKey')
-- to ordinary keys (i.e. 'VerificationKey' 'GenesisKey') but this is /not/ the
-- case for the signing keys. The signing keys can be used to witness
-- transactions directly, with verification via their non-extended verification
-- key ('VerificationKey' 'GenesisKey').
--
-- This is a type level tag, used with other interfaces like 'Key'.
--
data GenesisDelegateExtendedKey

instance HasTypeProxy GenesisDelegateExtendedKey where
    data AsType GenesisDelegateExtendedKey = AsGenesisDelegateExtendedKey
    proxyToAsType :: Proxy GenesisDelegateExtendedKey
-> AsType GenesisDelegateExtendedKey
proxyToAsType Proxy GenesisDelegateExtendedKey
_ = AsType GenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey

instance Key GenesisDelegateExtendedKey where

    newtype VerificationKey GenesisDelegateExtendedKey =
        GenesisDelegateExtendedVerificationKey Crypto.HD.XPub
      deriving stock (VerificationKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey -> Bool
(VerificationKey GenesisDelegateExtendedKey
 -> VerificationKey GenesisDelegateExtendedKey -> Bool)
-> (VerificationKey GenesisDelegateExtendedKey
    -> VerificationKey GenesisDelegateExtendedKey -> Bool)
-> Eq (VerificationKey GenesisDelegateExtendedKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey -> Bool
== :: VerificationKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey -> Bool
$c/= :: VerificationKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey -> Bool
/= :: VerificationKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey -> Bool
Eq)
      deriving anyclass HasTypeProxy (VerificationKey GenesisDelegateExtendedKey)
HasTypeProxy (VerificationKey GenesisDelegateExtendedKey) =>
(VerificationKey GenesisDelegateExtendedKey -> ByteString)
-> (AsType (VerificationKey GenesisDelegateExtendedKey)
    -> ByteString
    -> Either
         DecoderError (VerificationKey GenesisDelegateExtendedKey))
-> SerialiseAsCBOR (VerificationKey GenesisDelegateExtendedKey)
AsType (VerificationKey GenesisDelegateExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisDelegateExtendedKey)
VerificationKey GenesisDelegateExtendedKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey GenesisDelegateExtendedKey -> ByteString
serialiseToCBOR :: VerificationKey GenesisDelegateExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey GenesisDelegateExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisDelegateExtendedKey)
deserialiseFromCBOR :: AsType (VerificationKey GenesisDelegateExtendedKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisDelegateExtendedKey)
SerialiseAsCBOR
      deriving (Int -> VerificationKey GenesisDelegateExtendedKey -> ShowS
[VerificationKey GenesisDelegateExtendedKey] -> ShowS
VerificationKey GenesisDelegateExtendedKey -> String
(Int -> VerificationKey GenesisDelegateExtendedKey -> ShowS)
-> (VerificationKey GenesisDelegateExtendedKey -> String)
-> ([VerificationKey GenesisDelegateExtendedKey] -> ShowS)
-> Show (VerificationKey GenesisDelegateExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey GenesisDelegateExtendedKey -> ShowS
showsPrec :: Int -> VerificationKey GenesisDelegateExtendedKey -> ShowS
$cshow :: VerificationKey GenesisDelegateExtendedKey -> String
show :: VerificationKey GenesisDelegateExtendedKey -> String
$cshowList :: [VerificationKey GenesisDelegateExtendedKey] -> ShowS
showList :: [VerificationKey GenesisDelegateExtendedKey] -> ShowS
Show, String -> VerificationKey GenesisDelegateExtendedKey
(String -> VerificationKey GenesisDelegateExtendedKey)
-> IsString (VerificationKey GenesisDelegateExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey GenesisDelegateExtendedKey
fromString :: String -> VerificationKey GenesisDelegateExtendedKey
IsString) via UsingRawBytesHex (VerificationKey GenesisDelegateExtendedKey)

    newtype SigningKey GenesisDelegateExtendedKey =
        GenesisDelegateExtendedSigningKey Crypto.HD.XPrv
      deriving anyclass HasTypeProxy (SigningKey GenesisDelegateExtendedKey)
HasTypeProxy (SigningKey GenesisDelegateExtendedKey) =>
(SigningKey GenesisDelegateExtendedKey -> ByteString)
-> (AsType (SigningKey GenesisDelegateExtendedKey)
    -> ByteString
    -> Either DecoderError (SigningKey GenesisDelegateExtendedKey))
-> SerialiseAsCBOR (SigningKey GenesisDelegateExtendedKey)
AsType (SigningKey GenesisDelegateExtendedKey)
-> ByteString
-> Either DecoderError (SigningKey GenesisDelegateExtendedKey)
SigningKey GenesisDelegateExtendedKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey GenesisDelegateExtendedKey -> ByteString
serialiseToCBOR :: SigningKey GenesisDelegateExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey GenesisDelegateExtendedKey)
-> ByteString
-> Either DecoderError (SigningKey GenesisDelegateExtendedKey)
deserialiseFromCBOR :: AsType (SigningKey GenesisDelegateExtendedKey)
-> ByteString
-> Either DecoderError (SigningKey GenesisDelegateExtendedKey)
SerialiseAsCBOR
      deriving (Int -> SigningKey GenesisDelegateExtendedKey -> ShowS
[SigningKey GenesisDelegateExtendedKey] -> ShowS
SigningKey GenesisDelegateExtendedKey -> String
(Int -> SigningKey GenesisDelegateExtendedKey -> ShowS)
-> (SigningKey GenesisDelegateExtendedKey -> String)
-> ([SigningKey GenesisDelegateExtendedKey] -> ShowS)
-> Show (SigningKey GenesisDelegateExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey GenesisDelegateExtendedKey -> ShowS
showsPrec :: Int -> SigningKey GenesisDelegateExtendedKey -> ShowS
$cshow :: SigningKey GenesisDelegateExtendedKey -> String
show :: SigningKey GenesisDelegateExtendedKey -> String
$cshowList :: [SigningKey GenesisDelegateExtendedKey] -> ShowS
showList :: [SigningKey GenesisDelegateExtendedKey] -> ShowS
Show, String -> SigningKey GenesisDelegateExtendedKey
(String -> SigningKey GenesisDelegateExtendedKey)
-> IsString (SigningKey GenesisDelegateExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey GenesisDelegateExtendedKey
fromString :: String -> SigningKey GenesisDelegateExtendedKey
IsString) via UsingRawBytesHex (SigningKey GenesisDelegateExtendedKey)

    deterministicSigningKey :: AsType GenesisDelegateExtendedKey
                            -> Crypto.Seed
                            -> SigningKey GenesisDelegateExtendedKey
    deterministicSigningKey :: AsType GenesisDelegateExtendedKey
-> Seed -> SigningKey GenesisDelegateExtendedKey
deterministicSigningKey AsType GenesisDelegateExtendedKey
R:AsTypeGenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey Seed
seed =
        XPrv -> SigningKey GenesisDelegateExtendedKey
GenesisDelegateExtendedSigningKey
          (ByteString -> ByteString -> XPrv
forall passPhrase seed.
(ByteArrayAccess passPhrase, ByteArrayAccess seed) =>
seed -> passPhrase -> XPrv
Crypto.HD.generate ByteString
seedbs ByteString
BS.empty)
      where
       (ByteString
seedbs, Seed
_) = Word -> Seed -> (ByteString, Seed)
Crypto.getBytesFromSeedT Word
32 Seed
seed

    deterministicSigningKeySeedSize :: AsType GenesisDelegateExtendedKey -> Word
    deterministicSigningKeySeedSize :: AsType GenesisDelegateExtendedKey -> Word
deterministicSigningKeySeedSize AsType GenesisDelegateExtendedKey
R:AsTypeGenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey = Word
32

    getVerificationKey :: SigningKey GenesisDelegateExtendedKey
                       -> VerificationKey GenesisDelegateExtendedKey
    getVerificationKey :: SigningKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey
getVerificationKey (GenesisDelegateExtendedSigningKey XPrv
sk) =
        XPub -> VerificationKey GenesisDelegateExtendedKey
GenesisDelegateExtendedVerificationKey (HasCallStack => XPrv -> XPub
XPrv -> XPub
Crypto.HD.toXPub XPrv
sk)

    -- | We use the hash of the normal non-extended pub key so that it is
    -- consistent with the one used in addresses and signatures.
    --
    verificationKeyHash :: VerificationKey GenesisDelegateExtendedKey
                        -> Hash GenesisDelegateExtendedKey
    verificationKeyHash :: VerificationKey GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
verificationKeyHash (GenesisDelegateExtendedVerificationKey XPub
vk) =
        KeyHash 'Staking StandardCrypto -> Hash GenesisDelegateExtendedKey
GenesisDelegateExtendedKeyHash
      (KeyHash 'Staking StandardCrypto
 -> Hash GenesisDelegateExtendedKey)
-> (Hash Blake2b_224 XPub -> KeyHash 'Staking StandardCrypto)
-> Hash Blake2b_224 XPub
-> Hash GenesisDelegateExtendedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Staking StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Staking StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash
      (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
 -> KeyHash 'Staking StandardCrypto)
-> (Hash Blake2b_224 XPub
    -> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Hash Blake2b_224 XPub
-> KeyHash 'Staking StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 XPub
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
forall h a b. Hash h a -> Hash h b
Crypto.castHash
      (Hash Blake2b_224 XPub -> Hash GenesisDelegateExtendedKey)
-> Hash Blake2b_224 XPub -> Hash GenesisDelegateExtendedKey
forall a b. (a -> b) -> a -> b
$ (XPub -> ByteString) -> XPub -> Hash Blake2b_224 XPub
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith XPub -> ByteString
Crypto.HD.xpubPublicKey XPub
vk


instance ToCBOR (VerificationKey GenesisDelegateExtendedKey) where
    toCBOR :: VerificationKey GenesisDelegateExtendedKey -> Encoding
toCBOR (GenesisDelegateExtendedVerificationKey XPub
xpub) =
      ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (XPub -> ByteString
Crypto.HD.unXPub XPub
xpub)

instance FromCBOR (VerificationKey GenesisDelegateExtendedKey) where
    fromCBOR :: forall s. Decoder s (VerificationKey GenesisDelegateExtendedKey)
fromCBOR = do
      ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (String -> Decoder s (VerificationKey GenesisDelegateExtendedKey))
-> (XPub -> Decoder s (VerificationKey GenesisDelegateExtendedKey))
-> Either String XPub
-> Decoder s (VerificationKey GenesisDelegateExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Decoder s (VerificationKey GenesisDelegateExtendedKey)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (VerificationKey GenesisDelegateExtendedKey
-> Decoder s (VerificationKey GenesisDelegateExtendedKey)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey GenesisDelegateExtendedKey
 -> Decoder s (VerificationKey GenesisDelegateExtendedKey))
-> (XPub -> VerificationKey GenesisDelegateExtendedKey)
-> XPub
-> Decoder s (VerificationKey GenesisDelegateExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey GenesisDelegateExtendedKey
GenesisDelegateExtendedVerificationKey)
             (ByteString -> Either String XPub
Crypto.HD.xpub (ByteString
bs :: ByteString))

instance ToCBOR (SigningKey GenesisDelegateExtendedKey) where
    toCBOR :: SigningKey GenesisDelegateExtendedKey -> Encoding
toCBOR (GenesisDelegateExtendedSigningKey XPrv
xprv) =
      ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (XPrv -> ByteString
Crypto.HD.unXPrv XPrv
xprv)

instance FromCBOR (SigningKey GenesisDelegateExtendedKey) where
    fromCBOR :: forall s. Decoder s (SigningKey GenesisDelegateExtendedKey)
fromCBOR = do
      ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
      (String -> Decoder s (SigningKey GenesisDelegateExtendedKey))
-> (XPrv -> Decoder s (SigningKey GenesisDelegateExtendedKey))
-> Either String XPrv
-> Decoder s (SigningKey GenesisDelegateExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Decoder s (SigningKey GenesisDelegateExtendedKey)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (SigningKey GenesisDelegateExtendedKey
-> Decoder s (SigningKey GenesisDelegateExtendedKey)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (SigningKey GenesisDelegateExtendedKey
 -> Decoder s (SigningKey GenesisDelegateExtendedKey))
-> (XPrv -> SigningKey GenesisDelegateExtendedKey)
-> XPrv
-> Decoder s (SigningKey GenesisDelegateExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey GenesisDelegateExtendedKey
GenesisDelegateExtendedSigningKey)
             (ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
Crypto.HD.xprv (ByteString
bs :: ByteString))

instance SerialiseAsRawBytes (VerificationKey GenesisDelegateExtendedKey) where
    serialiseToRawBytes :: VerificationKey GenesisDelegateExtendedKey -> ByteString
serialiseToRawBytes (GenesisDelegateExtendedVerificationKey XPub
xpub) =
      XPub -> ByteString
Crypto.HD.unXPub XPub
xpub

    deserialiseFromRawBytes :: AsType (VerificationKey GenesisDelegateExtendedKey)
-> ByteString -> Maybe (VerificationKey GenesisDelegateExtendedKey)
deserialiseFromRawBytes (AsVerificationKey AsType GenesisDelegateExtendedKey
R:AsTypeGenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey) ByteString
bs =
      (String -> Maybe (VerificationKey GenesisDelegateExtendedKey))
-> (XPub -> Maybe (VerificationKey GenesisDelegateExtendedKey))
-> Either String XPub
-> Maybe (VerificationKey GenesisDelegateExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (VerificationKey GenesisDelegateExtendedKey)
-> String -> Maybe (VerificationKey GenesisDelegateExtendedKey)
forall a b. a -> b -> a
const Maybe (VerificationKey GenesisDelegateExtendedKey)
forall a. Maybe a
Nothing) (VerificationKey GenesisDelegateExtendedKey
-> Maybe (VerificationKey GenesisDelegateExtendedKey)
forall a. a -> Maybe a
Just (VerificationKey GenesisDelegateExtendedKey
 -> Maybe (VerificationKey GenesisDelegateExtendedKey))
-> (XPub -> VerificationKey GenesisDelegateExtendedKey)
-> XPub
-> Maybe (VerificationKey GenesisDelegateExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey GenesisDelegateExtendedKey
GenesisDelegateExtendedVerificationKey)
             (ByteString -> Either String XPub
Crypto.HD.xpub ByteString
bs)

instance SerialiseAsRawBytes (SigningKey GenesisDelegateExtendedKey) where
    serialiseToRawBytes :: SigningKey GenesisDelegateExtendedKey -> ByteString
serialiseToRawBytes (GenesisDelegateExtendedSigningKey XPrv
xprv) =
      XPrv -> ByteString
Crypto.HD.unXPrv XPrv
xprv

    deserialiseFromRawBytes :: AsType (SigningKey GenesisDelegateExtendedKey)
-> ByteString -> Maybe (SigningKey GenesisDelegateExtendedKey)
deserialiseFromRawBytes (AsSigningKey AsType GenesisDelegateExtendedKey
R:AsTypeGenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey) ByteString
bs =
      (String -> Maybe (SigningKey GenesisDelegateExtendedKey))
-> (XPrv -> Maybe (SigningKey GenesisDelegateExtendedKey))
-> Either String XPrv
-> Maybe (SigningKey GenesisDelegateExtendedKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (SigningKey GenesisDelegateExtendedKey)
-> String -> Maybe (SigningKey GenesisDelegateExtendedKey)
forall a b. a -> b -> a
const Maybe (SigningKey GenesisDelegateExtendedKey)
forall a. Maybe a
Nothing) (SigningKey GenesisDelegateExtendedKey
-> Maybe (SigningKey GenesisDelegateExtendedKey)
forall a. a -> Maybe a
Just (SigningKey GenesisDelegateExtendedKey
 -> Maybe (SigningKey GenesisDelegateExtendedKey))
-> (XPrv -> SigningKey GenesisDelegateExtendedKey)
-> XPrv
-> Maybe (SigningKey GenesisDelegateExtendedKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey GenesisDelegateExtendedKey
GenesisDelegateExtendedSigningKey)
             (ByteString -> Either String XPrv
forall bin. ByteArrayAccess bin => bin -> Either String XPrv
Crypto.HD.xprv ByteString
bs)


newtype instance Hash GenesisDelegateExtendedKey =
    GenesisDelegateExtendedKeyHash (Shelley.KeyHash Shelley.Staking StandardCrypto)
  deriving stock (Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
(Hash GenesisDelegateExtendedKey
 -> Hash GenesisDelegateExtendedKey -> Bool)
-> (Hash GenesisDelegateExtendedKey
    -> Hash GenesisDelegateExtendedKey -> Bool)
-> Eq (Hash GenesisDelegateExtendedKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
== :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
$c/= :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
/= :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
Eq, Eq (Hash GenesisDelegateExtendedKey)
Eq (Hash GenesisDelegateExtendedKey) =>
(Hash GenesisDelegateExtendedKey
 -> Hash GenesisDelegateExtendedKey -> Ordering)
-> (Hash GenesisDelegateExtendedKey
    -> Hash GenesisDelegateExtendedKey -> Bool)
-> (Hash GenesisDelegateExtendedKey
    -> Hash GenesisDelegateExtendedKey -> Bool)
-> (Hash GenesisDelegateExtendedKey
    -> Hash GenesisDelegateExtendedKey -> Bool)
-> (Hash GenesisDelegateExtendedKey
    -> Hash GenesisDelegateExtendedKey -> Bool)
-> (Hash GenesisDelegateExtendedKey
    -> Hash GenesisDelegateExtendedKey
    -> Hash GenesisDelegateExtendedKey)
-> (Hash GenesisDelegateExtendedKey
    -> Hash GenesisDelegateExtendedKey
    -> Hash GenesisDelegateExtendedKey)
-> Ord (Hash GenesisDelegateExtendedKey)
Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Ordering
Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Ordering
compare :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Ordering
$c< :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
< :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
$c<= :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
<= :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
$c> :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
> :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
$c>= :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
>= :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey -> Bool
$cmax :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
max :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
$cmin :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
min :: Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
-> Hash GenesisDelegateExtendedKey
Ord)
  deriving (Int -> Hash GenesisDelegateExtendedKey -> ShowS
[Hash GenesisDelegateExtendedKey] -> ShowS
Hash GenesisDelegateExtendedKey -> String
(Int -> Hash GenesisDelegateExtendedKey -> ShowS)
-> (Hash GenesisDelegateExtendedKey -> String)
-> ([Hash GenesisDelegateExtendedKey] -> ShowS)
-> Show (Hash GenesisDelegateExtendedKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash GenesisDelegateExtendedKey -> ShowS
showsPrec :: Int -> Hash GenesisDelegateExtendedKey -> ShowS
$cshow :: Hash GenesisDelegateExtendedKey -> String
show :: Hash GenesisDelegateExtendedKey -> String
$cshowList :: [Hash GenesisDelegateExtendedKey] -> ShowS
showList :: [Hash GenesisDelegateExtendedKey] -> ShowS
Show, String -> Hash GenesisDelegateExtendedKey
(String -> Hash GenesisDelegateExtendedKey)
-> IsString (Hash GenesisDelegateExtendedKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash GenesisDelegateExtendedKey
fromString :: String -> Hash GenesisDelegateExtendedKey
IsString) via UsingRawBytesHex (Hash GenesisDelegateExtendedKey)
  deriving (Typeable (Hash GenesisDelegateExtendedKey)
Typeable (Hash GenesisDelegateExtendedKey) =>
(Hash GenesisDelegateExtendedKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash GenesisDelegateExtendedKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash GenesisDelegateExtendedKey] -> Size)
-> ToCBOR (Hash GenesisDelegateExtendedKey)
Hash GenesisDelegateExtendedKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisDelegateExtendedKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisDelegateExtendedKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Hash GenesisDelegateExtendedKey -> Encoding
toCBOR :: Hash GenesisDelegateExtendedKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisDelegateExtendedKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisDelegateExtendedKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisDelegateExtendedKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisDelegateExtendedKey] -> Size
ToCBOR, Typeable (Hash GenesisDelegateExtendedKey)
Typeable (Hash GenesisDelegateExtendedKey) =>
(forall s. Decoder s (Hash GenesisDelegateExtendedKey))
-> (Proxy (Hash GenesisDelegateExtendedKey) -> Text)
-> FromCBOR (Hash GenesisDelegateExtendedKey)
Proxy (Hash GenesisDelegateExtendedKey) -> Text
forall s. Decoder s (Hash GenesisDelegateExtendedKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash GenesisDelegateExtendedKey)
fromCBOR :: forall s. Decoder s (Hash GenesisDelegateExtendedKey)
$clabel :: Proxy (Hash GenesisDelegateExtendedKey) -> Text
label :: Proxy (Hash GenesisDelegateExtendedKey) -> Text
FromCBOR) via UsingRawBytes (Hash GenesisDelegateExtendedKey)
  deriving anyclass HasTypeProxy (Hash GenesisDelegateExtendedKey)
Hash GenesisDelegateExtendedKey -> ByteString
HasTypeProxy (Hash GenesisDelegateExtendedKey) =>
(Hash GenesisDelegateExtendedKey -> ByteString)
-> (AsType (Hash GenesisDelegateExtendedKey)
    -> ByteString
    -> Either DecoderError (Hash GenesisDelegateExtendedKey))
-> SerialiseAsCBOR (Hash GenesisDelegateExtendedKey)
AsType (Hash GenesisDelegateExtendedKey)
-> ByteString
-> Either DecoderError (Hash GenesisDelegateExtendedKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash GenesisDelegateExtendedKey -> ByteString
serialiseToCBOR :: Hash GenesisDelegateExtendedKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash GenesisDelegateExtendedKey)
-> ByteString
-> Either DecoderError (Hash GenesisDelegateExtendedKey)
deserialiseFromCBOR :: AsType (Hash GenesisDelegateExtendedKey)
-> ByteString
-> Either DecoderError (Hash GenesisDelegateExtendedKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash GenesisDelegateExtendedKey) where
    serialiseToRawBytes :: Hash GenesisDelegateExtendedKey -> ByteString
serialiseToRawBytes (GenesisDelegateExtendedKeyHash (Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
      Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

    deserialiseFromRawBytes :: AsType (Hash GenesisDelegateExtendedKey)
-> ByteString -> Maybe (Hash GenesisDelegateExtendedKey)
deserialiseFromRawBytes (AsHash AsType GenesisDelegateExtendedKey
R:AsTypeGenesisDelegateExtendedKey
AsGenesisDelegateExtendedKey) ByteString
bs =
      KeyHash 'Staking StandardCrypto -> Hash GenesisDelegateExtendedKey
GenesisDelegateExtendedKeyHash (KeyHash 'Staking StandardCrypto
 -> Hash GenesisDelegateExtendedKey)
-> (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
    -> KeyHash 'Staking StandardCrypto)
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> Hash GenesisDelegateExtendedKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Staking StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Staking StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
 -> Hash GenesisDelegateExtendedKey)
-> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Maybe (Hash GenesisDelegateExtendedKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey GenesisDelegateExtendedKey) where
    textEnvelopeType :: AsType (VerificationKey GenesisDelegateExtendedKey)
-> TextEnvelopeType
textEnvelopeType AsType (VerificationKey GenesisDelegateExtendedKey)
_ = TextEnvelopeType
"GenesisDelegateExtendedVerificationKey_ed25519_bip32"

instance HasTextEnvelope (SigningKey GenesisDelegateExtendedKey) where
    textEnvelopeType :: AsType (SigningKey GenesisDelegateExtendedKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey GenesisDelegateExtendedKey)
_ = TextEnvelopeType
"GenesisDelegateExtendedSigningKey_ed25519_bip32"

instance CastVerificationKeyRole GenesisDelegateExtendedKey GenesisDelegateKey where
    castVerificationKey :: VerificationKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateKey
castVerificationKey (GenesisDelegateExtendedVerificationKey XPub
vk) =
        VKey 'GenesisDelegate StandardCrypto
-> VerificationKey GenesisDelegateKey
GenesisDelegateVerificationKey
      (VKey 'GenesisDelegate StandardCrypto
 -> VerificationKey GenesisDelegateKey)
-> (XPub -> VKey 'GenesisDelegate StandardCrypto)
-> XPub
-> VerificationKey GenesisDelegateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VKey 'GenesisDelegate StandardCrypto
VerKeyDSIGN (DSIGN StandardCrypto)
-> VKey 'GenesisDelegate StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey
      (VerKeyDSIGN Ed25519DSIGN -> VKey 'GenesisDelegate StandardCrypto)
-> (XPub -> VerKeyDSIGN Ed25519DSIGN)
-> XPub
-> VKey 'GenesisDelegate StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN
-> Maybe (VerKeyDSIGN Ed25519DSIGN) -> VerKeyDSIGN Ed25519DSIGN
forall a. a -> Maybe a -> a
fromMaybe VerKeyDSIGN Ed25519DSIGN
forall {a}. a
impossible
      (Maybe (VerKeyDSIGN Ed25519DSIGN) -> VerKeyDSIGN Ed25519DSIGN)
-> (XPub -> Maybe (VerKeyDSIGN Ed25519DSIGN))
-> XPub
-> VerKeyDSIGN Ed25519DSIGN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
Crypto.rawDeserialiseVerKeyDSIGN
      (ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN))
-> (XPub -> ByteString) -> XPub -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
Crypto.HD.xpubPublicKey
      (XPub -> VerificationKey GenesisDelegateKey)
-> XPub -> VerificationKey GenesisDelegateKey
forall a b. (a -> b) -> a -> b
$ XPub
vk
      where
        impossible :: a
impossible =
          String -> a
forall a. HasCallStack => String -> a
error String
"castVerificationKey: byron and shelley key sizes do not match!"


--
-- Genesis UTxO keys
--

data GenesisUTxOKey

instance HasTypeProxy GenesisUTxOKey where
    data AsType GenesisUTxOKey = AsGenesisUTxOKey
    proxyToAsType :: Proxy GenesisUTxOKey -> AsType GenesisUTxOKey
proxyToAsType Proxy GenesisUTxOKey
_ = AsType GenesisUTxOKey
AsGenesisUTxOKey


instance Key GenesisUTxOKey where

    newtype VerificationKey GenesisUTxOKey =
        GenesisUTxOVerificationKey (Shelley.VKey Shelley.Payment StandardCrypto)
      deriving stock (VerificationKey GenesisUTxOKey
-> VerificationKey GenesisUTxOKey -> Bool
(VerificationKey GenesisUTxOKey
 -> VerificationKey GenesisUTxOKey -> Bool)
-> (VerificationKey GenesisUTxOKey
    -> VerificationKey GenesisUTxOKey -> Bool)
-> Eq (VerificationKey GenesisUTxOKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey GenesisUTxOKey
-> VerificationKey GenesisUTxOKey -> Bool
== :: VerificationKey GenesisUTxOKey
-> VerificationKey GenesisUTxOKey -> Bool
$c/= :: VerificationKey GenesisUTxOKey
-> VerificationKey GenesisUTxOKey -> Bool
/= :: VerificationKey GenesisUTxOKey
-> VerificationKey GenesisUTxOKey -> Bool
Eq)
      deriving (Int -> VerificationKey GenesisUTxOKey -> ShowS
[VerificationKey GenesisUTxOKey] -> ShowS
VerificationKey GenesisUTxOKey -> String
(Int -> VerificationKey GenesisUTxOKey -> ShowS)
-> (VerificationKey GenesisUTxOKey -> String)
-> ([VerificationKey GenesisUTxOKey] -> ShowS)
-> Show (VerificationKey GenesisUTxOKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey GenesisUTxOKey -> ShowS
showsPrec :: Int -> VerificationKey GenesisUTxOKey -> ShowS
$cshow :: VerificationKey GenesisUTxOKey -> String
show :: VerificationKey GenesisUTxOKey -> String
$cshowList :: [VerificationKey GenesisUTxOKey] -> ShowS
showList :: [VerificationKey GenesisUTxOKey] -> ShowS
Show, String -> VerificationKey GenesisUTxOKey
(String -> VerificationKey GenesisUTxOKey)
-> IsString (VerificationKey GenesisUTxOKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey GenesisUTxOKey
fromString :: String -> VerificationKey GenesisUTxOKey
IsString) via UsingRawBytesHex (VerificationKey GenesisUTxOKey)
      deriving newtype (Typeable (VerificationKey GenesisUTxOKey)
Typeable (VerificationKey GenesisUTxOKey) =>
(VerificationKey GenesisUTxOKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey GenesisUTxOKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey GenesisUTxOKey] -> Size)
-> ToCBOR (VerificationKey GenesisUTxOKey)
VerificationKey GenesisUTxOKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey GenesisUTxOKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey GenesisUTxOKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: VerificationKey GenesisUTxOKey -> Encoding
toCBOR :: VerificationKey GenesisUTxOKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey GenesisUTxOKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey GenesisUTxOKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey GenesisUTxOKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey GenesisUTxOKey] -> Size
ToCBOR, Typeable (VerificationKey GenesisUTxOKey)
Typeable (VerificationKey GenesisUTxOKey) =>
(forall s. Decoder s (VerificationKey GenesisUTxOKey))
-> (Proxy (VerificationKey GenesisUTxOKey) -> Text)
-> FromCBOR (VerificationKey GenesisUTxOKey)
Proxy (VerificationKey GenesisUTxOKey) -> Text
forall s. Decoder s (VerificationKey GenesisUTxOKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (VerificationKey GenesisUTxOKey)
fromCBOR :: forall s. Decoder s (VerificationKey GenesisUTxOKey)
$clabel :: Proxy (VerificationKey GenesisUTxOKey) -> Text
label :: Proxy (VerificationKey GenesisUTxOKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (VerificationKey GenesisUTxOKey)
HasTypeProxy (VerificationKey GenesisUTxOKey) =>
(VerificationKey GenesisUTxOKey -> ByteString)
-> (AsType (VerificationKey GenesisUTxOKey)
    -> ByteString
    -> Either DecoderError (VerificationKey GenesisUTxOKey))
-> SerialiseAsCBOR (VerificationKey GenesisUTxOKey)
AsType (VerificationKey GenesisUTxOKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisUTxOKey)
VerificationKey GenesisUTxOKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey GenesisUTxOKey -> ByteString
serialiseToCBOR :: VerificationKey GenesisUTxOKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey GenesisUTxOKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisUTxOKey)
deserialiseFromCBOR :: AsType (VerificationKey GenesisUTxOKey)
-> ByteString
-> Either DecoderError (VerificationKey GenesisUTxOKey)
SerialiseAsCBOR

    newtype SigningKey GenesisUTxOKey =
        GenesisUTxOSigningKey (Shelley.SignKeyDSIGN StandardCrypto)
      deriving (Int -> SigningKey GenesisUTxOKey -> ShowS
[SigningKey GenesisUTxOKey] -> ShowS
SigningKey GenesisUTxOKey -> String
(Int -> SigningKey GenesisUTxOKey -> ShowS)
-> (SigningKey GenesisUTxOKey -> String)
-> ([SigningKey GenesisUTxOKey] -> ShowS)
-> Show (SigningKey GenesisUTxOKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey GenesisUTxOKey -> ShowS
showsPrec :: Int -> SigningKey GenesisUTxOKey -> ShowS
$cshow :: SigningKey GenesisUTxOKey -> String
show :: SigningKey GenesisUTxOKey -> String
$cshowList :: [SigningKey GenesisUTxOKey] -> ShowS
showList :: [SigningKey GenesisUTxOKey] -> ShowS
Show, String -> SigningKey GenesisUTxOKey
(String -> SigningKey GenesisUTxOKey)
-> IsString (SigningKey GenesisUTxOKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey GenesisUTxOKey
fromString :: String -> SigningKey GenesisUTxOKey
IsString) via UsingRawBytesHex (SigningKey GenesisUTxOKey)
      deriving newtype (Typeable (SigningKey GenesisUTxOKey)
Typeable (SigningKey GenesisUTxOKey) =>
(SigningKey GenesisUTxOKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey GenesisUTxOKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey GenesisUTxOKey] -> Size)
-> ToCBOR (SigningKey GenesisUTxOKey)
SigningKey GenesisUTxOKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey GenesisUTxOKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey GenesisUTxOKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SigningKey GenesisUTxOKey -> Encoding
toCBOR :: SigningKey GenesisUTxOKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey GenesisUTxOKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey GenesisUTxOKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey GenesisUTxOKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey GenesisUTxOKey] -> Size
ToCBOR, Typeable (SigningKey GenesisUTxOKey)
Typeable (SigningKey GenesisUTxOKey) =>
(forall s. Decoder s (SigningKey GenesisUTxOKey))
-> (Proxy (SigningKey GenesisUTxOKey) -> Text)
-> FromCBOR (SigningKey GenesisUTxOKey)
Proxy (SigningKey GenesisUTxOKey) -> Text
forall s. Decoder s (SigningKey GenesisUTxOKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (SigningKey GenesisUTxOKey)
fromCBOR :: forall s. Decoder s (SigningKey GenesisUTxOKey)
$clabel :: Proxy (SigningKey GenesisUTxOKey) -> Text
label :: Proxy (SigningKey GenesisUTxOKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (SigningKey GenesisUTxOKey)
HasTypeProxy (SigningKey GenesisUTxOKey) =>
(SigningKey GenesisUTxOKey -> ByteString)
-> (AsType (SigningKey GenesisUTxOKey)
    -> ByteString -> Either DecoderError (SigningKey GenesisUTxOKey))
-> SerialiseAsCBOR (SigningKey GenesisUTxOKey)
AsType (SigningKey GenesisUTxOKey)
-> ByteString -> Either DecoderError (SigningKey GenesisUTxOKey)
SigningKey GenesisUTxOKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey GenesisUTxOKey -> ByteString
serialiseToCBOR :: SigningKey GenesisUTxOKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey GenesisUTxOKey)
-> ByteString -> Either DecoderError (SigningKey GenesisUTxOKey)
deserialiseFromCBOR :: AsType (SigningKey GenesisUTxOKey)
-> ByteString -> Either DecoderError (SigningKey GenesisUTxOKey)
SerialiseAsCBOR

    deterministicSigningKey :: AsType GenesisUTxOKey -> Crypto.Seed -> SigningKey GenesisUTxOKey
    deterministicSigningKey :: AsType GenesisUTxOKey -> Seed -> SigningKey GenesisUTxOKey
deterministicSigningKey AsType GenesisUTxOKey
R:AsTypeGenesisUTxOKey
AsGenesisUTxOKey Seed
seed =
        SignKeyDSIGN StandardCrypto -> SigningKey GenesisUTxOKey
GenesisUTxOSigningKey (Seed -> SignKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
Crypto.genKeyDSIGN Seed
seed)

    deterministicSigningKeySeedSize :: AsType GenesisUTxOKey -> Word
    deterministicSigningKeySeedSize :: AsType GenesisUTxOKey -> Word
deterministicSigningKeySeedSize AsType GenesisUTxOKey
R:AsTypeGenesisUTxOKey
AsGenesisUTxOKey =
        Proxy Ed25519DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
Crypto.seedSizeDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

    getVerificationKey :: SigningKey GenesisUTxOKey -> VerificationKey GenesisUTxOKey
    getVerificationKey :: SigningKey GenesisUTxOKey -> VerificationKey GenesisUTxOKey
getVerificationKey (GenesisUTxOSigningKey SignKeyDSIGN StandardCrypto
sk) =
        VKey 'Payment StandardCrypto -> VerificationKey GenesisUTxOKey
GenesisUTxOVerificationKey (VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Payment StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
Crypto.deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk))

    verificationKeyHash :: VerificationKey GenesisUTxOKey -> Hash GenesisUTxOKey
    verificationKeyHash :: VerificationKey GenesisUTxOKey -> Hash GenesisUTxOKey
verificationKeyHash (GenesisUTxOVerificationKey VKey 'Payment StandardCrypto
vkey) =
        KeyHash 'Payment StandardCrypto -> Hash GenesisUTxOKey
GenesisUTxOKeyHash (VKey 'Payment StandardCrypto -> KeyHash 'Payment StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
Shelley.hashKey VKey 'Payment StandardCrypto
vkey)


instance SerialiseAsRawBytes (VerificationKey GenesisUTxOKey) where
    serialiseToRawBytes :: VerificationKey GenesisUTxOKey -> ByteString
serialiseToRawBytes (GenesisUTxOVerificationKey (Shelley.VKey VerKeyDSIGN (DSIGN StandardCrypto)
vk)) =
      VerKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
Crypto.rawSerialiseVerKeyDSIGN VerKeyDSIGN Ed25519DSIGN
VerKeyDSIGN (DSIGN StandardCrypto)
vk

    deserialiseFromRawBytes :: AsType (VerificationKey GenesisUTxOKey)
-> ByteString -> Maybe (VerificationKey GenesisUTxOKey)
deserialiseFromRawBytes (AsVerificationKey AsType GenesisUTxOKey
R:AsTypeGenesisUTxOKey
AsGenesisUTxOKey) ByteString
bs =
      VKey 'Payment StandardCrypto -> VerificationKey GenesisUTxOKey
GenesisUTxOVerificationKey (VKey 'Payment StandardCrypto -> VerificationKey GenesisUTxOKey)
-> (VerKeyDSIGN Ed25519DSIGN -> VKey 'Payment StandardCrypto)
-> VerKeyDSIGN Ed25519DSIGN
-> VerificationKey GenesisUTxOKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VKey 'Payment StandardCrypto
VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Payment StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (VerKeyDSIGN Ed25519DSIGN -> VerificationKey GenesisUTxOKey)
-> Maybe (VerKeyDSIGN Ed25519DSIGN)
-> Maybe (VerificationKey GenesisUTxOKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
Crypto.rawDeserialiseVerKeyDSIGN ByteString
bs

instance SerialiseAsRawBytes (SigningKey GenesisUTxOKey) where
    serialiseToRawBytes :: SigningKey GenesisUTxOKey -> ByteString
serialiseToRawBytes (GenesisUTxOSigningKey SignKeyDSIGN StandardCrypto
sk) =
      SignKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
Crypto.rawSerialiseSignKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk

    deserialiseFromRawBytes :: AsType (SigningKey GenesisUTxOKey)
-> ByteString -> Maybe (SigningKey GenesisUTxOKey)
deserialiseFromRawBytes (AsSigningKey AsType GenesisUTxOKey
R:AsTypeGenesisUTxOKey
AsGenesisUTxOKey) ByteString
bs =
      SignKeyDSIGN Ed25519DSIGN -> SigningKey GenesisUTxOKey
SignKeyDSIGN StandardCrypto -> SigningKey GenesisUTxOKey
GenesisUTxOSigningKey (SignKeyDSIGN Ed25519DSIGN -> SigningKey GenesisUTxOKey)
-> Maybe (SignKeyDSIGN Ed25519DSIGN)
-> Maybe (SigningKey GenesisUTxOKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (SignKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
Crypto.rawDeserialiseSignKeyDSIGN ByteString
bs


newtype instance Hash GenesisUTxOKey =
    GenesisUTxOKeyHash (Shelley.KeyHash Shelley.Payment StandardCrypto)
  deriving stock (Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
(Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool)
-> (Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool)
-> Eq (Hash GenesisUTxOKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
== :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
$c/= :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
/= :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
Eq, Eq (Hash GenesisUTxOKey)
Eq (Hash GenesisUTxOKey) =>
(Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Ordering)
-> (Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool)
-> (Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool)
-> (Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool)
-> (Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool)
-> (Hash GenesisUTxOKey
    -> Hash GenesisUTxOKey -> Hash GenesisUTxOKey)
-> (Hash GenesisUTxOKey
    -> Hash GenesisUTxOKey -> Hash GenesisUTxOKey)
-> Ord (Hash GenesisUTxOKey)
Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Ordering
Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Hash GenesisUTxOKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Ordering
compare :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Ordering
$c< :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
< :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
$c<= :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
<= :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
$c> :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
> :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
$c>= :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
>= :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Bool
$cmax :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Hash GenesisUTxOKey
max :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Hash GenesisUTxOKey
$cmin :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Hash GenesisUTxOKey
min :: Hash GenesisUTxOKey -> Hash GenesisUTxOKey -> Hash GenesisUTxOKey
Ord)
  deriving (Int -> Hash GenesisUTxOKey -> ShowS
[Hash GenesisUTxOKey] -> ShowS
Hash GenesisUTxOKey -> String
(Int -> Hash GenesisUTxOKey -> ShowS)
-> (Hash GenesisUTxOKey -> String)
-> ([Hash GenesisUTxOKey] -> ShowS)
-> Show (Hash GenesisUTxOKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash GenesisUTxOKey -> ShowS
showsPrec :: Int -> Hash GenesisUTxOKey -> ShowS
$cshow :: Hash GenesisUTxOKey -> String
show :: Hash GenesisUTxOKey -> String
$cshowList :: [Hash GenesisUTxOKey] -> ShowS
showList :: [Hash GenesisUTxOKey] -> ShowS
Show, String -> Hash GenesisUTxOKey
(String -> Hash GenesisUTxOKey) -> IsString (Hash GenesisUTxOKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash GenesisUTxOKey
fromString :: String -> Hash GenesisUTxOKey
IsString) via UsingRawBytesHex (Hash GenesisUTxOKey)
  deriving (Typeable (Hash GenesisUTxOKey)
Typeable (Hash GenesisUTxOKey) =>
(Hash GenesisUTxOKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash GenesisUTxOKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash GenesisUTxOKey] -> Size)
-> ToCBOR (Hash GenesisUTxOKey)
Hash GenesisUTxOKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisUTxOKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisUTxOKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Hash GenesisUTxOKey -> Encoding
toCBOR :: Hash GenesisUTxOKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisUTxOKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash GenesisUTxOKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisUTxOKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash GenesisUTxOKey] -> Size
ToCBOR, Typeable (Hash GenesisUTxOKey)
Typeable (Hash GenesisUTxOKey) =>
(forall s. Decoder s (Hash GenesisUTxOKey))
-> (Proxy (Hash GenesisUTxOKey) -> Text)
-> FromCBOR (Hash GenesisUTxOKey)
Proxy (Hash GenesisUTxOKey) -> Text
forall s. Decoder s (Hash GenesisUTxOKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash GenesisUTxOKey)
fromCBOR :: forall s. Decoder s (Hash GenesisUTxOKey)
$clabel :: Proxy (Hash GenesisUTxOKey) -> Text
label :: Proxy (Hash GenesisUTxOKey) -> Text
FromCBOR) via UsingRawBytes (Hash GenesisUTxOKey)
  deriving anyclass HasTypeProxy (Hash GenesisUTxOKey)
Hash GenesisUTxOKey -> ByteString
HasTypeProxy (Hash GenesisUTxOKey) =>
(Hash GenesisUTxOKey -> ByteString)
-> (AsType (Hash GenesisUTxOKey)
    -> ByteString -> Either DecoderError (Hash GenesisUTxOKey))
-> SerialiseAsCBOR (Hash GenesisUTxOKey)
AsType (Hash GenesisUTxOKey)
-> ByteString -> Either DecoderError (Hash GenesisUTxOKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash GenesisUTxOKey -> ByteString
serialiseToCBOR :: Hash GenesisUTxOKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash GenesisUTxOKey)
-> ByteString -> Either DecoderError (Hash GenesisUTxOKey)
deserialiseFromCBOR :: AsType (Hash GenesisUTxOKey)
-> ByteString -> Either DecoderError (Hash GenesisUTxOKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash GenesisUTxOKey) where
    serialiseToRawBytes :: Hash GenesisUTxOKey -> ByteString
serialiseToRawBytes (GenesisUTxOKeyHash (Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
      Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

    deserialiseFromRawBytes :: AsType (Hash GenesisUTxOKey)
-> ByteString -> Maybe (Hash GenesisUTxOKey)
deserialiseFromRawBytes (AsHash AsType GenesisUTxOKey
R:AsTypeGenesisUTxOKey
AsGenesisUTxOKey) ByteString
bs =
      KeyHash 'Payment StandardCrypto -> Hash GenesisUTxOKey
GenesisUTxOKeyHash (KeyHash 'Payment StandardCrypto -> Hash GenesisUTxOKey)
-> (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
    -> KeyHash 'Payment StandardCrypto)
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> Hash GenesisUTxOKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'Payment StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Payment StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
 -> Hash GenesisUTxOKey)
-> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Maybe (Hash GenesisUTxOKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance HasTextEnvelope (VerificationKey GenesisUTxOKey) where
    textEnvelopeType :: AsType (VerificationKey GenesisUTxOKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey GenesisUTxOKey)
_ = TextEnvelopeType
"GenesisUTxOVerificationKey_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

instance HasTextEnvelope (SigningKey GenesisUTxOKey) where
    textEnvelopeType :: AsType (SigningKey GenesisUTxOKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey GenesisUTxOKey)
_ = TextEnvelopeType
"GenesisUTxOSigningKey_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy
    -- TODO: use a different type from the stake pool key, since some operations
    -- need a genesis key specifically

instance CastVerificationKeyRole GenesisUTxOKey PaymentKey where
    castVerificationKey :: VerificationKey GenesisUTxOKey -> VerificationKey PaymentKey
castVerificationKey (GenesisUTxOVerificationKey (Shelley.VKey VerKeyDSIGN (DSIGN StandardCrypto)
vkey)) =
      VKey 'Payment StandardCrypto -> VerificationKey PaymentKey
PaymentVerificationKey (VerKeyDSIGN (DSIGN StandardCrypto) -> VKey 'Payment StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey VerKeyDSIGN (DSIGN StandardCrypto)
vkey)

instance CastSigningKeyRole GenesisUTxOKey PaymentKey where
    castSigningKey :: SigningKey GenesisUTxOKey -> SigningKey PaymentKey
castSigningKey (GenesisUTxOSigningKey SignKeyDSIGN StandardCrypto
skey) =
      SignKeyDSIGN StandardCrypto -> SigningKey PaymentKey
PaymentSigningKey SignKeyDSIGN StandardCrypto
skey


--
-- stake pool keys
--

data StakePoolKey

instance HasTypeProxy StakePoolKey where
    data AsType StakePoolKey = AsStakePoolKey
    proxyToAsType :: Proxy StakePoolKey -> AsType StakePoolKey
proxyToAsType Proxy StakePoolKey
_ = AsType StakePoolKey
AsStakePoolKey

instance Key StakePoolKey where

    newtype VerificationKey StakePoolKey =
        StakePoolVerificationKey (Shelley.VKey Shelley.StakePool StandardCrypto)
      deriving stock (VerificationKey StakePoolKey
-> VerificationKey StakePoolKey -> Bool
(VerificationKey StakePoolKey
 -> VerificationKey StakePoolKey -> Bool)
-> (VerificationKey StakePoolKey
    -> VerificationKey StakePoolKey -> Bool)
-> Eq (VerificationKey StakePoolKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerificationKey StakePoolKey
-> VerificationKey StakePoolKey -> Bool
== :: VerificationKey StakePoolKey
-> VerificationKey StakePoolKey -> Bool
$c/= :: VerificationKey StakePoolKey
-> VerificationKey StakePoolKey -> Bool
/= :: VerificationKey StakePoolKey
-> VerificationKey StakePoolKey -> Bool
Eq)
      deriving (Int -> VerificationKey StakePoolKey -> ShowS
[VerificationKey StakePoolKey] -> ShowS
VerificationKey StakePoolKey -> String
(Int -> VerificationKey StakePoolKey -> ShowS)
-> (VerificationKey StakePoolKey -> String)
-> ([VerificationKey StakePoolKey] -> ShowS)
-> Show (VerificationKey StakePoolKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerificationKey StakePoolKey -> ShowS
showsPrec :: Int -> VerificationKey StakePoolKey -> ShowS
$cshow :: VerificationKey StakePoolKey -> String
show :: VerificationKey StakePoolKey -> String
$cshowList :: [VerificationKey StakePoolKey] -> ShowS
showList :: [VerificationKey StakePoolKey] -> ShowS
Show, String -> VerificationKey StakePoolKey
(String -> VerificationKey StakePoolKey)
-> IsString (VerificationKey StakePoolKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey StakePoolKey
fromString :: String -> VerificationKey StakePoolKey
IsString) via UsingRawBytesHex (VerificationKey StakePoolKey)
      deriving newtype (Typeable (VerificationKey StakePoolKey)
Typeable (VerificationKey StakePoolKey) =>
(VerificationKey StakePoolKey -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey StakePoolKey) -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey StakePoolKey] -> Size)
-> EncCBOR (VerificationKey StakePoolKey)
VerificationKey StakePoolKey -> Encoding
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey StakePoolKey] -> Size
(forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey StakePoolKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. EncCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> EncCBOR a
$cencCBOR :: VerificationKey StakePoolKey -> Encoding
encCBOR :: VerificationKey StakePoolKey -> Encoding
$cencodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey StakePoolKey) -> Size
encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey StakePoolKey) -> Size
$cencodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey StakePoolKey] -> Size
encodedListSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey StakePoolKey] -> Size
EncCBOR, Typeable (VerificationKey StakePoolKey)
Typeable (VerificationKey StakePoolKey) =>
(forall s. Decoder s (VerificationKey StakePoolKey))
-> (forall s. Proxy (VerificationKey StakePoolKey) -> Decoder s ())
-> (Proxy (VerificationKey StakePoolKey) -> Text)
-> DecCBOR (VerificationKey StakePoolKey)
Proxy (VerificationKey StakePoolKey) -> Text
forall s. Decoder s (VerificationKey StakePoolKey)
forall a.
Typeable a =>
(forall s. Decoder s a)
-> (forall s. Proxy a -> Decoder s ())
-> (Proxy a -> Text)
-> DecCBOR a
forall s. Proxy (VerificationKey StakePoolKey) -> Decoder s ()
$cdecCBOR :: forall s. Decoder s (VerificationKey StakePoolKey)
decCBOR :: forall s. Decoder s (VerificationKey StakePoolKey)
$cdropCBOR :: forall s. Proxy (VerificationKey StakePoolKey) -> Decoder s ()
dropCBOR :: forall s. Proxy (VerificationKey StakePoolKey) -> Decoder s ()
$clabel :: Proxy (VerificationKey StakePoolKey) -> Text
label :: Proxy (VerificationKey StakePoolKey) -> Text
DecCBOR, Typeable (VerificationKey StakePoolKey)
Typeable (VerificationKey StakePoolKey) =>
(VerificationKey StakePoolKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (VerificationKey StakePoolKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [VerificationKey StakePoolKey] -> Size)
-> ToCBOR (VerificationKey StakePoolKey)
VerificationKey StakePoolKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey StakePoolKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey StakePoolKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: VerificationKey StakePoolKey -> Encoding
toCBOR :: VerificationKey StakePoolKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey StakePoolKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey StakePoolKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey StakePoolKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey StakePoolKey] -> Size
ToCBOR, Typeable (VerificationKey StakePoolKey)
Typeable (VerificationKey StakePoolKey) =>
(forall s. Decoder s (VerificationKey StakePoolKey))
-> (Proxy (VerificationKey StakePoolKey) -> Text)
-> FromCBOR (VerificationKey StakePoolKey)
Proxy (VerificationKey StakePoolKey) -> Text
forall s. Decoder s (VerificationKey StakePoolKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (VerificationKey StakePoolKey)
fromCBOR :: forall s. Decoder s (VerificationKey StakePoolKey)
$clabel :: Proxy (VerificationKey StakePoolKey) -> Text
label :: Proxy (VerificationKey StakePoolKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (VerificationKey StakePoolKey)
HasTypeProxy (VerificationKey StakePoolKey) =>
(VerificationKey StakePoolKey -> ByteString)
-> (AsType (VerificationKey StakePoolKey)
    -> ByteString
    -> Either DecoderError (VerificationKey StakePoolKey))
-> SerialiseAsCBOR (VerificationKey StakePoolKey)
AsType (VerificationKey StakePoolKey)
-> ByteString -> Either DecoderError (VerificationKey StakePoolKey)
VerificationKey StakePoolKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: VerificationKey StakePoolKey -> ByteString
serialiseToCBOR :: VerificationKey StakePoolKey -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey StakePoolKey)
-> ByteString -> Either DecoderError (VerificationKey StakePoolKey)
deserialiseFromCBOR :: AsType (VerificationKey StakePoolKey)
-> ByteString -> Either DecoderError (VerificationKey StakePoolKey)
SerialiseAsCBOR

    newtype SigningKey StakePoolKey =
        StakePoolSigningKey (Shelley.SignKeyDSIGN StandardCrypto)
      deriving (Int -> SigningKey StakePoolKey -> ShowS
[SigningKey StakePoolKey] -> ShowS
SigningKey StakePoolKey -> String
(Int -> SigningKey StakePoolKey -> ShowS)
-> (SigningKey StakePoolKey -> String)
-> ([SigningKey StakePoolKey] -> ShowS)
-> Show (SigningKey StakePoolKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SigningKey StakePoolKey -> ShowS
showsPrec :: Int -> SigningKey StakePoolKey -> ShowS
$cshow :: SigningKey StakePoolKey -> String
show :: SigningKey StakePoolKey -> String
$cshowList :: [SigningKey StakePoolKey] -> ShowS
showList :: [SigningKey StakePoolKey] -> ShowS
Show, String -> SigningKey StakePoolKey
(String -> SigningKey StakePoolKey)
-> IsString (SigningKey StakePoolKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> SigningKey StakePoolKey
fromString :: String -> SigningKey StakePoolKey
IsString) via UsingRawBytesHex (SigningKey StakePoolKey)
      deriving newtype (Typeable (SigningKey StakePoolKey)
Typeable (SigningKey StakePoolKey) =>
(SigningKey StakePoolKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (SigningKey StakePoolKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SigningKey StakePoolKey] -> Size)
-> ToCBOR (SigningKey StakePoolKey)
SigningKey StakePoolKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey StakePoolKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey StakePoolKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SigningKey StakePoolKey -> Encoding
toCBOR :: SigningKey StakePoolKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey StakePoolKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SigningKey StakePoolKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey StakePoolKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SigningKey StakePoolKey] -> Size
ToCBOR, Typeable (SigningKey StakePoolKey)
Typeable (SigningKey StakePoolKey) =>
(forall s. Decoder s (SigningKey StakePoolKey))
-> (Proxy (SigningKey StakePoolKey) -> Text)
-> FromCBOR (SigningKey StakePoolKey)
Proxy (SigningKey StakePoolKey) -> Text
forall s. Decoder s (SigningKey StakePoolKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (SigningKey StakePoolKey)
fromCBOR :: forall s. Decoder s (SigningKey StakePoolKey)
$clabel :: Proxy (SigningKey StakePoolKey) -> Text
label :: Proxy (SigningKey StakePoolKey) -> Text
FromCBOR)
      deriving anyclass HasTypeProxy (SigningKey StakePoolKey)
HasTypeProxy (SigningKey StakePoolKey) =>
(SigningKey StakePoolKey -> ByteString)
-> (AsType (SigningKey StakePoolKey)
    -> ByteString -> Either DecoderError (SigningKey StakePoolKey))
-> SerialiseAsCBOR (SigningKey StakePoolKey)
AsType (SigningKey StakePoolKey)
-> ByteString -> Either DecoderError (SigningKey StakePoolKey)
SigningKey StakePoolKey -> ByteString
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: SigningKey StakePoolKey -> ByteString
serialiseToCBOR :: SigningKey StakePoolKey -> ByteString
$cdeserialiseFromCBOR :: AsType (SigningKey StakePoolKey)
-> ByteString -> Either DecoderError (SigningKey StakePoolKey)
deserialiseFromCBOR :: AsType (SigningKey StakePoolKey)
-> ByteString -> Either DecoderError (SigningKey StakePoolKey)
SerialiseAsCBOR

    deterministicSigningKey :: AsType StakePoolKey -> Crypto.Seed -> SigningKey StakePoolKey
    deterministicSigningKey :: AsType StakePoolKey -> Seed -> SigningKey StakePoolKey
deterministicSigningKey AsType StakePoolKey
R:AsTypeStakePoolKey
AsStakePoolKey Seed
seed =
        SignKeyDSIGN StandardCrypto -> SigningKey StakePoolKey
StakePoolSigningKey (Seed -> SignKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
Crypto.genKeyDSIGN Seed
seed)

    deterministicSigningKeySeedSize :: AsType StakePoolKey -> Word
    deterministicSigningKeySeedSize :: AsType StakePoolKey -> Word
deterministicSigningKeySeedSize AsType StakePoolKey
R:AsTypeStakePoolKey
AsStakePoolKey =
        Proxy Ed25519DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
Crypto.seedSizeDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

    getVerificationKey :: SigningKey StakePoolKey -> VerificationKey StakePoolKey
    getVerificationKey :: SigningKey StakePoolKey -> VerificationKey StakePoolKey
getVerificationKey (StakePoolSigningKey SignKeyDSIGN StandardCrypto
sk) =
        VKey 'StakePool StandardCrypto -> VerificationKey StakePoolKey
StakePoolVerificationKey (VerKeyDSIGN (DSIGN StandardCrypto)
-> VKey 'StakePool StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (SignKeyDSIGN Ed25519DSIGN -> VerKeyDSIGN Ed25519DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
Crypto.deriveVerKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk))

    verificationKeyHash :: VerificationKey StakePoolKey -> Hash StakePoolKey
    verificationKeyHash :: VerificationKey StakePoolKey -> Hash StakePoolKey
verificationKeyHash (StakePoolVerificationKey VKey 'StakePool StandardCrypto
vkey) =
        KeyHash 'StakePool StandardCrypto -> Hash StakePoolKey
StakePoolKeyHash (VKey 'StakePool StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
Shelley.hashKey VKey 'StakePool StandardCrypto
vkey)

instance SerialiseAsRawBytes (VerificationKey StakePoolKey) where
    serialiseToRawBytes :: VerificationKey StakePoolKey -> ByteString
serialiseToRawBytes (StakePoolVerificationKey (Shelley.VKey VerKeyDSIGN (DSIGN StandardCrypto)
vk)) =
      VerKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => VerKeyDSIGN v -> ByteString
Crypto.rawSerialiseVerKeyDSIGN VerKeyDSIGN Ed25519DSIGN
VerKeyDSIGN (DSIGN StandardCrypto)
vk

    deserialiseFromRawBytes :: AsType (VerificationKey StakePoolKey)
-> ByteString -> Maybe (VerificationKey StakePoolKey)
deserialiseFromRawBytes (AsVerificationKey AsType StakePoolKey
R:AsTypeStakePoolKey
AsStakePoolKey) ByteString
bs =
      VKey 'StakePool StandardCrypto -> VerificationKey StakePoolKey
StakePoolVerificationKey (VKey 'StakePool StandardCrypto -> VerificationKey StakePoolKey)
-> (VerKeyDSIGN Ed25519DSIGN -> VKey 'StakePool StandardCrypto)
-> VerKeyDSIGN Ed25519DSIGN
-> VerificationKey StakePoolKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN Ed25519DSIGN -> VKey 'StakePool StandardCrypto
VerKeyDSIGN (DSIGN StandardCrypto)
-> VKey 'StakePool StandardCrypto
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
Shelley.VKey (VerKeyDSIGN Ed25519DSIGN -> VerificationKey StakePoolKey)
-> Maybe (VerKeyDSIGN Ed25519DSIGN)
-> Maybe (VerificationKey StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ByteString -> Maybe (VerKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (VerKeyDSIGN v)
Crypto.rawDeserialiseVerKeyDSIGN ByteString
bs

instance SerialiseAsRawBytes (SigningKey StakePoolKey) where
    serialiseToRawBytes :: SigningKey StakePoolKey -> ByteString
serialiseToRawBytes (StakePoolSigningKey SignKeyDSIGN StandardCrypto
sk) =
      SignKeyDSIGN Ed25519DSIGN -> ByteString
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> ByteString
Crypto.rawSerialiseSignKeyDSIGN SignKeyDSIGN Ed25519DSIGN
SignKeyDSIGN StandardCrypto
sk

    deserialiseFromRawBytes :: AsType (SigningKey StakePoolKey)
-> ByteString -> Maybe (SigningKey StakePoolKey)
deserialiseFromRawBytes (AsSigningKey AsType StakePoolKey
R:AsTypeStakePoolKey
AsStakePoolKey) ByteString
bs =
      SignKeyDSIGN Ed25519DSIGN -> SigningKey StakePoolKey
SignKeyDSIGN StandardCrypto -> SigningKey StakePoolKey
StakePoolSigningKey (SignKeyDSIGN Ed25519DSIGN -> SigningKey StakePoolKey)
-> Maybe (SignKeyDSIGN Ed25519DSIGN)
-> Maybe (SigningKey StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (SignKeyDSIGN Ed25519DSIGN)
forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
Crypto.rawDeserialiseSignKeyDSIGN ByteString
bs

instance SerialiseAsBech32 (VerificationKey StakePoolKey) where
    bech32PrefixFor :: VerificationKey StakePoolKey -> Text
bech32PrefixFor         VerificationKey StakePoolKey
_ =  Text
"pool_vk"
    bech32PrefixesPermitted :: AsType (VerificationKey StakePoolKey) -> [Text]
bech32PrefixesPermitted AsType (VerificationKey StakePoolKey)
_ = [Text
"pool_vk"]

instance SerialiseAsBech32 (SigningKey StakePoolKey) where
    bech32PrefixFor :: SigningKey StakePoolKey -> Text
bech32PrefixFor         SigningKey StakePoolKey
_ =  Text
"pool_sk"
    bech32PrefixesPermitted :: AsType (SigningKey StakePoolKey) -> [Text]
bech32PrefixesPermitted AsType (SigningKey StakePoolKey)
_ = [Text
"pool_sk"]

newtype instance Hash StakePoolKey =
    StakePoolKeyHash (Shelley.KeyHash Shelley.StakePool StandardCrypto)
  deriving stock (Hash StakePoolKey -> Hash StakePoolKey -> Bool
(Hash StakePoolKey -> Hash StakePoolKey -> Bool)
-> (Hash StakePoolKey -> Hash StakePoolKey -> Bool)
-> Eq (Hash StakePoolKey)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
== :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
$c/= :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
/= :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
Eq, Eq (Hash StakePoolKey)
Eq (Hash StakePoolKey) =>
(Hash StakePoolKey -> Hash StakePoolKey -> Ordering)
-> (Hash StakePoolKey -> Hash StakePoolKey -> Bool)
-> (Hash StakePoolKey -> Hash StakePoolKey -> Bool)
-> (Hash StakePoolKey -> Hash StakePoolKey -> Bool)
-> (Hash StakePoolKey -> Hash StakePoolKey -> Bool)
-> (Hash StakePoolKey -> Hash StakePoolKey -> Hash StakePoolKey)
-> (Hash StakePoolKey -> Hash StakePoolKey -> Hash StakePoolKey)
-> Ord (Hash StakePoolKey)
Hash StakePoolKey -> Hash StakePoolKey -> Bool
Hash StakePoolKey -> Hash StakePoolKey -> Ordering
Hash StakePoolKey -> Hash StakePoolKey -> Hash StakePoolKey
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Hash StakePoolKey -> Hash StakePoolKey -> Ordering
compare :: Hash StakePoolKey -> Hash StakePoolKey -> Ordering
$c< :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
< :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
$c<= :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
<= :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
$c> :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
> :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
$c>= :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
>= :: Hash StakePoolKey -> Hash StakePoolKey -> Bool
$cmax :: Hash StakePoolKey -> Hash StakePoolKey -> Hash StakePoolKey
max :: Hash StakePoolKey -> Hash StakePoolKey -> Hash StakePoolKey
$cmin :: Hash StakePoolKey -> Hash StakePoolKey -> Hash StakePoolKey
min :: Hash StakePoolKey -> Hash StakePoolKey -> Hash StakePoolKey
Ord)
  deriving (Int -> Hash StakePoolKey -> ShowS
[Hash StakePoolKey] -> ShowS
Hash StakePoolKey -> String
(Int -> Hash StakePoolKey -> ShowS)
-> (Hash StakePoolKey -> String)
-> ([Hash StakePoolKey] -> ShowS)
-> Show (Hash StakePoolKey)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hash StakePoolKey -> ShowS
showsPrec :: Int -> Hash StakePoolKey -> ShowS
$cshow :: Hash StakePoolKey -> String
show :: Hash StakePoolKey -> String
$cshowList :: [Hash StakePoolKey] -> ShowS
showList :: [Hash StakePoolKey] -> ShowS
Show, String -> Hash StakePoolKey
(String -> Hash StakePoolKey) -> IsString (Hash StakePoolKey)
forall a. (String -> a) -> IsString a
$cfromString :: String -> Hash StakePoolKey
fromString :: String -> Hash StakePoolKey
IsString) via UsingRawBytesHex (Hash StakePoolKey)
  deriving (Typeable (Hash StakePoolKey)
Typeable (Hash StakePoolKey) =>
(Hash StakePoolKey -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy (Hash StakePoolKey) -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [Hash StakePoolKey] -> Size)
-> ToCBOR (Hash StakePoolKey)
Hash StakePoolKey -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash StakePoolKey] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash StakePoolKey) -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Hash StakePoolKey -> Encoding
toCBOR :: Hash StakePoolKey -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash StakePoolKey) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (Hash StakePoolKey) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash StakePoolKey] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [Hash StakePoolKey] -> Size
ToCBOR, Typeable (Hash StakePoolKey)
Typeable (Hash StakePoolKey) =>
(forall s. Decoder s (Hash StakePoolKey))
-> (Proxy (Hash StakePoolKey) -> Text)
-> FromCBOR (Hash StakePoolKey)
Proxy (Hash StakePoolKey) -> Text
forall s. Decoder s (Hash StakePoolKey)
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s (Hash StakePoolKey)
fromCBOR :: forall s. Decoder s (Hash StakePoolKey)
$clabel :: Proxy (Hash StakePoolKey) -> Text
label :: Proxy (Hash StakePoolKey) -> Text
FromCBOR) via UsingRawBytes (Hash StakePoolKey)
  deriving anyclass HasTypeProxy (Hash StakePoolKey)
Hash StakePoolKey -> ByteString
HasTypeProxy (Hash StakePoolKey) =>
(Hash StakePoolKey -> ByteString)
-> (AsType (Hash StakePoolKey)
    -> ByteString -> Either DecoderError (Hash StakePoolKey))
-> SerialiseAsCBOR (Hash StakePoolKey)
AsType (Hash StakePoolKey)
-> ByteString -> Either DecoderError (Hash StakePoolKey)
forall a.
HasTypeProxy a =>
(a -> ByteString)
-> (AsType a -> ByteString -> Either DecoderError a)
-> SerialiseAsCBOR a
$cserialiseToCBOR :: Hash StakePoolKey -> ByteString
serialiseToCBOR :: Hash StakePoolKey -> ByteString
$cdeserialiseFromCBOR :: AsType (Hash StakePoolKey)
-> ByteString -> Either DecoderError (Hash StakePoolKey)
deserialiseFromCBOR :: AsType (Hash StakePoolKey)
-> ByteString -> Either DecoderError (Hash StakePoolKey)
SerialiseAsCBOR

instance SerialiseAsRawBytes (Hash StakePoolKey) where
    serialiseToRawBytes :: Hash StakePoolKey -> ByteString
serialiseToRawBytes (StakePoolKeyHash (Shelley.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
      Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

    deserialiseFromRawBytes :: AsType (Hash StakePoolKey)
-> ByteString -> Maybe (Hash StakePoolKey)
deserialiseFromRawBytes (AsHash AsType StakePoolKey
R:AsTypeStakePoolKey
AsStakePoolKey) ByteString
bs =
      KeyHash 'StakePool StandardCrypto -> Hash StakePoolKey
StakePoolKeyHash (KeyHash 'StakePool StandardCrypto -> Hash StakePoolKey)
-> (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
    -> KeyHash 'StakePool StandardCrypto)
-> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> Hash StakePoolKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
-> KeyHash 'StakePool StandardCrypto
Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'StakePool StandardCrypto
forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
Shelley.KeyHash (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN) -> Hash StakePoolKey)
-> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
-> Maybe (Hash StakePoolKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN))
forall h a. HashAlgorithm h => ByteString -> Maybe (Hash h a)
Crypto.hashFromBytes ByteString
bs

instance SerialiseAsBech32 (Hash StakePoolKey) where
    bech32PrefixFor :: Hash StakePoolKey -> Text
bech32PrefixFor         Hash StakePoolKey
_ =  Text
"pool"
    bech32PrefixesPermitted :: AsType (Hash StakePoolKey) -> [Text]
bech32PrefixesPermitted AsType (Hash StakePoolKey)
_ = [Text
"pool"]

instance ToJSON (Hash StakePoolKey) where
    toJSON :: Hash StakePoolKey -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (Hash StakePoolKey -> Text) -> Hash StakePoolKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash StakePoolKey -> Text
forall a. a -> Text
serialiseToBech32

instance ToJSONKey (Hash StakePoolKey) where
  toJSONKey :: ToJSONKeyFunction (Hash StakePoolKey)
toJSONKey = (Hash StakePoolKey -> Text)
-> ToJSONKeyFunction (Hash StakePoolKey)
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText Hash StakePoolKey -> Text
forall a. a -> Text
serialiseToBech32

instance FromJSON (Hash StakePoolKey) where
  parseJSON :: Value -> Parser (Hash StakePoolKey)
parseJSON = String
-> (Text -> Parser (Hash StakePoolKey))
-> Value
-> Parser (Hash StakePoolKey)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"PoolId" ((Text -> Parser (Hash StakePoolKey))
 -> Value -> Parser (Hash StakePoolKey))
-> (Text -> Parser (Hash StakePoolKey))
-> Value
-> Parser (Hash StakePoolKey)
forall a b. (a -> b) -> a -> b
$ \Text
str ->
    case AsType (Hash StakePoolKey)
-> Text -> Either Bech32DecodeError (Hash StakePoolKey)
forall a. AsType a -> Text -> Either Bech32DecodeError a
deserialiseFromBech32 (AsType StakePoolKey -> AsType (Hash StakePoolKey)
forall a. AsType a -> AsType (Hash a)
AsHash AsType StakePoolKey
AsStakePoolKey) Text
str of
      Left Bech32DecodeError
err ->
        String -> Parser (Hash StakePoolKey)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Hash StakePoolKey))
-> String -> Parser (Hash StakePoolKey)
forall a b. (a -> b) -> a -> b
$ String
"Error deserialising Hash StakePoolKey: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
str String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
               String
" Error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Bech32DecodeError -> String
forall e. Error e => e -> String
displayError Bech32DecodeError
err
      Right Hash StakePoolKey
h -> Hash StakePoolKey -> Parser (Hash StakePoolKey)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Hash StakePoolKey
h

instance HasTextEnvelope (VerificationKey StakePoolKey) where
    textEnvelopeType :: AsType (VerificationKey StakePoolKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey StakePoolKey)
_ = TextEnvelopeType
"StakePoolVerificationKey_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy

instance HasTextEnvelope (SigningKey StakePoolKey) where
    textEnvelopeType :: AsType (SigningKey StakePoolKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey StakePoolKey)
_ = TextEnvelopeType
"StakePoolSigningKey_"
                      TextEnvelopeType -> TextEnvelopeType -> TextEnvelopeType
forall a. Semigroup a => a -> a -> a
<> String -> TextEnvelopeType
forall a. IsString a => String -> a
fromString (Proxy Ed25519DSIGN -> String
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> String
forall (proxy :: * -> *). proxy Ed25519DSIGN -> String
Crypto.algorithmNameDSIGN Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
proxy)
      where
        proxy :: Proxy (Shelley.DSIGN StandardCrypto)
        proxy :: Proxy (DSIGN StandardCrypto)
proxy = Proxy Ed25519DSIGN
Proxy (DSIGN StandardCrypto)
forall {k} (t :: k). Proxy t
Proxy