{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Copyright: © 2018-2020 IOHK
-- License: Apache-2.0
--
-- Primitives for performing address derivation for some given schemes. This is
-- where most of the crypto happens in the wallet and, it is quite important to
-- ensure that the implementations match with other Cardano wallets
-- (like cardano-sl, Yoroi/Icarus, or cardano-cli)
--
-- The actual implementations are in the following modules:
--
--  * "Cardano.Wallet.Primitive.AddressDerivation.Shelley"
--  * "Cardano.Wallet.Primitive.AddressDerivation.Byron"

module Cardano.Wallet.Primitive.AddressDerivation
    (
    -- * HD Derivation
      Depth (..)
    , Index (..)
    , Role (..)
    , roleVal
    , utxoExternal
    , utxoInternal
    , mutableAccount
    , zeroAccount
    , stakeDerivationPath
    , DerivationType (..)
    , HardDerivation (..)
    , SoftDerivation (..)
    , DerivationPrefix (..)
    , DerivationIndex (..)
    , liftIndex
    , hashVerificationKey

    -- * Delegation
    , RewardAccount (..)
    , ToRewardAccount(..)
    , deriveRewardAccount

    -- * Helpers
    , hex
    , fromHex

    -- * Network Discrimination
    , NetworkDiscriminant (..)
    , NetworkDiscriminantVal
    , networkDiscriminantVal

    -- * Backends Interoperability
    , PaymentAddress(..)
    , DelegationAddress(..)
    , BoundedAddressLength (..)
    , WalletKey(..)
    , PersistPrivateKey(..)
    , PersistPublicKey(..)
    , MkKeyFingerprint(..)
    , ErrMkKeyFingerprint(..)
    , KeyFingerprint(..)
    ) where

import Prelude

import Cardano.Address.Derivation
    ( XPrv, XPub, xpubPublicKey )
import Cardano.Address.Script
    ( KeyHash (..), KeyRole )
import Cardano.Mnemonic
    ( SomeMnemonic )
import Cardano.Wallet.Primitive.Passphrase.Types
    ( Passphrase (..), PassphraseHash (..), PassphraseScheme )
import Cardano.Wallet.Primitive.Types.Address
    ( Address (..) )
import Cardano.Wallet.Primitive.Types.RewardAccount
    ( RewardAccount (..) )
import Control.Applicative
    ( (<|>) )
import Control.DeepSeq
    ( NFData )
import Control.Monad
    ( (>=>) )
import Crypto.Hash
    ( Digest, HashAlgorithm )
import Crypto.Hash.Utils
    ( blake2b224 )
import Data.ByteArray
    ( ByteArray, ByteArrayAccess )
import Data.ByteArray.Encoding
    ( Base (..), convertFromBase, convertToBase )
import Data.ByteString
    ( ByteString )
import Data.Kind
    ( Type )
import Data.List.NonEmpty
    ( NonEmpty (..) )
import Data.Maybe
    ( fromMaybe )
import Data.Proxy
    ( Proxy (..) )
import Data.Scientific
    ( Scientific, toBoundedInteger )
import Data.String
    ( fromString )
import Data.Text
    ( Text )
import Data.Text.Class
    ( CaseStyle (..)
    , FromText (..)
    , TextDecodingError (..)
    , ToText (..)
    , fromTextToBoundedEnum
    , toTextFromBoundedEnum
    )
import Data.Type.Equality
    ( (:~:) (..), testEquality )
import Data.Word
    ( Word32 )
import Fmt
    ( Buildable (..) )
import GHC.Generics
    ( Generic )
import GHC.TypeLits
    ( KnownNat, Nat, Symbol, natVal )
import Quiet
    ( Quiet (..) )
import Safe
    ( readMay, toEnumMay )
import Type.Reflection
    ( Typeable, typeRep )

import qualified Data.Text as T

{-------------------------------------------------------------------------------
                                HD Hierarchy
-------------------------------------------------------------------------------}

-- | Typically used as a phantom type parameter, a witness to the type of the
-- key being used.
--
-- For example, @key 'RootK XPrv@, represents the private key at the root of the
-- HD hierarchy.
--
-- According to BIP-0044 / CIP-1852, we have the following keys in our HD
-- hierarchy:
--
-- @m | purpose' | cointype' | account' | role | address@
--
-- Plus, we also have script keys (which are used in shared wallets) and policy
-- keys (which are used in minting and burning).
data Depth
    = RootK
    | PurposeK
    | CoinTypeK
    | AccountK
    | RoleK
    | AddressK
    | ScriptK
    | PolicyK

-- | Marker for addresses type engaged. We want to handle four cases here.
-- The first two are pertinent to UTxO accounting,
-- next handles rewards from participation in staking
-- the last one is used for getting verification keys used in scripts.
-- (a) external chain is used for addresses that are part of the 'advertised'
--     targets of a given transaction
-- (b) internal change is for addresses used to handle the change of a
--     the transaction within a given wallet
-- (c) the addresses for a reward account
-- (d) used for keys used inside scripts
data Role
    = UtxoExternal
    | UtxoInternal
    | MutableAccount
    deriving ((forall x. Role -> Rep Role x)
-> (forall x. Rep Role x -> Role) -> Generic Role
forall x. Rep Role x -> Role
forall x. Role -> Rep Role x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Role x -> Role
$cfrom :: forall x. Role -> Rep Role x
Generic, Typeable, Int -> Role -> ShowS
[Role] -> ShowS
Role -> String
(Int -> Role -> ShowS)
-> (Role -> String) -> ([Role] -> ShowS) -> Show Role
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Role] -> ShowS
$cshowList :: [Role] -> ShowS
show :: Role -> String
$cshow :: Role -> String
showsPrec :: Int -> Role -> ShowS
$cshowsPrec :: Int -> Role -> ShowS
Show, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c== :: Role -> Role -> Bool
Eq, Eq Role
Eq Role
-> (Role -> Role -> Ordering)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Bool)
-> (Role -> Role -> Role)
-> (Role -> Role -> Role)
-> Ord Role
Role -> Role -> Bool
Role -> Role -> Ordering
Role -> Role -> Role
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Role -> Role -> Role
$cmin :: Role -> Role -> Role
max :: Role -> Role -> Role
$cmax :: Role -> Role -> Role
>= :: Role -> Role -> Bool
$c>= :: Role -> Role -> Bool
> :: Role -> Role -> Bool
$c> :: Role -> Role -> Bool
<= :: Role -> Role -> Bool
$c<= :: Role -> Role -> Bool
< :: Role -> Role -> Bool
$c< :: Role -> Role -> Bool
compare :: Role -> Role -> Ordering
$ccompare :: Role -> Role -> Ordering
$cp1Ord :: Eq Role
Ord, Role
Role -> Role -> Bounded Role
forall a. a -> a -> Bounded a
maxBound :: Role
$cmaxBound :: Role
minBound :: Role
$cminBound :: Role
Bounded)

instance NFData Role

-- Not deriving 'Enum' because this could have a dramatic impact if we were
-- to assign the wrong index to the corresponding constructor (by swapping
-- around the constructor above for instance).
instance Enum Role where
    toEnum :: Int -> Role
toEnum = \case
        Int
0 -> Role
UtxoExternal
        Int
1 -> Role
UtxoInternal
        Int
2 -> Role
MutableAccount
        Int
_ -> String -> Role
forall a. HasCallStack => String -> a
error String
"Role.toEnum: bad argument"
    fromEnum :: Role -> Int
fromEnum = \case
        Role
UtxoExternal -> Int
0
        Role
UtxoInternal -> Int
1
        Role
MutableAccount -> Int
2

instance ToText Role where
    toText :: Role -> Text
toText = CaseStyle -> Role -> Text
forall a. (Bounded a, Enum a, Show a) => CaseStyle -> a -> Text
toTextFromBoundedEnum CaseStyle
SnakeLowerCase

instance FromText Role where
    fromText :: Text -> Either TextDecodingError Role
fromText = CaseStyle -> Text -> Either TextDecodingError Role
forall a.
(Bounded a, Enum a, Show a) =>
CaseStyle -> Text -> Either TextDecodingError a
fromTextToBoundedEnum CaseStyle
SnakeLowerCase

-- | Bring a 'Role' type back to the term-level. This requires a type
-- application and either a scoped type variable, or an explicit passing of a
-- 'Role'.
--
-- >>> roleVal @'UtxoExternal
-- UtxoExternal
--
-- >>> roleVal @chain
-- ...
roleVal :: forall (c :: Role). Typeable c => Role
roleVal :: Role
roleVal = Role -> Maybe Role -> Role
forall a. a -> Maybe a -> a
fromMaybe (String -> Role
forall a. HasCallStack => String -> a
error (String -> Role) -> String -> Role
forall a b. (a -> b) -> a -> b
$ String
"role: unmatched type" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TypeRep c -> String
forall a. Show a => a -> String
show (Typeable c => TypeRep c
forall k (a :: k). Typeable a => TypeRep a
typeRep @c))
       (Maybe Role
tryUtxoExternal Maybe Role -> Maybe Role -> Maybe Role
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Role
tryUtxoInternal Maybe Role -> Maybe Role -> Maybe Role
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Role
tryMutableAccount)
  where
    tryUtxoExternal :: Maybe Role
tryUtxoExternal =
        case TypeRep c -> TypeRep 'UtxoExternal -> Maybe (c :~: 'UtxoExternal)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (Typeable c => TypeRep c
forall k (a :: k). Typeable a => TypeRep a
typeRep @c) (Typeable 'UtxoExternal => TypeRep 'UtxoExternal
forall k (a :: k). Typeable a => TypeRep a
typeRep @'UtxoExternal) of
            Just c :~: 'UtxoExternal
Refl  -> Role -> Maybe Role
forall a. a -> Maybe a
Just Role
UtxoExternal
            Maybe (c :~: 'UtxoExternal)
Nothing -> Maybe Role
forall a. Maybe a
Nothing
    tryUtxoInternal :: Maybe Role
tryUtxoInternal =
        case TypeRep c -> TypeRep 'UtxoInternal -> Maybe (c :~: 'UtxoInternal)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (Typeable c => TypeRep c
forall k (a :: k). Typeable a => TypeRep a
typeRep @c) (Typeable 'UtxoInternal => TypeRep 'UtxoInternal
forall k (a :: k). Typeable a => TypeRep a
typeRep @'UtxoInternal) of
            Just c :~: 'UtxoInternal
Refl  -> Role -> Maybe Role
forall a. a -> Maybe a
Just Role
UtxoInternal
            Maybe (c :~: 'UtxoInternal)
Nothing -> Maybe Role
forall a. Maybe a
Nothing
    tryMutableAccount :: Maybe Role
tryMutableAccount =
        case TypeRep c
-> TypeRep 'MutableAccount -> Maybe (c :~: 'MutableAccount)
forall k (f :: k -> *) (a :: k) (b :: k).
TestEquality f =>
f a -> f b -> Maybe (a :~: b)
testEquality (Typeable c => TypeRep c
forall k (a :: k). Typeable a => TypeRep a
typeRep @c) (Typeable 'MutableAccount => TypeRep 'MutableAccount
forall k (a :: k). Typeable a => TypeRep a
typeRep @'MutableAccount) of
            Just c :~: 'MutableAccount
Refl  -> Role -> Maybe Role
forall a. a -> Maybe a
Just Role
MutableAccount
            Maybe (c :~: 'MutableAccount)
Nothing -> Maybe Role
forall a. Maybe a
Nothing

-- | smart-constructor for getting a derivation index that refers to external
-- utxo.
utxoExternal :: Index 'Soft 'RoleK
utxoExternal :: Index 'Soft 'RoleK
utxoExternal = Int -> Index 'Soft 'RoleK
forall a. Enum a => Int -> a
toEnum (Int -> Index 'Soft 'RoleK) -> Int -> Index 'Soft 'RoleK
forall a b. (a -> b) -> a -> b
$ Role -> Int
forall a. Enum a => a -> Int
fromEnum Role
UtxoExternal

-- | smart-constructor for getting a derivation index that refers to internal
-- utxo.
utxoInternal :: Index 'Soft 'RoleK
utxoInternal :: Index 'Soft 'RoleK
utxoInternal = Int -> Index 'Soft 'RoleK
forall a. Enum a => Int -> a
toEnum (Int -> Index 'Soft 'RoleK) -> Int -> Index 'Soft 'RoleK
forall a b. (a -> b) -> a -> b
$ Role -> Int
forall a. Enum a => a -> Int
fromEnum Role
UtxoInternal

-- | smart-constructor for getting a derivation index that refers to stake
-- key level (a.k.a mutable account)
mutableAccount :: Index 'Soft 'RoleK
mutableAccount :: Index 'Soft 'RoleK
mutableAccount = Int -> Index 'Soft 'RoleK
forall a. Enum a => Int -> a
toEnum (Int -> Index 'Soft 'RoleK) -> Int -> Index 'Soft 'RoleK
forall a b. (a -> b) -> a -> b
$ Role -> Int
forall a. Enum a => a -> Int
fromEnum Role
MutableAccount

zeroAccount :: Index 'Soft 'AddressK
zeroAccount :: Index 'Soft 'AddressK
zeroAccount = Index 'Soft 'AddressK
forall a. Bounded a => a
minBound

-- | Full path to the stake key. There's only one.
stakeDerivationPath :: DerivationPrefix -> NonEmpty DerivationIndex
stakeDerivationPath :: DerivationPrefix -> NonEmpty DerivationIndex
stakeDerivationPath (DerivationPrefix (Index 'Hardened 'PurposeK
purpose, Index 'Hardened 'CoinTypeK
coin, Index 'Hardened 'AccountK
acc)) =
    (Index 'Hardened 'PurposeK -> DerivationIndex
forall (t :: DerivationType) (l :: Depth).
Index t l -> DerivationIndex
fromIndex Index 'Hardened 'PurposeK
purpose) DerivationIndex -> [DerivationIndex] -> NonEmpty DerivationIndex
forall a. a -> [a] -> NonEmpty a
:| [
      Index 'Hardened 'CoinTypeK -> DerivationIndex
forall (t :: DerivationType) (l :: Depth).
Index t l -> DerivationIndex
fromIndex Index 'Hardened 'CoinTypeK
coin
    , Index 'Hardened 'AccountK -> DerivationIndex
forall (t :: DerivationType) (l :: Depth).
Index t l -> DerivationIndex
fromIndex Index 'Hardened 'AccountK
acc
    , Index 'Soft 'RoleK -> DerivationIndex
forall (t :: DerivationType) (l :: Depth).
Index t l -> DerivationIndex
fromIndex Index 'Soft 'RoleK
mutableAccount
    , Index 'Soft 'AddressK -> DerivationIndex
forall (t :: DerivationType) (l :: Depth).
Index t l -> DerivationIndex
fromIndex Index 'Soft 'AddressK
zeroAccount]
  where
    fromIndex :: Index t l -> DerivationIndex
    fromIndex :: Index t l -> DerivationIndex
fromIndex = Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex)
-> (Index t l -> Word32) -> Index t l -> DerivationIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index t l -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex

-- | A thin wrapper around derivation indexes. This can be used to represent
-- derivation path as homogeneous lists of 'DerivationIndex'. This is slightly
-- more convenient than having to carry heterogeneous lists of 'Index depth type'
-- and works fine because:
--
-- 1. The 'depth' matters not because what the depth captures is actually the
--    position of the index in that list. It makes sense to carry at the type
--    level when manipulating standalone indexes to avoid mistakes, but when
--    treating them as a part of a list it is redundant.
--
-- 2. The derivationType is captured by representing indexes as plain Word32.
--    The Soft / Hardened notation is for easing human-readability but in the
--    end, a soft index is simply a value < 2^31, whereas a "hardened" index is
--    simply a value >= 2^31. Therefore, instead of representing indexes as
--    derivationType + relative index within 0 and 2^31, we can represent them
--    as just an index between 0 and 2^32, which is what DerivationIndex does.
newtype DerivationIndex
    = DerivationIndex { DerivationIndex -> Word32
getDerivationIndex :: Word32 }
    deriving (DerivationIndex -> DerivationIndex -> Bool
(DerivationIndex -> DerivationIndex -> Bool)
-> (DerivationIndex -> DerivationIndex -> Bool)
-> Eq DerivationIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DerivationIndex -> DerivationIndex -> Bool
$c/= :: DerivationIndex -> DerivationIndex -> Bool
== :: DerivationIndex -> DerivationIndex -> Bool
$c== :: DerivationIndex -> DerivationIndex -> Bool
Eq, Eq DerivationIndex
Eq DerivationIndex
-> (DerivationIndex -> DerivationIndex -> Ordering)
-> (DerivationIndex -> DerivationIndex -> Bool)
-> (DerivationIndex -> DerivationIndex -> Bool)
-> (DerivationIndex -> DerivationIndex -> Bool)
-> (DerivationIndex -> DerivationIndex -> Bool)
-> (DerivationIndex -> DerivationIndex -> DerivationIndex)
-> (DerivationIndex -> DerivationIndex -> DerivationIndex)
-> Ord DerivationIndex
DerivationIndex -> DerivationIndex -> Bool
DerivationIndex -> DerivationIndex -> Ordering
DerivationIndex -> DerivationIndex -> DerivationIndex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DerivationIndex -> DerivationIndex -> DerivationIndex
$cmin :: DerivationIndex -> DerivationIndex -> DerivationIndex
max :: DerivationIndex -> DerivationIndex -> DerivationIndex
$cmax :: DerivationIndex -> DerivationIndex -> DerivationIndex
>= :: DerivationIndex -> DerivationIndex -> Bool
$c>= :: DerivationIndex -> DerivationIndex -> Bool
> :: DerivationIndex -> DerivationIndex -> Bool
$c> :: DerivationIndex -> DerivationIndex -> Bool
<= :: DerivationIndex -> DerivationIndex -> Bool
$c<= :: DerivationIndex -> DerivationIndex -> Bool
< :: DerivationIndex -> DerivationIndex -> Bool
$c< :: DerivationIndex -> DerivationIndex -> Bool
compare :: DerivationIndex -> DerivationIndex -> Ordering
$ccompare :: DerivationIndex -> DerivationIndex -> Ordering
$cp1Ord :: Eq DerivationIndex
Ord, (forall x. DerivationIndex -> Rep DerivationIndex x)
-> (forall x. Rep DerivationIndex x -> DerivationIndex)
-> Generic DerivationIndex
forall x. Rep DerivationIndex x -> DerivationIndex
forall x. DerivationIndex -> Rep DerivationIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DerivationIndex x -> DerivationIndex
$cfrom :: forall x. DerivationIndex -> Rep DerivationIndex x
Generic)
    deriving Int -> DerivationIndex -> ShowS
[DerivationIndex] -> ShowS
DerivationIndex -> String
(Int -> DerivationIndex -> ShowS)
-> (DerivationIndex -> String)
-> ([DerivationIndex] -> ShowS)
-> Show DerivationIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DerivationIndex] -> ShowS
$cshowList :: [DerivationIndex] -> ShowS
show :: DerivationIndex -> String
$cshow :: DerivationIndex -> String
showsPrec :: Int -> DerivationIndex -> ShowS
$cshowsPrec :: Int -> DerivationIndex -> ShowS
Show via (Quiet DerivationIndex)

instance NFData DerivationIndex

instance ToText DerivationIndex where
    toText :: DerivationIndex -> Text
toText (DerivationIndex Word32
ix)
        | Word32
ix Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
firstHardened  = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ 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 = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Word32 -> String
forall a. Show a => a -> String
show Word32
ix
      where
        firstHardened :: Word32
firstHardened = Index 'Hardened Any -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex @'Hardened Index 'Hardened Any
forall a. Bounded a => a
minBound

instance FromText DerivationIndex where
    fromText :: Text -> Either TextDecodingError DerivationIndex
fromText Text
source =
        if Text
"H" Text -> Text -> Bool
`T.isSuffixOf` Text
source then do
            DerivationIndex Word32
ix <- Text -> Either TextDecodingError Scientific
castNumber (Text -> Text
T.init Text
source) Either TextDecodingError Scientific
-> (Scientific -> Either TextDecodingError DerivationIndex)
-> Either TextDecodingError DerivationIndex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Either TextDecodingError DerivationIndex
parseAsScientific
            DerivationIndex -> Either TextDecodingError DerivationIndex
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DerivationIndex -> Either TextDecodingError DerivationIndex)
-> DerivationIndex -> Either TextDecodingError DerivationIndex
forall a b. (a -> b) -> a -> b
$ Word32 -> DerivationIndex
DerivationIndex (Word32 -> DerivationIndex) -> Word32 -> DerivationIndex
forall a b. (a -> b) -> a -> b
$ Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
firstHardened
        else
            Text -> Either TextDecodingError Scientific
castNumber Text
source Either TextDecodingError Scientific
-> (Scientific -> Either TextDecodingError DerivationIndex)
-> Either TextDecodingError DerivationIndex
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Scientific -> Either TextDecodingError DerivationIndex
parseAsScientific
      where
        firstHardened :: Word32
firstHardened = Index 'Hardened Any -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex @'Hardened Index 'Hardened Any
forall a. Bounded a => a
minBound

        errMalformed :: TextDecodingError
errMalformed = String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"A derivation index must be a natural number between"
            , Word32 -> String
forall a. Show a => a -> String
show (Index 'Soft Any -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex @'Soft Index 'Soft Any
forall a. Bounded a => a
minBound)
            , String
"and"
            , Word32 -> String
forall a. Show a => a -> String
show (Index 'Soft Any -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex @'Soft Index 'Soft Any
forall a. Bounded a => a
maxBound)
            , String
"with an optional 'H' suffix (e.g. '1815H' or '44')."
            , String
"Indexes without suffixes are called 'Soft'"
            , String
"Indexes with suffixes are called 'Hardened'."
            ]

        parseAsScientific :: Scientific -> Either TextDecodingError DerivationIndex
        parseAsScientific :: Scientific -> Either TextDecodingError DerivationIndex
parseAsScientific Scientific
x =
            case Scientific -> Maybe Word32
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
toBoundedInteger Scientific
x of
                Just Word32
ix | Word32
ix Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
firstHardened ->
                    DerivationIndex -> Either TextDecodingError DerivationIndex
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DerivationIndex -> Either TextDecodingError DerivationIndex)
-> DerivationIndex -> Either TextDecodingError DerivationIndex
forall a b. (a -> b) -> a -> b
$ Word32 -> DerivationIndex
DerivationIndex Word32
ix
                Maybe Word32
_ ->
                    TextDecodingError -> Either TextDecodingError DerivationIndex
forall a b. a -> Either a b
Left TextDecodingError
errMalformed

        castNumber :: Text -> Either TextDecodingError Scientific
        castNumber :: Text -> Either TextDecodingError Scientific
castNumber Text
txt =
            case String -> Maybe Scientific
forall a. Read a => String -> Maybe a
readMay (Text -> String
T.unpack Text
txt) of
                Maybe Scientific
Nothing ->
                    TextDecodingError -> Either TextDecodingError Scientific
forall a b. a -> Either a b
Left TextDecodingError
errMalformed
                Just Scientific
s ->
                    Scientific -> Either TextDecodingError Scientific
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
s

-- | A derivation index, with phantom-types to disambiguate derivation type.
--
-- @
-- let accountIx = Index 'Hardened 'AccountK
-- let addressIx = Index 'Soft 'AddressK
-- @
newtype Index (derivationType :: DerivationType) (level :: Depth) = Index
    { Index derivationType level -> Word32
getIndex :: Word32 }
    deriving stock ((forall x.
 Index derivationType level -> Rep (Index derivationType level) x)
-> (forall x.
    Rep (Index derivationType level) x -> Index derivationType level)
-> Generic (Index derivationType level)
forall x.
Rep (Index derivationType level) x -> Index derivationType level
forall x.
Index derivationType level -> Rep (Index derivationType level) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (derivationType :: DerivationType) (level :: Depth) x.
Rep (Index derivationType level) x -> Index derivationType level
forall (derivationType :: DerivationType) (level :: Depth) x.
Index derivationType level -> Rep (Index derivationType level) x
$cto :: forall (derivationType :: DerivationType) (level :: Depth) x.
Rep (Index derivationType level) x -> Index derivationType level
$cfrom :: forall (derivationType :: DerivationType) (level :: Depth) x.
Index derivationType level -> Rep (Index derivationType level) x
Generic, Int -> Index derivationType level -> ShowS
[Index derivationType level] -> ShowS
Index derivationType level -> String
(Int -> Index derivationType level -> ShowS)
-> (Index derivationType level -> String)
-> ([Index derivationType level] -> ShowS)
-> Show (Index derivationType level)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (derivationType :: DerivationType) (level :: Depth).
Int -> Index derivationType level -> ShowS
forall (derivationType :: DerivationType) (level :: Depth).
[Index derivationType level] -> ShowS
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> String
showList :: [Index derivationType level] -> ShowS
$cshowList :: forall (derivationType :: DerivationType) (level :: Depth).
[Index derivationType level] -> ShowS
show :: Index derivationType level -> String
$cshow :: forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> String
showsPrec :: Int -> Index derivationType level -> ShowS
$cshowsPrec :: forall (derivationType :: DerivationType) (level :: Depth).
Int -> Index derivationType level -> ShowS
Show, Index derivationType level -> Index derivationType level -> Bool
(Index derivationType level -> Index derivationType level -> Bool)
-> (Index derivationType level
    -> Index derivationType level -> Bool)
-> Eq (Index derivationType level)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Index derivationType level -> Bool
/= :: Index derivationType level -> Index derivationType level -> Bool
$c/= :: forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Index derivationType level -> Bool
== :: Index derivationType level -> Index derivationType level -> Bool
$c== :: forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Index derivationType level -> Bool
Eq, Eq (Index derivationType level)
Eq (Index derivationType level)
-> (Index derivationType level
    -> Index derivationType level -> Ordering)
-> (Index derivationType level
    -> Index derivationType level -> Bool)
-> (Index derivationType level
    -> Index derivationType level -> Bool)
-> (Index derivationType level
    -> Index derivationType level -> Bool)
-> (Index derivationType level
    -> Index derivationType level -> Bool)
-> (Index derivationType level
    -> Index derivationType level -> Index derivationType level)
-> (Index derivationType level
    -> Index derivationType level -> Index derivationType level)
-> Ord (Index derivationType level)
Index derivationType level -> Index derivationType level -> Bool
Index derivationType level
-> Index derivationType level -> Ordering
Index derivationType level
-> Index derivationType level -> Index derivationType level
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
forall (derivationType :: DerivationType) (level :: Depth).
Eq (Index derivationType level)
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Index derivationType level -> Bool
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level
-> Index derivationType level -> Ordering
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level
-> Index derivationType level -> Index derivationType level
min :: Index derivationType level
-> Index derivationType level -> Index derivationType level
$cmin :: forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level
-> Index derivationType level -> Index derivationType level
max :: Index derivationType level
-> Index derivationType level -> Index derivationType level
$cmax :: forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level
-> Index derivationType level -> Index derivationType level
>= :: Index derivationType level -> Index derivationType level -> Bool
$c>= :: forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Index derivationType level -> Bool
> :: Index derivationType level -> Index derivationType level -> Bool
$c> :: forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Index derivationType level -> Bool
<= :: Index derivationType level -> Index derivationType level -> Bool
$c<= :: forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Index derivationType level -> Bool
< :: Index derivationType level -> Index derivationType level -> Bool
$c< :: forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Index derivationType level -> Bool
compare :: Index derivationType level
-> Index derivationType level -> Ordering
$ccompare :: forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level
-> Index derivationType level -> Ordering
$cp1Ord :: forall (derivationType :: DerivationType) (level :: Depth).
Eq (Index derivationType level)
Ord)

instance NFData (Index derivationType level)

instance Bounded (Index 'Hardened level) where
    minBound :: Index 'Hardened level
minBound = Word32 -> Index 'Hardened level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index Word32
0x80000000
    maxBound :: Index 'Hardened level
maxBound = Word32 -> Index 'Hardened level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index Word32
forall a. Bounded a => a
maxBound

instance Bounded (Index 'Soft level) where
    minBound :: Index 'Soft level
minBound = Word32 -> Index 'Soft level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index Word32
forall a. Bounded a => a
minBound
    maxBound :: Index 'Soft level
maxBound = let (Index Word32
ix) = Bounded (Index 'Hardened Any) => Index 'Hardened Any
forall a. Bounded a => a
minBound @(Index 'Hardened _) in Word32 -> Index 'Soft level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index (Word32
ix Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1)

instance Bounded (Index 'WholeDomain level) where
    minBound :: Index 'WholeDomain level
minBound = Word32 -> Index 'WholeDomain level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index Word32
forall a. Bounded a => a
minBound
    maxBound :: Index 'WholeDomain level
maxBound = Word32 -> Index 'WholeDomain level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index Word32
forall a. Bounded a => a
maxBound

instance Enum (Index 'Hardened level) where
    fromEnum :: Index 'Hardened level -> Int
fromEnum (Index Word32
ix) = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ix
    toEnum :: Int -> Index 'Hardened level
toEnum Int
ix
        | Word32 -> Index 'Hardened Any
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix) Index 'Hardened Any -> Index 'Hardened Any -> Bool
forall a. Ord a => a -> a -> Bool
< Bounded (Index 'Hardened Any) => Index 'Hardened Any
forall a. Bounded a => a
minBound @(Index 'Hardened _) =
            String -> Index 'Hardened level
forall a. HasCallStack => String -> a
error String
"Index@Hardened.toEnum: bad argument"
        | Bool
otherwise =
            Word32 -> Index 'Hardened level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix)

instance Enum (Index 'Soft level) where
    fromEnum :: Index 'Soft level -> Int
fromEnum (Index Word32
ix) = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ix
    toEnum :: Int -> Index 'Soft level
toEnum Int
ix
        | Word32 -> Index 'Soft Any
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix) Index 'Soft Any -> Index 'Soft Any -> Bool
forall a. Ord a => a -> a -> Bool
> Bounded (Index 'Soft Any) => Index 'Soft Any
forall a. Bounded a => a
maxBound @(Index 'Soft _) =
            String -> Index 'Soft level
forall a. HasCallStack => String -> a
error String
"Index@Soft.toEnum: bad argument"
        | Bool
otherwise =
            Word32 -> Index 'Soft level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix)

instance Enum (Index 'WholeDomain level) where
    fromEnum :: Index 'WholeDomain level -> Int
fromEnum (Index Word32
ix) = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
ix
    toEnum :: Int -> Index 'WholeDomain level
toEnum Int
ix
        | Word32 -> Index 'WholeDomain Any
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix) Index 'WholeDomain Any -> Index 'WholeDomain Any -> Bool
forall a. Ord a => a -> a -> Bool
> Bounded (Index 'WholeDomain Any) => Index 'WholeDomain Any
forall a. Bounded a => a
maxBound @(Index 'WholeDomain _) =
            String -> Index 'WholeDomain level
forall a. HasCallStack => String -> a
error String
"Index@WholeDomain.toEnum: bad argument"
        | Bool
otherwise =
            Word32 -> Index 'WholeDomain level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
ix)

instance Buildable (Index derivationType level) where
    build :: Index derivationType level -> Builder
build (Index Word32
ix) = String -> Builder
forall a. IsString a => String -> a
fromString (Word32 -> String
forall a. Show a => a -> String
show Word32
ix)

instance
  ( Enum (Index derivation level)
  , Bounded (Index derivation level)
  ) => FromText (Index derivation level) where
    fromText :: Text -> Either TextDecodingError (Index derivation level)
fromText = Text -> Either TextDecodingError Int
forall a. FromText a => Text -> Either TextDecodingError a
fromText (Text -> Either TextDecodingError Int)
-> (Int -> Either TextDecodingError (Index derivation level))
-> Text
-> Either TextDecodingError (Index derivation level)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \Int
n -> case Int -> Maybe (Index derivation level)
forall a. (Enum a, Bounded a) => Int -> Maybe a
toEnumMay Int
n of
        Just Index derivation level
ix -> Index derivation level
-> Either TextDecodingError (Index derivation level)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Index derivation level
ix
        Maybe (Index derivation level)
Nothing -> TextDecodingError
-> Either TextDecodingError (Index derivation level)
forall a b. a -> Either a b
Left (TextDecodingError
 -> Either TextDecodingError (Index derivation level))
-> TextDecodingError
-> Either TextDecodingError (Index derivation level)
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError (String -> TextDecodingError) -> String -> TextDecodingError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
            [ String
"Couldn't parse derivation index. Expected an integer between"
            , Index derivation level -> String
forall a. Show a => a -> String
show (Bounded (Index derivation level) => Index derivation level
forall a. Bounded a => a
minBound @(Index derivation level))
            , String
"and"
            , Index derivation level -> String
forall a. Show a => a -> String
show (Bounded (Index derivation level) => Index derivation level
forall a. Bounded a => a
maxBound @(Index derivation level))
            ]

-- Safe coercion to WholeDomain from smaller domains.
class LiftIndex derivation where
    liftIndex :: Index derivation level -> Index 'WholeDomain level

instance LiftIndex 'Hardened where
    liftIndex :: Index 'Hardened level -> Index 'WholeDomain level
liftIndex (Index Word32
ix) = Word32 -> Index 'WholeDomain level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index Word32
ix

instance LiftIndex 'Soft where
    liftIndex :: Index 'Soft level -> Index 'WholeDomain level
liftIndex (Index Word32
ix) = Word32 -> Index 'WholeDomain level
forall (derivationType :: DerivationType) (level :: Depth).
Word32 -> Index derivationType level
Index Word32
ix

-- | Each 'SeqState' is like a bucket of addresses associated with an 'account'.
-- An 'account' corresponds to a subset of an HD tree as defined in BIP-0039.
--
-- cardano-wallet implements two similar HD schemes on top of BIP-0039 that are:
--
-- - BIP-0044 (for so-called Icarus wallets)
-- - CIP-1815 (for so-called Shelley and Jormungandr wallets)
--
-- Both scheme works by considering 5 levels of derivation from an initial root
-- key (see also 'Depth' from Cardano.Wallet.Primitive.AddressDerivation). A
-- SeqState keeps track of indexes from the two last levels of a derivation
-- branch. The 'DerivationPrefix' defines the first three indexes chosen for
-- this particular 'SeqState'.
newtype DerivationPrefix = DerivationPrefix
    ( Index 'Hardened 'PurposeK
    , Index 'Hardened 'CoinTypeK
    , Index 'Hardened 'AccountK
    ) deriving (Int -> DerivationPrefix -> ShowS
[DerivationPrefix] -> ShowS
DerivationPrefix -> String
(Int -> DerivationPrefix -> ShowS)
-> (DerivationPrefix -> String)
-> ([DerivationPrefix] -> ShowS)
-> Show DerivationPrefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DerivationPrefix] -> ShowS
$cshowList :: [DerivationPrefix] -> ShowS
show :: DerivationPrefix -> String
$cshow :: DerivationPrefix -> String
showsPrec :: Int -> DerivationPrefix -> ShowS
$cshowsPrec :: Int -> DerivationPrefix -> ShowS
Show, (forall x. DerivationPrefix -> Rep DerivationPrefix x)
-> (forall x. Rep DerivationPrefix x -> DerivationPrefix)
-> Generic DerivationPrefix
forall x. Rep DerivationPrefix x -> DerivationPrefix
forall x. DerivationPrefix -> Rep DerivationPrefix x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DerivationPrefix x -> DerivationPrefix
$cfrom :: forall x. DerivationPrefix -> Rep DerivationPrefix x
Generic, DerivationPrefix -> DerivationPrefix -> Bool
(DerivationPrefix -> DerivationPrefix -> Bool)
-> (DerivationPrefix -> DerivationPrefix -> Bool)
-> Eq DerivationPrefix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DerivationPrefix -> DerivationPrefix -> Bool
$c/= :: DerivationPrefix -> DerivationPrefix -> Bool
== :: DerivationPrefix -> DerivationPrefix -> Bool
$c== :: DerivationPrefix -> DerivationPrefix -> Bool
Eq, Eq DerivationPrefix
Eq DerivationPrefix
-> (DerivationPrefix -> DerivationPrefix -> Ordering)
-> (DerivationPrefix -> DerivationPrefix -> Bool)
-> (DerivationPrefix -> DerivationPrefix -> Bool)
-> (DerivationPrefix -> DerivationPrefix -> Bool)
-> (DerivationPrefix -> DerivationPrefix -> Bool)
-> (DerivationPrefix -> DerivationPrefix -> DerivationPrefix)
-> (DerivationPrefix -> DerivationPrefix -> DerivationPrefix)
-> Ord DerivationPrefix
DerivationPrefix -> DerivationPrefix -> Bool
DerivationPrefix -> DerivationPrefix -> Ordering
DerivationPrefix -> DerivationPrefix -> DerivationPrefix
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DerivationPrefix -> DerivationPrefix -> DerivationPrefix
$cmin :: DerivationPrefix -> DerivationPrefix -> DerivationPrefix
max :: DerivationPrefix -> DerivationPrefix -> DerivationPrefix
$cmax :: DerivationPrefix -> DerivationPrefix -> DerivationPrefix
>= :: DerivationPrefix -> DerivationPrefix -> Bool
$c>= :: DerivationPrefix -> DerivationPrefix -> Bool
> :: DerivationPrefix -> DerivationPrefix -> Bool
$c> :: DerivationPrefix -> DerivationPrefix -> Bool
<= :: DerivationPrefix -> DerivationPrefix -> Bool
$c<= :: DerivationPrefix -> DerivationPrefix -> Bool
< :: DerivationPrefix -> DerivationPrefix -> Bool
$c< :: DerivationPrefix -> DerivationPrefix -> Bool
compare :: DerivationPrefix -> DerivationPrefix -> Ordering
$ccompare :: DerivationPrefix -> DerivationPrefix -> Ordering
$cp1Ord :: Eq DerivationPrefix
Ord)

instance NFData DerivationPrefix

instance ToText DerivationPrefix where
    toText :: DerivationPrefix -> Text
toText (DerivationPrefix (Index 'Hardened 'PurposeK
purpose, Index 'Hardened 'CoinTypeK
coinType, Index 'Hardened 'AccountK
account))
        = Text -> [Text] -> Text
T.intercalate Text
"/"
        ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Word32 -> Text) -> [Word32] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> Text
forall a. ToText a => a -> Text
toText
        [Index 'Hardened 'PurposeK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Hardened 'PurposeK
purpose, Index 'Hardened 'CoinTypeK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Hardened 'CoinTypeK
coinType, Index 'Hardened 'AccountK -> Word32
forall (derivationType :: DerivationType) (level :: Depth).
Index derivationType level -> Word32
getIndex Index 'Hardened 'AccountK
account]

instance FromText DerivationPrefix where
    fromText :: Text -> Either TextDecodingError DerivationPrefix
fromText Text
txt =
        (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
 Index 'Hardened 'AccountK)
-> DerivationPrefix
DerivationPrefix ((Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
  Index 'Hardened 'AccountK)
 -> DerivationPrefix)
-> Either
     TextDecodingError
     (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
      Index 'Hardened 'AccountK)
-> Either TextDecodingError DerivationPrefix
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Text -> Text -> [Text]
T.splitOn Text
"/" Text
txt of
            [Text
purposeT, Text
coinTypeT, Text
accountT] -> (,,)
                (Index 'Hardened 'PurposeK
 -> Index 'Hardened 'CoinTypeK
 -> Index 'Hardened 'AccountK
 -> (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
     Index 'Hardened 'AccountK))
-> Either TextDecodingError (Index 'Hardened 'PurposeK)
-> Either
     TextDecodingError
     (Index 'Hardened 'CoinTypeK
      -> Index 'Hardened 'AccountK
      -> (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
          Index 'Hardened 'AccountK))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either TextDecodingError (Index 'Hardened 'PurposeK)
forall a. FromText a => Text -> Either TextDecodingError a
fromText Text
purposeT
                Either
  TextDecodingError
  (Index 'Hardened 'CoinTypeK
   -> Index 'Hardened 'AccountK
   -> (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
       Index 'Hardened 'AccountK))
-> Either TextDecodingError (Index 'Hardened 'CoinTypeK)
-> Either
     TextDecodingError
     (Index 'Hardened 'AccountK
      -> (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
          Index 'Hardened 'AccountK))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Either TextDecodingError (Index 'Hardened 'CoinTypeK)
forall a. FromText a => Text -> Either TextDecodingError a
fromText Text
coinTypeT
                Either
  TextDecodingError
  (Index 'Hardened 'AccountK
   -> (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
       Index 'Hardened 'AccountK))
-> Either TextDecodingError (Index 'Hardened 'AccountK)
-> Either
     TextDecodingError
     (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
      Index 'Hardened 'AccountK)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Either TextDecodingError (Index 'Hardened 'AccountK)
forall a. FromText a => Text -> Either TextDecodingError a
fromText Text
accountT
            [Text]
_ ->
                TextDecodingError
-> Either
     TextDecodingError
     (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
      Index 'Hardened 'AccountK)
forall a b. a -> Either a b
Left (TextDecodingError
 -> Either
      TextDecodingError
      (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
       Index 'Hardened 'AccountK))
-> TextDecodingError
-> Either
     TextDecodingError
     (Index 'Hardened 'PurposeK, Index 'Hardened 'CoinTypeK,
      Index 'Hardened 'AccountK)
forall a b. (a -> b) -> a -> b
$ String -> TextDecodingError
TextDecodingError String
"expected exactly 3 derivation paths"

-- | Type of derivation that should be used with the given indexes.
--
-- In theory, we should only consider two derivation types: soft and hard.
--
-- However, historically, addresses in Cardano used to be generated across the
-- both soft and hard domain. We therefore introduce a 'WholeDomain' derivation
-- type that is the exact union of `Hardened` and `Soft`.
data DerivationType = Hardened | Soft | WholeDomain

-- | An interface for doing hard derivations from the root private key
class HardDerivation (key :: Depth -> Type -> Type) where
    type AddressIndexDerivationType key :: DerivationType

    -- | Derives account private key from the given root private key, using
    -- derivation scheme 2 (see <https://github.com/input-output-hk/cardano-crypto/ cardano-crypto>
    -- package for more details).
    --
    -- NOTE: The caller is expected to provide the corresponding passphrase (and
    -- to have checked that the passphrase is valid). Providing a wrong passphrase
    -- will not make the function fail but will instead, yield an incorrect new
    -- key that doesn't belong to the wallet.
    deriveAccountPrivateKey
        :: Passphrase "encryption"
        -> key 'RootK XPrv
        -> Index 'Hardened 'AccountK
        -> key 'AccountK XPrv

    -- | Derives address private key from the given account private key, using
    -- derivation scheme 2 (see <https://github.com/input-output-hk/cardano-crypto/ cardano-crypto>
    -- package for more details).
    --
    -- It is preferred to use 'deriveAddressPublicKey' whenever possible to avoid
    -- having to manipulate passphrases and private keys.
    --
    -- NOTE: The caller is expected to provide the corresponding passphrase (and
    -- to have checked that the passphrase is valid). Providing a wrong passphrase
    -- will not make the function fail but will instead, yield an incorrect new
    -- key that doesn't belong to the wallet.
    deriveAddressPrivateKey
        :: Passphrase "encryption"
        -> key 'AccountK XPrv
        -> Role
        -> Index (AddressIndexDerivationType key) 'AddressK
        -> key 'AddressK XPrv

-- | An interface for doing soft derivations from an account public key
class HardDerivation key => SoftDerivation (key :: Depth -> Type -> Type) where
    -- | Derives address public key from the given account public key, using
    -- derivation scheme 2 (see <https://github.com/input-output-hk/cardano-crypto/ cardano-crypto>
    -- package for more details).
    --
    -- This is the preferred way of deriving new sequential address public keys.
    deriveAddressPublicKey
        :: key 'AccountK XPub
        -> Role
        -> Index 'Soft 'AddressK
        -> key 'AddressK XPub

-- | Derivation of a reward account, as a type-class because different between
-- key types (in particular, Jörmungandr vs Shelley).
class ToRewardAccount k where
    toRewardAccount :: k 'AddressK XPub -> RewardAccount
    someRewardAccount :: SomeMnemonic -> (XPrv, RewardAccount, NonEmpty DerivationIndex)

-- | Derive a reward account from a root private key. It is agreed by standard
-- that every HD wallet will use only a single reward account. This account is
-- located into a special derivation path and uses the first index of that path.
deriveRewardAccount
    :: ( HardDerivation k
       , Bounded (Index (AddressIndexDerivationType k) 'AddressK)
       )
    => Passphrase "encryption"
    -> k 'RootK XPrv
    -> k 'AddressK XPrv
deriveRewardAccount :: Passphrase "encryption" -> k 'RootK XPrv -> k 'AddressK XPrv
deriveRewardAccount Passphrase "encryption"
pwd k 'RootK XPrv
rootPrv =
    let accPrv :: k 'AccountK XPrv
accPrv = Passphrase "encryption"
-> k 'RootK XPrv -> Index 'Hardened 'AccountK -> k 'AccountK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
Passphrase "encryption"
-> key 'RootK XPrv
-> Index 'Hardened 'AccountK
-> key 'AccountK XPrv
deriveAccountPrivateKey Passphrase "encryption"
pwd k 'RootK XPrv
rootPrv Index 'Hardened 'AccountK
forall a. Bounded a => a
minBound
    in Passphrase "encryption"
-> k 'AccountK XPrv
-> Role
-> Index (AddressIndexDerivationType k) 'AddressK
-> k 'AddressK XPrv
forall (key :: Depth -> * -> *).
HardDerivation key =>
Passphrase "encryption"
-> key 'AccountK XPrv
-> Role
-> Index (AddressIndexDerivationType key) 'AddressK
-> key 'AddressK XPrv
deriveAddressPrivateKey Passphrase "encryption"
pwd k 'AccountK XPrv
accPrv Role
MutableAccount Index (AddressIndexDerivationType k) 'AddressK
forall a. Bounded a => a
minBound

hashVerificationKey
    :: WalletKey key
    => KeyRole
    -> key depth XPub
    -> KeyHash
hashVerificationKey :: KeyRole -> key depth XPub -> KeyHash
hashVerificationKey KeyRole
keyRole =
    KeyRole -> ByteString -> KeyHash
KeyHash KeyRole
keyRole (ByteString -> KeyHash)
-> (key depth XPub -> ByteString) -> key depth XPub -> KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. ByteArrayAccess a => a -> ByteString
blake2b224 (ByteString -> ByteString)
-> (key depth XPub -> ByteString) -> key depth XPub -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPub -> ByteString
xpubPublicKey (XPub -> ByteString)
-> (key depth XPub -> XPub) -> key depth XPub -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. key depth XPub -> XPub
forall (key :: Depth -> * -> *) (depth :: Depth) raw.
WalletKey key =>
key depth raw -> raw
getRawKey

{-------------------------------------------------------------------------------
                             Network Discrimination
-------------------------------------------------------------------------------}

-- | Available network options.
--
-- - @Mainnet@: is a shortcut for quickly pointing to mainnet. On Byron and
--              Shelley, it assumes no discrimination. It has a known magic and
--              known genesis parameters.
--
-- - @Testnet@: can be used to identify any network that has a custom genesis
--              and, that requires _explicit_ network discrimination in
--              addresses. Genesis file needs to be passed explicitly when
--              starting the application.
--
-- - @Staging@: very much like testnet, but like mainnet, assumes to no address
--              discrimination. Genesis file needs to be passed explicitly when
--              starting the application.
--
data NetworkDiscriminant = Mainnet | Testnet Nat | Staging Nat
    deriving Typeable

class NetworkDiscriminantVal (n :: NetworkDiscriminant) where
    networkDiscriminantVal :: Text

instance NetworkDiscriminantVal 'Mainnet where
    networkDiscriminantVal :: Text
networkDiscriminantVal =
        Text
"mainnet"

instance KnownNat pm => NetworkDiscriminantVal ('Testnet pm) where
    networkDiscriminantVal :: Text
networkDiscriminantVal =
        Text
"testnet (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Proxy pm -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy pm -> Integer) -> Proxy pm -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy pm
forall k (t :: k). Proxy t
Proxy @pm) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

instance KnownNat pm => NetworkDiscriminantVal ('Staging pm) where
    networkDiscriminantVal :: Text
networkDiscriminantVal =
        Text
"staging (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Proxy pm -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy pm -> Integer) -> Proxy pm -> Integer
forall a b. (a -> b) -> a -> b
$ Proxy pm
forall k (t :: k). Proxy t
Proxy @pm) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

{-------------------------------------------------------------------------------
                     Interface over keys / address types
-------------------------------------------------------------------------------}

class WalletKey (key :: Depth -> Type -> Type) where
    -- | Re-encrypt a private key using a different passphrase.
    --
    -- **Important**:
    -- This function doesn't check that the old passphrase is correct! Caller is
    -- expected to have already checked that. Using an incorrect passphrase here
    -- will lead to very bad thing.
    changePassphrase
        :: (PassphraseScheme, Passphrase "user")
            -- ^ Old passphrase
        -> (PassphraseScheme, Passphrase "user")
            -- ^ New passphrase
        -> key depth XPrv
        -> key depth XPrv

    -- | Extract the public key part of a private key.
    publicKey
        :: key depth XPrv
        -> key depth XPub

    -- | Hash a public key to some other representation.
    digest
        :: HashAlgorithm a
        => key depth XPub
        -> Digest a

    -- | Get a short, human-readable string descriptor that uniquely identifies
    --   the specified key type.
    keyTypeDescriptor :: Proxy key -> String

    -- | Unwrap the 'WalletKey' to use the 'XPrv' or 'XPub'.
    getRawKey
        :: key depth raw
        -> raw

    -- | Lift 'XPrv' or 'XPub' to 'WalletKey'.
    liftRawKey
        :: raw
        -> key depth raw

-- | The class of keys for which addresses are bounded in length.
--
class BoundedAddressLength key where
    -- | Returns the longest address that the wallet can generate for a given
    --   key.
    --
    -- This is useful in situations where we want to compute some function of
    -- an output under construction (such as a minimum UTxO value), but don't
    -- yet have convenient access to a real address.
    --
    -- Please note that this address should:
    --
    --  - never be used for anything besides its length and validity properties.
    --  - never be used as a payment target within a real transaction.
    --
    maxLengthAddressFor
        :: Proxy key
        -> Address

-- | Encoding of addresses for certain key types and backend targets.
class MkKeyFingerprint key Address
    => PaymentAddress (network :: NetworkDiscriminant) key where
    -- | Convert a public key to a payment 'Address' valid for the given
    -- network discrimination.
    --
    -- Note that 'paymentAddress' is ambiguous and requires therefore a type
    -- application.
    paymentAddress
        :: key 'AddressK XPub
        -> Address

    -- | Lift a payment fingerprint back into a payment address.
    liftPaymentAddress
        :: KeyFingerprint "payment" key
            -- ^ Payment fingerprint
        -> Address

instance PaymentAddress 'Mainnet k => PaymentAddress ('Staging pm) k where
    paymentAddress :: k 'AddressK XPub -> Address
paymentAddress = forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
PaymentAddress network key =>
key 'AddressK XPub -> Address
forall (key :: Depth -> * -> *).
PaymentAddress 'Mainnet key =>
key 'AddressK XPub -> Address
paymentAddress @'Mainnet
    liftPaymentAddress :: KeyFingerprint "payment" k -> Address
liftPaymentAddress = forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
PaymentAddress network key =>
KeyFingerprint "payment" key -> Address
forall (key :: Depth -> * -> *).
PaymentAddress 'Mainnet key =>
KeyFingerprint "payment" key -> Address
liftPaymentAddress @'Mainnet

class PaymentAddress network key
    => DelegationAddress (network :: NetworkDiscriminant) key where
    -- | Convert a public key and a staking key to a delegation 'Address' valid
    -- for the given network discrimination. Funds sent to this address will be
    -- delegated according to the delegation settings attached to the delegation
    -- key.
    --
    -- Note that 'delegationAddress' is ambiguous and requires therefore a type
    -- application.
    delegationAddress
        :: key 'AddressK XPub
            -- ^ Payment key
        -> key 'AddressK XPub
            -- ^ Staking key / Reward account
        -> Address

    -- | Lift a payment fingerprint back into a delegation address.
    liftDelegationAddress
        :: KeyFingerprint "payment" key
            -- ^ Payment fingerprint
        -> key 'AddressK XPub
            -- ^ Staking key / Reward account
        -> Address

instance DelegationAddress 'Mainnet k => DelegationAddress ('Staging pm) k where
    delegationAddress :: k 'AddressK XPub -> k 'AddressK XPub -> Address
delegationAddress = forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
DelegationAddress network key =>
key 'AddressK XPub -> key 'AddressK XPub -> Address
forall (key :: Depth -> * -> *).
DelegationAddress 'Mainnet key =>
key 'AddressK XPub -> key 'AddressK XPub -> Address
delegationAddress @'Mainnet
    liftDelegationAddress :: KeyFingerprint "payment" k -> k 'AddressK XPub -> Address
liftDelegationAddress = forall (network :: NetworkDiscriminant) (key :: Depth -> * -> *).
DelegationAddress network key =>
KeyFingerprint "payment" key -> key 'AddressK XPub -> Address
forall (key :: Depth -> * -> *).
DelegationAddress 'Mainnet key =>
KeyFingerprint "payment" key -> key 'AddressK XPub -> Address
liftDelegationAddress @'Mainnet

-- | Operations for saving a private key into a database, and restoring it from
-- a database. The keys should be encoded in hexadecimal strings.
class PersistPrivateKey (key :: Type -> Type) where
    -- | Convert a private key and its password hash into hexadecimal strings
    -- suitable for storing in a text file or database column.
    serializeXPrv
        :: (key XPrv, PassphraseHash)
        -> (ByteString, ByteString)

    -- | The reverse of 'serializeXPrv'. This may fail if the inputs are not
    -- valid hexadecimal strings, or if the key is of the wrong length.
    unsafeDeserializeXPrv
        :: (ByteString, ByteString)
        -> (key XPrv, PassphraseHash)

-- | Operations for saving a public key into a database, and restoring it from
-- a database. The keys should be encoded in hexadecimal strings.
class PersistPublicKey (key :: Type -> Type) where
    -- | Convert a private key and its password hash into hexadecimal strings
    -- suitable for storing in a text file or database column.
    serializeXPub
        :: key XPub
        -> ByteString

    -- | Convert a public key into hexadecimal strings suitable for storing in
    -- a text file or database column.
    unsafeDeserializeXPub
        :: ByteString
        -> key XPub

-- | Something that uniquely identifies a public key. Typically,
-- a hash of that key or the key itself.
newtype KeyFingerprint (s :: Symbol) key = KeyFingerprint ByteString
    deriving ((forall x. KeyFingerprint s key -> Rep (KeyFingerprint s key) x)
-> (forall x. Rep (KeyFingerprint s key) x -> KeyFingerprint s key)
-> Generic (KeyFingerprint s key)
forall x. Rep (KeyFingerprint s key) x -> KeyFingerprint s key
forall x. KeyFingerprint s key -> Rep (KeyFingerprint s key) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Symbol) k (key :: k) x.
Rep (KeyFingerprint s key) x -> KeyFingerprint s key
forall (s :: Symbol) k (key :: k) x.
KeyFingerprint s key -> Rep (KeyFingerprint s key) x
$cto :: forall (s :: Symbol) k (key :: k) x.
Rep (KeyFingerprint s key) x -> KeyFingerprint s key
$cfrom :: forall (s :: Symbol) k (key :: k) x.
KeyFingerprint s key -> Rep (KeyFingerprint s key) x
Generic, Int -> KeyFingerprint s key -> ShowS
[KeyFingerprint s key] -> ShowS
KeyFingerprint s key -> String
(Int -> KeyFingerprint s key -> ShowS)
-> (KeyFingerprint s key -> String)
-> ([KeyFingerprint s key] -> ShowS)
-> Show (KeyFingerprint s key)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Symbol) k (key :: k).
Int -> KeyFingerprint s key -> ShowS
forall (s :: Symbol) k (key :: k). [KeyFingerprint s key] -> ShowS
forall (s :: Symbol) k (key :: k). KeyFingerprint s key -> String
showList :: [KeyFingerprint s key] -> ShowS
$cshowList :: forall (s :: Symbol) k (key :: k). [KeyFingerprint s key] -> ShowS
show :: KeyFingerprint s key -> String
$cshow :: forall (s :: Symbol) k (key :: k). KeyFingerprint s key -> String
showsPrec :: Int -> KeyFingerprint s key -> ShowS
$cshowsPrec :: forall (s :: Symbol) k (key :: k).
Int -> KeyFingerprint s key -> ShowS
Show, KeyFingerprint s key -> KeyFingerprint s key -> Bool
(KeyFingerprint s key -> KeyFingerprint s key -> Bool)
-> (KeyFingerprint s key -> KeyFingerprint s key -> Bool)
-> Eq (KeyFingerprint s key)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Symbol) k (key :: k).
KeyFingerprint s key -> KeyFingerprint s key -> Bool
/= :: KeyFingerprint s key -> KeyFingerprint s key -> Bool
$c/= :: forall (s :: Symbol) k (key :: k).
KeyFingerprint s key -> KeyFingerprint s key -> Bool
== :: KeyFingerprint s key -> KeyFingerprint s key -> Bool
$c== :: forall (s :: Symbol) k (key :: k).
KeyFingerprint s key -> KeyFingerprint s key -> Bool
Eq, Eq (KeyFingerprint s key)
Eq (KeyFingerprint s key)
-> (KeyFingerprint s key -> KeyFingerprint s key -> Ordering)
-> (KeyFingerprint s key -> KeyFingerprint s key -> Bool)
-> (KeyFingerprint s key -> KeyFingerprint s key -> Bool)
-> (KeyFingerprint s key -> KeyFingerprint s key -> Bool)
-> (KeyFingerprint s key -> KeyFingerprint s key -> Bool)
-> (KeyFingerprint s key
    -> KeyFingerprint s key -> KeyFingerprint s key)
-> (KeyFingerprint s key
    -> KeyFingerprint s key -> KeyFingerprint s key)
-> Ord (KeyFingerprint s key)
KeyFingerprint s key -> KeyFingerprint s key -> Bool
KeyFingerprint s key -> KeyFingerprint s key -> Ordering
KeyFingerprint s key
-> KeyFingerprint s key -> KeyFingerprint s key
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
forall (s :: Symbol) k (key :: k). Eq (KeyFingerprint s key)
forall (s :: Symbol) k (key :: k).
KeyFingerprint s key -> KeyFingerprint s key -> Bool
forall (s :: Symbol) k (key :: k).
KeyFingerprint s key -> KeyFingerprint s key -> Ordering
forall (s :: Symbol) k (key :: k).
KeyFingerprint s key
-> KeyFingerprint s key -> KeyFingerprint s key
min :: KeyFingerprint s key
-> KeyFingerprint s key -> KeyFingerprint s key
$cmin :: forall (s :: Symbol) k (key :: k).
KeyFingerprint s key
-> KeyFingerprint s key -> KeyFingerprint s key
max :: KeyFingerprint s key
-> KeyFingerprint s key -> KeyFingerprint s key
$cmax :: forall (s :: Symbol) k (key :: k).
KeyFingerprint s key
-> KeyFingerprint s key -> KeyFingerprint s key
>= :: KeyFingerprint s key -> KeyFingerprint s key -> Bool
$c>= :: forall (s :: Symbol) k (key :: k).
KeyFingerprint s key -> KeyFingerprint s key -> Bool
> :: KeyFingerprint s key -> KeyFingerprint s key -> Bool
$c> :: forall (s :: Symbol) k (key :: k).
KeyFingerprint s key -> KeyFingerprint s key -> Bool
<= :: KeyFingerprint s key -> KeyFingerprint s key -> Bool
$c<= :: forall (s :: Symbol) k (key :: k).
KeyFingerprint s key -> KeyFingerprint s key -> Bool
< :: KeyFingerprint s key -> KeyFingerprint s key -> Bool
$c< :: forall (s :: Symbol) k (key :: k).
KeyFingerprint s key -> KeyFingerprint s key -> Bool
compare :: KeyFingerprint s key -> KeyFingerprint s key -> Ordering
$ccompare :: forall (s :: Symbol) k (key :: k).
KeyFingerprint s key -> KeyFingerprint s key -> Ordering
$cp1Ord :: forall (s :: Symbol) k (key :: k). Eq (KeyFingerprint s key)
Ord)

instance NFData (KeyFingerprint s key)

-- | Produce 'KeyFingerprint' for existing types. A fingerprint here uniquely
-- identifies part of an address. It can refer to either the payment key or, if
-- any, the delegation key of an address.
--
-- The fingerprint obeys the following rules:
--
-- - If two addresses are the same, then they have the same fingerprints
-- - It is possible to lift the fingerprint back into an address
--
-- This second rule pretty much fixes what can be chosen as a fingerprint for
-- various key types:
--
-- 1. For 'ByronKey', it can only be the address itself!
-- 2. For 'ShelleyKey', then the "payment" fingerprint refers to the payment key
--    within a single or grouped address.
class Show from => MkKeyFingerprint (key :: Depth -> Type -> Type) from where
    paymentKeyFingerprint
        :: from
        -> Either
            (ErrMkKeyFingerprint key from)
            (KeyFingerprint "payment" key)

data ErrMkKeyFingerprint key from
    = ErrInvalidAddress from (Proxy key) deriving (Int -> ErrMkKeyFingerprint key from -> ShowS
[ErrMkKeyFingerprint key from] -> ShowS
ErrMkKeyFingerprint key from -> String
(Int -> ErrMkKeyFingerprint key from -> ShowS)
-> (ErrMkKeyFingerprint key from -> String)
-> ([ErrMkKeyFingerprint key from] -> ShowS)
-> Show (ErrMkKeyFingerprint key from)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (key :: k) from.
Show from =>
Int -> ErrMkKeyFingerprint key from -> ShowS
forall k (key :: k) from.
Show from =>
[ErrMkKeyFingerprint key from] -> ShowS
forall k (key :: k) from.
Show from =>
ErrMkKeyFingerprint key from -> String
showList :: [ErrMkKeyFingerprint key from] -> ShowS
$cshowList :: forall k (key :: k) from.
Show from =>
[ErrMkKeyFingerprint key from] -> ShowS
show :: ErrMkKeyFingerprint key from -> String
$cshow :: forall k (key :: k) from.
Show from =>
ErrMkKeyFingerprint key from -> String
showsPrec :: Int -> ErrMkKeyFingerprint key from -> ShowS
$cshowsPrec :: forall k (key :: k) from.
Show from =>
Int -> ErrMkKeyFingerprint key from -> ShowS
Show, ErrMkKeyFingerprint key from
-> ErrMkKeyFingerprint key from -> Bool
(ErrMkKeyFingerprint key from
 -> ErrMkKeyFingerprint key from -> Bool)
-> (ErrMkKeyFingerprint key from
    -> ErrMkKeyFingerprint key from -> Bool)
-> Eq (ErrMkKeyFingerprint key from)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (key :: k) from.
Eq from =>
ErrMkKeyFingerprint key from
-> ErrMkKeyFingerprint key from -> Bool
/= :: ErrMkKeyFingerprint key from
-> ErrMkKeyFingerprint key from -> Bool
$c/= :: forall k (key :: k) from.
Eq from =>
ErrMkKeyFingerprint key from
-> ErrMkKeyFingerprint key from -> Bool
== :: ErrMkKeyFingerprint key from
-> ErrMkKeyFingerprint key from -> Bool
$c== :: forall k (key :: k) from.
Eq from =>
ErrMkKeyFingerprint key from
-> ErrMkKeyFingerprint key from -> Bool
Eq)

{-------------------------------------------------------------------------------
                                Helpers
-------------------------------------------------------------------------------}

-- | Encode a 'ByteString' in base16
hex :: ByteArrayAccess bin => bin -> ByteString
hex :: bin -> ByteString
hex = Base -> bin -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base16

-- | Decode a 'ByteString' from base16
fromHex :: ByteArray bout => ByteString -> Either String bout
fromHex :: ByteString -> Either String bout
fromHex = Base -> ByteString -> Either String bout
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base16