{-# 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.KeysByron (

    -- * Key types
    ByronKey,
    ByronKeyLegacy,

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

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

    SomeByronSigningKey(..),
    toByronSigningKey
  ) where

import           Cardano.Prelude (cborError, toCborError)
import           Prelude

import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Read as CBOR
import           Control.Monad
import qualified Data.ByteString.Lazy as LB
import           Data.String (IsString)
import           Data.Text (Text)
import qualified Data.Text as Text

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.HasTypeProxy
import           Cardano.Api.Hash
import           Cardano.Api.Key
import           Cardano.Api.KeysShelley
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 sKey) -> SigningKey
sKey
    AByronSigningKey (ByronSigningKey sKey) -> SigningKey
sKey

--
-- Byron key
--

instance Key ByronKey where

    newtype VerificationKey ByronKey =
           ByronVerificationKey Byron.VerificationKey
      deriving stock VerificationKey ByronKey -> VerificationKey ByronKey -> Bool
(VerificationKey ByronKey -> VerificationKey ByronKey -> Bool)
-> (VerificationKey ByronKey -> VerificationKey ByronKey -> Bool)
-> Eq (VerificationKey ByronKey)
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
(Int -> VerificationKey ByronKey -> ShowS)
-> (VerificationKey ByronKey -> String)
-> ([VerificationKey ByronKey] -> ShowS)
-> Show (VerificationKey ByronKey)
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
(String -> VerificationKey ByronKey)
-> IsString (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)
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)
-> ToCBOR (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
$cp1ToCBOR :: Typeable (VerificationKey ByronKey)
ToCBOR, Typeable (VerificationKey ByronKey)
Decoder s (VerificationKey ByronKey)
Typeable (VerificationKey ByronKey)
-> (forall s. Decoder s (VerificationKey ByronKey))
-> (Proxy (VerificationKey ByronKey) -> Text)
-> FromCBOR (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 :: Decoder s (VerificationKey ByronKey)
$cfromCBOR :: forall s. Decoder s (VerificationKey ByronKey)
$cp1FromCBOR :: Typeable (VerificationKey ByronKey)
FromCBOR)
      deriving anyclass HasTypeProxy (VerificationKey ByronKey)
HasTypeProxy (VerificationKey ByronKey)
-> (VerificationKey ByronKey -> ByteString)
-> (AsType (VerificationKey ByronKey)
    -> ByteString -> Either DecoderError (VerificationKey ByronKey))
-> SerialiseAsCBOR (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
$cp1SerialiseAsCBOR :: HasTypeProxy (VerificationKey ByronKey)
SerialiseAsCBOR

    newtype SigningKey ByronKey =
           ByronSigningKey Byron.SigningKey
      deriving (Int -> SigningKey ByronKey -> ShowS
[SigningKey ByronKey] -> ShowS
SigningKey ByronKey -> String
(Int -> SigningKey ByronKey -> ShowS)
-> (SigningKey ByronKey -> String)
-> ([SigningKey ByronKey] -> ShowS)
-> Show (SigningKey ByronKey)
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
(String -> SigningKey ByronKey) -> IsString (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)
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)
-> ToCBOR (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
$cp1ToCBOR :: Typeable (SigningKey ByronKey)
ToCBOR, Typeable (SigningKey ByronKey)
Decoder s (SigningKey ByronKey)
Typeable (SigningKey ByronKey)
-> (forall s. Decoder s (SigningKey ByronKey))
-> (Proxy (SigningKey ByronKey) -> Text)
-> FromCBOR (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 :: Decoder s (SigningKey ByronKey)
$cfromCBOR :: forall s. Decoder s (SigningKey ByronKey)
$cp1FromCBOR :: Typeable (SigningKey ByronKey)
FromCBOR)
      deriving anyclass HasTypeProxy (SigningKey ByronKey)
HasTypeProxy (SigningKey ByronKey)
-> (SigningKey ByronKey -> ByteString)
-> (AsType (SigningKey ByronKey)
    -> ByteString -> Either DecoderError (SigningKey ByronKey))
-> SerialiseAsCBOR (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
$cp1SerialiseAsCBOR :: HasTypeProxy (SigningKey ByronKey)
SerialiseAsCBOR

    deterministicSigningKey :: AsType ByronKey -> Crypto.Seed -> SigningKey ByronKey
    deterministicSigningKey :: AsType ByronKey -> Seed -> SigningKey ByronKey
deterministicSigningKey AsType ByronKey
AsByronKey Seed
seed =
       SigningKey -> SigningKey ByronKey
ByronSigningKey ((VerificationKey, SigningKey) -> SigningKey
forall a b. (a, b) -> b
snd (Seed
-> (forall (m :: * -> *).
    MonadRandom m =>
    m (VerificationKey, SigningKey))
-> (VerificationKey, SigningKey)
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
AsByronKey = Word
32

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

    verificationKeyHash :: VerificationKey ByronKey -> Hash ByronKey
    verificationKeyHash :: VerificationKey ByronKey -> Hash ByronKey
verificationKeyHash (ByronVerificationKey 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 xvk)) =
      XPub -> ByteString
Crypto.HD.unXPub XPub
xvk

    deserialiseFromRawBytes :: AsType (VerificationKey ByronKey)
-> ByteString -> Maybe (VerificationKey ByronKey)
deserialiseFromRawBytes (AsVerificationKey AsByronKey) ByteString
bs =
      (String -> Maybe (VerificationKey ByronKey))
-> (XPub -> Maybe (VerificationKey ByronKey))
-> Either String XPub
-> Maybe (VerificationKey ByronKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (VerificationKey ByronKey)
-> String -> Maybe (VerificationKey ByronKey)
forall a b. a -> b -> a
const Maybe (VerificationKey ByronKey)
forall a. Maybe a
Nothing) (VerificationKey ByronKey -> Maybe (VerificationKey ByronKey)
forall a. a -> Maybe a
Just (VerificationKey ByronKey -> Maybe (VerificationKey ByronKey))
-> (XPub -> VerificationKey ByronKey)
-> XPub
-> Maybe (VerificationKey ByronKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey -> VerificationKey ByronKey
ByronVerificationKey (VerificationKey -> VerificationKey ByronKey)
-> (XPub -> VerificationKey) -> XPub -> VerificationKey ByronKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey
Byron.VerificationKey)
             (ByteString -> Either String XPub
Crypto.HD.xpub ByteString
bs)

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

    deserialiseFromRawBytes :: AsType (SigningKey ByronKey)
-> ByteString -> Maybe (SigningKey ByronKey)
deserialiseFromRawBytes (AsSigningKey AsByronKey) ByteString
bs =
      (DeserialiseFailure -> Maybe (SigningKey ByronKey))
-> (XPrv -> Maybe (SigningKey ByronKey))
-> Either DeserialiseFailure XPrv
-> Maybe (SigningKey ByronKey)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (SigningKey ByronKey)
-> DeserialiseFailure -> Maybe (SigningKey ByronKey)
forall a b. a -> b -> a
const Maybe (SigningKey ByronKey)
forall a. Maybe a
Nothing) (SigningKey ByronKey -> Maybe (SigningKey ByronKey)
forall a. a -> Maybe a
Just (SigningKey ByronKey -> Maybe (SigningKey ByronKey))
-> (XPrv -> SigningKey ByronKey)
-> XPrv
-> Maybe (SigningKey ByronKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey -> SigningKey ByronKey
ByronSigningKey (SigningKey -> SigningKey ByronKey)
-> (XPrv -> SigningKey) -> XPrv -> SigningKey ByronKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrv -> SigningKey
Byron.SigningKey)
             ((ByteString, XPrv) -> XPrv
forall a b. (a, b) -> b
snd ((ByteString, XPrv) -> XPrv)
-> Either DeserialiseFailure (ByteString, XPrv)
-> Either DeserialiseFailure XPrv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. Decoder s XPrv)
-> ByteString -> Either DeserialiseFailure (ByteString, XPrv)
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
(Hash ByronKey -> Hash ByronKey -> Bool)
-> (Hash ByronKey -> Hash ByronKey -> Bool) -> Eq (Hash ByronKey)
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)
Eq (Hash ByronKey)
-> (Hash ByronKey -> Hash ByronKey -> Ordering)
-> (Hash ByronKey -> Hash ByronKey -> Bool)
-> (Hash ByronKey -> Hash ByronKey -> Bool)
-> (Hash ByronKey -> Hash ByronKey -> Bool)
-> (Hash ByronKey -> Hash ByronKey -> Bool)
-> (Hash ByronKey -> Hash ByronKey -> Hash ByronKey)
-> (Hash ByronKey -> Hash ByronKey -> Hash ByronKey)
-> Ord (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
$cp1Ord :: Eq (Hash ByronKey)
Ord)
  deriving (Int -> Hash ByronKey -> ShowS
[Hash ByronKey] -> ShowS
Hash ByronKey -> String
(Int -> Hash ByronKey -> ShowS)
-> (Hash ByronKey -> String)
-> ([Hash ByronKey] -> ShowS)
-> Show (Hash ByronKey)
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
(String -> Hash ByronKey) -> IsString (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)
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)
-> ToCBOR (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
$cp1ToCBOR :: Typeable (Hash ByronKey)
ToCBOR, Typeable (Hash ByronKey)
Decoder s (Hash ByronKey)
Typeable (Hash ByronKey)
-> (forall s. Decoder s (Hash ByronKey))
-> (Proxy (Hash ByronKey) -> Text)
-> FromCBOR (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 :: Decoder s (Hash ByronKey)
$cfromCBOR :: forall s. Decoder s (Hash ByronKey)
$cp1FromCBOR :: Typeable (Hash ByronKey)
FromCBOR) via UsingRawBytes (Hash ByronKey)
  deriving anyclass HasTypeProxy (Hash ByronKey)
HasTypeProxy (Hash ByronKey)
-> (Hash ByronKey -> ByteString)
-> (AsType (Hash ByronKey)
    -> ByteString -> Either DecoderError (Hash ByronKey))
-> SerialiseAsCBOR (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
$cp1SerialiseAsCBOR :: HasTypeProxy (Hash ByronKey)
SerialiseAsCBOR

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

    deserialiseFromRawBytes :: AsType (Hash ByronKey) -> ByteString -> Maybe (Hash ByronKey)
deserialiseFromRawBytes (AsHash AsByronKey) ByteString
bs =
      KeyHash -> Hash ByronKey
ByronKeyHash (KeyHash -> Hash ByronKey)
-> (AbstractHash Blake2b_224 VerificationKey -> KeyHash)
-> AbstractHash Blake2b_224 VerificationKey
-> Hash ByronKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractHash Blake2b_224 VerificationKey -> KeyHash
Byron.KeyHash (AbstractHash Blake2b_224 VerificationKey -> Hash ByronKey)
-> Maybe (AbstractHash Blake2b_224 VerificationKey)
-> Maybe (Hash ByronKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (AbstractHash Blake2b_224 VerificationKey)
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 vk) =
        XPub -> VerificationKey PaymentExtendedKey
PaymentExtendedVerificationKey
          (VerificationKey -> XPub
Byron.unVerificationKey VerificationKey
vk)

instance CastVerificationKeyRole ByronKey PaymentKey where
    castVerificationKey :: VerificationKey ByronKey -> VerificationKey PaymentKey
castVerificationKey =
        (VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey :: VerificationKey PaymentExtendedKey
                             -> VerificationKey PaymentKey)
      (VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey)
-> (VerificationKey ByronKey -> VerificationKey PaymentExtendedKey)
-> VerificationKey ByronKey
-> VerificationKey PaymentKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerificationKey ByronKey -> VerificationKey PaymentExtendedKey
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
(VerificationKey ByronKeyLegacy
 -> VerificationKey ByronKeyLegacy -> Bool)
-> (VerificationKey ByronKeyLegacy
    -> VerificationKey ByronKeyLegacy -> Bool)
-> Eq (VerificationKey ByronKeyLegacy)
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
(Int -> VerificationKey ByronKeyLegacy -> ShowS)
-> (VerificationKey ByronKeyLegacy -> String)
-> ([VerificationKey ByronKeyLegacy] -> ShowS)
-> Show (VerificationKey ByronKeyLegacy)
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
(String -> VerificationKey ByronKeyLegacy)
-> IsString (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)
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)
-> ToCBOR (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
$cp1ToCBOR :: Typeable (VerificationKey ByronKeyLegacy)
ToCBOR, Typeable (VerificationKey ByronKeyLegacy)
Decoder s (VerificationKey ByronKeyLegacy)
Typeable (VerificationKey ByronKeyLegacy)
-> (forall s. Decoder s (VerificationKey ByronKeyLegacy))
-> (Proxy (VerificationKey ByronKeyLegacy) -> Text)
-> FromCBOR (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 :: Decoder s (VerificationKey ByronKeyLegacy)
$cfromCBOR :: forall s. Decoder s (VerificationKey ByronKeyLegacy)
$cp1FromCBOR :: Typeable (VerificationKey ByronKeyLegacy)
FromCBOR)
      deriving anyclass HasTypeProxy (VerificationKey ByronKeyLegacy)
HasTypeProxy (VerificationKey ByronKeyLegacy)
-> (VerificationKey ByronKeyLegacy -> ByteString)
-> (AsType (VerificationKey ByronKeyLegacy)
    -> ByteString
    -> Either DecoderError (VerificationKey ByronKeyLegacy))
-> SerialiseAsCBOR (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
$cp1SerialiseAsCBOR :: HasTypeProxy (VerificationKey ByronKeyLegacy)
SerialiseAsCBOR

    newtype SigningKey ByronKeyLegacy =
           ByronSigningKeyLegacy Byron.SigningKey
      deriving (Int -> SigningKey ByronKeyLegacy -> ShowS
[SigningKey ByronKeyLegacy] -> ShowS
SigningKey ByronKeyLegacy -> String
(Int -> SigningKey ByronKeyLegacy -> ShowS)
-> (SigningKey ByronKeyLegacy -> String)
-> ([SigningKey ByronKeyLegacy] -> ShowS)
-> Show (SigningKey ByronKeyLegacy)
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
(String -> SigningKey ByronKeyLegacy)
-> IsString (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)
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)
-> ToCBOR (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
$cp1ToCBOR :: Typeable (SigningKey ByronKeyLegacy)
ToCBOR, Typeable (SigningKey ByronKeyLegacy)
Decoder s (SigningKey ByronKeyLegacy)
Typeable (SigningKey ByronKeyLegacy)
-> (forall s. Decoder s (SigningKey ByronKeyLegacy))
-> (Proxy (SigningKey ByronKeyLegacy) -> Text)
-> FromCBOR (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 :: Decoder s (SigningKey ByronKeyLegacy)
$cfromCBOR :: forall s. Decoder s (SigningKey ByronKeyLegacy)
$cp1FromCBOR :: Typeable (SigningKey ByronKeyLegacy)
FromCBOR)
      deriving anyclass HasTypeProxy (SigningKey ByronKeyLegacy)
HasTypeProxy (SigningKey ByronKeyLegacy)
-> (SigningKey ByronKeyLegacy -> ByteString)
-> (AsType (SigningKey ByronKeyLegacy)
    -> ByteString -> Either DecoderError (SigningKey ByronKeyLegacy))
-> SerialiseAsCBOR (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
$cp1SerialiseAsCBOR :: HasTypeProxy (SigningKey ByronKeyLegacy)
SerialiseAsCBOR

    deterministicSigningKey :: AsType ByronKeyLegacy -> Crypto.Seed -> SigningKey ByronKeyLegacy
    deterministicSigningKey :: AsType ByronKeyLegacy -> Seed -> SigningKey ByronKeyLegacy
deterministicSigningKey AsType ByronKeyLegacy
_ Seed
_ = String -> SigningKey ByronKeyLegacy
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
AsByronKeyLegacy = Word
32

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

    verificationKeyHash :: VerificationKey ByronKeyLegacy -> Hash ByronKeyLegacy
    verificationKeyHash :: VerificationKey ByronKeyLegacy -> Hash ByronKeyLegacy
verificationKeyHash (ByronVerificationKeyLegacy 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
(Hash ByronKeyLegacy -> Hash ByronKeyLegacy -> Bool)
-> (Hash ByronKeyLegacy -> Hash ByronKeyLegacy -> Bool)
-> Eq (Hash ByronKeyLegacy)
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)
Eq (Hash ByronKeyLegacy)
-> (Hash ByronKeyLegacy -> Hash ByronKeyLegacy -> Ordering)
-> (Hash ByronKeyLegacy -> Hash ByronKeyLegacy -> Bool)
-> (Hash ByronKeyLegacy -> Hash ByronKeyLegacy -> Bool)
-> (Hash ByronKeyLegacy -> Hash ByronKeyLegacy -> Bool)
-> (Hash ByronKeyLegacy -> Hash ByronKeyLegacy -> Bool)
-> (Hash ByronKeyLegacy
    -> Hash ByronKeyLegacy -> Hash ByronKeyLegacy)
-> (Hash ByronKeyLegacy
    -> Hash ByronKeyLegacy -> Hash ByronKeyLegacy)
-> Ord (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
$cp1Ord :: Eq (Hash ByronKeyLegacy)
Ord)
  deriving (Int -> Hash ByronKeyLegacy -> ShowS
[Hash ByronKeyLegacy] -> ShowS
Hash ByronKeyLegacy -> String
(Int -> Hash ByronKeyLegacy -> ShowS)
-> (Hash ByronKeyLegacy -> String)
-> ([Hash ByronKeyLegacy] -> ShowS)
-> Show (Hash ByronKeyLegacy)
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
(String -> Hash ByronKeyLegacy) -> IsString (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)
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)
-> ToCBOR (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
$cp1ToCBOR :: Typeable (Hash ByronKeyLegacy)
ToCBOR, Typeable (Hash ByronKeyLegacy)
Decoder s (Hash ByronKeyLegacy)
Typeable (Hash ByronKeyLegacy)
-> (forall s. Decoder s (Hash ByronKeyLegacy))
-> (Proxy (Hash ByronKeyLegacy) -> Text)
-> FromCBOR (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 :: Decoder s (Hash ByronKeyLegacy)
$cfromCBOR :: forall s. Decoder s (Hash ByronKeyLegacy)
$cp1FromCBOR :: Typeable (Hash ByronKeyLegacy)
FromCBOR) via UsingRawBytes (Hash ByronKeyLegacy)
  deriving anyclass HasTypeProxy (Hash ByronKeyLegacy)
HasTypeProxy (Hash ByronKeyLegacy)
-> (Hash ByronKeyLegacy -> ByteString)
-> (AsType (Hash ByronKeyLegacy)
    -> ByteString -> Either DecoderError (Hash ByronKeyLegacy))
-> SerialiseAsCBOR (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
$cp1SerialiseAsCBOR :: HasTypeProxy (Hash ByronKeyLegacy)
SerialiseAsCBOR

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

    deserialiseFromRawBytes :: AsType (Hash ByronKeyLegacy)
-> ByteString -> Maybe (Hash ByronKeyLegacy)
deserialiseFromRawBytes (AsHash AsByronKeyLegacy) ByteString
bs =
      KeyHash -> Hash ByronKeyLegacy
ByronKeyHashLegacy (KeyHash -> Hash ByronKeyLegacy)
-> (AbstractHash Blake2b_224 VerificationKey -> KeyHash)
-> AbstractHash Blake2b_224 VerificationKey
-> Hash ByronKeyLegacy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstractHash Blake2b_224 VerificationKey -> KeyHash
Byron.KeyHash (AbstractHash Blake2b_224 VerificationKey -> Hash ByronKeyLegacy)
-> Maybe (AbstractHash Blake2b_224 VerificationKey)
-> Maybe (Hash ByronKeyLegacy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (AbstractHash Blake2b_224 VerificationKey)
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 xvk)) =
      XPub -> ByteString
Crypto.HD.unXPub XPub
xvk

    deserialiseFromRawBytes :: AsType (VerificationKey ByronKeyLegacy)
-> ByteString -> Maybe (VerificationKey ByronKeyLegacy)
deserialiseFromRawBytes (AsVerificationKey AsByronKeyLegacy) ByteString
bs =
      (String -> Maybe (VerificationKey ByronKeyLegacy))
-> (XPub -> Maybe (VerificationKey ByronKeyLegacy))
-> Either String XPub
-> Maybe (VerificationKey ByronKeyLegacy)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (VerificationKey ByronKeyLegacy)
-> String -> Maybe (VerificationKey ByronKeyLegacy)
forall a b. a -> b -> a
const Maybe (VerificationKey ByronKeyLegacy)
forall a. Maybe a
Nothing) (VerificationKey ByronKeyLegacy
-> Maybe (VerificationKey ByronKeyLegacy)
forall a. a -> Maybe a
Just (VerificationKey ByronKeyLegacy
 -> Maybe (VerificationKey ByronKeyLegacy))
-> (XPub -> VerificationKey ByronKeyLegacy)
-> XPub
-> Maybe (VerificationKey ByronKeyLegacy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey -> VerificationKey ByronKeyLegacy
ByronVerificationKeyLegacy (VerificationKey -> VerificationKey ByronKeyLegacy)
-> (XPub -> VerificationKey)
-> XPub
-> VerificationKey ByronKeyLegacy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey
Byron.VerificationKey)
             (ByteString -> Either String XPub
Crypto.HD.xpub ByteString
bs)

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

    deserialiseFromRawBytes :: AsType (SigningKey ByronKeyLegacy)
-> ByteString -> Maybe (SigningKey ByronKeyLegacy)
deserialiseFromRawBytes (AsSigningKey AsByronKeyLegacy) ByteString
bs =
      (DeserialiseFailure -> Maybe (SigningKey ByronKeyLegacy))
-> ((ByteString, SigningKey) -> Maybe (SigningKey ByronKeyLegacy))
-> Either DeserialiseFailure (ByteString, SigningKey)
-> Maybe (SigningKey ByronKeyLegacy)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (SigningKey ByronKeyLegacy)
-> DeserialiseFailure -> Maybe (SigningKey ByronKeyLegacy)
forall a b. a -> b -> a
const Maybe (SigningKey ByronKeyLegacy)
forall a. Maybe a
Nothing) (SigningKey ByronKeyLegacy -> Maybe (SigningKey ByronKeyLegacy)
forall a. a -> Maybe a
Just (SigningKey ByronKeyLegacy -> Maybe (SigningKey ByronKeyLegacy))
-> ((ByteString, SigningKey) -> SigningKey ByronKeyLegacy)
-> (ByteString, SigningKey)
-> Maybe (SigningKey ByronKeyLegacy)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey -> SigningKey ByronKeyLegacy
ByronSigningKeyLegacy (SigningKey -> SigningKey ByronKeyLegacy)
-> ((ByteString, SigningKey) -> SigningKey)
-> (ByteString, SigningKey)
-> SigningKey ByronKeyLegacy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, SigningKey) -> SigningKey
forall a b. (a, b) -> b
snd)
             ((forall s. Decoder s SigningKey)
-> ByteString -> Either DeserialiseFailure (ByteString, SigningKey)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes forall s. Decoder s SigningKey
decodeLegacyDelegateKey (ByteString -> Either DeserialiseFailure (ByteString, SigningKey))
-> ByteString -> Either DeserialiseFailure (ByteString, SigningKey)
forall a b. (a -> b) -> a -> b
$ 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 :: Text -> Int -> Decoder s ()
enforceSize Text
lbl Int
requestedSize = Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLenCanonical Decoder s Int -> (Int -> Decoder s ()) -> Decoder s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Text -> Int -> Decoder s ()
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 :: Int -> Text -> Int -> Decoder s ()
matchSize Int
requestedSize Text
lbl Int
actualSize =
        Bool -> Decoder s () -> Decoder s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
actualSize Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
requestedSize) (Decoder s () -> Decoder s ()) -> Decoder s () -> Decoder s ()
forall a b. (a -> b) -> a -> b
$
          Text -> Decoder s ()
forall e s a. Buildable e => e -> Decoder s a
cborError ( Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed the size check. Expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
requestedSize)
                          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Int -> String
forall a. Show a => a -> String
show Int
actualSize)
                    )

      decodeXPrv :: CBOR.Decoder s Wallet.XPrv
      decodeXPrv :: Decoder s XPrv
decodeXPrv = Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytesCanonical Decoder s ByteString
-> (ByteString -> Decoder s XPrv) -> Decoder s XPrv
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either String XPrv -> Decoder s XPrv
forall e a s. Buildable e => Either e a -> Decoder s a
toCborError (Either String XPrv -> Decoder s XPrv)
-> (ByteString -> Either String XPrv)
-> ByteString
-> Decoder s XPrv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String XPrv
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 :: Decoder s SigningKey
decodeLegacyDelegateKey = do
          Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"UserSecret" Int
4
          ByteString
_    <- do
            Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"vss" Int
1
            Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
          SigningKey
pkey <- do
            Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"pkey" Int
1
            XPrv -> SigningKey
Byron.SigningKey (XPrv -> SigningKey) -> Decoder s XPrv -> Decoder s SigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s XPrv
forall s. Decoder s XPrv
decodeXPrv
          [()]
_    <- do
            Decoder s ()
forall s. Decoder s ()
CBOR.decodeListLenIndef
            ([()] -> () -> [()])
-> [()] -> ([()] -> [()]) -> Decoder s () -> Decoder s [()]
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 Decoder s ()
forall s. Decoder s ()
CBOR.decodeNull
          ()
_    <- do
            Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"wallet" Int
0
          SigningKey -> Decoder s SigningKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure SigningKey
pkey

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

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