{-# 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           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

import           Cardano.Binary (cborError, toStrictByteString)
import qualified Cardano.Chain.Common as Crypto
import qualified Cardano.Crypto.DSIGN.Class as Crypto
import qualified Cardano.Crypto.Hashing 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 qualified Cardano.Crypto.Wallet as Wallet

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.Either.Combinators
import           Data.String (IsString)
import           Data.Text (Text)
import qualified Data.Text as Text
import           Formatting (build, formatToString)

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

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

  verificationKeyHash :: VerificationKey ByronKey -> Hash ByronKey
  verificationKeyHash :: VerificationKey ByronKey -> Hash ByronKey
verificationKeyHash (ByronVerificationKey VerificationKey
vkey) =
    KeyHash -> Hash ByronKey
ByronKeyHash (VerificationKey -> KeyHash
Crypto.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 (Crypto.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 =
    (String -> SerialiseAsRawBytesError)
-> Either String (VerificationKey ByronKey)
-> Either SerialiseAsRawBytesError (VerificationKey ByronKey)
forall a b c. (a -> b) -> Either a c -> Either b c
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" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg)) (Either String (VerificationKey ByronKey)
 -> Either SerialiseAsRawBytesError (VerificationKey ByronKey))
-> Either String (VerificationKey ByronKey)
-> Either SerialiseAsRawBytesError (VerificationKey ByronKey)
forall a b. (a -> b) -> a -> b
$
      VerificationKey -> VerificationKey ByronKey
ByronVerificationKey (VerificationKey -> VerificationKey ByronKey)
-> (XPub -> VerificationKey) -> XPub -> VerificationKey ByronKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey
Crypto.VerificationKey (XPub -> VerificationKey ByronKey)
-> Either String XPub -> Either String (VerificationKey ByronKey)
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 SigningKey
sk) = Encoding -> ByteString
toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ SigningKey -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SigningKey
sk

  deserialiseFromRawBytes :: AsType (SigningKey ByronKey)
-> ByteString
-> Either SerialiseAsRawBytesError (SigningKey ByronKey)
deserialiseFromRawBytes (AsSigningKey AsType ByronKey
R:AsTypeByronKey
AsByronKey) ByteString
bs =
    (DeserialiseFailure -> SerialiseAsRawBytesError)
-> Either DeserialiseFailure (SigningKey ByronKey)
-> Either SerialiseAsRawBytesError (SigningKey ByronKey)
forall a b c. (a -> b) -> Either a c -> Either b c
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" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
e)) (Either DeserialiseFailure (SigningKey ByronKey)
 -> Either SerialiseAsRawBytesError (SigningKey ByronKey))
-> Either DeserialiseFailure (SigningKey ByronKey)
-> Either SerialiseAsRawBytesError (SigningKey ByronKey)
forall a b. (a -> b) -> a -> b
$
      SigningKey -> SigningKey ByronKey
ByronSigningKey (SigningKey -> SigningKey ByronKey)
-> ((ByteString, SigningKey) -> SigningKey)
-> (ByteString, SigningKey)
-> SigningKey ByronKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, SigningKey) -> SigningKey
forall a b. (a, b) -> b
snd ((ByteString, SigningKey) -> SigningKey ByronKey)
-> Either DeserialiseFailure (ByteString, SigningKey)
-> Either DeserialiseFailure (SigningKey ByronKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. Decoder s SigningKey)
-> ByteString -> Either DeserialiseFailure (ByteString, SigningKey)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes Decoder s SigningKey
forall s. Decoder s SigningKey
forall a s. FromCBOR a => Decoder s a
fromCBOR (ByteString -> ByteString
LB.fromStrict ByteString
bs)

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

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

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

instance CastVerificationKeyRole ByronKey PaymentExtendedKey where
  castVerificationKey :: VerificationKey ByronKey -> VerificationKey PaymentExtendedKey
castVerificationKey (ByronVerificationKey VerificationKey
vk) =
    XPub -> VerificationKey PaymentExtendedKey
PaymentExtendedVerificationKey
      (VerificationKey -> XPub
Crypto.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 Crypto.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
$c== :: VerificationKey ByronKeyLegacy
-> VerificationKey ByronKeyLegacy -> Bool
== :: VerificationKey ByronKeyLegacy
-> VerificationKey ByronKeyLegacy -> Bool
$c/= :: VerificationKey ByronKeyLegacy
-> VerificationKey ByronKeyLegacy -> Bool
/= :: 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
$cshowsPrec :: Int -> VerificationKey ByronKeyLegacy -> ShowS
showsPrec :: Int -> VerificationKey ByronKeyLegacy -> ShowS
$cshow :: VerificationKey ByronKeyLegacy -> String
show :: VerificationKey ByronKeyLegacy -> String
$cshowList :: [VerificationKey ByronKeyLegacy] -> ShowS
showList :: [VerificationKey ByronKeyLegacy] -> ShowS
Show, String -> VerificationKey ByronKeyLegacy
(String -> VerificationKey ByronKeyLegacy)
-> IsString (VerificationKey ByronKeyLegacy)
forall a. (String -> a) -> IsString a
$cfromString :: String -> VerificationKey ByronKeyLegacy
fromString :: 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
$ctoCBOR :: VerificationKey ByronKeyLegacy -> Encoding
toCBOR :: VerificationKey ByronKeyLegacy -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey ByronKeyLegacy) -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerificationKey ByronKeyLegacy) -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey ByronKeyLegacy] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [VerificationKey ByronKeyLegacy] -> Size
ToCBOR, Typeable (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
$cfromCBOR :: forall s. Decoder s (VerificationKey ByronKeyLegacy)
fromCBOR :: forall s. Decoder s (VerificationKey ByronKeyLegacy)
$clabel :: Proxy (VerificationKey ByronKeyLegacy) -> Text
label :: Proxy (VerificationKey ByronKeyLegacy) -> Text
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
$cserialiseToCBOR :: VerificationKey ByronKeyLegacy -> ByteString
serialiseToCBOR :: VerificationKey ByronKeyLegacy -> ByteString
$cdeserialiseFromCBOR :: AsType (VerificationKey ByronKeyLegacy)
-> ByteString
-> Either DecoderError (VerificationKey ByronKeyLegacy)
deserialiseFromCBOR :: AsType (VerificationKey ByronKeyLegacy)
-> ByteString
-> Either DecoderError (VerificationKey ByronKeyLegacy)
SerialiseAsCBOR

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

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

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

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

instance SerialiseAsRawBytes (VerificationKey ByronKeyLegacy) where
  serialiseToRawBytes :: VerificationKey ByronKeyLegacy -> ByteString
serialiseToRawBytes (ByronVerificationKeyLegacy (Crypto.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 =
    (String -> SerialiseAsRawBytesError)
-> Either String (VerificationKey ByronKeyLegacy)
-> Either SerialiseAsRawBytesError (VerificationKey ByronKeyLegacy)
forall a b c. (a -> b) -> Either a c -> Either b c
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" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg))
      (Either String (VerificationKey ByronKeyLegacy)
 -> Either
      SerialiseAsRawBytesError (VerificationKey ByronKeyLegacy))
-> Either String (VerificationKey ByronKeyLegacy)
-> Either SerialiseAsRawBytesError (VerificationKey ByronKeyLegacy)
forall a b. (a -> b) -> a -> b
$ VerificationKey -> VerificationKey ByronKeyLegacy
ByronVerificationKeyLegacy (VerificationKey -> VerificationKey ByronKeyLegacy)
-> (XPub -> VerificationKey)
-> XPub
-> VerificationKey ByronKeyLegacy
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> VerificationKey
Crypto.VerificationKey (XPub -> VerificationKey ByronKeyLegacy)
-> Either String XPub
-> Either String (VerificationKey ByronKeyLegacy)
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 (Crypto.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 =
    (DeserialiseFailure -> SerialiseAsRawBytesError)
-> Either DeserialiseFailure (SigningKey ByronKeyLegacy)
-> Either SerialiseAsRawBytesError (SigningKey ByronKeyLegacy)
forall a b c. (a -> b) -> Either a c -> Either b c
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" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DeserialiseFailure -> String
forall a. Show a => a -> String
show DeserialiseFailure
e)) (Either DeserialiseFailure (SigningKey ByronKeyLegacy)
 -> Either SerialiseAsRawBytesError (SigningKey ByronKeyLegacy))
-> Either DeserialiseFailure (SigningKey ByronKeyLegacy)
-> Either SerialiseAsRawBytesError (SigningKey ByronKeyLegacy)
forall a b. (a -> b) -> a -> b
$
      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 ((ByteString, SigningKey) -> SigningKey ByronKeyLegacy)
-> Either DeserialiseFailure (ByteString, SigningKey)
-> Either DeserialiseFailure (SigningKey ByronKeyLegacy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall s. Decoder s SigningKey)
-> ByteString -> Either DeserialiseFailure (ByteString, SigningKey)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure (ByteString, a)
CBOR.deserialiseFromBytes Decoder s SigningKey
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 = Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLenCanonical Decoder s Int -> (Int -> Decoder s ()) -> Decoder s ()
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
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 :: forall s. 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 (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m 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 :: forall s. 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 a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Decoder s XPrv)
-> (XPrv -> Decoder s XPrv) -> Either String XPrv -> Decoder s XPrv
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Decoder s XPrv
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s XPrv) -> ShowS -> String -> Decoder s XPrv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format String ShowS -> ShowS
forall a. Format String a -> a
formatToString Format String ShowS
forall a r. Buildable a => Format r (a -> r)
build) XPrv -> Decoder s XPrv
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 Crypto.SigningKey
    decodeLegacyDelegateKey :: forall s. 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
Crypto.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 a. a -> Decoder s a
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