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

-- | Byron key types and their 'Key' class instances
--
module Cardano.Api.Keys.Byron (

    -- * Key types
    ByronKey,
    ByronKeyLegacy,

    -- * Data family instances
    AsType(..),
    VerificationKey(..),
    SigningKey(..),
    Hash(..),

    -- * Legacy format
    IsByronKey(..),
    ByronKeyFormat(..),

    SomeByronSigningKey(..),
    toByronSigningKey
  ) where

import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Read as CBOR
import           Control.Monad
import           Data.Bifunctor
import qualified Data.ByteString.Lazy as LB
import           Data.Coders (cborError)
import           Data.Either.Combinators
import           Data.String (IsString)
import           Data.Text (Text)
import qualified Data.Text as Text
import           Formatting (build, formatToString)

import qualified Cardano.Crypto.DSIGN.Class as Crypto
import qualified Cardano.Crypto.Seed as Crypto
import qualified Cardano.Crypto.Signing as Crypto
import qualified Cardano.Crypto.Wallet as Crypto.HD

import           Cardano.Binary (toStrictByteString)
import qualified Cardano.Chain.Common as Byron
import qualified Cardano.Crypto.Hashing as Byron
import qualified Cardano.Crypto.Signing as Byron
import qualified Cardano.Crypto.Wallet as Wallet

import           Cardano.Api.Hash
import           Cardano.Api.HasTypeProxy
import           Cardano.Api.Keys.Class
import           Cardano.Api.Keys.Shelley
import           Cardano.Api.SerialiseCBOR
import           Cardano.Api.SerialiseRaw
import           Cardano.Api.SerialiseTextEnvelope
import           Cardano.Api.SerialiseUsing


-- | Byron-era payment keys. Used for Byron addresses and witnessing
-- transactions that spend from these addresses.
--
-- These use Ed25519 but with a 32byte \"chaincode\" used in HD derivation.
-- The inclusion of the chaincode is a design mistake but one that cannot
-- be corrected for the Byron era. The Shelley era 'PaymentKey's do not include
-- a chaincode. It is safe to use a zero or random chaincode for new Byron keys.
--
-- This is a type level tag, used with other interfaces like 'Key'.
--
data ByronKey
data ByronKeyLegacy

class IsByronKey key where
    byronKeyFormat :: ByronKeyFormat key

data ByronKeyFormat key where
  ByronLegacyKeyFormat :: ByronKeyFormat ByronKeyLegacy
  ByronModernKeyFormat :: ByronKeyFormat ByronKey

data SomeByronSigningKey
  = AByronSigningKeyLegacy (SigningKey ByronKeyLegacy)
  | AByronSigningKey (SigningKey ByronKey)

toByronSigningKey :: SomeByronSigningKey -> Byron.SigningKey
toByronSigningKey :: SomeByronSigningKey -> SigningKey
toByronSigningKey SomeByronSigningKey
bWit =
  case SomeByronSigningKey
bWit of
    AByronSigningKeyLegacy (ByronSigningKeyLegacy SigningKey
sKey) -> SigningKey
sKey
    AByronSigningKey (ByronSigningKey SigningKey
sKey) -> SigningKey
sKey

--
-- Byron key
--

instance Key ByronKey where

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

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

    deterministicSigningKey :: AsType ByronKey -> Crypto.Seed -> SigningKey ByronKey
    deterministicSigningKey :: AsType ByronKey -> Seed -> SigningKey ByronKey
deterministicSigningKey AsType ByronKey
R:AsTypeByronKey
AsByronKey Seed
seed =
       SigningKey -> SigningKey ByronKey
ByronSigningKey (forall a b. (a, b) -> b
snd (forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
Crypto.runMonadRandomWithSeed Seed
seed forall (m :: * -> *).
MonadRandom m =>
m (VerificationKey, SigningKey)
Byron.keyGen))

    deterministicSigningKeySeedSize :: AsType ByronKey -> Word
    deterministicSigningKeySeedSize :: AsType ByronKey -> Word
deterministicSigningKeySeedSize AsType ByronKey
R:AsTypeByronKey
AsByronKey = Word
32

    getVerificationKey :: SigningKey ByronKey -> VerificationKey ByronKey
    getVerificationKey :: SigningKey ByronKey -> VerificationKey ByronKey
getVerificationKey (ByronSigningKey SigningKey
sk) =
      VerificationKey -> VerificationKey ByronKey
ByronVerificationKey (SigningKey -> VerificationKey
Byron.toVerification SigningKey
sk)

    verificationKeyHash :: VerificationKey ByronKey -> Hash ByronKey
    verificationKeyHash :: VerificationKey ByronKey -> Hash ByronKey
verificationKeyHash (ByronVerificationKey VerificationKey
vkey) =
      KeyHash -> Hash ByronKey
ByronKeyHash (VerificationKey -> KeyHash
Byron.hashKey VerificationKey
vkey)

instance HasTypeProxy ByronKey where
    data AsType ByronKey = AsByronKey
    proxyToAsType :: Proxy ByronKey -> AsType ByronKey
proxyToAsType Proxy ByronKey
_ = AsType ByronKey
AsByronKey

instance HasTextEnvelope (VerificationKey ByronKey) where
    textEnvelopeType :: AsType (VerificationKey ByronKey) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey ByronKey)
_ = TextEnvelopeType
"PaymentVerificationKeyByron_ed25519_bip32"

instance HasTextEnvelope (SigningKey ByronKey) where
    textEnvelopeType :: AsType (SigningKey ByronKey) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey ByronKey)
_ = TextEnvelopeType
"PaymentSigningKeyByron_ed25519_bip32"

instance SerialiseAsRawBytes (VerificationKey ByronKey) where
    serialiseToRawBytes :: VerificationKey ByronKey -> ByteString
serialiseToRawBytes (ByronVerificationKey (Byron.VerificationKey XPub
xvk)) =
      XPub -> ByteString
Crypto.HD.unXPub XPub
xvk

    deserialiseFromRawBytes :: AsType (VerificationKey ByronKey)
-> ByteString
-> Either SerialiseAsRawBytesError (VerificationKey ByronKey)
deserialiseFromRawBytes (AsVerificationKey AsType ByronKey
R:AsTypeByronKey
AsByronKey) ByteString
bs =
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\String
msg -> String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String
"Unable to deserialise VerificationKey ByronKey" forall a. [a] -> [a] -> [a]
++ String
msg)) forall a b. (a -> b) -> a -> b
$
        VerificationKey -> VerificationKey ByronKey
ByronVerificationKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey
Byron.VerificationKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String XPub
Crypto.HD.xpub ByteString
bs

instance SerialiseAsRawBytes (SigningKey ByronKey) where
    serialiseToRawBytes :: SigningKey ByronKey -> ByteString
serialiseToRawBytes (ByronSigningKey (Byron.SigningKey XPrv
xsk)) =
      Encoding -> ByteString
toStrictByteString forall a b. (a -> b) -> a -> b
$ XPrv -> Encoding
Crypto.toCBORXPrv XPrv
xsk

    deserialiseFromRawBytes :: AsType (SigningKey ByronKey)
-> ByteString
-> Either SerialiseAsRawBytesError (SigningKey ByronKey)
deserialiseFromRawBytes (AsSigningKey AsType ByronKey
R:AsTypeByronKey
AsByronKey) ByteString
bs =
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\DeserialiseFailure
e -> String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String
"Unable to deserialise SigningKey ByronKey" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DeserialiseFailure
e)) forall a b. (a -> b) -> a -> b
$
        SigningKey -> SigningKey ByronKey
ByronSigningKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey
Byron.SigningKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes forall s. Decoder s XPrv
Byron.fromCBORXPrv (ByteString -> ByteString
LB.fromStrict ByteString
bs)

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

instance SerialiseAsRawBytes (Hash ByronKey) where
    serialiseToRawBytes :: Hash ByronKey -> ByteString
serialiseToRawBytes (ByronKeyHash (Byron.KeyHash AddressHash VerificationKey
vkh)) =
      forall algo a. AbstractHash algo a -> ByteString
Byron.abstractHashToBytes AddressHash VerificationKey
vkh

    deserialiseFromRawBytes :: AsType (Hash ByronKey)
-> ByteString -> Either SerialiseAsRawBytesError (Hash ByronKey)
deserialiseFromRawBytes (AsHash AsType ByronKey
R:AsTypeByronKey
AsByronKey) ByteString
bs =
      forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError String
"Unable to deserialise Hash ByronKey") forall a b. (a -> b) -> a -> b
$
        KeyHash -> Hash ByronKey
ByronKeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressHash VerificationKey -> KeyHash
Byron.KeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall algo a.
HashAlgorithm algo =>
ByteString -> Maybe (AbstractHash algo a)
Byron.abstractHashFromBytes ByteString
bs

instance CastVerificationKeyRole ByronKey PaymentExtendedKey where
    castVerificationKey :: VerificationKey ByronKey -> VerificationKey PaymentExtendedKey
castVerificationKey (ByronVerificationKey VerificationKey
vk) =
        XPub -> VerificationKey PaymentExtendedKey
PaymentExtendedVerificationKey
          (VerificationKey -> XPub
Byron.unVerificationKey VerificationKey
vk)

instance CastVerificationKeyRole ByronKey PaymentKey where
    castVerificationKey :: VerificationKey ByronKey -> VerificationKey PaymentKey
castVerificationKey =
        (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey :: VerificationKey PaymentExtendedKey
                             -> VerificationKey PaymentKey)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey :: VerificationKey ByronKey
                             -> VerificationKey PaymentExtendedKey)

instance IsByronKey ByronKey where
  byronKeyFormat :: ByronKeyFormat ByronKey
byronKeyFormat = ByronKeyFormat ByronKey
ByronModernKeyFormat

--
-- Legacy Byron key
--

instance Key ByronKeyLegacy where

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

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

    deterministicSigningKey :: AsType ByronKeyLegacy -> Crypto.Seed -> SigningKey ByronKeyLegacy
    deterministicSigningKey :: AsType ByronKeyLegacy -> Seed -> SigningKey ByronKeyLegacy
deterministicSigningKey AsType ByronKeyLegacy
_ Seed
_ = forall a. HasCallStack => String -> a
error String
"Please generate a non legacy Byron key instead"

    deterministicSigningKeySeedSize :: AsType ByronKeyLegacy -> Word
    deterministicSigningKeySeedSize :: AsType ByronKeyLegacy -> Word
deterministicSigningKeySeedSize AsType ByronKeyLegacy
R:AsTypeByronKeyLegacy
AsByronKeyLegacy = Word
32

    getVerificationKey :: SigningKey ByronKeyLegacy -> VerificationKey ByronKeyLegacy
    getVerificationKey :: SigningKey ByronKeyLegacy -> VerificationKey ByronKeyLegacy
getVerificationKey (ByronSigningKeyLegacy SigningKey
sk) =
      VerificationKey -> VerificationKey ByronKeyLegacy
ByronVerificationKeyLegacy (SigningKey -> VerificationKey
Byron.toVerification SigningKey
sk)

    verificationKeyHash :: VerificationKey ByronKeyLegacy -> Hash ByronKeyLegacy
    verificationKeyHash :: VerificationKey ByronKeyLegacy -> Hash ByronKeyLegacy
verificationKeyHash (ByronVerificationKeyLegacy VerificationKey
vkey) =
      KeyHash -> Hash ByronKeyLegacy
ByronKeyHashLegacy (VerificationKey -> KeyHash
Byron.hashKey VerificationKey
vkey)

instance HasTypeProxy ByronKeyLegacy where
  data AsType ByronKeyLegacy = AsByronKeyLegacy
  proxyToAsType :: Proxy ByronKeyLegacy -> AsType ByronKeyLegacy
proxyToAsType Proxy ByronKeyLegacy
_ = AsType ByronKeyLegacy
AsByronKeyLegacy

instance HasTextEnvelope (VerificationKey ByronKeyLegacy) where
    textEnvelopeType :: AsType (VerificationKey ByronKeyLegacy) -> TextEnvelopeType
textEnvelopeType AsType (VerificationKey ByronKeyLegacy)
_ = TextEnvelopeType
"PaymentVerificationKeyByronLegacy_ed25519_bip32"

instance HasTextEnvelope (SigningKey ByronKeyLegacy) where
    textEnvelopeType :: AsType (SigningKey ByronKeyLegacy) -> TextEnvelopeType
textEnvelopeType AsType (SigningKey ByronKeyLegacy)
_ = TextEnvelopeType
"PaymentSigningKeyByronLegacy_ed25519_bip32"

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

instance SerialiseAsRawBytes (Hash ByronKeyLegacy) where
    serialiseToRawBytes :: Hash ByronKeyLegacy -> ByteString
serialiseToRawBytes (ByronKeyHashLegacy (Byron.KeyHash AddressHash VerificationKey
vkh)) =
      forall algo a. AbstractHash algo a -> ByteString
Byron.abstractHashToBytes AddressHash VerificationKey
vkh

    deserialiseFromRawBytes :: AsType (Hash ByronKeyLegacy)
-> ByteString
-> Either SerialiseAsRawBytesError (Hash ByronKeyLegacy)
deserialiseFromRawBytes (AsHash AsType ByronKeyLegacy
R:AsTypeByronKeyLegacy
AsByronKeyLegacy) ByteString
bs =
      forall b a. b -> Maybe a -> Either b a
maybeToRight (String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError String
"Unable to deserialise Hash ByronKeyLegacy") forall a b. (a -> b) -> a -> b
$
        KeyHash -> Hash ByronKeyLegacy
ByronKeyHashLegacy forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressHash VerificationKey -> KeyHash
Byron.KeyHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall algo a.
HashAlgorithm algo =>
ByteString -> Maybe (AbstractHash algo a)
Byron.abstractHashFromBytes ByteString
bs

instance SerialiseAsRawBytes (VerificationKey ByronKeyLegacy) where
    serialiseToRawBytes :: VerificationKey ByronKeyLegacy -> ByteString
serialiseToRawBytes (ByronVerificationKeyLegacy (Byron.VerificationKey XPub
xvk)) =
      XPub -> ByteString
Crypto.HD.unXPub XPub
xvk

    deserialiseFromRawBytes :: AsType (VerificationKey ByronKeyLegacy)
-> ByteString
-> Either SerialiseAsRawBytesError (VerificationKey ByronKeyLegacy)
deserialiseFromRawBytes (AsVerificationKey AsType ByronKeyLegacy
R:AsTypeByronKeyLegacy
AsByronKeyLegacy) ByteString
bs =
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\String
msg -> String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String
"Unable to deserialise VerificationKey ByronKeyLegacy" forall a. [a] -> [a] -> [a]
++ String
msg)) forall a b. (a -> b) -> a -> b
$
        VerificationKey -> VerificationKey ByronKeyLegacy
ByronVerificationKeyLegacy forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey
Byron.VerificationKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String XPub
Crypto.HD.xpub ByteString
bs

instance SerialiseAsRawBytes (SigningKey ByronKeyLegacy) where
    serialiseToRawBytes :: SigningKey ByronKeyLegacy -> ByteString
serialiseToRawBytes (ByronSigningKeyLegacy (Byron.SigningKey XPrv
xsk)) =
      XPrv -> ByteString
Crypto.HD.unXPrv XPrv
xsk

    deserialiseFromRawBytes :: AsType (SigningKey ByronKeyLegacy)
-> ByteString
-> Either SerialiseAsRawBytesError (SigningKey ByronKeyLegacy)
deserialiseFromRawBytes (AsSigningKey AsType ByronKeyLegacy
R:AsTypeByronKeyLegacy
AsByronKeyLegacy) ByteString
bs =
      forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\DeserialiseFailure
e -> String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String
"Unable to deserialise SigningKey ByronKeyLegacy" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DeserialiseFailure
e)) forall a b. (a -> b) -> a -> b
$
        SigningKey -> SigningKey ByronKeyLegacy
ByronSigningKeyLegacy forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes forall s. Decoder s SigningKey
decodeLegacyDelegateKey (ByteString -> ByteString
LB.fromStrict ByteString
bs)
     where
      -- Stolen from: cardano-sl/binary/src/Pos/Binary/Class/Core.hs
      -- | Enforces that the input size is the same as the decoded one, failing in
      -- case it's not.
      enforceSize :: Text -> Int -> CBOR.Decoder s ()
      enforceSize :: forall s. Text -> Int -> Decoder s ()
enforceSize Text
lbl Int
requestedSize = forall s. Decoder s Int
CBOR.decodeListLenCanonical forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s. Int -> Text -> Int -> Decoder s ()
matchSize Int
requestedSize Text
lbl

      -- Stolen from: cardano-sl/binary/src/Pos/Binary/Class/Core.hs
      -- | Compare two sizes, failing if they are not equal.
      matchSize :: Int -> Text -> Int -> CBOR.Decoder s ()
      matchSize :: forall s. Int -> Text -> Int -> Decoder s ()
matchSize Int
requestedSize Text
lbl Int
actualSize =
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
actualSize forall a. Eq a => a -> a -> Bool
/= Int
requestedSize) forall a b. (a -> b) -> a -> b
$
          forall e s a. Buildable e => e -> Decoder s a
cborError ( Text
lbl forall a. Semigroup a => a -> a -> a
<> Text
" failed the size check. Expected " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Int
requestedSize)
                          forall a. Semigroup a => a -> a -> a
<> Text
", found " forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (forall a. Show a => a -> String
show Int
actualSize)
                    )

      decodeXPrv :: CBOR.Decoder s Wallet.XPrv
      decodeXPrv :: forall s. Decoder s XPrv
decodeXPrv = forall s. Decoder s ByteString
CBOR.decodeBytesCanonical forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Format String a -> a
formatToString forall a r. Buildable a => Format r (a -> r)
build) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall bin. ByteArrayAccess bin => bin -> Either String XPrv
Wallet.xprv

      -- | Decoder for a Byron/Classic signing key.
      --   Lifted from cardano-sl legacy codebase.
      decodeLegacyDelegateKey :: CBOR.Decoder s Byron.SigningKey
      decodeLegacyDelegateKey :: forall s. Decoder s SigningKey
decodeLegacyDelegateKey = do
          forall s. Text -> Int -> Decoder s ()
enforceSize Text
"UserSecret" Int
4
          ByteString
_    <- do
            forall s. Text -> Int -> Decoder s ()
enforceSize Text
"vss" Int
1
            forall s. Decoder s ByteString
CBOR.decodeBytes
          SigningKey
pkey <- do
            forall s. Text -> Int -> Decoder s ()
enforceSize Text
"pkey" Int
1
            XPrv -> SigningKey
Byron.SigningKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. Decoder s XPrv
decodeXPrv
          [()]
_    <- do
            forall s. Decoder s ()
CBOR.decodeListLenIndef
            forall r a r' s.
(r -> a -> r) -> r -> (r -> r') -> Decoder s a -> Decoder s r'
CBOR.decodeSequenceLenIndef (forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] forall a. [a] -> [a]
reverse forall s. Decoder s ()
CBOR.decodeNull
          ()
_    <- do
            forall s. Text -> Int -> Decoder s ()
enforceSize Text
"wallet" Int
0
          forall (f :: * -> *) a. Applicative f => a -> f a
pure SigningKey
pkey

instance CastVerificationKeyRole ByronKeyLegacy ByronKey where
    castVerificationKey :: VerificationKey ByronKeyLegacy -> VerificationKey ByronKey
castVerificationKey (ByronVerificationKeyLegacy VerificationKey
vk) =
        VerificationKey -> VerificationKey ByronKey
ByronVerificationKey VerificationKey
vk

instance IsByronKey ByronKeyLegacy where
  byronKeyFormat :: ByronKeyFormat ByronKeyLegacy
byronKeyFormat = ByronKeyFormat ByronKeyLegacy
ByronLegacyKeyFormat