{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_HADDOCK prune #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0

module Cardano.Address.Style.Byron
    ( -- $overview

      -- * Byron
      Byron
    , DerivationPath
    , payloadPassphrase
    , derivationPath
    , getKey

      -- * Key Derivation
      -- $keyDerivation
    , genMasterKeyFromXPrv
    , genMasterKeyFromMnemonic
    , deriveAccountPrivateKey
    , deriveAddressPrivateKey

      -- * Addresses
      -- $addresses
    , AddressInfo (..)
    , eitherInspectAddress
    , inspectAddress
    , inspectByronAddress
    , paymentAddress
    , ErrInspectAddress (..)
    , prettyErrInspectAddress

      -- * Network Discrimination
    , byronMainnet
    , byronStaging
    , byronTestnet

      -- * Unsafe
    , liftXPrv
    , liftXPub

      -- Internals
    , minSeedLengthBytes
    ) where

import Prelude

import Cardano.Address
    ( Address
    , AddressDiscrimination (..)
    , HasNetworkDiscriminant (..)
    , NetworkTag (..)
    , unAddress
    , unsafeMkAddress
    )
import Cardano.Address.Derivation
    ( Depth (..)
    , DerivationScheme (DerivationScheme1)
    , DerivationType (..)
    , Index (..)
    , XPrv
    , XPub
    , deriveXPrv
    , generate
    , toXPub
    , xpubToBytes
    )
import Cardano.Address.Internal
    ( DeserialiseFailure, WithErrorMessage (..) )
import Cardano.Mnemonic
    ( SomeMnemonic (..), entropyToBytes, mnemonicToEntropy )
import Codec.Binary.Encoding
    ( AbstractEncoding (..), encode )
import Control.DeepSeq
    ( NFData )
import Control.Exception
    ( Exception, displayException )
import Control.Exception.Base
    ( assert )
import Control.Monad.Catch
    ( MonadThrow, throwM )
import Crypto.Hash
    ( hash )
import Crypto.Hash.Algorithms
    ( Blake2b_256, SHA512 (..) )
import Data.Aeson
    ( ToJSON (..), (.=) )
import Data.Bifunctor
    ( bimap, first )
import Data.ByteArray
    ( ScrubbedBytes )
import Data.ByteString
    ( ByteString )
import Data.Kind
    ( Type )
import Data.List
    ( find )
import Data.Word
    ( Word32, Word8 )
import GHC.Generics
    ( Generic )

import qualified Cardano.Address as Internal
import qualified Cardano.Address.Derivation as Internal
import qualified Cardano.Codec.Cbor as CBOR
import qualified Codec.CBOR.Decoding as CBOR
import qualified Crypto.KDF.PBKDF2 as PBKDF2
import qualified Data.Aeson as Json
import qualified Data.ByteArray as BA
import qualified Data.Text.Encoding as T

-- $overview
--
-- This module provides an implementation of:
--
-- - 'Cardano.Address.Derivation.GenMasterKey': for generating Byron master keys from mnemonic sentences
-- - 'Cardano.Address.Derivation.HardDerivation': for hierarchical derivation of parent to child keys
-- - 'Cardano.Address.PaymentAddress': for constructing addresses from a public key
--
-- We call 'Byron' addresses the old address type used by Daedalus in the early
-- days of Cardano. Using this type of addresses and underlying key scheme is
-- now considered __deprecated__ because of some security implications.
--
-- The internals of the 'Byron' does not matter for the reader, but basically
-- contains what is necessary to perform key derivation and generate addresses
-- from a 'Byron' type.
--
-- == Deprecation Notice
--
-- Unless you have good reason to do so (like writing backward-compatible code
-- with an existing piece), any new implementation __should use__ the
-- 'Cardano.Address.Style.Icarus.Icarus' style for key and addresses.


-- | Material for deriving HD random scheme keys, which can be used for making
-- addresses.
--
-- @since 1.0.0
data Byron (depth :: Depth) key = Byron
    { Byron depth key -> key
getKey :: key
    -- ^ The raw private or public key.
    --
    -- @since 1.0.0
    , Byron depth key -> DerivationPath depth
derivationPath :: DerivationPath depth
    -- ^ The address derivation indices for the level of this key.
    --
    -- @since 1.0.0
    , Byron depth key -> ScrubbedBytes
payloadPassphrase :: ScrubbedBytes
    -- ^ Used for encryption of the derivation path payload within an address.
    --
    -- @since 1.0.0
    } deriving stock ((forall x. Byron depth key -> Rep (Byron depth key) x)
-> (forall x. Rep (Byron depth key) x -> Byron depth key)
-> Generic (Byron depth key)
forall x. Rep (Byron depth key) x -> Byron depth key
forall x. Byron depth key -> Rep (Byron depth key) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (depth :: Depth) key x.
Rep (Byron depth key) x -> Byron depth key
forall (depth :: Depth) key x.
Byron depth key -> Rep (Byron depth key) x
$cto :: forall (depth :: Depth) key x.
Rep (Byron depth key) x -> Byron depth key
$cfrom :: forall (depth :: Depth) key x.
Byron depth key -> Rep (Byron depth key) x
Generic)
{-# DEPRECATED Byron "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
{-# DEPRECATED getKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
{-# DEPRECATED derivationPath "see 'Cardano.Address.Style.Icarus.Icarus'" #-}
{-# DEPRECATED payloadPassphrase "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

instance (NFData key, NFData (DerivationPath depth)) => NFData (Byron depth key)
deriving instance (Show key, Show (DerivationPath depth)) => Show (Byron depth key)
deriving instance (Eq key, Eq (DerivationPath depth)) => Eq (Byron depth key)
deriving instance (Functor (Byron depth))

-- | The hierarchical derivation indices for a given level/depth.
--
-- @since 1.0.0
type family DerivationPath (depth :: Depth) :: Type where
    -- The root key is generated from the seed.
    DerivationPath 'RootK =
        ()
    -- The account key is generated from the root key and account index.
    DerivationPath 'AccountK =
        Index 'WholeDomain 'AccountK
    -- The address key is generated from the account key and address index.
    DerivationPath 'PaymentK =
        (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'PaymentK)
{-# DEPRECATED DerivationPath "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

--
-- Key Derivation
--
-- === Generating a root key from 'SomeMnemonic'
-- > :set -XOverloadedStrings
-- > :set -XTypeApplications
-- > :set -XDataKinds
-- > import Cardano.Mnemonic ( mkSomeMnemonic )
-- >
-- > let (Right mw) = mkSomeMnemonic @'[12] ["moon","fox","ostrich","quick","cactus","raven","wasp","intact","first","ring","crumble","error"]
-- > let rootK = genMasterKeyFromMnemonic mw :: Byron 'RootK XPrv
--
-- === Deriving child keys
--
-- > let Just accIx = fromWord32 0x80000000
-- > let acctK = deriveAccountPrivateKey rootK accIx
-- >
-- > let Just addIx = fromWord32 0x80000014
-- > let addrK = deriveAddressPrivateKey acctK addIx

instance Internal.GenMasterKey Byron where
    type SecondFactor Byron = ()

    genMasterKeyFromXPrv :: XPrv -> Byron 'RootK XPrv
genMasterKeyFromXPrv XPrv
xprv =
        XPub -> DerivationPath 'RootK -> XPrv -> Byron 'RootK XPrv
forall (depth :: Depth).
XPub -> DerivationPath depth -> XPrv -> Byron depth XPrv
liftXPrv (HasCallStack => XPrv -> XPub
XPrv -> XPub
toXPub XPrv
xprv) () XPrv
xprv
    genMasterKeyFromMnemonic :: SomeMnemonic -> SecondFactor Byron -> Byron 'RootK XPrv
genMasterKeyFromMnemonic (SomeMnemonic Mnemonic mw
mw) () =
        XPub -> DerivationPath 'RootK -> XPrv -> Byron 'RootK XPrv
forall (depth :: Depth).
XPub -> DerivationPath depth -> XPrv -> Byron depth XPrv
liftXPrv (HasCallStack => XPrv -> XPub
XPrv -> XPub
toXPub XPrv
xprv) () XPrv
xprv
      where
        xprv :: XPrv
xprv = ScrubbedBytes -> XPrv
forall seed. ByteArrayAccess seed => seed -> XPrv
generate (ScrubbedBytes -> ScrubbedBytes
hashSeed ScrubbedBytes
seedValidated)
        seed :: ScrubbedBytes
seed  = Entropy (EntropySize mw) -> ScrubbedBytes
forall (n :: Nat). Entropy n -> ScrubbedBytes
entropyToBytes (Entropy (EntropySize mw) -> ScrubbedBytes)
-> Entropy (EntropySize mw) -> ScrubbedBytes
forall a b. (a -> b) -> a -> b
$ Mnemonic mw -> Entropy (EntropySize mw)
forall (mw :: Nat). Mnemonic mw -> Entropy (EntropySize mw)
mnemonicToEntropy Mnemonic mw
mw
        seedValidated :: ScrubbedBytes
seedValidated = Bool -> ScrubbedBytes -> ScrubbedBytes
forall a. HasCallStack => Bool -> a -> a
assert
            (ScrubbedBytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
seed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minSeedLengthBytes Bool -> Bool -> Bool
&& ScrubbedBytes -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ScrubbedBytes
seed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
255)
            ScrubbedBytes
seed

instance Internal.HardDerivation Byron where
    type AddressIndexDerivationType Byron = 'WholeDomain
    type AccountIndexDerivationType Byron = 'WholeDomain
    type WithRole Byron = ()

    deriveAccountPrivateKey :: Byron 'RootK XPrv
-> Index (AccountIndexDerivationType Byron) 'AccountK
-> Byron 'AccountK XPrv
deriveAccountPrivateKey Byron 'RootK XPrv
rootXPrv Index (AccountIndexDerivationType Byron) 'AccountK
accIx = Byron :: forall (depth :: Depth) key.
key -> DerivationPath depth -> ScrubbedBytes -> Byron depth key
Byron
        { $sel:getKey:Byron :: XPrv
getKey = DerivationScheme -> XPrv -> Index 'WholeDomain 'AccountK -> XPrv
forall (derivationType :: DerivationType) (depth :: Depth).
DerivationScheme -> XPrv -> Index derivationType depth -> XPrv
deriveXPrv DerivationScheme
DerivationScheme1 (Byron 'RootK XPrv -> XPrv
forall (depth :: Depth) key. Byron depth key -> key
getKey Byron 'RootK XPrv
rootXPrv) Index (AccountIndexDerivationType Byron) 'AccountK
Index 'WholeDomain 'AccountK
accIx
        , $sel:derivationPath:Byron :: DerivationPath 'AccountK
derivationPath = Index (AccountIndexDerivationType Byron) 'AccountK
DerivationPath 'AccountK
accIx
        , $sel:payloadPassphrase:Byron :: ScrubbedBytes
payloadPassphrase = Byron 'RootK XPrv -> ScrubbedBytes
forall (depth :: Depth) key. Byron depth key -> ScrubbedBytes
payloadPassphrase Byron 'RootK XPrv
rootXPrv
        }

    deriveAddressPrivateKey :: Byron 'AccountK XPrv
-> WithRole Byron
-> Index (AddressIndexDerivationType Byron) 'PaymentK
-> Byron 'PaymentK XPrv
deriveAddressPrivateKey Byron 'AccountK XPrv
accXPrv () Index (AddressIndexDerivationType Byron) 'PaymentK
addrIx = Byron :: forall (depth :: Depth) key.
key -> DerivationPath depth -> ScrubbedBytes -> Byron depth key
Byron
        { $sel:getKey:Byron :: XPrv
getKey = DerivationScheme -> XPrv -> Index 'WholeDomain 'PaymentK -> XPrv
forall (derivationType :: DerivationType) (depth :: Depth).
DerivationScheme -> XPrv -> Index derivationType depth -> XPrv
deriveXPrv DerivationScheme
DerivationScheme1 (Byron 'AccountK XPrv -> XPrv
forall (depth :: Depth) key. Byron depth key -> key
getKey Byron 'AccountK XPrv
accXPrv) Index (AddressIndexDerivationType Byron) 'PaymentK
Index 'WholeDomain 'PaymentK
addrIx
        , $sel:derivationPath:Byron :: DerivationPath 'PaymentK
derivationPath = (Byron 'AccountK XPrv -> DerivationPath 'AccountK
forall (depth :: Depth) key.
Byron depth key -> DerivationPath depth
derivationPath Byron 'AccountK XPrv
accXPrv, Index (AddressIndexDerivationType Byron) 'PaymentK
Index 'WholeDomain 'PaymentK
addrIx)
        , $sel:payloadPassphrase:Byron :: ScrubbedBytes
payloadPassphrase = Byron 'AccountK XPrv -> ScrubbedBytes
forall (depth :: Depth) key. Byron depth key -> ScrubbedBytes
payloadPassphrase Byron 'AccountK XPrv
accXPrv
        }

-- | Generate a root key from a corresponding mnemonic.
--
-- @since 1.0.0
genMasterKeyFromMnemonic
    :: SomeMnemonic
        -- ^ Some valid mnemonic sentence.
    -> Byron 'RootK XPrv
genMasterKeyFromMnemonic :: SomeMnemonic -> Byron 'RootK XPrv
genMasterKeyFromMnemonic =
    (SomeMnemonic -> () -> Byron 'RootK XPrv)
-> () -> SomeMnemonic -> Byron 'RootK XPrv
forall a b c. (a -> b -> c) -> b -> a -> c
flip SomeMnemonic -> () -> Byron 'RootK XPrv
forall (key :: Depth -> * -> *).
GenMasterKey key =>
SomeMnemonic -> SecondFactor key -> key 'RootK XPrv
Internal.genMasterKeyFromMnemonic ()
{-# DEPRECATED genMasterKeyFromMnemonic "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

-- | Generate a root key from a corresponding root 'XPrv'
--
-- @since 1.0.0
genMasterKeyFromXPrv
    :: XPrv
    -> Byron 'RootK XPrv
genMasterKeyFromXPrv :: XPrv -> Byron 'RootK XPrv
genMasterKeyFromXPrv =
    XPrv -> Byron 'RootK XPrv
forall (key :: Depth -> * -> *).
GenMasterKey key =>
XPrv -> key 'RootK XPrv
Internal.genMasterKeyFromXPrv
{-# DEPRECATED genMasterKeyFromXPrv "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
--
-- | Derives an account private key from the given root private key.
--
-- @since 1.0.0
deriveAccountPrivateKey
    :: Byron 'RootK XPrv
    -> Index 'WholeDomain 'AccountK
    -> Byron 'AccountK XPrv
deriveAccountPrivateKey :: Byron 'RootK XPrv
-> Index 'WholeDomain 'AccountK -> Byron 'AccountK XPrv
deriveAccountPrivateKey =
    Byron 'RootK XPrv
-> Index 'WholeDomain 'AccountK -> Byron 'AccountK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
key 'RootK XPrv
-> Index (AccountIndexDerivationType key) 'AccountK
-> key 'AccountK XPrv
Internal.deriveAccountPrivateKey
{-# DEPRECATED deriveAccountPrivateKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

-- Re-export from 'Cardano.Address.Derivation' to have it documented specialized in Haddock.
--
-- | Derives an address private key from the given account private key.
--
-- @since 1.0.0
deriveAddressPrivateKey
    :: Byron 'AccountK XPrv
    -> Index 'WholeDomain 'PaymentK
    -> Byron 'PaymentK XPrv
deriveAddressPrivateKey :: Byron 'AccountK XPrv
-> Index 'WholeDomain 'PaymentK -> Byron 'PaymentK XPrv
deriveAddressPrivateKey Byron 'AccountK XPrv
acctK =
    Byron 'AccountK XPrv
-> WithRole Byron
-> Index (AddressIndexDerivationType Byron) 'PaymentK
-> Byron 'PaymentK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
key 'AccountK XPrv
-> WithRole key
-> Index (AddressIndexDerivationType key) 'PaymentK
-> key 'PaymentK XPrv
Internal.deriveAddressPrivateKey Byron 'AccountK XPrv
acctK ()
{-# DEPRECATED deriveAddressPrivateKey "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

--
-- Addresses
--
-- $addresses
-- === Generating a 'PaymentAddress'
--
-- > import Cardano.Address ( base58 )
-- > import Cardano.Address.Derivation ( toXPub(..) )
-- >
-- > base58 $ paymentAddress byronMainnet (toXPub <$> addrK)
-- > "DdzFFzCqrhsq3KjLtT51mESbZ4RepiHPzLqEhamexVFTJpGbCXmh7qSxnHvaL88QmtVTD1E1sjx8Z1ZNDhYmcBV38ZjDST9kYVxSkhcw"

-- | Possible errors from inspecting a Byron address
--
-- @since 3.0.0
data ErrInspectAddress
    = MissingExpectedDerivationPath
    | DeserialiseError DeserialiseFailure
    | FailedToDecryptPath
    deriving ((forall x. ErrInspectAddress -> Rep ErrInspectAddress x)
-> (forall x. Rep ErrInspectAddress x -> ErrInspectAddress)
-> Generic ErrInspectAddress
forall x. Rep ErrInspectAddress x -> ErrInspectAddress
forall x. ErrInspectAddress -> Rep ErrInspectAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ErrInspectAddress x -> ErrInspectAddress
$cfrom :: forall x. ErrInspectAddress -> Rep ErrInspectAddress x
Generic, Int -> ErrInspectAddress -> ShowS
[ErrInspectAddress] -> ShowS
ErrInspectAddress -> String
(Int -> ErrInspectAddress -> ShowS)
-> (ErrInspectAddress -> String)
-> ([ErrInspectAddress] -> ShowS)
-> Show ErrInspectAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrInspectAddress] -> ShowS
$cshowList :: [ErrInspectAddress] -> ShowS
show :: ErrInspectAddress -> String
$cshow :: ErrInspectAddress -> String
showsPrec :: Int -> ErrInspectAddress -> ShowS
$cshowsPrec :: Int -> ErrInspectAddress -> ShowS
Show, ErrInspectAddress -> ErrInspectAddress -> Bool
(ErrInspectAddress -> ErrInspectAddress -> Bool)
-> (ErrInspectAddress -> ErrInspectAddress -> Bool)
-> Eq ErrInspectAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrInspectAddress -> ErrInspectAddress -> Bool
$c/= :: ErrInspectAddress -> ErrInspectAddress -> Bool
== :: ErrInspectAddress -> ErrInspectAddress -> Bool
$c== :: ErrInspectAddress -> ErrInspectAddress -> Bool
Eq)
    deriving [ErrInspectAddress] -> Encoding
[ErrInspectAddress] -> Value
ErrInspectAddress -> Encoding
ErrInspectAddress -> Value
(ErrInspectAddress -> Value)
-> (ErrInspectAddress -> Encoding)
-> ([ErrInspectAddress] -> Value)
-> ([ErrInspectAddress] -> Encoding)
-> ToJSON ErrInspectAddress
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ErrInspectAddress] -> Encoding
$ctoEncodingList :: [ErrInspectAddress] -> Encoding
toJSONList :: [ErrInspectAddress] -> Value
$ctoJSONList :: [ErrInspectAddress] -> Value
toEncoding :: ErrInspectAddress -> Encoding
$ctoEncoding :: ErrInspectAddress -> Encoding
toJSON :: ErrInspectAddress -> Value
$ctoJSON :: ErrInspectAddress -> Value
ToJSON via WithErrorMessage ErrInspectAddress

instance Exception ErrInspectAddress where
  displayException :: ErrInspectAddress -> String
displayException = ErrInspectAddress -> String
prettyErrInspectAddress

-- | Pretty-print an 'ErrInspectAddress'
--
-- @since 3.0.0
prettyErrInspectAddress :: ErrInspectAddress -> String
prettyErrInspectAddress :: ErrInspectAddress -> String
prettyErrInspectAddress = \case
    ErrInspectAddress
MissingExpectedDerivationPath ->
        String
"Missing expected derivation path"
    DeserialiseError DeserialiseFailure
e ->
        DeserialiseFailure -> String
forall e. Exception e => e -> String
displayException DeserialiseFailure
e
    ErrInspectAddress
FailedToDecryptPath ->
        String
"Failed to decrypt derivation path"

-- Determines whether an 'Address' is a Byron address.
--
-- Returns a JSON object with information about the address, or throws
-- 'ErrInspectAddress' if the address isn't a byron address.
--
-- @since 2.0.0
inspectByronAddress :: forall m. MonadThrow m => Maybe XPub -> Address -> m Json.Value
inspectByronAddress :: Maybe XPub -> Address -> m Value
inspectByronAddress = Maybe XPub -> Address -> m Value
forall (m :: * -> *).
MonadThrow m =>
Maybe XPub -> Address -> m Value
inspectAddress
{-# DEPRECATED inspectByronAddress "use qualified 'inspectAddress' instead." #-}

-- | Determines whether an 'Address' is a Byron address.
--
-- Returns a JSON object with information about the address, or throws
-- 'ErrInspectAddress' if the address isn't a byron address.
--
-- @since 3.0.0
inspectAddress :: forall m. MonadThrow m => Maybe XPub -> Address -> m Json.Value
inspectAddress :: Maybe XPub -> Address -> m Value
inspectAddress Maybe XPub
mRootPub Address
addr = (ErrInspectAddress -> m Value)
-> (AddressInfo -> m Value)
-> Either ErrInspectAddress AddressInfo
-> m Value
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrInspectAddress -> m Value
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> m Value)
-> (AddressInfo -> Value) -> AddressInfo -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressInfo -> Value
forall a. ToJSON a => a -> Value
toJSON) (Either ErrInspectAddress AddressInfo -> m Value)
-> Either ErrInspectAddress AddressInfo -> m Value
forall a b. (a -> b) -> a -> b
$
    Maybe XPub -> Address -> Either ErrInspectAddress AddressInfo
eitherInspectAddress Maybe XPub
mRootPub Address
addr

-- | Determines whether an 'Address' is a Byron address.
--
-- Returns either details about the 'Address', or 'ErrInspectAddress' if it's
-- not a valid address.
--
-- @since 3.4.0
eitherInspectAddress :: Maybe XPub -> Address -> Either ErrInspectAddress AddressInfo
eitherInspectAddress :: Maybe XPub -> Address -> Either ErrInspectAddress AddressInfo
eitherInspectAddress Maybe XPub
mRootPub Address
addr = do
    ByteString
payload <- (DeserialiseFailure -> ErrInspectAddress)
-> Either DeserialiseFailure ByteString
-> Either ErrInspectAddress ByteString
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DeserialiseFailure -> ErrInspectAddress
DeserialiseError (Either DeserialiseFailure ByteString
 -> Either ErrInspectAddress ByteString)
-> Either DeserialiseFailure ByteString
-> Either ErrInspectAddress ByteString
forall a b. (a -> b) -> a -> b
$
        (forall s. Decoder s ByteString)
-> ByteString -> Either DeserialiseFailure ByteString
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure a
CBOR.deserialiseCbor forall s. Decoder s ByteString
CBOR.decodeAddressPayload ByteString
bytes

    (ByteString
root, [(Word8, ByteString)]
attrs) <- (DeserialiseFailure -> ErrInspectAddress)
-> Either DeserialiseFailure (ByteString, [(Word8, ByteString)])
-> Either ErrInspectAddress (ByteString, [(Word8, ByteString)])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first DeserialiseFailure -> ErrInspectAddress
DeserialiseError (Either DeserialiseFailure (ByteString, [(Word8, ByteString)])
 -> Either ErrInspectAddress (ByteString, [(Word8, ByteString)]))
-> Either DeserialiseFailure (ByteString, [(Word8, ByteString)])
-> Either ErrInspectAddress (ByteString, [(Word8, ByteString)])
forall a b. (a -> b) -> a -> b
$
        (forall s. Decoder s (ByteString, [(Word8, ByteString)]))
-> ByteString
-> Either DeserialiseFailure (ByteString, [(Word8, ByteString)])
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure a
CBOR.deserialiseCbor forall s. Decoder s (ByteString, [(Word8, ByteString)])
decodePayload ByteString
payload

    PayloadInfo
path <- do
        (Word8, ByteString)
attr <- Either ErrInspectAddress (Word8, ByteString)
-> ((Word8, ByteString)
    -> Either ErrInspectAddress (Word8, ByteString))
-> Maybe (Word8, ByteString)
-> Either ErrInspectAddress (Word8, ByteString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ErrInspectAddress -> Either ErrInspectAddress (Word8, ByteString)
forall a b. a -> Either a b
Left ErrInspectAddress
MissingExpectedDerivationPath) (Word8, ByteString) -> Either ErrInspectAddress (Word8, ByteString)
forall a b. b -> Either a b
Right (Maybe (Word8, ByteString)
 -> Either ErrInspectAddress (Word8, ByteString))
-> Maybe (Word8, ByteString)
-> Either ErrInspectAddress (Word8, ByteString)
forall a b. (a -> b) -> a -> b
$
            ((Word8, ByteString) -> Bool)
-> [(Word8, ByteString)] -> Maybe (Word8, ByteString)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1) (Word8 -> Bool)
-> ((Word8, ByteString) -> Word8) -> (Word8, ByteString) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8, ByteString) -> Word8
forall a b. (a, b) -> a
fst) [(Word8, ByteString)]
attrs
        case Maybe XPub
mRootPub of
            Maybe XPub
Nothing -> PayloadInfo -> Either ErrInspectAddress PayloadInfo
forall a b. b -> Either a b
Right (PayloadInfo -> Either ErrInspectAddress PayloadInfo)
-> PayloadInfo -> Either ErrInspectAddress PayloadInfo
forall a b. (a -> b) -> a -> b
$ ByteString -> PayloadInfo
EncryptedDerivationPath (ByteString -> PayloadInfo) -> ByteString -> PayloadInfo
forall a b. (a -> b) -> a -> b
$ (Word8, ByteString) -> ByteString
forall a b. (a, b) -> b
snd (Word8, ByteString)
attr
            Just XPub
rootPub -> (Word8, ByteString) -> XPub -> Either ErrInspectAddress PayloadInfo
decryptPath (Word8, ByteString)
attr XPub
rootPub

    Maybe NetworkTag
ntwrk <- (DeserialiseFailure -> ErrInspectAddress)
-> (Maybe Word32 -> Maybe NetworkTag)
-> Either DeserialiseFailure (Maybe Word32)
-> Either ErrInspectAddress (Maybe NetworkTag)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DeserialiseFailure -> ErrInspectAddress
DeserialiseError ((Word32 -> NetworkTag) -> Maybe Word32 -> Maybe NetworkTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> NetworkTag
NetworkTag) (Either DeserialiseFailure (Maybe Word32)
 -> Either ErrInspectAddress (Maybe NetworkTag))
-> Either DeserialiseFailure (Maybe Word32)
-> Either ErrInspectAddress (Maybe NetworkTag)
forall a b. (a -> b) -> a -> b
$
        (forall s. Decoder s (Maybe Word32))
-> ByteString -> Either DeserialiseFailure (Maybe Word32)
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure a
CBOR.deserialiseCbor forall s. Decoder s (Maybe Word32)
CBOR.decodeProtocolMagicAttr ByteString
payload

    AddressInfo -> Either ErrInspectAddress AddressInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure AddressInfo :: ByteString -> PayloadInfo -> Maybe NetworkTag -> AddressInfo
AddressInfo
        { $sel:infoAddressRoot:AddressInfo :: ByteString
infoAddressRoot = ByteString
root
        , $sel:infoPayload:AddressInfo :: PayloadInfo
infoPayload = PayloadInfo
path
        , $sel:infoNetworkTag:AddressInfo :: Maybe NetworkTag
infoNetworkTag = Maybe NetworkTag
ntwrk
        }
  where
    bytes :: ByteString
    bytes :: ByteString
bytes = Address -> ByteString
unAddress Address
addr

    decodePayload :: forall s. CBOR.Decoder s (ByteString, [(Word8, ByteString)])
    decodePayload :: Decoder s (ByteString, [(Word8, ByteString)])
decodePayload = do
        ()
_ <- Int -> Decoder s ()
forall s. Int -> Decoder s ()
CBOR.decodeListLenCanonicalOf Int
3
        ByteString
root <- Decoder s ByteString
forall s. Decoder s ByteString
CBOR.decodeBytes
        (ByteString
root,) ([(Word8, ByteString)] -> (ByteString, [(Word8, ByteString)]))
-> Decoder s [(Word8, ByteString)]
-> Decoder s (ByteString, [(Word8, ByteString)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s [(Word8, ByteString)]
forall s. Decoder s [(Word8, ByteString)]
CBOR.decodeAllAttributes

    decryptPath :: (Word8, ByteString) -> XPub -> Either ErrInspectAddress PayloadInfo
    decryptPath :: (Word8, ByteString) -> XPub -> Either ErrInspectAddress PayloadInfo
decryptPath (Word8, ByteString)
attr XPub
rootPub = do
        let pwd :: ScrubbedBytes
pwd = XPub -> ScrubbedBytes
hdPassphrase XPub
rootPub
        Maybe (Word32, Word32)
path <- (DeserialiseFailure -> ErrInspectAddress)
-> Either DeserialiseFailure (Maybe (Word32, Word32))
-> Either ErrInspectAddress (Maybe (Word32, Word32))
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ErrInspectAddress -> DeserialiseFailure -> ErrInspectAddress
forall a b. a -> b -> a
const ErrInspectAddress
FailedToDecryptPath) (Either DeserialiseFailure (Maybe (Word32, Word32))
 -> Either ErrInspectAddress (Maybe (Word32, Word32)))
-> Either DeserialiseFailure (Maybe (Word32, Word32))
-> Either ErrInspectAddress (Maybe (Word32, Word32))
forall a b. (a -> b) -> a -> b
$
            (forall s. Decoder s (Maybe (Word32, Word32)))
-> ByteString -> Either DeserialiseFailure (Maybe (Word32, Word32))
forall a.
(forall s. Decoder s a)
-> ByteString -> Either DeserialiseFailure a
CBOR.deserialiseCbor (ScrubbedBytes
-> [(Word8, ByteString)] -> Decoder s (Maybe (Word32, Word32))
forall s.
ScrubbedBytes
-> [(Word8, ByteString)] -> Decoder s (Maybe (Word32, Word32))
CBOR.decodeDerivationPathAttr ScrubbedBytes
pwd [(Word8, ByteString)
attr]) ByteString
forall a. Monoid a => a
mempty
        case Maybe (Word32, Word32)
path of
            Maybe (Word32, Word32)
Nothing -> ErrInspectAddress -> Either ErrInspectAddress PayloadInfo
forall a b. a -> Either a b
Left ErrInspectAddress
FailedToDecryptPath
            Just (Word32
accountIndex, Word32
addressIndex) -> PayloadInfo -> Either ErrInspectAddress PayloadInfo
forall a b. b -> Either a b
Right PayloadDerivationPath :: Word32 -> Word32 -> PayloadInfo
PayloadDerivationPath{Word32
$sel:addressIndex:PayloadDerivationPath :: Word32
$sel:accountIndex:PayloadDerivationPath :: Word32
addressIndex :: Word32
accountIndex :: Word32
..}

-- | The result of 'eitherInspectAddress' for Byron addresses.
--
-- @since 3.4.0
data AddressInfo = AddressInfo
    { AddressInfo -> ByteString
infoAddressRoot :: !ByteString
    , AddressInfo -> PayloadInfo
infoPayload :: !PayloadInfo
    , AddressInfo -> Maybe NetworkTag
infoNetworkTag :: !(Maybe NetworkTag)
    } deriving ((forall x. AddressInfo -> Rep AddressInfo x)
-> (forall x. Rep AddressInfo x -> AddressInfo)
-> Generic AddressInfo
forall x. Rep AddressInfo x -> AddressInfo
forall x. AddressInfo -> Rep AddressInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddressInfo x -> AddressInfo
$cfrom :: forall x. AddressInfo -> Rep AddressInfo x
Generic, Int -> AddressInfo -> ShowS
[AddressInfo] -> ShowS
AddressInfo -> String
(Int -> AddressInfo -> ShowS)
-> (AddressInfo -> String)
-> ([AddressInfo] -> ShowS)
-> Show AddressInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddressInfo] -> ShowS
$cshowList :: [AddressInfo] -> ShowS
show :: AddressInfo -> String
$cshow :: AddressInfo -> String
showsPrec :: Int -> AddressInfo -> ShowS
$cshowsPrec :: Int -> AddressInfo -> ShowS
Show, AddressInfo -> AddressInfo -> Bool
(AddressInfo -> AddressInfo -> Bool)
-> (AddressInfo -> AddressInfo -> Bool) -> Eq AddressInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddressInfo -> AddressInfo -> Bool
$c/= :: AddressInfo -> AddressInfo -> Bool
== :: AddressInfo -> AddressInfo -> Bool
$c== :: AddressInfo -> AddressInfo -> Bool
Eq)

-- | The derivation path in a Byron address payload.
--
-- @since 3.4.0
data PayloadInfo
    = PayloadDerivationPath
        { PayloadInfo -> Word32
accountIndex :: !Word32
        , PayloadInfo -> Word32
addressIndex :: !Word32
        }
    | EncryptedDerivationPath
        { PayloadInfo -> ByteString
encryptedDerivationPath :: !ByteString
        }
    deriving ((forall x. PayloadInfo -> Rep PayloadInfo x)
-> (forall x. Rep PayloadInfo x -> PayloadInfo)
-> Generic PayloadInfo
forall x. Rep PayloadInfo x -> PayloadInfo
forall x. PayloadInfo -> Rep PayloadInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PayloadInfo x -> PayloadInfo
$cfrom :: forall x. PayloadInfo -> Rep PayloadInfo x
Generic, Int -> PayloadInfo -> ShowS
[PayloadInfo] -> ShowS
PayloadInfo -> String
(Int -> PayloadInfo -> ShowS)
-> (PayloadInfo -> String)
-> ([PayloadInfo] -> ShowS)
-> Show PayloadInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PayloadInfo] -> ShowS
$cshowList :: [PayloadInfo] -> ShowS
show :: PayloadInfo -> String
$cshow :: PayloadInfo -> String
showsPrec :: Int -> PayloadInfo -> ShowS
$cshowsPrec :: Int -> PayloadInfo -> ShowS
Show, PayloadInfo -> PayloadInfo -> Bool
(PayloadInfo -> PayloadInfo -> Bool)
-> (PayloadInfo -> PayloadInfo -> Bool) -> Eq PayloadInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PayloadInfo -> PayloadInfo -> Bool
$c/= :: PayloadInfo -> PayloadInfo -> Bool
== :: PayloadInfo -> PayloadInfo -> Bool
$c== :: PayloadInfo -> PayloadInfo -> Bool
Eq)

instance ToJSON AddressInfo where
    toJSON :: AddressInfo -> Value
toJSON AddressInfo{Maybe NetworkTag
ByteString
PayloadInfo
infoNetworkTag :: Maybe NetworkTag
infoPayload :: PayloadInfo
infoAddressRoot :: ByteString
$sel:infoNetworkTag:AddressInfo :: AddressInfo -> Maybe NetworkTag
$sel:infoPayload:AddressInfo :: AddressInfo -> PayloadInfo
$sel:infoAddressRoot:AddressInfo :: AddressInfo -> ByteString
..} = [Pair] -> Value
Json.object
        [ Key
"address_root"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
T.decodeUtf8 (Encoding -> ByteString -> ByteString
encode Encoding
forall a. AbstractEncoding a
EBase16 ByteString
infoAddressRoot)
        , Key
"derivation_path" Key -> PayloadInfo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PayloadInfo
infoPayload
        , Key
"network_tag"     Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value -> (NetworkTag -> Value) -> Maybe NetworkTag -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Json.Null NetworkTag -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe NetworkTag
infoNetworkTag
        , Key
"address_type"    Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word8 -> Value
forall a. ToJSON a => a -> Value
toJSON @Word8 Word8
8
        ]

instance ToJSON PayloadInfo where
    toJSON :: PayloadInfo -> Value
toJSON PayloadDerivationPath{Word32
addressIndex :: Word32
accountIndex :: Word32
$sel:addressIndex:PayloadDerivationPath :: PayloadInfo -> Word32
$sel:accountIndex:PayloadDerivationPath :: PayloadInfo -> Word32
..} = [Pair] -> Value
Json.object
        [ Key
"account_index" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32 -> String
prettyIndex Word32
accountIndex
        , Key
"address_index" Key -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word32 -> String
prettyIndex Word32
addressIndex
        ]
      where
        prettyIndex :: Word32 -> String
        prettyIndex :: Word32 -> String
prettyIndex Word32
ix
            | Word32
ix Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
firstHardened = Word32 -> String
forall a. Show a => a -> String
show (Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
firstHardened) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"H"
            | Bool
otherwise = Word32 -> String
forall a. Show a => a -> String
show Word32
ix
          where
            firstHardened :: Word32
firstHardened = Word32
0x80000000
    toJSON EncryptedDerivationPath{ByteString
encryptedDerivationPath :: ByteString
$sel:encryptedDerivationPath:PayloadDerivationPath :: PayloadInfo -> ByteString
..} = Text -> Value
Json.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$
        ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString -> ByteString
encode Encoding
forall a. AbstractEncoding a
EBase16 ByteString
encryptedDerivationPath

instance Internal.PaymentAddress Byron where
    paymentAddress :: NetworkDiscriminant Byron -> Byron 'PaymentK XPub -> Address
paymentAddress NetworkDiscriminant Byron
discrimination Byron 'PaymentK XPub
k = ByteString -> Address
unsafeMkAddress
        (ByteString -> Address) -> ByteString -> Address
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString
CBOR.toStrictByteString
        (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ XPub -> [Encoding] -> Encoding
CBOR.encodeAddress (Byron 'PaymentK XPub -> XPub
forall (depth :: Depth) key. Byron depth key -> key
getKey Byron 'PaymentK XPub
k) [Encoding]
attrs
      where
        (Word32
acctIx, Word32
addrIx) = (Index 'WholeDomain 'AccountK -> Word32)
-> (Index 'WholeDomain 'PaymentK -> Word32)
-> (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'PaymentK)
-> (Word32, Word32)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Index 'WholeDomain 'AccountK -> Word32
forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Word32
indexToWord32 Index 'WholeDomain 'PaymentK -> Word32
forall (derivationType :: DerivationType) (depth :: Depth).
Index derivationType depth -> Word32
indexToWord32 ((Index 'WholeDomain 'AccountK, Index 'WholeDomain 'PaymentK)
 -> (Word32, Word32))
-> (Index 'WholeDomain 'AccountK, Index 'WholeDomain 'PaymentK)
-> (Word32, Word32)
forall a b. (a -> b) -> a -> b
$ Byron 'PaymentK XPub -> DerivationPath 'PaymentK
forall (depth :: Depth) key.
Byron depth key -> DerivationPath depth
derivationPath Byron 'PaymentK XPub
k
        pwd :: ScrubbedBytes
pwd = Byron 'PaymentK XPub -> ScrubbedBytes
forall (depth :: Depth) key. Byron depth key -> ScrubbedBytes
payloadPassphrase Byron 'PaymentK XPub
k
        NetworkTag Word32
magic = NetworkDiscriminant Byron -> NetworkTag
forall (key :: Depth -> * -> *).
HasNetworkDiscriminant key =>
NetworkDiscriminant key -> NetworkTag
networkTag @Byron NetworkDiscriminant Byron
discrimination
        attrs :: [Encoding]
attrs = case NetworkDiscriminant Byron -> AddressDiscrimination
forall (key :: Depth -> * -> *).
HasNetworkDiscriminant key =>
NetworkDiscriminant key -> AddressDiscrimination
addressDiscrimination @Byron NetworkDiscriminant Byron
discrimination of
            AddressDiscrimination
RequiresNetworkTag ->
                [ ScrubbedBytes -> Word32 -> Word32 -> Encoding
CBOR.encodeDerivationPathAttr ScrubbedBytes
pwd Word32
acctIx Word32
addrIx
                , Word32 -> Encoding
CBOR.encodeProtocolMagicAttr Word32
magic
                ]
            AddressDiscrimination
RequiresNoTag ->
                [ ScrubbedBytes -> Word32 -> Word32 -> Encoding
CBOR.encodeDerivationPathAttr ScrubbedBytes
pwd Word32
acctIx Word32
addrIx
                ]

-- Re-export from 'Cardano.Address' to have it documented specialized in Haddock.
--
-- | Convert a public key to a payment 'Address' valid for the given
-- network discrimination.
--
-- @since 1.0.0
paymentAddress
    :: NetworkDiscriminant Byron
    -> Byron 'PaymentK XPub
    -> Address
paymentAddress :: NetworkDiscriminant Byron -> Byron 'PaymentK XPub -> Address
paymentAddress =
    NetworkDiscriminant Byron -> Byron 'PaymentK XPub -> Address
forall (key :: Depth -> * -> *).
PaymentAddress key =>
NetworkDiscriminant key -> key 'PaymentK XPub -> Address
Internal.paymentAddress

--
-- Network Discrimination
--

instance HasNetworkDiscriminant Byron where
    type NetworkDiscriminant Byron = (AddressDiscrimination, NetworkTag)
    addressDiscrimination :: NetworkDiscriminant Byron -> AddressDiscrimination
addressDiscrimination = NetworkDiscriminant Byron -> AddressDiscrimination
forall a b. (a, b) -> a
fst
    networkTag :: NetworkDiscriminant Byron -> NetworkTag
networkTag = NetworkDiscriminant Byron -> NetworkTag
forall a b. (a, b) -> b
snd

-- | 'NetworkDiscriminant' for Cardano MainNet & Byron
--
-- @since 2.0.0
byronMainnet :: NetworkDiscriminant Byron
byronMainnet :: NetworkDiscriminant Byron
byronMainnet = (AddressDiscrimination
RequiresNoTag, Word32 -> NetworkTag
NetworkTag Word32
764824073)

-- | 'NetworkDiscriminant' for Cardano Staging & Byron
--
-- @since 2.0.0
byronStaging :: NetworkDiscriminant Byron
byronStaging :: NetworkDiscriminant Byron
byronStaging = (AddressDiscrimination
RequiresNetworkTag, Word32 -> NetworkTag
NetworkTag Word32
633343913)

-- | 'NetworkDiscriminant' for Cardano TestNet & Byron
--
-- @since 2.0.0
byronTestnet :: NetworkDiscriminant Byron
byronTestnet :: NetworkDiscriminant Byron
byronTestnet = (AddressDiscrimination
RequiresNetworkTag, Word32 -> NetworkTag
NetworkTag Word32
1097911063)

--
-- Unsafe
--

-- | Backdoor for generating a new key from a raw 'XPrv'.
--
-- Note that the @depth@ is left open so that the caller gets to decide what type
-- of key this is. This is mostly for testing, in practice, seeds are used to
-- represent root keys, and one should 'genMasterKeyFromXPrv'
--
-- The first argument is a type-family 'DerivationPath' and its type depends on
-- the 'depth' of the key.
--
-- __examples:__
--
-- >>> liftXPrv rootPrv () prv
-- _ :: Byron RootK XPrv
--
-- >>> liftXPrv rootPrv minBound prv
-- _ :: Byron AccountK XPrv
--
-- >>> liftXPrv rootPrv (minBound, minBound) prv
-- _ :: Byron PaymentK XPrv
--
-- @since 2.0.0
liftXPrv
    :: XPub -- ^ A root public key
    -> DerivationPath depth
    -> XPrv
    -> Byron depth XPrv
liftXPrv :: XPub -> DerivationPath depth -> XPrv -> Byron depth XPrv
liftXPrv XPub
rootPub DerivationPath depth
derivationPath XPrv
getKey = Byron :: forall (depth :: Depth) key.
key -> DerivationPath depth -> ScrubbedBytes -> Byron depth key
Byron
    { XPrv
getKey :: XPrv
$sel:getKey:Byron :: XPrv
getKey
    , DerivationPath depth
derivationPath :: DerivationPath depth
$sel:derivationPath:Byron :: DerivationPath depth
derivationPath
    , $sel:payloadPassphrase:Byron :: ScrubbedBytes
payloadPassphrase = XPub -> ScrubbedBytes
hdPassphrase XPub
rootPub
    }
{-# DEPRECATED liftXPrv "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

-- | Backdoor for generating a new key from a raw 'XPub'.
--
-- Note that the @depth@ is left open so that the caller gets to decide what type
-- of key this is. This is mostly for testing, in practice, seeds are used to
-- represent root keys, and one should 'genMasterKeyFromXPrv'
--
-- see also 'liftXPrv'
--
-- @since 2.0.0
liftXPub
    :: XPub -- ^ A root public key
    -> DerivationPath depth
    -> XPub
    -> Byron depth XPub
liftXPub :: XPub -> DerivationPath depth -> XPub -> Byron depth XPub
liftXPub XPub
rootPub DerivationPath depth
derivationPath XPub
getKey = Byron :: forall (depth :: Depth) key.
key -> DerivationPath depth -> ScrubbedBytes -> Byron depth key
Byron
    { XPub
getKey :: XPub
$sel:getKey:Byron :: XPub
getKey
    , DerivationPath depth
derivationPath :: DerivationPath depth
$sel:derivationPath:Byron :: DerivationPath depth
derivationPath
    , $sel:payloadPassphrase:Byron :: ScrubbedBytes
payloadPassphrase = XPub -> ScrubbedBytes
hdPassphrase XPub
rootPub
    }
{-# DEPRECATED liftXPub "see 'Cardano.Address.Style.Icarus.Icarus'" #-}

--
-- Internal
--

-- The amount of entropy carried by a BIP-39 12-word mnemonic is 16 bytes.
minSeedLengthBytes :: Int
minSeedLengthBytes :: Int
minSeedLengthBytes = Int
16

-- Hash the seed entropy (generated from mnemonic) used to initiate a HD
-- wallet. This increases the key length to 34 bytes, selectKey is greater than the
-- minimum for 'generate' (32 bytes).
--
-- Note that our current implementation deviates from BIP-39 because we use a
-- hash function (Blake2b) rather than key stretching with PBKDF2.
--
-- There are two methods of hashing the seed entropy, for different use cases.
--
-- 1. Normal random derivation wallet seeds. The seed entropy is hashed using
--    Blake2b_256, inside a double CBOR serialization sandwich.
--
-- 2. Seeds for redeeming paper wallets. The seed entropy is hashed using
--    Blake2b_256, without any serialization.
hashSeed :: ScrubbedBytes -> ScrubbedBytes
hashSeed :: ScrubbedBytes -> ScrubbedBytes
hashSeed = ScrubbedBytes -> ScrubbedBytes
serialize (ScrubbedBytes -> ScrubbedBytes)
-> (ScrubbedBytes -> ScrubbedBytes)
-> ScrubbedBytes
-> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ScrubbedBytes
blake2b256 (ScrubbedBytes -> ScrubbedBytes)
-> (ScrubbedBytes -> ScrubbedBytes)
-> ScrubbedBytes
-> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ScrubbedBytes
serialize
  where
    serialize :: ScrubbedBytes -> ScrubbedBytes
serialize = ByteString -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> ScrubbedBytes)
-> (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
cbor (ByteString -> ByteString)
-> (ScrubbedBytes -> ByteString) -> ScrubbedBytes -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScrubbedBytes -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
    cbor :: ByteString -> ByteString
cbor = Encoding -> ByteString
CBOR.toStrictByteString (Encoding -> ByteString)
-> (ByteString -> Encoding) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Encoding
CBOR.encodeBytes

-- Hash a byte string through blake2b 256
blake2b256 :: ScrubbedBytes -> ScrubbedBytes
blake2b256 :: ScrubbedBytes -> ScrubbedBytes
blake2b256 = Digest Blake2b_256 -> ScrubbedBytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (Digest Blake2b_256 -> ScrubbedBytes)
-> (ScrubbedBytes -> Digest Blake2b_256)
-> ScrubbedBytes
-> ScrubbedBytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteArrayAccess ScrubbedBytes, HashAlgorithm Blake2b_256) =>
ScrubbedBytes -> Digest Blake2b_256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash @ScrubbedBytes @Blake2b_256

-- Derive a symmetric key for encrypting and authenticating the address
-- derivation path. PBKDF2 encryption using HMAC with the hash algorithm SHA512
-- is employed.
hdPassphrase :: XPub -> ScrubbedBytes
hdPassphrase :: XPub -> ScrubbedBytes
hdPassphrase XPub
masterKey =
    PRF ByteString
-> Parameters -> ByteString -> ByteString -> ScrubbedBytes
forall password salt ba.
(ByteArrayAccess password, ByteArrayAccess salt, ByteArray ba) =>
PRF password -> Parameters -> password -> salt -> ba
PBKDF2.generate
    (SHA512 -> PRF ByteString
forall a password.
(HashAlgorithm a, ByteArrayAccess password) =>
a -> PRF password
PBKDF2.prfHMAC SHA512
SHA512)
    (Int -> Int -> Parameters
PBKDF2.Parameters Int
500 Int
32)
    (XPub -> ByteString
xpubToBytes XPub
masterKey)
    (ByteString
"address-hashing" :: ByteString)