{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : Haskoin.Keys.Extended
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX

BIP-32 extended keys.
-}
module Haskoin.Keys.Extended (
    -- * Extended Keys
    XPubKey (..),
    XPrvKey (..),
    ChainCode,
    KeyIndex,
    Fingerprint,
    fingerprintToText,
    textToFingerprint,
    DerivationException (..),
    makeXPrvKey,
    deriveXPubKey,
    prvSubKey,
    pubSubKey,
    hardSubKey,
    xPrvIsHard,
    xPubIsHard,
    xPrvChild,
    xPubChild,
    xPubID,
    xPrvID,
    xPubFP,
    xPrvFP,
    xPubAddr,
    xPubWitnessAddr,
    xPubCompatWitnessAddr,
    xPubExport,
    xPubToJSON,
    xPubToEncoding,
    xPubFromJSON,
    xPrvExport,
    xPrvToJSON,
    xPrvToEncoding,
    xPrvFromJSON,
    xPubImport,
    xPrvImport,
    xPrvWif,
    putXPrvKey,
    putXPubKey,
    getXPrvKey,
    getXPubKey,

    -- ** Helper Functions
    prvSubKeys,
    pubSubKeys,
    hardSubKeys,
    deriveAddr,
    deriveWitnessAddr,
    deriveCompatWitnessAddr,
    deriveAddrs,
    deriveWitnessAddrs,
    deriveCompatWitnessAddrs,
    deriveMSAddr,
    deriveMSAddrs,
    cycleIndex,

    -- ** Derivation Paths
    DerivPathI (..),
    AnyDeriv,
    HardDeriv,
    SoftDeriv,
    HardOrAny,
    AnyOrSoft,
    DerivPath,
    HardPath,
    SoftPath,
    Bip32PathIndex (..),
    derivePath,
    derivePubPath,
    toHard,
    toSoft,
    toGeneric,
    (++/),
    pathToStr,
    listToPath,
    pathToList,

    -- *** Derivation Path Parser
    XKey (..),
    ParsedPath (..),
    parsePath,
    parseHard,
    parseSoft,
    applyPath,
    derivePathAddr,
    derivePathAddrs,
    derivePathMSAddr,
    derivePathMSAddrs,
    concatBip32Segments,
) where

import Control.Applicative
import Control.DeepSeq
import Control.Exception (Exception, throw)
import Control.Monad (guard, mzero, unless, (<=<))
import Crypto.Secp256k1
import Data.Aeson as A (
    FromJSON,
    ToJSON (..),
    Value (String),
    parseJSON,
    toJSON,
    withText,
 )
import Data.Aeson.Encoding (Encoding, text)
import Data.Aeson.Types (Parser)
import Data.Binary (Binary (get, put))
import Data.Bits (clearBit, setBit, testBit)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Either (fromRight)
import Data.Hashable
import Data.List (foldl')
import Data.List.Split (splitOn)
import Data.Maybe (fromMaybe)
import Data.Serialize (Serialize (..))
import qualified Data.Serialize as S
import Data.String (IsString, fromString)
import Data.String.Conversions (cs)
import qualified Data.Text as Text
import Data.Typeable (Typeable)
import Data.Word (Word32, Word8)
import GHC.Generics (Generic)
import Haskoin.Address
import Haskoin.Crypto.Hash
import Haskoin.Data
import Haskoin.Keys.Common
import Haskoin.Keys.Extended.Internal (
    Fingerprint (..),
    fingerprintToText,
    textToFingerprint,
 )
import Haskoin.Script
import Haskoin.Util
import Text.Read as R
import Text.Read.Lex

{- | A derivation exception is thrown in the very unlikely event that a
 derivation is invalid.
-}
newtype DerivationException = DerivationException String
    deriving (DerivationException -> DerivationException -> Bool
(DerivationException -> DerivationException -> Bool)
-> (DerivationException -> DerivationException -> Bool)
-> Eq DerivationException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DerivationException -> DerivationException -> Bool
$c/= :: DerivationException -> DerivationException -> Bool
== :: DerivationException -> DerivationException -> Bool
$c== :: DerivationException -> DerivationException -> Bool
Eq, ReadPrec [DerivationException]
ReadPrec DerivationException
Int -> ReadS DerivationException
ReadS [DerivationException]
(Int -> ReadS DerivationException)
-> ReadS [DerivationException]
-> ReadPrec DerivationException
-> ReadPrec [DerivationException]
-> Read DerivationException
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DerivationException]
$creadListPrec :: ReadPrec [DerivationException]
readPrec :: ReadPrec DerivationException
$creadPrec :: ReadPrec DerivationException
readList :: ReadS [DerivationException]
$creadList :: ReadS [DerivationException]
readsPrec :: Int -> ReadS DerivationException
$creadsPrec :: Int -> ReadS DerivationException
Read, Int -> DerivationException -> ShowS
[DerivationException] -> ShowS
DerivationException -> String
(Int -> DerivationException -> ShowS)
-> (DerivationException -> String)
-> ([DerivationException] -> ShowS)
-> Show DerivationException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DerivationException] -> ShowS
$cshowList :: [DerivationException] -> ShowS
show :: DerivationException -> String
$cshow :: DerivationException -> String
showsPrec :: Int -> DerivationException -> ShowS
$cshowsPrec :: Int -> DerivationException -> ShowS
Show, Typeable, (forall x. DerivationException -> Rep DerivationException x)
-> (forall x. Rep DerivationException x -> DerivationException)
-> Generic DerivationException
forall x. Rep DerivationException x -> DerivationException
forall x. DerivationException -> Rep DerivationException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DerivationException x -> DerivationException
$cfrom :: forall x. DerivationException -> Rep DerivationException x
Generic, DerivationException -> ()
(DerivationException -> ()) -> NFData DerivationException
forall a. (a -> ()) -> NFData a
rnf :: DerivationException -> ()
$crnf :: DerivationException -> ()
NFData)

instance Exception DerivationException

-- | Chain code as specified in BIP-32.
type ChainCode = Hash256

-- | Index of key as specified in BIP-32.
type KeyIndex = Word32

{- | Data type representing an extended BIP32 private key. An extended key
 is a node in a tree of key derivations. It has a depth in the tree, a
 parent node and an index to differentiate it from other siblings.
-}
data XPrvKey = XPrvKey
    { -- | depth in the tree
      XPrvKey -> Word8
xPrvDepth :: !Word8
    , -- | fingerprint of parent
      XPrvKey -> Fingerprint
xPrvParent :: !Fingerprint
    , -- | derivation index
      XPrvKey -> KeyIndex
xPrvIndex :: !KeyIndex
    , -- | chain code
      XPrvKey -> ChainCode
xPrvChain :: !ChainCode
    , -- | private key of this node
      XPrvKey -> SecKey
xPrvKey :: !SecKey
    }
    deriving ((forall x. XPrvKey -> Rep XPrvKey x)
-> (forall x. Rep XPrvKey x -> XPrvKey) -> Generic XPrvKey
forall x. Rep XPrvKey x -> XPrvKey
forall x. XPrvKey -> Rep XPrvKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XPrvKey x -> XPrvKey
$cfrom :: forall x. XPrvKey -> Rep XPrvKey x
Generic, XPrvKey -> XPrvKey -> Bool
(XPrvKey -> XPrvKey -> Bool)
-> (XPrvKey -> XPrvKey -> Bool) -> Eq XPrvKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPrvKey -> XPrvKey -> Bool
$c/= :: XPrvKey -> XPrvKey -> Bool
== :: XPrvKey -> XPrvKey -> Bool
$c== :: XPrvKey -> XPrvKey -> Bool
Eq, Int -> XPrvKey -> ShowS
[XPrvKey] -> ShowS
XPrvKey -> String
(Int -> XPrvKey -> ShowS)
-> (XPrvKey -> String) -> ([XPrvKey] -> ShowS) -> Show XPrvKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPrvKey] -> ShowS
$cshowList :: [XPrvKey] -> ShowS
show :: XPrvKey -> String
$cshow :: XPrvKey -> String
showsPrec :: Int -> XPrvKey -> ShowS
$cshowsPrec :: Int -> XPrvKey -> ShowS
Show, ReadPrec [XPrvKey]
ReadPrec XPrvKey
Int -> ReadS XPrvKey
ReadS [XPrvKey]
(Int -> ReadS XPrvKey)
-> ReadS [XPrvKey]
-> ReadPrec XPrvKey
-> ReadPrec [XPrvKey]
-> Read XPrvKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XPrvKey]
$creadListPrec :: ReadPrec [XPrvKey]
readPrec :: ReadPrec XPrvKey
$creadPrec :: ReadPrec XPrvKey
readList :: ReadS [XPrvKey]
$creadList :: ReadS [XPrvKey]
readsPrec :: Int -> ReadS XPrvKey
$creadsPrec :: Int -> ReadS XPrvKey
Read, XPrvKey -> ()
(XPrvKey -> ()) -> NFData XPrvKey
forall a. (a -> ()) -> NFData a
rnf :: XPrvKey -> ()
$crnf :: XPrvKey -> ()
NFData, Int -> XPrvKey -> Int
XPrvKey -> Int
(Int -> XPrvKey -> Int) -> (XPrvKey -> Int) -> Hashable XPrvKey
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: XPrvKey -> Int
$chash :: XPrvKey -> Int
hashWithSalt :: Int -> XPrvKey -> Int
$chashWithSalt :: Int -> XPrvKey -> Int
Hashable)

instance Serial XPrvKey where
    serialize :: XPrvKey -> m ()
serialize XPrvKey
k = do
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ XPrvKey -> Word8
xPrvDepth XPrvKey
k
        Fingerprint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Fingerprint -> m ()) -> Fingerprint -> m ()
forall a b. (a -> b) -> a -> b
$ XPrvKey -> Fingerprint
xPrvParent XPrvKey
k
        KeyIndex -> m ()
forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be (KeyIndex -> m ()) -> KeyIndex -> m ()
forall a b. (a -> b) -> a -> b
$ XPrvKey -> KeyIndex
xPrvIndex XPrvKey
k
        ChainCode -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ChainCode -> m ()) -> ChainCode -> m ()
forall a b. (a -> b) -> a -> b
$ XPrvKey -> ChainCode
xPrvChain XPrvKey
k
        SecKey -> m ()
forall (m :: * -> *). MonadPut m => SecKey -> m ()
putPadPrvKey (SecKey -> m ()) -> SecKey -> m ()
forall a b. (a -> b) -> a -> b
$ XPrvKey -> SecKey
xPrvKey XPrvKey
k
    deserialize :: m XPrvKey
deserialize =
        Word8 -> Fingerprint -> KeyIndex -> ChainCode -> SecKey -> XPrvKey
XPrvKey (Word8
 -> Fingerprint -> KeyIndex -> ChainCode -> SecKey -> XPrvKey)
-> m Word8
-> m (Fingerprint -> KeyIndex -> ChainCode -> SecKey -> XPrvKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
            m (Fingerprint -> KeyIndex -> ChainCode -> SecKey -> XPrvKey)
-> m Fingerprint -> m (KeyIndex -> ChainCode -> SecKey -> XPrvKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            m (KeyIndex -> ChainCode -> SecKey -> XPrvKey)
-> m KeyIndex -> m (ChainCode -> SecKey -> XPrvKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m KeyIndex
forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
            m (ChainCode -> SecKey -> XPrvKey)
-> m ChainCode -> m (SecKey -> XPrvKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ChainCode
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            m (SecKey -> XPrvKey) -> m SecKey -> m XPrvKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m SecKey
forall (m :: * -> *). MonadGet m => m SecKey
getPadPrvKey

instance Binary XPrvKey where
    put :: XPrvKey -> Put
put = XPrvKey -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get XPrvKey
get = Get XPrvKey
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serialize XPrvKey where
    put :: Putter XPrvKey
put = Putter XPrvKey
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get XPrvKey
get = Get XPrvKey
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

xPrvToJSON :: Network -> XPrvKey -> Value
xPrvToJSON :: Network -> XPrvKey -> Value
xPrvToJSON Network
net = Text -> Value
A.String (Text -> Value) -> (XPrvKey -> Text) -> XPrvKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> XPrvKey -> Text
xPrvExport Network
net

xPrvToEncoding :: Network -> XPrvKey -> Encoding
xPrvToEncoding :: Network -> XPrvKey -> Encoding
xPrvToEncoding Network
net = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding) -> (XPrvKey -> Text) -> XPrvKey -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> XPrvKey -> Text
xPrvExport Network
net

-- | Decode an extended private key from a JSON string
xPrvFromJSON :: Network -> Value -> Parser XPrvKey
xPrvFromJSON :: Network -> Value -> Parser XPrvKey
xPrvFromJSON Network
net =
    String -> (Text -> Parser XPrvKey) -> Value -> Parser XPrvKey
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"xprv" ((Text -> Parser XPrvKey) -> Value -> Parser XPrvKey)
-> (Text -> Parser XPrvKey) -> Value -> Parser XPrvKey
forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case Network -> Text -> Maybe XPrvKey
xPrvImport Network
net Text
t of
            Maybe XPrvKey
Nothing -> String -> Parser XPrvKey
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not read xprv"
            Just XPrvKey
x -> XPrvKey -> Parser XPrvKey
forall (m :: * -> *) a. Monad m => a -> m a
return XPrvKey
x

-- | Data type representing an extended BIP32 public key.
data XPubKey = XPubKey
    { -- | depth in the tree
      XPubKey -> Word8
xPubDepth :: !Word8
    , -- | fingerprint of parent
      XPubKey -> Fingerprint
xPubParent :: !Fingerprint
    , -- | derivation index
      XPubKey -> KeyIndex
xPubIndex :: !KeyIndex
    , -- | chain code
      XPubKey -> ChainCode
xPubChain :: !ChainCode
    , -- | public key of this node
      XPubKey -> PubKey
xPubKey :: !PubKey
    }
    deriving ((forall x. XPubKey -> Rep XPubKey x)
-> (forall x. Rep XPubKey x -> XPubKey) -> Generic XPubKey
forall x. Rep XPubKey x -> XPubKey
forall x. XPubKey -> Rep XPubKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XPubKey x -> XPubKey
$cfrom :: forall x. XPubKey -> Rep XPubKey x
Generic, XPubKey -> XPubKey -> Bool
(XPubKey -> XPubKey -> Bool)
-> (XPubKey -> XPubKey -> Bool) -> Eq XPubKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPubKey -> XPubKey -> Bool
$c/= :: XPubKey -> XPubKey -> Bool
== :: XPubKey -> XPubKey -> Bool
$c== :: XPubKey -> XPubKey -> Bool
Eq, Int -> XPubKey -> ShowS
[XPubKey] -> ShowS
XPubKey -> String
(Int -> XPubKey -> ShowS)
-> (XPubKey -> String) -> ([XPubKey] -> ShowS) -> Show XPubKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPubKey] -> ShowS
$cshowList :: [XPubKey] -> ShowS
show :: XPubKey -> String
$cshow :: XPubKey -> String
showsPrec :: Int -> XPubKey -> ShowS
$cshowsPrec :: Int -> XPubKey -> ShowS
Show, ReadPrec [XPubKey]
ReadPrec XPubKey
Int -> ReadS XPubKey
ReadS [XPubKey]
(Int -> ReadS XPubKey)
-> ReadS [XPubKey]
-> ReadPrec XPubKey
-> ReadPrec [XPubKey]
-> Read XPubKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XPubKey]
$creadListPrec :: ReadPrec [XPubKey]
readPrec :: ReadPrec XPubKey
$creadPrec :: ReadPrec XPubKey
readList :: ReadS [XPubKey]
$creadList :: ReadS [XPubKey]
readsPrec :: Int -> ReadS XPubKey
$creadsPrec :: Int -> ReadS XPubKey
Read, XPubKey -> ()
(XPubKey -> ()) -> NFData XPubKey
forall a. (a -> ()) -> NFData a
rnf :: XPubKey -> ()
$crnf :: XPubKey -> ()
NFData, Int -> XPubKey -> Int
XPubKey -> Int
(Int -> XPubKey -> Int) -> (XPubKey -> Int) -> Hashable XPubKey
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: XPubKey -> Int
$chash :: XPubKey -> Int
hashWithSalt :: Int -> XPubKey -> Int
$chashWithSalt :: Int -> XPubKey -> Int
Hashable)

instance Serial XPubKey where
    serialize :: XPubKey -> m ()
serialize XPubKey
k = do
        Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 (Word8 -> m ()) -> Word8 -> m ()
forall a b. (a -> b) -> a -> b
$ XPubKey -> Word8
xPubDepth XPubKey
k
        Fingerprint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Fingerprint -> m ()) -> Fingerprint -> m ()
forall a b. (a -> b) -> a -> b
$ XPubKey -> Fingerprint
xPubParent XPubKey
k
        KeyIndex -> m ()
forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be (KeyIndex -> m ()) -> KeyIndex -> m ()
forall a b. (a -> b) -> a -> b
$ XPubKey -> KeyIndex
xPubIndex XPubKey
k
        ChainCode -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ChainCode -> m ()) -> ChainCode -> m ()
forall a b. (a -> b) -> a -> b
$ XPubKey -> ChainCode
xPubChain XPubKey
k
        PubKeyI -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (PubKeyI -> m ()) -> PubKeyI -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> PubKey -> PubKeyI
wrapPubKey Bool
True (XPubKey -> PubKey
xPubKey XPubKey
k)
    deserialize :: m XPubKey
deserialize =
        Word8 -> Fingerprint -> KeyIndex -> ChainCode -> PubKey -> XPubKey
XPubKey (Word8
 -> Fingerprint -> KeyIndex -> ChainCode -> PubKey -> XPubKey)
-> m Word8
-> m (Fingerprint -> KeyIndex -> ChainCode -> PubKey -> XPubKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
            m (Fingerprint -> KeyIndex -> ChainCode -> PubKey -> XPubKey)
-> m Fingerprint -> m (KeyIndex -> ChainCode -> PubKey -> XPubKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            m (KeyIndex -> ChainCode -> PubKey -> XPubKey)
-> m KeyIndex -> m (ChainCode -> PubKey -> XPubKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m KeyIndex
forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
            m (ChainCode -> PubKey -> XPubKey)
-> m ChainCode -> m (PubKey -> XPubKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m ChainCode
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            m (PubKey -> XPubKey) -> m PubKey -> m XPubKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PubKeyI -> PubKey
pubKeyPoint (PubKeyI -> PubKey) -> m PubKeyI -> m PubKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m PubKeyI
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)

instance Serialize XPubKey where
    put :: Putter XPubKey
put = Putter XPubKey
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get XPubKey
get = Get XPubKey
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Binary XPubKey where
    put :: XPubKey -> Put
put = XPubKey -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get XPubKey
get = Get XPubKey
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Decode an extended public key from a JSON string
xPubFromJSON :: Network -> Value -> Parser XPubKey
xPubFromJSON :: Network -> Value -> Parser XPubKey
xPubFromJSON Network
net =
    String -> (Text -> Parser XPubKey) -> Value -> Parser XPubKey
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"xpub" ((Text -> Parser XPubKey) -> Value -> Parser XPubKey)
-> (Text -> Parser XPubKey) -> Value -> Parser XPubKey
forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case Network -> Text -> Maybe XPubKey
xPubImport Network
net Text
t of
            Maybe XPubKey
Nothing -> String -> Parser XPubKey
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not read xpub"
            Just XPubKey
x -> XPubKey -> Parser XPubKey
forall (m :: * -> *) a. Monad m => a -> m a
return XPubKey
x

-- | Get JSON 'Value' from 'XPubKey'.
xPubToJSON :: Network -> XPubKey -> Value
xPubToJSON :: Network -> XPubKey -> Value
xPubToJSON Network
net = Text -> Value
A.String (Text -> Value) -> (XPubKey -> Text) -> XPubKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> XPubKey -> Text
xPubExport Network
net

xPubToEncoding :: Network -> XPubKey -> Encoding
xPubToEncoding :: Network -> XPubKey -> Encoding
xPubToEncoding Network
net = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding) -> (XPubKey -> Text) -> XPubKey -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> XPubKey -> Text
xPubExport Network
net

{- | Build a BIP32 compatible extended private key from a bytestring. This will
 produce a root node (@depth=0@ and @parent=0@).
-}
makeXPrvKey :: ByteString -> XPrvKey
makeXPrvKey :: ByteString -> XPrvKey
makeXPrvKey ByteString
bs =
    Word8 -> Fingerprint -> KeyIndex -> ChainCode -> SecKey -> XPrvKey
XPrvKey Word8
0 (KeyIndex -> Fingerprint
Fingerprint KeyIndex
0) KeyIndex
0 ChainCode
c SecKey
k
  where
    (ChainCode
p, ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 (Hash512 -> (ChainCode, ChainCode))
-> Hash512 -> (ChainCode, ChainCode)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 ByteString
"Bitcoin seed" ByteString
bs
    k :: SecKey
k = SecKey -> Maybe SecKey -> SecKey
forall a. a -> Maybe a -> a
fromMaybe SecKey
forall a. a
err (ByteString -> Maybe SecKey
secKey (Put -> ByteString
runPutS (ChainCode -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize ChainCode
p)))
    err :: a
err = DerivationException -> a
forall a e. Exception e => e -> a
throw (DerivationException -> a) -> DerivationException -> a
forall a b. (a -> b) -> a -> b
$ String -> DerivationException
DerivationException String
"Invalid seed"

{- | Derive an extended public key from an extended private key. This function
 will preserve the depth, parent, index and chaincode fields of the extended
 private keys.
-}
deriveXPubKey :: XPrvKey -> XPubKey
deriveXPubKey :: XPrvKey -> XPubKey
deriveXPubKey (XPrvKey Word8
d Fingerprint
p KeyIndex
i ChainCode
c SecKey
k) = Word8 -> Fingerprint -> KeyIndex -> ChainCode -> PubKey -> XPubKey
XPubKey Word8
d Fingerprint
p KeyIndex
i ChainCode
c (SecKey -> PubKey
derivePubKey SecKey
k)

{- | Compute a private, soft child key derivation. A private soft derivation
 will allow the equivalent extended public key to derive the public key for
 this child. Given a parent key /m/ and a derivation index /i/, this function
 will compute /m\/i/.

 Soft derivations allow for more flexibility such as read-only wallets.
 However, care must be taken not the leak both the parent extended public key
 and one of the extended child private keys as this would compromise the
 extended parent private key.
-}
prvSubKey ::
    -- | extended parent private key
    XPrvKey ->
    -- | child derivation index
    KeyIndex ->
    -- | extended child private key
    XPrvKey
prvSubKey :: XPrvKey -> KeyIndex -> XPrvKey
prvSubKey XPrvKey
xkey KeyIndex
child
    | KeyIndex
child KeyIndex -> KeyIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= KeyIndex
0 Bool -> Bool -> Bool
&& KeyIndex
child KeyIndex -> KeyIndex -> Bool
forall a. Ord a => a -> a -> Bool
< KeyIndex
0x80000000 =
        Word8 -> Fingerprint -> KeyIndex -> ChainCode -> SecKey -> XPrvKey
XPrvKey (XPrvKey -> Word8
xPrvDepth XPrvKey
xkey Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) (XPrvKey -> Fingerprint
xPrvFP XPrvKey
xkey) KeyIndex
child ChainCode
c SecKey
k
    | Bool
otherwise = String -> XPrvKey
forall a. HasCallStack => String -> a
error String
"Invalid child derivation index"
  where
    pK :: PubKey
pK = XPubKey -> PubKey
xPubKey (XPubKey -> PubKey) -> XPubKey -> PubKey
forall a b. (a -> b) -> a -> b
$ XPrvKey -> XPubKey
deriveXPubKey XPrvKey
xkey
    m :: ByteString
m = ByteString -> ByteString -> ByteString
B.append (Bool -> PubKey -> ByteString
exportPubKey Bool
True PubKey
pK) (Put -> ByteString
runPutS (KeyIndex -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize KeyIndex
child))
    (ChainCode
a, ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 (Hash512 -> (ChainCode, ChainCode))
-> Hash512 -> (ChainCode, ChainCode)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 (Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ChainCode -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ChainCode -> Put) -> ChainCode -> Put
forall a b. (a -> b) -> a -> b
$ XPrvKey -> ChainCode
xPrvChain XPrvKey
xkey) ByteString
m
    k :: SecKey
k = SecKey -> Maybe SecKey -> SecKey
forall a. a -> Maybe a -> a
fromMaybe SecKey
forall a. a
err (Maybe SecKey -> SecKey) -> Maybe SecKey -> SecKey
forall a b. (a -> b) -> a -> b
$ SecKey -> ChainCode -> Maybe SecKey
tweakSecKey (XPrvKey -> SecKey
xPrvKey XPrvKey
xkey) ChainCode
a
    err :: a
err = DerivationException -> a
forall a e. Exception e => e -> a
throw (DerivationException -> a) -> DerivationException -> a
forall a b. (a -> b) -> a -> b
$ String -> DerivationException
DerivationException String
"Invalid prvSubKey derivation"

{- | Compute a public, soft child key derivation. Given a parent key /M/
 and a derivation index /i/, this function will compute /M\/i/.
-}
pubSubKey ::
    -- | extended parent public key
    XPubKey ->
    -- | child derivation index
    KeyIndex ->
    -- | extended child public key
    XPubKey
pubSubKey :: XPubKey -> KeyIndex -> XPubKey
pubSubKey XPubKey
xKey KeyIndex
child
    | KeyIndex
child KeyIndex -> KeyIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= KeyIndex
0 Bool -> Bool -> Bool
&& KeyIndex
child KeyIndex -> KeyIndex -> Bool
forall a. Ord a => a -> a -> Bool
< KeyIndex
0x80000000 =
        Word8 -> Fingerprint -> KeyIndex -> ChainCode -> PubKey -> XPubKey
XPubKey (XPubKey -> Word8
xPubDepth XPubKey
xKey Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) (XPubKey -> Fingerprint
xPubFP XPubKey
xKey) KeyIndex
child ChainCode
c PubKey
pK
    | Bool
otherwise = String -> XPubKey
forall a. HasCallStack => String -> a
error String
"Invalid child derivation index"
  where
    m :: ByteString
m = ByteString -> ByteString -> ByteString
B.append (Bool -> PubKey -> ByteString
exportPubKey Bool
True (XPubKey -> PubKey
xPubKey XPubKey
xKey)) (Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ KeyIndex -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize KeyIndex
child)
    (ChainCode
a, ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 (Hash512 -> (ChainCode, ChainCode))
-> Hash512 -> (ChainCode, ChainCode)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 (Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ChainCode -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ChainCode -> Put) -> ChainCode -> Put
forall a b. (a -> b) -> a -> b
$ XPubKey -> ChainCode
xPubChain XPubKey
xKey) ByteString
m
    pK :: PubKey
pK = PubKey -> Maybe PubKey -> PubKey
forall a. a -> Maybe a -> a
fromMaybe PubKey
forall a. a
err (Maybe PubKey -> PubKey) -> Maybe PubKey -> PubKey
forall a b. (a -> b) -> a -> b
$ PubKey -> ChainCode -> Maybe PubKey
tweakPubKey (XPubKey -> PubKey
xPubKey XPubKey
xKey) ChainCode
a
    err :: a
err = DerivationException -> a
forall a e. Exception e => e -> a
throw (DerivationException -> a) -> DerivationException -> a
forall a b. (a -> b) -> a -> b
$ String -> DerivationException
DerivationException String
"Invalid pubSubKey derivation"

{- | Compute a hard child key derivation. Hard derivations can only be computed
 for private keys. Hard derivations do not allow the parent public key to
 derive the child public keys. However, they are safer as a breach of the
 parent public key and child private keys does not lead to a breach of the
 parent private key. Given a parent key /m/ and a derivation index /i/, this
 function will compute /m\/i'/.
-}
hardSubKey ::
    -- | extended parent private key
    XPrvKey ->
    -- | child derivation index
    KeyIndex ->
    -- | extended child private key
    XPrvKey
hardSubKey :: XPrvKey -> KeyIndex -> XPrvKey
hardSubKey XPrvKey
xkey KeyIndex
child
    | KeyIndex
child KeyIndex -> KeyIndex -> Bool
forall a. Ord a => a -> a -> Bool
>= KeyIndex
0 Bool -> Bool -> Bool
&& KeyIndex
child KeyIndex -> KeyIndex -> Bool
forall a. Ord a => a -> a -> Bool
< KeyIndex
0x80000000 =
        Word8 -> Fingerprint -> KeyIndex -> ChainCode -> SecKey -> XPrvKey
XPrvKey (XPrvKey -> Word8
xPrvDepth XPrvKey
xkey Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) (XPrvKey -> Fingerprint
xPrvFP XPrvKey
xkey) KeyIndex
i ChainCode
c SecKey
k
    | Bool
otherwise = String -> XPrvKey
forall a. HasCallStack => String -> a
error String
"Invalid child derivation index"
  where
    i :: KeyIndex
i = KeyIndex -> Int -> KeyIndex
forall a. Bits a => a -> Int -> a
setBit KeyIndex
child Int
31
    m :: ByteString
m = ByteString -> ByteString -> ByteString
B.append (SecKey -> ByteString
bsPadPrvKey (SecKey -> ByteString) -> SecKey -> ByteString
forall a b. (a -> b) -> a -> b
$ XPrvKey -> SecKey
xPrvKey XPrvKey
xkey) (Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ KeyIndex -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize KeyIndex
i)
    (ChainCode
a, ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 (Hash512 -> (ChainCode, ChainCode))
-> Hash512 -> (ChainCode, ChainCode)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 (Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ChainCode -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ChainCode -> Put) -> ChainCode -> Put
forall a b. (a -> b) -> a -> b
$ XPrvKey -> ChainCode
xPrvChain XPrvKey
xkey) ByteString
m
    k :: SecKey
k = SecKey -> Maybe SecKey -> SecKey
forall a. a -> Maybe a -> a
fromMaybe SecKey
forall a. a
err (Maybe SecKey -> SecKey) -> Maybe SecKey -> SecKey
forall a b. (a -> b) -> a -> b
$ SecKey -> ChainCode -> Maybe SecKey
tweakSecKey (XPrvKey -> SecKey
xPrvKey XPrvKey
xkey) ChainCode
a
    err :: a
err = DerivationException -> a
forall a e. Exception e => e -> a
throw (DerivationException -> a) -> DerivationException -> a
forall a b. (a -> b) -> a -> b
$ String -> DerivationException
DerivationException String
"Invalid hardSubKey derivation"

{- | Returns true if the extended private key was derived through a hard
 derivation.
-}
xPrvIsHard :: XPrvKey -> Bool
xPrvIsHard :: XPrvKey -> Bool
xPrvIsHard XPrvKey
k = KeyIndex -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (XPrvKey -> KeyIndex
xPrvIndex XPrvKey
k) Int
31

{- | Returns true if the extended public key was derived through a hard
 derivation.
-}
xPubIsHard :: XPubKey -> Bool
xPubIsHard :: XPubKey -> Bool
xPubIsHard XPubKey
k = KeyIndex -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit (XPubKey -> KeyIndex
xPubIndex XPubKey
k) Int
31

{- | Returns the derivation index of this extended private key without the hard
 bit set.
-}
xPrvChild :: XPrvKey -> KeyIndex
xPrvChild :: XPrvKey -> KeyIndex
xPrvChild XPrvKey
k = KeyIndex -> Int -> KeyIndex
forall a. Bits a => a -> Int -> a
clearBit (XPrvKey -> KeyIndex
xPrvIndex XPrvKey
k) Int
31

{- | Returns the derivation index of this extended public key without the hard
 bit set.
-}
xPubChild :: XPubKey -> KeyIndex
xPubChild :: XPubKey -> KeyIndex
xPubChild XPubKey
k = KeyIndex -> Int -> KeyIndex
forall a. Bits a => a -> Int -> a
clearBit (XPubKey -> KeyIndex
xPubIndex XPubKey
k) Int
31

-- | Computes the key identifier of an extended private key.
xPrvID :: XPrvKey -> Hash160
xPrvID :: XPrvKey -> Hash160
xPrvID = XPubKey -> Hash160
xPubID (XPubKey -> Hash160) -> (XPrvKey -> XPubKey) -> XPrvKey -> Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrvKey -> XPubKey
deriveXPubKey

-- | Computes the key identifier of an extended public key.
xPubID :: XPubKey -> Hash160
xPubID :: XPubKey -> Hash160
xPubID = ByteString -> Hash160
forall b. ByteArrayAccess b => b -> Hash160
ripemd160 (ByteString -> Hash160)
-> (XPubKey -> ByteString) -> XPubKey -> Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> Putter XPubKey -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainCode -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ChainCode -> Put) -> (XPubKey -> ChainCode) -> Putter XPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ChainCode
forall b. ByteArrayAccess b => b -> ChainCode
sha256 (ByteString -> ChainCode)
-> (XPubKey -> ByteString) -> XPubKey -> ChainCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> PubKey -> ByteString
exportPubKey Bool
True (PubKey -> ByteString)
-> (XPubKey -> PubKey) -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> PubKey
xPubKey

-- | Computes the key fingerprint of an extended private key.
xPrvFP :: XPrvKey -> Fingerprint
xPrvFP :: XPrvKey -> Fingerprint
xPrvFP =
    Fingerprint -> Either String Fingerprint -> Fingerprint
forall b a. b -> Either a b -> b
fromRight Fingerprint
forall a. a
err (Either String Fingerprint -> Fingerprint)
-> (XPrvKey -> Either String Fingerprint) -> XPrvKey -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get Fingerprint -> ByteString -> Either String Fingerprint
forall a. Get a -> ByteString -> Either String a
runGetS Get Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> Either String Fingerprint)
-> (XPrvKey -> ByteString) -> XPrvKey -> Either String Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
4 (ByteString -> ByteString)
-> (XPrvKey -> ByteString) -> XPrvKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> Putter XPrvKey -> XPrvKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Hash160 -> Put) -> (XPrvKey -> Hash160) -> Putter XPrvKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrvKey -> Hash160
xPrvID
  where
    err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"Could not decode xPrvFP"

-- | Computes the key fingerprint of an extended public key.
xPubFP :: XPubKey -> Fingerprint
xPubFP :: XPubKey -> Fingerprint
xPubFP =
    Fingerprint -> Either String Fingerprint -> Fingerprint
forall b a. b -> Either a b -> b
fromRight Fingerprint
forall a. a
err (Either String Fingerprint -> Fingerprint)
-> (XPubKey -> Either String Fingerprint) -> XPubKey -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get Fingerprint -> ByteString -> Either String Fingerprint
forall a. Get a -> ByteString -> Either String a
runGetS Get Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize (ByteString -> Either String Fingerprint)
-> (XPubKey -> ByteString) -> XPubKey -> Either String Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
4 (ByteString -> ByteString)
-> (XPubKey -> ByteString) -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> Putter XPubKey -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (Hash160 -> Put) -> (XPubKey -> Hash160) -> Putter XPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> Hash160
xPubID
  where
    err :: a
err = String -> a
forall a. HasCallStack => String -> a
error String
"Could not decode xPubFP"

-- | Compute a standard P2PKH address for an extended public key.
xPubAddr :: XPubKey -> Address
xPubAddr :: XPubKey -> Address
xPubAddr XPubKey
xkey = PubKeyI -> Address
pubKeyAddr (Bool -> PubKey -> PubKeyI
wrapPubKey Bool
True (XPubKey -> PubKey
xPubKey XPubKey
xkey))

-- | Compute a SegWit P2WPKH address for an extended public key.
xPubWitnessAddr :: XPubKey -> Address
xPubWitnessAddr :: XPubKey -> Address
xPubWitnessAddr XPubKey
xkey = PubKeyI -> Address
pubKeyWitnessAddr (Bool -> PubKey -> PubKeyI
wrapPubKey Bool
True (XPubKey -> PubKey
xPubKey XPubKey
xkey))

{- | Compute a backwards-compatible SegWit P2SH-P2WPKH address for an extended
 public key.
-}
xPubCompatWitnessAddr :: XPubKey -> Address
xPubCompatWitnessAddr :: XPubKey -> Address
xPubCompatWitnessAddr XPubKey
xkey =
    PubKeyI -> Address
pubKeyCompatWitnessAddr (Bool -> PubKey -> PubKeyI
wrapPubKey Bool
True (XPubKey -> PubKey
xPubKey XPubKey
xkey))

-- | Exports an extended private key to the BIP32 key export format ('Base58').
xPrvExport :: Network -> XPrvKey -> Base58
xPrvExport :: Network -> XPrvKey -> Text
xPrvExport Network
net = ByteString -> Text
encodeBase58Check (ByteString -> Text) -> (XPrvKey -> ByteString) -> XPrvKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> Putter XPrvKey -> XPrvKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Putter XPrvKey
forall (m :: * -> *). MonadPut m => Network -> XPrvKey -> m ()
putXPrvKey Network
net

-- | Exports an extended public key to the BIP32 key export format ('Base58').
xPubExport :: Network -> XPubKey -> Base58
xPubExport :: Network -> XPubKey -> Text
xPubExport Network
net = ByteString -> Text
encodeBase58Check (ByteString -> Text) -> (XPubKey -> ByteString) -> XPubKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS (Put -> ByteString) -> Putter XPubKey -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Putter XPubKey
forall (m :: * -> *). MonadPut m => Network -> XPubKey -> m ()
putXPubKey Network
net

{- | Decodes a BIP32 encoded extended private key. This function will fail if
 invalid base 58 characters are detected or if the checksum fails.
-}
xPrvImport :: Network -> Base58 -> Maybe XPrvKey
xPrvImport :: Network -> Text -> Maybe XPrvKey
xPrvImport Network
net = Either String XPrvKey -> Maybe XPrvKey
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String XPrvKey -> Maybe XPrvKey)
-> (ByteString -> Either String XPrvKey)
-> ByteString
-> Maybe XPrvKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get XPrvKey -> ByteString -> Either String XPrvKey
forall a. Get a -> ByteString -> Either String a
runGetS (Network -> Get XPrvKey
forall (m :: * -> *). MonadGet m => Network -> m XPrvKey
getXPrvKey Network
net) (ByteString -> Maybe XPrvKey)
-> (Text -> Maybe ByteString) -> Text -> Maybe XPrvKey
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeBase58Check

{- | Decodes a BIP32 encoded extended public key. This function will fail if
 invalid base 58 characters are detected or if the checksum fails.
-}
xPubImport :: Network -> Base58 -> Maybe XPubKey
xPubImport :: Network -> Text -> Maybe XPubKey
xPubImport Network
net = Either String XPubKey -> Maybe XPubKey
forall a b. Either a b -> Maybe b
eitherToMaybe (Either String XPubKey -> Maybe XPubKey)
-> (ByteString -> Either String XPubKey)
-> ByteString
-> Maybe XPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Get XPubKey -> ByteString -> Either String XPubKey
forall a. Get a -> ByteString -> Either String a
runGetS (Network -> Get XPubKey
forall (m :: * -> *). MonadGet m => Network -> m XPubKey
getXPubKey Network
net) (ByteString -> Maybe XPubKey)
-> (Text -> Maybe ByteString) -> Text -> Maybe XPubKey
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Text -> Maybe ByteString
decodeBase58Check

-- | Export an extended private key to WIF (Wallet Import Format).
xPrvWif :: Network -> XPrvKey -> Base58
xPrvWif :: Network -> XPrvKey -> Text
xPrvWif Network
net XPrvKey
xkey = Network -> SecKeyI -> Text
toWif Network
net (Bool -> SecKey -> SecKeyI
wrapSecKey Bool
True (XPrvKey -> SecKey
xPrvKey XPrvKey
xkey))

-- | Parse a binary extended private key.
getXPrvKey :: MonadGet m => Network -> m XPrvKey
getXPrvKey :: Network -> m XPrvKey
getXPrvKey Network
net = do
    KeyIndex
ver <- m KeyIndex
forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (KeyIndex
ver KeyIndex -> KeyIndex -> Bool
forall a. Eq a => a -> a -> Bool
== Network -> KeyIndex
getExtSecretPrefix Network
net) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
            String
"Get: Invalid version for extended private key"
    m XPrvKey
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Serialize an extended private key.
putXPrvKey :: MonadPut m => Network -> XPrvKey -> m ()
putXPrvKey :: Network -> XPrvKey -> m ()
putXPrvKey Network
net XPrvKey
k = do
    KeyIndex -> m ()
forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be (KeyIndex -> m ()) -> KeyIndex -> m ()
forall a b. (a -> b) -> a -> b
$ Network -> KeyIndex
getExtSecretPrefix Network
net
    XPrvKey -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize XPrvKey
k

-- | Parse a binary extended public key.
getXPubKey :: MonadGet m => Network -> m XPubKey
getXPubKey :: Network -> m XPubKey
getXPubKey Network
net = do
    KeyIndex
ver <- m KeyIndex
forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (KeyIndex
ver KeyIndex -> KeyIndex -> Bool
forall a. Eq a => a -> a -> Bool
== Network -> KeyIndex
getExtPubKeyPrefix Network
net) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
            String
"Get: Invalid version for extended public key"
    m XPubKey
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Serialize an extended public key.
putXPubKey :: MonadPut m => Network -> XPubKey -> m ()
putXPubKey :: Network -> XPubKey -> m ()
putXPubKey Network
net XPubKey
k = do
    KeyIndex -> m ()
forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be (KeyIndex -> m ()) -> KeyIndex -> m ()
forall a b. (a -> b) -> a -> b
$ Network -> KeyIndex
getExtPubKeyPrefix Network
net
    XPubKey -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize XPubKey
k

{- Derivation helpers -}

{- | Cyclic list of all private soft child key derivations of a parent key
 starting from an offset index.
-}
prvSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)]
prvSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)]
prvSubKeys XPrvKey
k = (KeyIndex -> (XPrvKey, KeyIndex))
-> [KeyIndex] -> [(XPrvKey, KeyIndex)]
forall a b. (a -> b) -> [a] -> [b]
map (\KeyIndex
i -> (XPrvKey -> KeyIndex -> XPrvKey
prvSubKey XPrvKey
k KeyIndex
i, KeyIndex
i)) ([KeyIndex] -> [(XPrvKey, KeyIndex)])
-> (KeyIndex -> [KeyIndex]) -> KeyIndex -> [(XPrvKey, KeyIndex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIndex -> [KeyIndex]
cycleIndex

{- | Cyclic list of all public soft child key derivations of a parent key
 starting from an offset index.
-}
pubSubKeys :: XPubKey -> KeyIndex -> [(XPubKey, KeyIndex)]
pubSubKeys :: XPubKey -> KeyIndex -> [(XPubKey, KeyIndex)]
pubSubKeys XPubKey
k = (KeyIndex -> (XPubKey, KeyIndex))
-> [KeyIndex] -> [(XPubKey, KeyIndex)]
forall a b. (a -> b) -> [a] -> [b]
map (\KeyIndex
i -> (XPubKey -> KeyIndex -> XPubKey
pubSubKey XPubKey
k KeyIndex
i, KeyIndex
i)) ([KeyIndex] -> [(XPubKey, KeyIndex)])
-> (KeyIndex -> [KeyIndex]) -> KeyIndex -> [(XPubKey, KeyIndex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIndex -> [KeyIndex]
cycleIndex

{- | Cyclic list of all hard child key derivations of a parent key starting
 from an offset index.
-}
hardSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)]
hardSubKeys :: XPrvKey -> KeyIndex -> [(XPrvKey, KeyIndex)]
hardSubKeys XPrvKey
k = (KeyIndex -> (XPrvKey, KeyIndex))
-> [KeyIndex] -> [(XPrvKey, KeyIndex)]
forall a b. (a -> b) -> [a] -> [b]
map (\KeyIndex
i -> (XPrvKey -> KeyIndex -> XPrvKey
hardSubKey XPrvKey
k KeyIndex
i, KeyIndex
i)) ([KeyIndex] -> [(XPrvKey, KeyIndex)])
-> (KeyIndex -> [KeyIndex]) -> KeyIndex -> [(XPrvKey, KeyIndex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIndex -> [KeyIndex]
cycleIndex

-- | Derive a standard address from an extended public key and an index.
deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKey)
deriveAddr :: XPubKey -> KeyIndex -> (Address, PubKey)
deriveAddr XPubKey
k KeyIndex
i =
    (XPubKey -> Address
xPubAddr XPubKey
key, XPubKey -> PubKey
xPubKey XPubKey
key)
  where
    key :: XPubKey
key = XPubKey -> KeyIndex -> XPubKey
pubSubKey XPubKey
k KeyIndex
i

-- | Derive a SegWit P2WPKH address from an extended public key and an index.
deriveWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey)
deriveWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey)
deriveWitnessAddr XPubKey
k KeyIndex
i =
    (XPubKey -> Address
xPubWitnessAddr XPubKey
key, XPubKey -> PubKey
xPubKey XPubKey
key)
  where
    key :: XPubKey
key = XPubKey -> KeyIndex -> XPubKey
pubSubKey XPubKey
k KeyIndex
i

{- | Derive a backwards-compatible SegWit P2SH-P2WPKH address from an extended
 public key and an index.
-}
deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey)
deriveCompatWitnessAddr :: XPubKey -> KeyIndex -> (Address, PubKey)
deriveCompatWitnessAddr XPubKey
k KeyIndex
i =
    (XPubKey -> Address
xPubCompatWitnessAddr XPubKey
key, XPubKey -> PubKey
xPubKey XPubKey
key)
  where
    key :: XPubKey
key = XPubKey -> KeyIndex -> XPubKey
pubSubKey XPubKey
k KeyIndex
i

{- | Cyclic list of all addresses derived from a public key starting from an
 offset index.
-}
deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
deriveAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
deriveAddrs XPubKey
k =
    (KeyIndex -> (Address, PubKey, KeyIndex))
-> [KeyIndex] -> [(Address, PubKey, KeyIndex)]
forall a b. (a -> b) -> [a] -> [b]
map KeyIndex -> (Address, PubKey, KeyIndex)
f ([KeyIndex] -> [(Address, PubKey, KeyIndex)])
-> (KeyIndex -> [KeyIndex])
-> KeyIndex
-> [(Address, PubKey, KeyIndex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIndex -> [KeyIndex]
cycleIndex
  where
    f :: KeyIndex -> (Address, PubKey, KeyIndex)
f KeyIndex
i = let (Address
a, PubKey
key) = XPubKey -> KeyIndex -> (Address, PubKey)
deriveAddr XPubKey
k KeyIndex
i in (Address
a, PubKey
key, KeyIndex
i)

{- | Cyclic list of all SegWit P2WPKH addresses derived from a public key
 starting from an offset index.
-}
deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
deriveWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
deriveWitnessAddrs XPubKey
k =
    (KeyIndex -> (Address, PubKey, KeyIndex))
-> [KeyIndex] -> [(Address, PubKey, KeyIndex)]
forall a b. (a -> b) -> [a] -> [b]
map KeyIndex -> (Address, PubKey, KeyIndex)
f ([KeyIndex] -> [(Address, PubKey, KeyIndex)])
-> (KeyIndex -> [KeyIndex])
-> KeyIndex
-> [(Address, PubKey, KeyIndex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIndex -> [KeyIndex]
cycleIndex
  where
    f :: KeyIndex -> (Address, PubKey, KeyIndex)
f KeyIndex
i = let (Address
a, PubKey
key) = XPubKey -> KeyIndex -> (Address, PubKey)
deriveWitnessAddr XPubKey
k KeyIndex
i in (Address
a, PubKey
key, KeyIndex
i)

{- | Cyclic list of all backwards-compatible SegWit P2SH-P2WPKH addresses
 derived from a public key starting from an offset index.
-}
deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
deriveCompatWitnessAddrs :: XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
deriveCompatWitnessAddrs XPubKey
k =
    (KeyIndex -> (Address, PubKey, KeyIndex))
-> [KeyIndex] -> [(Address, PubKey, KeyIndex)]
forall a b. (a -> b) -> [a] -> [b]
map KeyIndex -> (Address, PubKey, KeyIndex)
f ([KeyIndex] -> [(Address, PubKey, KeyIndex)])
-> (KeyIndex -> [KeyIndex])
-> KeyIndex
-> [(Address, PubKey, KeyIndex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIndex -> [KeyIndex]
cycleIndex
  where
    f :: KeyIndex -> (Address, PubKey, KeyIndex)
f KeyIndex
i = let (Address
a, PubKey
key) = XPubKey -> KeyIndex -> (Address, PubKey)
deriveCompatWitnessAddr XPubKey
k KeyIndex
i in (Address
a, PubKey
key, KeyIndex
i)

{- | Derive a multisig address from a list of public keys, the number of
 required signatures /m/ and a derivation index. The derivation type is a
 public, soft derivation.
-}
deriveMSAddr :: [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript)
deriveMSAddr :: [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript)
deriveMSAddr [XPubKey]
keys Int
m KeyIndex
i = (RedeemScript -> Address
payToScriptAddress RedeemScript
rdm, RedeemScript
rdm)
  where
    rdm :: RedeemScript
rdm = RedeemScript -> RedeemScript
sortMulSig (RedeemScript -> RedeemScript) -> RedeemScript -> RedeemScript
forall a b. (a -> b) -> a -> b
$ [PubKeyI] -> Int -> RedeemScript
PayMulSig [PubKeyI]
k Int
m
    k :: [PubKeyI]
k = (XPubKey -> PubKeyI) -> [XPubKey] -> [PubKeyI]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> PubKey -> PubKeyI
wrapPubKey Bool
True (PubKey -> PubKeyI) -> (XPubKey -> PubKey) -> XPubKey -> PubKeyI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> PubKey
xPubKey (XPubKey -> PubKey) -> (XPubKey -> XPubKey) -> XPubKey -> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubKey -> KeyIndex -> XPubKey) -> KeyIndex -> XPubKey -> XPubKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip XPubKey -> KeyIndex -> XPubKey
pubSubKey KeyIndex
i) [XPubKey]
keys

{- | Cyclic list of all multisig addresses derived from a list of public keys,
 a number of required signatures /m/ and starting from an offset index. The
 derivation type is a public, soft derivation.
-}
deriveMSAddrs ::
    [XPubKey] ->
    Int ->
    KeyIndex ->
    [(Address, RedeemScript, KeyIndex)]
deriveMSAddrs :: [XPubKey] -> Int -> KeyIndex -> [(Address, RedeemScript, KeyIndex)]
deriveMSAddrs [XPubKey]
keys Int
m = (KeyIndex -> (Address, RedeemScript, KeyIndex))
-> [KeyIndex] -> [(Address, RedeemScript, KeyIndex)]
forall a b. (a -> b) -> [a] -> [b]
map KeyIndex -> (Address, RedeemScript, KeyIndex)
f ([KeyIndex] -> [(Address, RedeemScript, KeyIndex)])
-> (KeyIndex -> [KeyIndex])
-> KeyIndex
-> [(Address, RedeemScript, KeyIndex)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIndex -> [KeyIndex]
cycleIndex
  where
    f :: KeyIndex -> (Address, RedeemScript, KeyIndex)
f KeyIndex
i =
        let (Address
a, RedeemScript
rdm) = [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript)
deriveMSAddr [XPubKey]
keys Int
m KeyIndex
i
         in (Address
a, RedeemScript
rdm, KeyIndex
i)

-- | Helper function to go through derivation indices.
cycleIndex :: KeyIndex -> [KeyIndex]
cycleIndex :: KeyIndex -> [KeyIndex]
cycleIndex KeyIndex
i
    | KeyIndex
i KeyIndex -> KeyIndex -> Bool
forall a. Eq a => a -> a -> Bool
== KeyIndex
0 = [KeyIndex] -> [KeyIndex]
forall a. [a] -> [a]
cycle [KeyIndex
0 .. KeyIndex
0x7fffffff]
    | KeyIndex
i KeyIndex -> KeyIndex -> Bool
forall a. Ord a => a -> a -> Bool
< KeyIndex
0x80000000 = [KeyIndex] -> [KeyIndex]
forall a. [a] -> [a]
cycle ([KeyIndex] -> [KeyIndex]) -> [KeyIndex] -> [KeyIndex]
forall a b. (a -> b) -> a -> b
$ [KeyIndex
i .. KeyIndex
0x7fffffff] [KeyIndex] -> [KeyIndex] -> [KeyIndex]
forall a. [a] -> [a] -> [a]
++ [KeyIndex
0 .. (KeyIndex
i KeyIndex -> KeyIndex -> KeyIndex
forall a. Num a => a -> a -> a
- KeyIndex
1)]
    | Bool
otherwise = String -> [KeyIndex]
forall a. HasCallStack => String -> a
error (String -> [KeyIndex]) -> String -> [KeyIndex]
forall a b. (a -> b) -> a -> b
$ String
"cycleIndex: invalid index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ KeyIndex -> String
forall a. Show a => a -> String
show KeyIndex
i

{- Derivation Paths -}

{- | Phantom type signaling a hardened derivation path that can only be computed
 from private extended key.
-}
data HardDeriv deriving ((forall x. HardDeriv -> Rep HardDeriv x)
-> (forall x. Rep HardDeriv x -> HardDeriv) -> Generic HardDeriv
forall x. Rep HardDeriv x -> HardDeriv
forall x. HardDeriv -> Rep HardDeriv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HardDeriv x -> HardDeriv
$cfrom :: forall x. HardDeriv -> Rep HardDeriv x
Generic, HardDeriv -> ()
(HardDeriv -> ()) -> NFData HardDeriv
forall a. (a -> ()) -> NFData a
rnf :: HardDeriv -> ()
$crnf :: HardDeriv -> ()
NFData)

-- | Phantom type signaling no knowledge about derivation path: can be hardened or not.
data AnyDeriv deriving ((forall x. AnyDeriv -> Rep AnyDeriv x)
-> (forall x. Rep AnyDeriv x -> AnyDeriv) -> Generic AnyDeriv
forall x. Rep AnyDeriv x -> AnyDeriv
forall x. AnyDeriv -> Rep AnyDeriv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AnyDeriv x -> AnyDeriv
$cfrom :: forall x. AnyDeriv -> Rep AnyDeriv x
Generic, AnyDeriv -> ()
(AnyDeriv -> ()) -> NFData AnyDeriv
forall a. (a -> ()) -> NFData a
rnf :: AnyDeriv -> ()
$crnf :: AnyDeriv -> ()
NFData)

{- | Phantom type signaling derivation path including only non-hardened paths
 that can be computed from an extended public key.
-}
data SoftDeriv deriving ((forall x. SoftDeriv -> Rep SoftDeriv x)
-> (forall x. Rep SoftDeriv x -> SoftDeriv) -> Generic SoftDeriv
forall x. Rep SoftDeriv x -> SoftDeriv
forall x. SoftDeriv -> Rep SoftDeriv x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SoftDeriv x -> SoftDeriv
$cfrom :: forall x. SoftDeriv -> Rep SoftDeriv x
Generic, SoftDeriv -> ()
(SoftDeriv -> ()) -> NFData SoftDeriv
forall a. (a -> ()) -> NFData a
rnf :: SoftDeriv -> ()
$crnf :: SoftDeriv -> ()
NFData)

-- | Hardened derivation path. Can be computed from extended private key only.
type HardPath = DerivPathI HardDeriv

-- | Any derivation path.
type DerivPath = DerivPathI AnyDeriv

-- | Non-hardened derivation path can be computed from extended public key.
type SoftPath = DerivPathI SoftDeriv

-- | Helper class to perform validations on a hardened derivation path.
class HardOrAny a

instance HardOrAny HardDeriv
instance HardOrAny AnyDeriv

-- | Helper class to perform validations on a non-hardened derivation path.
class AnyOrSoft a

instance AnyOrSoft AnyDeriv
instance AnyOrSoft SoftDeriv

{- | Data type representing a derivation path. Two constructors are provided
 for specifying soft or hard derivations. The path /\/0\/1'\/2/ for example can be
 expressed as @'Deriv' :\/ 0 :| 1 :\/ 2@. The 'HardOrAny' and 'AnyOrSoft' type
 classes are used to constrain the valid values for the phantom type /t/. If
 you mix hard '(:|)' and soft '(:\/)' paths, the only valid type for /t/ is 'AnyDeriv'.
 Otherwise, /t/ can be 'HardDeriv' if you only have hard derivation or 'SoftDeriv'
 if you only have soft derivations.

 Using this type is as easy as writing the required derivation like in these
 example:

 > Deriv :/ 0 :/ 1 :/ 2 :: SoftPath
 > Deriv :| 0 :| 1 :| 2 :: HardPath
 > Deriv :| 0 :/ 1 :/ 2 :: DerivPath
-}
data DerivPathI t where
    (:|) :: HardOrAny t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t
    (:/) :: AnyOrSoft t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t
    Deriv :: DerivPathI t

instance NFData (DerivPathI t) where
    rnf :: DerivPathI t -> ()
rnf (DerivPathI t
a :| KeyIndex
b) = DerivPathI t -> ()
forall a. NFData a => a -> ()
rnf DerivPathI t
a () -> () -> ()
`seq` KeyIndex -> ()
forall a. NFData a => a -> ()
rnf KeyIndex
b
    rnf (DerivPathI t
a :/ KeyIndex
b) = DerivPathI t -> ()
forall a. NFData a => a -> ()
rnf DerivPathI t
a () -> () -> ()
`seq` KeyIndex -> ()
forall a. NFData a => a -> ()
rnf KeyIndex
b
    rnf DerivPathI t
Deriv = ()

instance Eq (DerivPathI t) where
    (DerivPathI t
nextA :| KeyIndex
iA) == :: DerivPathI t -> DerivPathI t -> Bool
== (DerivPathI t
nextB :| KeyIndex
iB) = KeyIndex
iA KeyIndex -> KeyIndex -> Bool
forall a. Eq a => a -> a -> Bool
== KeyIndex
iB Bool -> Bool -> Bool
&& DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Bool
forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB
    (DerivPathI t
nextA :/ KeyIndex
iA) == (DerivPathI t
nextB :/ KeyIndex
iB) = KeyIndex
iA KeyIndex -> KeyIndex -> Bool
forall a. Eq a => a -> a -> Bool
== KeyIndex
iB Bool -> Bool -> Bool
&& DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Bool
forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB
    DerivPathI t
Deriv == DerivPathI t
Deriv = Bool
True
    DerivPathI t
_ == DerivPathI t
_ = Bool
False

instance Ord (DerivPathI t) where
    -- Same hardness on each side
    (DerivPathI t
nextA :| KeyIndex
iA) compare :: DerivPathI t -> DerivPathI t -> Ordering
`compare` (DerivPathI t
nextB :| KeyIndex
iB) =
        if DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Bool
forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then KeyIndex
iA KeyIndex -> KeyIndex -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` KeyIndex
iB else DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` DerivPathI t
nextB
    (DerivPathI t
nextA :/ KeyIndex
iA) `compare` (DerivPathI t
nextB :/ KeyIndex
iB) =
        if DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Bool
forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then KeyIndex
iA KeyIndex -> KeyIndex -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` KeyIndex
iB else DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` DerivPathI t
nextB
    -- Different hardness: hard paths are LT soft paths
    (DerivPathI t
nextA :/ KeyIndex
_iA) `compare` (DerivPathI t
nextB :| KeyIndex
_iB) =
        if DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Bool
forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then Ordering
LT else DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` DerivPathI t
nextB
    (DerivPathI t
nextA :| KeyIndex
_iA) `compare` (DerivPathI t
nextB :/ KeyIndex
_iB) =
        if DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Bool
forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then Ordering
GT else DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` DerivPathI t
nextB
    DerivPathI t
Deriv `compare` DerivPathI t
Deriv = Ordering
EQ
    DerivPathI t
Deriv `compare` DerivPathI t
_ = Ordering
LT
    DerivPathI t
_ `compare` DerivPathI t
Deriv = Ordering
GT

instance Serial DerivPath where
    deserialize :: m DerivPath
deserialize = [KeyIndex] -> DerivPath
listToPath ([KeyIndex] -> DerivPath) -> m [KeyIndex] -> m DerivPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m KeyIndex -> m [KeyIndex]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m KeyIndex
forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
    serialize :: DerivPath -> m ()
serialize = (KeyIndex -> m ()) -> [KeyIndex] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList KeyIndex -> m ()
forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be ([KeyIndex] -> m ())
-> (DerivPath -> [KeyIndex]) -> DerivPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> [KeyIndex]
forall t. DerivPathI t -> [KeyIndex]
pathToList

instance Serialize DerivPath where
    put :: Putter DerivPath
put = Putter DerivPath
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get DerivPath
get = Get DerivPath
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Binary DerivPath where
    put :: DerivPath -> Put
put = DerivPath -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get DerivPath
get = Get DerivPath
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial HardPath where
    deserialize :: m HardPath
deserialize =
        m HardPath
-> (HardPath -> m HardPath) -> Maybe HardPath -> m HardPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (String -> m HardPath
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not decode hard path")
            HardPath -> m HardPath
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Maybe HardPath -> m HardPath)
-> ([KeyIndex] -> Maybe HardPath) -> [KeyIndex] -> m HardPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> Maybe HardPath
forall t. DerivPathI t -> Maybe HardPath
toHard
            (DerivPath -> Maybe HardPath)
-> ([KeyIndex] -> DerivPath) -> [KeyIndex] -> Maybe HardPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KeyIndex] -> DerivPath
listToPath
            ([KeyIndex] -> m HardPath) -> m [KeyIndex] -> m HardPath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m KeyIndex -> m [KeyIndex]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m KeyIndex
forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
    serialize :: HardPath -> m ()
serialize = (KeyIndex -> m ()) -> [KeyIndex] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList KeyIndex -> m ()
forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be ([KeyIndex] -> m ())
-> (HardPath -> [KeyIndex]) -> HardPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardPath -> [KeyIndex]
forall t. DerivPathI t -> [KeyIndex]
pathToList

instance Serialize HardPath where
    put :: Putter HardPath
put = Putter HardPath
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get HardPath
get = Get HardPath
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Binary HardPath where
    put :: HardPath -> Put
put = HardPath -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get HardPath
get = Get HardPath
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Serial SoftPath where
    deserialize :: m SoftPath
deserialize =
        m SoftPath
-> (SoftPath -> m SoftPath) -> Maybe SoftPath -> m SoftPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (String -> m SoftPath
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not decode soft path")
            SoftPath -> m SoftPath
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Maybe SoftPath -> m SoftPath)
-> ([KeyIndex] -> Maybe SoftPath) -> [KeyIndex] -> m SoftPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft
            (DerivPath -> Maybe SoftPath)
-> ([KeyIndex] -> DerivPath) -> [KeyIndex] -> Maybe SoftPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KeyIndex] -> DerivPath
listToPath
            ([KeyIndex] -> m SoftPath) -> m [KeyIndex] -> m SoftPath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m KeyIndex -> m [KeyIndex]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m KeyIndex
forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
    serialize :: SoftPath -> m ()
serialize = (KeyIndex -> m ()) -> [KeyIndex] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList KeyIndex -> m ()
forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be ([KeyIndex] -> m ())
-> (SoftPath -> [KeyIndex]) -> SoftPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SoftPath -> [KeyIndex]
forall t. DerivPathI t -> [KeyIndex]
pathToList

instance Serialize SoftPath where
    put :: Putter SoftPath
put = Putter SoftPath
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get SoftPath
get = Get SoftPath
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

instance Binary SoftPath where
    put :: SoftPath -> Put
put = SoftPath -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get SoftPath
get = Get SoftPath
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Get a list of derivation indices from a derivation path.
pathToList :: DerivPathI t -> [KeyIndex]
pathToList :: DerivPathI t -> [KeyIndex]
pathToList =
    [KeyIndex] -> [KeyIndex]
forall a. [a] -> [a]
reverse ([KeyIndex] -> [KeyIndex])
-> (DerivPathI t -> [KeyIndex]) -> DerivPathI t -> [KeyIndex]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPathI t -> [KeyIndex]
forall t. DerivPathI t -> [KeyIndex]
go
  where
    go :: DerivPathI t -> [KeyIndex]
go (DerivPathI t
next :| KeyIndex
i) = KeyIndex -> Int -> KeyIndex
forall a. Bits a => a -> Int -> a
setBit KeyIndex
i Int
31 KeyIndex -> [KeyIndex] -> [KeyIndex]
forall a. a -> [a] -> [a]
: DerivPathI t -> [KeyIndex]
go DerivPathI t
next
    go (DerivPathI t
next :/ KeyIndex
i) = KeyIndex
i KeyIndex -> [KeyIndex] -> [KeyIndex]
forall a. a -> [a] -> [a]
: DerivPathI t -> [KeyIndex]
go DerivPathI t
next
    go DerivPathI t
_ = []

-- | Convert a list of derivation indices to a derivation path.
listToPath :: [KeyIndex] -> DerivPath
listToPath :: [KeyIndex] -> DerivPath
listToPath =
    [KeyIndex] -> DerivPath
forall t. (HardOrAny t, AnyOrSoft t) => [KeyIndex] -> DerivPathI t
go ([KeyIndex] -> DerivPath)
-> ([KeyIndex] -> [KeyIndex]) -> [KeyIndex] -> DerivPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [KeyIndex] -> [KeyIndex]
forall a. [a] -> [a]
reverse
  where
    go :: [KeyIndex] -> DerivPathI t
go (KeyIndex
i : [KeyIndex]
is)
        | KeyIndex -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit KeyIndex
i Int
31 = [KeyIndex] -> DerivPathI t
go [KeyIndex]
is DerivPathI t -> KeyIndex -> DerivPathI t
forall t. HardOrAny t => DerivPathI t -> KeyIndex -> DerivPathI t
:| KeyIndex -> Int -> KeyIndex
forall a. Bits a => a -> Int -> a
clearBit KeyIndex
i Int
31
        | Bool
otherwise = [KeyIndex] -> DerivPathI t
go [KeyIndex]
is DerivPathI t -> KeyIndex -> DerivPathI t
forall t. AnyOrSoft t => DerivPathI t -> KeyIndex -> DerivPathI t
:/ KeyIndex
i
    go [] = DerivPathI t
forall t. DerivPathI t
Deriv

-- | Convert a derivation path to a human-readable string.
pathToStr :: DerivPathI t -> String
pathToStr :: DerivPathI t -> String
pathToStr DerivPathI t
p =
    case DerivPathI t
p of
        DerivPathI t
next :| KeyIndex
i -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [DerivPathI t -> String
forall t. DerivPathI t -> String
pathToStr DerivPathI t
next, String
"/", KeyIndex -> String
forall a. Show a => a -> String
show KeyIndex
i, String
"'"]
        DerivPathI t
next :/ KeyIndex
i -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [DerivPathI t -> String
forall t. DerivPathI t -> String
pathToStr DerivPathI t
next, String
"/", KeyIndex -> String
forall a. Show a => a -> String
show KeyIndex
i]
        DerivPathI t
Deriv -> String
""

{- | Turn a derivation path into a hard derivation path. Will fail if the path
 contains soft derivations.
-}
toHard :: DerivPathI t -> Maybe HardPath
toHard :: DerivPathI t -> Maybe HardPath
toHard DerivPathI t
p = case DerivPathI t
p of
    DerivPathI t
next :| KeyIndex
i -> (HardPath -> KeyIndex -> HardPath
forall t. HardOrAny t => DerivPathI t -> KeyIndex -> DerivPathI t
:| KeyIndex
i) (HardPath -> HardPath) -> Maybe HardPath -> Maybe HardPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DerivPathI t -> Maybe HardPath
forall t. DerivPathI t -> Maybe HardPath
toHard DerivPathI t
next
    DerivPathI t
Deriv -> HardPath -> Maybe HardPath
forall a. a -> Maybe a
Just HardPath
forall t. DerivPathI t
Deriv
    DerivPathI t
_ -> Maybe HardPath
forall a. Maybe a
Nothing

{- | Turn a derivation path into a soft derivation path. Will fail if the path
 has hard derivations.
-}
toSoft :: DerivPathI t -> Maybe SoftPath
toSoft :: DerivPathI t -> Maybe SoftPath
toSoft DerivPathI t
p = case DerivPathI t
p of
    DerivPathI t
next :/ KeyIndex
i -> (SoftPath -> KeyIndex -> SoftPath
forall t. AnyOrSoft t => DerivPathI t -> KeyIndex -> DerivPathI t
:/ KeyIndex
i) (SoftPath -> SoftPath) -> Maybe SoftPath -> Maybe SoftPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DerivPathI t -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft DerivPathI t
next
    DerivPathI t
Deriv -> SoftPath -> Maybe SoftPath
forall a. a -> Maybe a
Just SoftPath
forall t. DerivPathI t
Deriv
    DerivPathI t
_ -> Maybe SoftPath
forall a. Maybe a
Nothing

-- | Make a derivation path generic.
toGeneric :: DerivPathI t -> DerivPath
toGeneric :: DerivPathI t -> DerivPath
toGeneric DerivPathI t
p = case DerivPathI t
p of
    DerivPathI t
next :/ KeyIndex
i -> DerivPathI t -> DerivPath
forall t. DerivPathI t -> DerivPath
toGeneric DerivPathI t
next DerivPath -> KeyIndex -> DerivPath
forall t. AnyOrSoft t => DerivPathI t -> KeyIndex -> DerivPathI t
:/ KeyIndex
i
    DerivPathI t
next :| KeyIndex
i -> DerivPathI t -> DerivPath
forall t. DerivPathI t -> DerivPath
toGeneric DerivPathI t
next DerivPath -> KeyIndex -> DerivPath
forall t. HardOrAny t => DerivPathI t -> KeyIndex -> DerivPathI t
:| KeyIndex
i
    DerivPathI t
Deriv -> DerivPath
forall t. DerivPathI t
Deriv

{- | Append two derivation paths together. The result will be a mixed
 derivation path.
-}
(++/) :: DerivPathI t1 -> DerivPathI t2 -> DerivPath
++/ :: DerivPathI t1 -> DerivPathI t2 -> DerivPath
(++/) DerivPathI t1
p1 DerivPathI t2
p2 =
    (DerivPath -> DerivPath) -> DerivPath -> DerivPath -> DerivPath
forall t c.
(AnyOrSoft t, HardOrAny t) =>
(DerivPathI t -> c) -> DerivPath -> DerivPathI t -> c
go DerivPath -> DerivPath
forall a. a -> a
id (DerivPathI t2 -> DerivPath
forall t. DerivPathI t -> DerivPath
toGeneric DerivPathI t2
p2) (DerivPath -> DerivPath) -> DerivPath -> DerivPath
forall a b. (a -> b) -> a -> b
$ DerivPathI t1 -> DerivPath
forall t. DerivPathI t -> DerivPath
toGeneric DerivPathI t1
p1
  where
    go :: (DerivPathI t -> c) -> DerivPath -> DerivPathI t -> c
go DerivPathI t -> c
f DerivPath
p = case DerivPath
p of
        DerivPath
next :/ KeyIndex
i -> (DerivPathI t -> c) -> DerivPath -> DerivPathI t -> c
go (DerivPathI t -> c
f (DerivPathI t -> c)
-> (DerivPathI t -> DerivPathI t) -> DerivPathI t -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DerivPathI t -> KeyIndex -> DerivPathI t
forall t. AnyOrSoft t => DerivPathI t -> KeyIndex -> DerivPathI t
:/ KeyIndex
i)) (DerivPath -> DerivPathI t -> c) -> DerivPath -> DerivPathI t -> c
forall a b. (a -> b) -> a -> b
$ DerivPath -> DerivPath
forall t. DerivPathI t -> DerivPath
toGeneric DerivPath
next
        DerivPath
next :| KeyIndex
i -> (DerivPathI t -> c) -> DerivPath -> DerivPathI t -> c
go (DerivPathI t -> c
f (DerivPathI t -> c)
-> (DerivPathI t -> DerivPathI t) -> DerivPathI t -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DerivPathI t -> KeyIndex -> DerivPathI t
forall t. HardOrAny t => DerivPathI t -> KeyIndex -> DerivPathI t
:| KeyIndex
i)) (DerivPath -> DerivPathI t -> c) -> DerivPath -> DerivPathI t -> c
forall a b. (a -> b) -> a -> b
$ DerivPath -> DerivPath
forall t. DerivPathI t -> DerivPath
toGeneric DerivPath
next
        DerivPath
_ -> DerivPathI t -> c
f

-- | Derive a private key from a derivation path
derivePath :: DerivPathI t -> XPrvKey -> XPrvKey
derivePath :: DerivPathI t -> XPrvKey -> XPrvKey
derivePath = (XPrvKey -> XPrvKey) -> DerivPathI t -> XPrvKey -> XPrvKey
forall c t. (XPrvKey -> c) -> DerivPathI t -> XPrvKey -> c
go XPrvKey -> XPrvKey
forall a. a -> a
id
  where
    -- Build the full derivation function starting from the end
    go :: (XPrvKey -> c) -> DerivPathI t -> XPrvKey -> c
go XPrvKey -> c
f DerivPathI t
p = case DerivPathI t
p of
        DerivPathI t
next :| KeyIndex
i -> (XPrvKey -> c) -> DerivPathI t -> XPrvKey -> c
go (XPrvKey -> c
f (XPrvKey -> c) -> (XPrvKey -> XPrvKey) -> XPrvKey -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPrvKey -> KeyIndex -> XPrvKey) -> KeyIndex -> XPrvKey -> XPrvKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip XPrvKey -> KeyIndex -> XPrvKey
hardSubKey KeyIndex
i) DerivPathI t
next
        DerivPathI t
next :/ KeyIndex
i -> (XPrvKey -> c) -> DerivPathI t -> XPrvKey -> c
go (XPrvKey -> c
f (XPrvKey -> c) -> (XPrvKey -> XPrvKey) -> XPrvKey -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPrvKey -> KeyIndex -> XPrvKey) -> KeyIndex -> XPrvKey -> XPrvKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip XPrvKey -> KeyIndex -> XPrvKey
prvSubKey KeyIndex
i) DerivPathI t
next
        DerivPathI t
_ -> XPrvKey -> c
f

-- | Derive a public key from a soft derivation path
derivePubPath :: SoftPath -> XPubKey -> XPubKey
derivePubPath :: SoftPath -> XPubKey -> XPubKey
derivePubPath = (XPubKey -> XPubKey) -> SoftPath -> XPubKey -> XPubKey
forall c t. (XPubKey -> c) -> DerivPathI t -> XPubKey -> c
go XPubKey -> XPubKey
forall a. a -> a
id
  where
    -- Build the full derivation function starting from the end
    go :: (XPubKey -> c) -> DerivPathI t -> XPubKey -> c
go XPubKey -> c
f DerivPathI t
p = case DerivPathI t
p of
        DerivPathI t
next :/ KeyIndex
i -> (XPubKey -> c) -> DerivPathI t -> XPubKey -> c
go (XPubKey -> c
f (XPubKey -> c) -> (XPubKey -> XPubKey) -> XPubKey -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubKey -> KeyIndex -> XPubKey) -> KeyIndex -> XPubKey -> XPubKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip XPubKey -> KeyIndex -> XPubKey
pubSubKey KeyIndex
i) DerivPathI t
next
        DerivPathI t
_ -> XPubKey -> c
f

instance Show DerivPath where
    showsPrec :: Int -> DerivPath -> ShowS
showsPrec Int
d DerivPath
p =
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"DerivPath " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows (DerivPath -> String
forall t. DerivPathI t -> String
pathToStr DerivPath
p)

instance Read DerivPath where
    readPrec :: ReadPrec DerivPath
readPrec = ReadPrec DerivPath -> ReadPrec DerivPath
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec DerivPath -> ReadPrec DerivPath)
-> ReadPrec DerivPath -> ReadPrec DerivPath
forall a b. (a -> b) -> a -> b
$ do
        R.Ident String
"DerivPath" <- ReadPrec Lexeme
lexP
        R.String String
str <- ReadPrec Lexeme
lexP
        ReadPrec DerivPath
-> (DerivPath -> ReadPrec DerivPath)
-> Maybe DerivPath
-> ReadPrec DerivPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec DerivPath
forall a. ReadPrec a
pfail DerivPath -> ReadPrec DerivPath
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DerivPath -> ReadPrec DerivPath)
-> Maybe DerivPath -> ReadPrec DerivPath
forall a b. (a -> b) -> a -> b
$ ParsedPath -> DerivPath
getParsedPath (ParsedPath -> DerivPath) -> Maybe ParsedPath -> Maybe DerivPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe ParsedPath
parsePath String
str

instance Show HardPath where
    showsPrec :: Int -> HardPath -> ShowS
showsPrec Int
d HardPath
p =
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"HardPath " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows (HardPath -> String
forall t. DerivPathI t -> String
pathToStr HardPath
p)

instance Read HardPath where
    readPrec :: ReadPrec HardPath
readPrec = ReadPrec HardPath -> ReadPrec HardPath
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec HardPath -> ReadPrec HardPath)
-> ReadPrec HardPath -> ReadPrec HardPath
forall a b. (a -> b) -> a -> b
$ do
        R.Ident String
"HardPath" <- ReadPrec Lexeme
lexP
        R.String String
str <- ReadPrec Lexeme
lexP
        ReadPrec HardPath
-> (HardPath -> ReadPrec HardPath)
-> Maybe HardPath
-> ReadPrec HardPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec HardPath
forall a. ReadPrec a
pfail HardPath -> ReadPrec HardPath
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe HardPath -> ReadPrec HardPath)
-> Maybe HardPath -> ReadPrec HardPath
forall a b. (a -> b) -> a -> b
$ String -> Maybe HardPath
parseHard String
str

instance Show SoftPath where
    showsPrec :: Int -> SoftPath -> ShowS
showsPrec Int
d SoftPath
p =
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"SoftPath " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows (SoftPath -> String
forall t. DerivPathI t -> String
pathToStr SoftPath
p)

instance Read SoftPath where
    readPrec :: ReadPrec SoftPath
readPrec = ReadPrec SoftPath -> ReadPrec SoftPath
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec SoftPath -> ReadPrec SoftPath)
-> ReadPrec SoftPath -> ReadPrec SoftPath
forall a b. (a -> b) -> a -> b
$ do
        R.Ident String
"SoftPath" <- ReadPrec Lexeme
lexP
        R.String String
str <- ReadPrec Lexeme
lexP
        ReadPrec SoftPath
-> (SoftPath -> ReadPrec SoftPath)
-> Maybe SoftPath
-> ReadPrec SoftPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec SoftPath
forall a. ReadPrec a
pfail SoftPath -> ReadPrec SoftPath
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SoftPath -> ReadPrec SoftPath)
-> Maybe SoftPath -> ReadPrec SoftPath
forall a b. (a -> b) -> a -> b
$ String -> Maybe SoftPath
parseSoft String
str

instance IsString ParsedPath where
    fromString :: String -> ParsedPath
fromString =
        ParsedPath -> Maybe ParsedPath -> ParsedPath
forall a. a -> Maybe a -> a
fromMaybe ParsedPath
forall a. a
e (Maybe ParsedPath -> ParsedPath)
-> (String -> Maybe ParsedPath) -> String -> ParsedPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe ParsedPath
parsePath
      where
        e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"Could not parse derivation path"

instance IsString DerivPath where
    fromString :: String -> DerivPath
fromString =
        ParsedPath -> DerivPath
getParsedPath (ParsedPath -> DerivPath)
-> (String -> ParsedPath) -> String -> DerivPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedPath -> Maybe ParsedPath -> ParsedPath
forall a. a -> Maybe a -> a
fromMaybe ParsedPath
forall a. a
e (Maybe ParsedPath -> ParsedPath)
-> (String -> Maybe ParsedPath) -> String -> ParsedPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe ParsedPath
parsePath
      where
        e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"Could not parse derivation path"

instance IsString HardPath where
    fromString :: String -> HardPath
fromString =
        HardPath -> Maybe HardPath -> HardPath
forall a. a -> Maybe a -> a
fromMaybe HardPath
forall a. a
e (Maybe HardPath -> HardPath)
-> (String -> Maybe HardPath) -> String -> HardPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe HardPath
parseHard
      where
        e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"Could not parse hard derivation path"

instance IsString SoftPath where
    fromString :: String -> SoftPath
fromString =
        SoftPath -> Maybe SoftPath -> SoftPath
forall a. a -> Maybe a -> a
fromMaybe SoftPath
forall a. a
e (Maybe SoftPath -> SoftPath)
-> (String -> Maybe SoftPath) -> String -> SoftPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe SoftPath
parseSoft
      where
        e :: a
e = String -> a
forall a. HasCallStack => String -> a
error String
"Could not parse soft derivation path"

instance FromJSON ParsedPath where
    parseJSON :: Value -> Parser ParsedPath
parseJSON = String -> (Text -> Parser ParsedPath) -> Value -> Parser ParsedPath
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ParsedPath" ((Text -> Parser ParsedPath) -> Value -> Parser ParsedPath)
-> (Text -> Parser ParsedPath) -> Value -> Parser ParsedPath
forall a b. (a -> b) -> a -> b
$ \Text
str -> case String -> Maybe ParsedPath
parsePath (String -> Maybe ParsedPath) -> String -> Maybe ParsedPath
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
str of
        Just ParsedPath
p -> ParsedPath -> Parser ParsedPath
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedPath
p
        Maybe ParsedPath
_ -> Parser ParsedPath
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance FromJSON DerivPath where
    parseJSON :: Value -> Parser DerivPath
parseJSON = String -> (Text -> Parser DerivPath) -> Value -> Parser DerivPath
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"DerivPath" ((Text -> Parser DerivPath) -> Value -> Parser DerivPath)
-> (Text -> Parser DerivPath) -> Value -> Parser DerivPath
forall a b. (a -> b) -> a -> b
$ \Text
str -> case String -> Maybe ParsedPath
parsePath (String -> Maybe ParsedPath) -> String -> Maybe ParsedPath
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
str of
        Just ParsedPath
p -> DerivPath -> Parser DerivPath
forall (m :: * -> *) a. Monad m => a -> m a
return (DerivPath -> Parser DerivPath) -> DerivPath -> Parser DerivPath
forall a b. (a -> b) -> a -> b
$ ParsedPath -> DerivPath
getParsedPath ParsedPath
p
        Maybe ParsedPath
_ -> Parser DerivPath
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance FromJSON HardPath where
    parseJSON :: Value -> Parser HardPath
parseJSON = String -> (Text -> Parser HardPath) -> Value -> Parser HardPath
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"HardPath" ((Text -> Parser HardPath) -> Value -> Parser HardPath)
-> (Text -> Parser HardPath) -> Value -> Parser HardPath
forall a b. (a -> b) -> a -> b
$ \Text
str -> case String -> Maybe HardPath
parseHard (String -> Maybe HardPath) -> String -> Maybe HardPath
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
str of
        Just HardPath
p -> HardPath -> Parser HardPath
forall (m :: * -> *) a. Monad m => a -> m a
return HardPath
p
        Maybe HardPath
_ -> Parser HardPath
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance FromJSON SoftPath where
    parseJSON :: Value -> Parser SoftPath
parseJSON = String -> (Text -> Parser SoftPath) -> Value -> Parser SoftPath
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"SoftPath" ((Text -> Parser SoftPath) -> Value -> Parser SoftPath)
-> (Text -> Parser SoftPath) -> Value -> Parser SoftPath
forall a b. (a -> b) -> a -> b
$ \Text
str -> case String -> Maybe SoftPath
parseSoft (String -> Maybe SoftPath) -> String -> Maybe SoftPath
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
str of
        Just SoftPath
p -> SoftPath -> Parser SoftPath
forall (m :: * -> *) a. Monad m => a -> m a
return SoftPath
p
        Maybe SoftPath
_ -> Parser SoftPath
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance ToJSON (DerivPathI t) where
    toJSON :: DerivPathI t -> Value
toJSON = Text -> Value
A.String (Text -> Value) -> (DerivPathI t -> Text) -> DerivPathI t -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text)
-> (DerivPathI t -> String) -> DerivPathI t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPathI t -> String
forall t. DerivPathI t -> String
pathToStr
    toEncoding :: DerivPathI t -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding)
-> (DerivPathI t -> Text) -> DerivPathI t -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text)
-> (DerivPathI t -> String) -> DerivPathI t -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPathI t -> String
forall t. DerivPathI t -> String
pathToStr

instance ToJSON ParsedPath where
    toJSON :: ParsedPath -> Value
toJSON (ParsedPrv DerivPath
p) = Text -> Value
A.String (Text -> Value) -> (DerivPath -> Text) -> DerivPath -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (DerivPath -> String) -> DerivPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"m" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (DerivPath -> String) -> DerivPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> String
forall t. DerivPathI t -> String
pathToStr (DerivPath -> Value) -> DerivPath -> Value
forall a b. (a -> b) -> a -> b
$ DerivPath
p
    toJSON (ParsedPub DerivPath
p) = Text -> Value
A.String (Text -> Value) -> (DerivPath -> Text) -> DerivPath -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (DerivPath -> String) -> DerivPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"M" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (DerivPath -> String) -> DerivPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> String
forall t. DerivPathI t -> String
pathToStr (DerivPath -> Value) -> DerivPath -> Value
forall a b. (a -> b) -> a -> b
$ DerivPath
p
    toJSON (ParsedEmpty DerivPath
p) = Text -> Value
A.String (Text -> Value) -> (DerivPath -> Text) -> DerivPath -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (DerivPath -> String) -> DerivPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (DerivPath -> String) -> DerivPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> String
forall t. DerivPathI t -> String
pathToStr (DerivPath -> Value) -> DerivPath -> Value
forall a b. (a -> b) -> a -> b
$ DerivPath
p
    toEncoding :: ParsedPath -> Encoding
toEncoding (ParsedPrv DerivPath
p) = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding) -> (DerivPath -> Text) -> DerivPath -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (DerivPath -> String) -> DerivPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"m" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (DerivPath -> String) -> DerivPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> String
forall t. DerivPathI t -> String
pathToStr (DerivPath -> Encoding) -> DerivPath -> Encoding
forall a b. (a -> b) -> a -> b
$ DerivPath
p
    toEncoding (ParsedPub DerivPath
p) = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding) -> (DerivPath -> Text) -> DerivPath -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (DerivPath -> String) -> DerivPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"M" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (DerivPath -> String) -> DerivPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> String
forall t. DerivPathI t -> String
pathToStr (DerivPath -> Encoding) -> DerivPath -> Encoding
forall a b. (a -> b) -> a -> b
$ DerivPath
p
    toEncoding (ParsedEmpty DerivPath
p) = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding) -> (DerivPath -> Text) -> DerivPath -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (String -> Text) -> (DerivPath -> String) -> DerivPath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (DerivPath -> String) -> DerivPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> String
forall t. DerivPathI t -> String
pathToStr (DerivPath -> Encoding) -> DerivPath -> Encoding
forall a b. (a -> b) -> a -> b
$ DerivPath
p

{- Parsing derivation paths of the form m/1/2'/3 or M/1/2'/3 -}

{- | Type for parsing derivation paths of the form /m\/1\/2'\/3/ or
 /M\/1\/2'\/3/.
-}
data ParsedPath
    = ParsedPrv {ParsedPath -> DerivPath
getParsedPath :: !DerivPath}
    | ParsedPub {getParsedPath :: !DerivPath}
    | ParsedEmpty {getParsedPath :: !DerivPath}
    deriving (ParsedPath -> ParsedPath -> Bool
(ParsedPath -> ParsedPath -> Bool)
-> (ParsedPath -> ParsedPath -> Bool) -> Eq ParsedPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParsedPath -> ParsedPath -> Bool
$c/= :: ParsedPath -> ParsedPath -> Bool
== :: ParsedPath -> ParsedPath -> Bool
$c== :: ParsedPath -> ParsedPath -> Bool
Eq, (forall x. ParsedPath -> Rep ParsedPath x)
-> (forall x. Rep ParsedPath x -> ParsedPath) -> Generic ParsedPath
forall x. Rep ParsedPath x -> ParsedPath
forall x. ParsedPath -> Rep ParsedPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ParsedPath x -> ParsedPath
$cfrom :: forall x. ParsedPath -> Rep ParsedPath x
Generic, ParsedPath -> ()
(ParsedPath -> ()) -> NFData ParsedPath
forall a. (a -> ()) -> NFData a
rnf :: ParsedPath -> ()
$crnf :: ParsedPath -> ()
NFData)

instance Show ParsedPath where
    showsPrec :: Int -> ParsedPath -> ShowS
showsPrec Int
d ParsedPath
p = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ParsedPath " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
forall a. Show a => a -> ShowS
shows String
f
      where
        f :: String
f =
            case ParsedPath
p of
                ParsedPrv DerivPath
d' -> String
"m" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DerivPath -> String
forall t. DerivPathI t -> String
pathToStr DerivPath
d'
                ParsedPub DerivPath
d' -> String
"M" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DerivPath -> String
forall t. DerivPathI t -> String
pathToStr DerivPath
d'
                ParsedEmpty DerivPath
d' -> DerivPath -> String
forall t. DerivPathI t -> String
pathToStr DerivPath
d'

instance Read ParsedPath where
    readPrec :: ReadPrec ParsedPath
readPrec = ReadPrec ParsedPath -> ReadPrec ParsedPath
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec ParsedPath -> ReadPrec ParsedPath)
-> ReadPrec ParsedPath -> ReadPrec ParsedPath
forall a b. (a -> b) -> a -> b
$ do
        R.Ident String
"ParsedPath" <- ReadPrec Lexeme
lexP
        R.String String
str <- ReadPrec Lexeme
lexP
        ReadPrec ParsedPath
-> (ParsedPath -> ReadPrec ParsedPath)
-> Maybe ParsedPath
-> ReadPrec ParsedPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec ParsedPath
forall a. ReadPrec a
pfail ParsedPath -> ReadPrec ParsedPath
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ParsedPath -> ReadPrec ParsedPath)
-> Maybe ParsedPath -> ReadPrec ParsedPath
forall a b. (a -> b) -> a -> b
$ String -> Maybe ParsedPath
parsePath String
str

{- | Parse derivation path string for extended key.
 Forms: /m\/0'\/2/, /M\/2\/3\/4/.
-}
parsePath :: String -> Maybe ParsedPath
parsePath :: String -> Maybe ParsedPath
parsePath String
str = do
    DerivPath
res <- [Bip32PathIndex] -> DerivPath
concatBip32Segments ([Bip32PathIndex] -> DerivPath)
-> Maybe [Bip32PathIndex] -> Maybe DerivPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Maybe Bip32PathIndex)
-> [String] -> Maybe [Bip32PathIndex]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> Maybe Bip32PathIndex
parseBip32PathIndex [String]
xs
    case String
x of
        String
"m" -> ParsedPath -> Maybe ParsedPath
forall a. a -> Maybe a
Just (ParsedPath -> Maybe ParsedPath) -> ParsedPath -> Maybe ParsedPath
forall a b. (a -> b) -> a -> b
$ DerivPath -> ParsedPath
ParsedPrv DerivPath
res
        String
"M" -> ParsedPath -> Maybe ParsedPath
forall a. a -> Maybe a
Just (ParsedPath -> Maybe ParsedPath) -> ParsedPath -> Maybe ParsedPath
forall a b. (a -> b) -> a -> b
$ DerivPath -> ParsedPath
ParsedPub DerivPath
res
        String
"" -> ParsedPath -> Maybe ParsedPath
forall a. a -> Maybe a
Just (ParsedPath -> Maybe ParsedPath) -> ParsedPath -> Maybe ParsedPath
forall a b. (a -> b) -> a -> b
$ DerivPath -> ParsedPath
ParsedEmpty DerivPath
res
        String
_ -> Maybe ParsedPath
forall a. Maybe a
Nothing
  where
    (String
x : [String]
xs) = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"/" String
str

-- | Concatenate derivation path indices into a derivation path.
concatBip32Segments :: [Bip32PathIndex] -> DerivPath
concatBip32Segments :: [Bip32PathIndex] -> DerivPath
concatBip32Segments = (DerivPath -> Bip32PathIndex -> DerivPath)
-> DerivPath -> [Bip32PathIndex] -> DerivPath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DerivPath -> Bip32PathIndex -> DerivPath
appendBip32Segment DerivPath
forall t. DerivPathI t
Deriv

-- | Append an extra derivation path index element into an existing path.
appendBip32Segment :: DerivPath -> Bip32PathIndex -> DerivPath
appendBip32Segment :: DerivPath -> Bip32PathIndex -> DerivPath
appendBip32Segment DerivPath
d (Bip32SoftIndex KeyIndex
i) = DerivPath
d DerivPath -> KeyIndex -> DerivPath
forall t. AnyOrSoft t => DerivPathI t -> KeyIndex -> DerivPathI t
:/ KeyIndex
i
appendBip32Segment DerivPath
d (Bip32HardIndex KeyIndex
i) = DerivPath
d DerivPath -> KeyIndex -> DerivPath
forall t. HardOrAny t => DerivPathI t -> KeyIndex -> DerivPathI t
:| KeyIndex
i

-- | Parse a BIP32 derivation path index element from a string.
parseBip32PathIndex :: String -> Maybe Bip32PathIndex
parseBip32PathIndex :: String -> Maybe Bip32PathIndex
parseBip32PathIndex String
segment = case ReadS KeyIndex
forall a. Read a => ReadS a
reads String
segment of
    [(KeyIndex
i, String
"")] -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (KeyIndex -> Bool
forall a. Integral a => a -> Bool
is31Bit KeyIndex
i) Maybe () -> Maybe Bip32PathIndex -> Maybe Bip32PathIndex
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bip32PathIndex -> Maybe Bip32PathIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyIndex -> Bip32PathIndex
Bip32SoftIndex KeyIndex
i)
    [(KeyIndex
i, String
"'")] -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (KeyIndex -> Bool
forall a. Integral a => a -> Bool
is31Bit KeyIndex
i) Maybe () -> Maybe Bip32PathIndex -> Maybe Bip32PathIndex
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bip32PathIndex -> Maybe Bip32PathIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyIndex -> Bip32PathIndex
Bip32HardIndex KeyIndex
i)
    [(KeyIndex, String)]
_ -> Maybe Bip32PathIndex
forall a. Maybe a
Nothing

-- | Type for BIP32 path index element.
data Bip32PathIndex
    = Bip32HardIndex KeyIndex
    | Bip32SoftIndex KeyIndex
    deriving (Bip32PathIndex -> Bip32PathIndex -> Bool
(Bip32PathIndex -> Bip32PathIndex -> Bool)
-> (Bip32PathIndex -> Bip32PathIndex -> Bool) -> Eq Bip32PathIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bip32PathIndex -> Bip32PathIndex -> Bool
$c/= :: Bip32PathIndex -> Bip32PathIndex -> Bool
== :: Bip32PathIndex -> Bip32PathIndex -> Bool
$c== :: Bip32PathIndex -> Bip32PathIndex -> Bool
Eq, (forall x. Bip32PathIndex -> Rep Bip32PathIndex x)
-> (forall x. Rep Bip32PathIndex x -> Bip32PathIndex)
-> Generic Bip32PathIndex
forall x. Rep Bip32PathIndex x -> Bip32PathIndex
forall x. Bip32PathIndex -> Rep Bip32PathIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bip32PathIndex x -> Bip32PathIndex
$cfrom :: forall x. Bip32PathIndex -> Rep Bip32PathIndex x
Generic, Bip32PathIndex -> ()
(Bip32PathIndex -> ()) -> NFData Bip32PathIndex
forall a. (a -> ()) -> NFData a
rnf :: Bip32PathIndex -> ()
$crnf :: Bip32PathIndex -> ()
NFData)

instance Show Bip32PathIndex where
    showsPrec :: Int -> Bip32PathIndex -> ShowS
showsPrec Int
d (Bip32HardIndex KeyIndex
i) =
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"Bip32HardIndex " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIndex -> ShowS
forall a. Show a => a -> ShowS
shows KeyIndex
i
    showsPrec Int
d (Bip32SoftIndex KeyIndex
i) =
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"Bip32SoftIndex " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyIndex -> ShowS
forall a. Show a => a -> ShowS
shows KeyIndex
i

instance Read Bip32PathIndex where
    readPrec :: ReadPrec Bip32PathIndex
readPrec = ReadPrec Bip32PathIndex
h ReadPrec Bip32PathIndex
-> ReadPrec Bip32PathIndex -> ReadPrec Bip32PathIndex
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadPrec Bip32PathIndex
s
      where
        h :: ReadPrec Bip32PathIndex
h =
            ReadPrec Bip32PathIndex -> ReadPrec Bip32PathIndex
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec Bip32PathIndex -> ReadPrec Bip32PathIndex)
-> ReadPrec Bip32PathIndex -> ReadPrec Bip32PathIndex
forall a b. (a -> b) -> a -> b
$ do
                R.Ident String
"Bip32HardIndex" <- ReadPrec Lexeme
lexP
                R.Number Number
n <- ReadPrec Lexeme
lexP
                ReadPrec Bip32PathIndex
-> (Bip32PathIndex -> ReadPrec Bip32PathIndex)
-> Maybe Bip32PathIndex
-> ReadPrec Bip32PathIndex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec Bip32PathIndex
forall a. ReadPrec a
pfail Bip32PathIndex -> ReadPrec Bip32PathIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bip32PathIndex -> ReadPrec Bip32PathIndex)
-> Maybe Bip32PathIndex -> ReadPrec Bip32PathIndex
forall a b. (a -> b) -> a -> b
$
                    KeyIndex -> Bip32PathIndex
Bip32HardIndex (KeyIndex -> Bip32PathIndex)
-> (Integer -> KeyIndex) -> Integer -> Bip32PathIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> KeyIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Bip32PathIndex)
-> Maybe Integer -> Maybe Bip32PathIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Number -> Maybe Integer
numberToInteger Number
n
        s :: ReadPrec Bip32PathIndex
s =
            ReadPrec Bip32PathIndex -> ReadPrec Bip32PathIndex
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec Bip32PathIndex -> ReadPrec Bip32PathIndex)
-> ReadPrec Bip32PathIndex -> ReadPrec Bip32PathIndex
forall a b. (a -> b) -> a -> b
$ do
                R.Ident String
"Bip32SoftIndex" <- ReadPrec Lexeme
lexP
                R.Number Number
n <- ReadPrec Lexeme
lexP
                ReadPrec Bip32PathIndex
-> (Bip32PathIndex -> ReadPrec Bip32PathIndex)
-> Maybe Bip32PathIndex
-> ReadPrec Bip32PathIndex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec Bip32PathIndex
forall a. ReadPrec a
pfail Bip32PathIndex -> ReadPrec Bip32PathIndex
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Bip32PathIndex -> ReadPrec Bip32PathIndex)
-> Maybe Bip32PathIndex -> ReadPrec Bip32PathIndex
forall a b. (a -> b) -> a -> b
$
                    KeyIndex -> Bip32PathIndex
Bip32SoftIndex (KeyIndex -> Bip32PathIndex)
-> (Integer -> KeyIndex) -> Integer -> Bip32PathIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> KeyIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Bip32PathIndex)
-> Maybe Integer -> Maybe Bip32PathIndex
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Number -> Maybe Integer
numberToInteger Number
n

-- | Test whether the number could be a valid BIP32 derivation index.
is31Bit :: (Integral a) => a -> Bool
is31Bit :: a -> Bool
is31Bit a
i = a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0x80000000

-- | Helper function to parse a hard path.
parseHard :: String -> Maybe HardPath
parseHard :: String -> Maybe HardPath
parseHard = DerivPath -> Maybe HardPath
forall t. DerivPathI t -> Maybe HardPath
toHard (DerivPath -> Maybe HardPath)
-> (ParsedPath -> DerivPath) -> ParsedPath -> Maybe HardPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedPath -> DerivPath
getParsedPath (ParsedPath -> Maybe HardPath)
-> (String -> Maybe ParsedPath) -> String -> Maybe HardPath
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Maybe ParsedPath
parsePath

-- | Helper function to parse a soft path.
parseSoft :: String -> Maybe SoftPath
parseSoft :: String -> Maybe SoftPath
parseSoft = DerivPath -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft (DerivPath -> Maybe SoftPath)
-> (ParsedPath -> DerivPath) -> ParsedPath -> Maybe SoftPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedPath -> DerivPath
getParsedPath (ParsedPath -> Maybe SoftPath)
-> (String -> Maybe ParsedPath) -> String -> Maybe SoftPath
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> Maybe ParsedPath
parsePath

-- | Data type representing a private or public key with its respective network.
data XKey
    = XPrv
        { XKey -> XPrvKey
getXKeyPrv :: !XPrvKey
        , XKey -> Network
getXKeyNet :: !Network
        }
    | XPub
        { XKey -> XPubKey
getXKeyPub :: !XPubKey
        , getXKeyNet :: !Network
        }
    deriving (XKey -> XKey -> Bool
(XKey -> XKey -> Bool) -> (XKey -> XKey -> Bool) -> Eq XKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XKey -> XKey -> Bool
$c/= :: XKey -> XKey -> Bool
== :: XKey -> XKey -> Bool
$c== :: XKey -> XKey -> Bool
Eq, Int -> XKey -> ShowS
[XKey] -> ShowS
XKey -> String
(Int -> XKey -> ShowS)
-> (XKey -> String) -> ([XKey] -> ShowS) -> Show XKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XKey] -> ShowS
$cshowList :: [XKey] -> ShowS
show :: XKey -> String
$cshow :: XKey -> String
showsPrec :: Int -> XKey -> ShowS
$cshowsPrec :: Int -> XKey -> ShowS
Show, (forall x. XKey -> Rep XKey x)
-> (forall x. Rep XKey x -> XKey) -> Generic XKey
forall x. Rep XKey x -> XKey
forall x. XKey -> Rep XKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep XKey x -> XKey
$cfrom :: forall x. XKey -> Rep XKey x
Generic, XKey -> ()
(XKey -> ()) -> NFData XKey
forall a. (a -> ()) -> NFData a
rnf :: XKey -> ()
$crnf :: XKey -> ()
NFData)

{- | Apply a parsed path to an extended key to derive the new key defined in the
 path. If the path starts with /m/, a private key will be returned and if the
 path starts with /M/, a public key will be returned. Private derivations on a
 public key, and public derivations with a hard segment, return an error
 value.
-}
applyPath :: ParsedPath -> XKey -> Either String XKey
applyPath :: ParsedPath -> XKey -> Either String XKey
applyPath ParsedPath
path XKey
key =
    case (ParsedPath
path, XKey
key) of
        (ParsedPrv DerivPath
_, XPrv XPrvKey
k Network
n) -> XKey -> Either String XKey
forall (m :: * -> *) a. Monad m => a -> m a
return (XKey -> Either String XKey) -> XKey -> Either String XKey
forall a b. (a -> b) -> a -> b
$ XPrvKey -> Network -> XKey
XPrv (XPrvKey -> XPrvKey
derivPrvF XPrvKey
k) Network
n
        (ParsedPrv DerivPath
_, XPub{}) -> String -> Either String XKey
forall a b. a -> Either a b
Left String
"applyPath: Invalid public key"
        (ParsedPub DerivPath
_, XPrv XPrvKey
k Network
n) -> XKey -> Either String XKey
forall (m :: * -> *) a. Monad m => a -> m a
return (XKey -> Either String XKey) -> XKey -> Either String XKey
forall a b. (a -> b) -> a -> b
$ XPubKey -> Network -> XKey
XPub (XPrvKey -> XPubKey
deriveXPubKey (XPrvKey -> XPrvKey
derivPrvF XPrvKey
k)) Network
n
        (ParsedPub DerivPath
_, XPub XPubKey
k Network
n) -> Either String (XPubKey -> XPubKey)
derivPubFE Either String (XPubKey -> XPubKey)
-> ((XPubKey -> XPubKey) -> Either String XKey)
-> Either String XKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \XPubKey -> XPubKey
f -> XKey -> Either String XKey
forall (m :: * -> *) a. Monad m => a -> m a
return (XKey -> Either String XKey) -> XKey -> Either String XKey
forall a b. (a -> b) -> a -> b
$ XPubKey -> Network -> XKey
XPub (XPubKey -> XPubKey
f XPubKey
k) Network
n
        -- For empty parsed paths, we take a hint from the provided key
        (ParsedEmpty DerivPath
_, XPrv XPrvKey
k Network
n) -> XKey -> Either String XKey
forall (m :: * -> *) a. Monad m => a -> m a
return (XKey -> Either String XKey) -> XKey -> Either String XKey
forall a b. (a -> b) -> a -> b
$ XPrvKey -> Network -> XKey
XPrv (XPrvKey -> XPrvKey
derivPrvF XPrvKey
k) Network
n
        (ParsedEmpty DerivPath
_, XPub XPubKey
k Network
n) -> Either String (XPubKey -> XPubKey)
derivPubFE Either String (XPubKey -> XPubKey)
-> ((XPubKey -> XPubKey) -> Either String XKey)
-> Either String XKey
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \XPubKey -> XPubKey
f -> XKey -> Either String XKey
forall (m :: * -> *) a. Monad m => a -> m a
return (XKey -> Either String XKey) -> XKey -> Either String XKey
forall a b. (a -> b) -> a -> b
$ XPubKey -> Network -> XKey
XPub (XPubKey -> XPubKey
f XPubKey
k) Network
n
  where
    derivPrvF :: XPrvKey -> XPrvKey
derivPrvF = (XPrvKey -> XPrvKey) -> DerivPath -> XPrvKey -> XPrvKey
forall c t. (XPrvKey -> c) -> DerivPathI t -> XPrvKey -> c
goPrv XPrvKey -> XPrvKey
forall a. a -> a
id (DerivPath -> XPrvKey -> XPrvKey)
-> DerivPath -> XPrvKey -> XPrvKey
forall a b. (a -> b) -> a -> b
$ ParsedPath -> DerivPath
getParsedPath ParsedPath
path
    derivPubFE :: Either String (XPubKey -> XPubKey)
derivPubFE = (XPubKey -> XPubKey)
-> DerivPath -> Either String (XPubKey -> XPubKey)
forall a c t.
IsString a =>
(XPubKey -> c) -> DerivPathI t -> Either a (XPubKey -> c)
goPubE XPubKey -> XPubKey
forall a. a -> a
id (DerivPath -> Either String (XPubKey -> XPubKey))
-> DerivPath -> Either String (XPubKey -> XPubKey)
forall a b. (a -> b) -> a -> b
$ ParsedPath -> DerivPath
getParsedPath ParsedPath
path
    -- Build the full private derivation function starting from the end
    goPrv :: (XPrvKey -> c) -> DerivPathI t -> XPrvKey -> c
goPrv XPrvKey -> c
f DerivPathI t
p =
        case DerivPathI t
p of
            DerivPathI t
next :| KeyIndex
i -> (XPrvKey -> c) -> DerivPathI t -> XPrvKey -> c
goPrv (XPrvKey -> c
f (XPrvKey -> c) -> (XPrvKey -> XPrvKey) -> XPrvKey -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPrvKey -> KeyIndex -> XPrvKey) -> KeyIndex -> XPrvKey -> XPrvKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip XPrvKey -> KeyIndex -> XPrvKey
hardSubKey KeyIndex
i) DerivPathI t
next
            DerivPathI t
next :/ KeyIndex
i -> (XPrvKey -> c) -> DerivPathI t -> XPrvKey -> c
goPrv (XPrvKey -> c
f (XPrvKey -> c) -> (XPrvKey -> XPrvKey) -> XPrvKey -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPrvKey -> KeyIndex -> XPrvKey) -> KeyIndex -> XPrvKey -> XPrvKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip XPrvKey -> KeyIndex -> XPrvKey
prvSubKey KeyIndex
i) DerivPathI t
next
            DerivPathI t
Deriv -> XPrvKey -> c
f
    -- Build the full public derivation function starting from the end
    goPubE :: (XPubKey -> c) -> DerivPathI t -> Either a (XPubKey -> c)
goPubE XPubKey -> c
f DerivPathI t
p =
        case DerivPathI t
p of
            DerivPathI t
next :/ KeyIndex
i -> (XPubKey -> c) -> DerivPathI t -> Either a (XPubKey -> c)
goPubE (XPubKey -> c
f (XPubKey -> c) -> (XPubKey -> XPubKey) -> XPubKey -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubKey -> KeyIndex -> XPubKey) -> KeyIndex -> XPubKey -> XPubKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip XPubKey -> KeyIndex -> XPubKey
pubSubKey KeyIndex
i) DerivPathI t
next
            DerivPathI t
Deriv -> (XPubKey -> c) -> Either a (XPubKey -> c)
forall a b. b -> Either a b
Right XPubKey -> c
f
            DerivPathI t
_ -> a -> Either a (XPubKey -> c)
forall a b. a -> Either a b
Left a
"applyPath: Invalid hard derivation"

{- Helpers for derivation paths and addresses -}

-- | Derive an address from a given parent path.
derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKey)
derivePathAddr :: XPubKey -> SoftPath -> KeyIndex -> (Address, PubKey)
derivePathAddr XPubKey
key SoftPath
path = XPubKey -> KeyIndex -> (Address, PubKey)
deriveAddr (SoftPath -> XPubKey -> XPubKey
derivePubPath SoftPath
path XPubKey
key)

{- | Cyclic list of all addresses derived from a given parent path and starting
 from the given offset index.
-}
derivePathAddrs ::
    XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKey, KeyIndex)]
derivePathAddrs :: XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKey, KeyIndex)]
derivePathAddrs XPubKey
key SoftPath
path = XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
deriveAddrs (SoftPath -> XPubKey -> XPubKey
derivePubPath SoftPath
path XPubKey
key)

{- | Derive a multisig address from a given parent path. The number of required
 signatures (m in m of n) is also needed.
-}
derivePathMSAddr ::
    [XPubKey] ->
    SoftPath ->
    Int ->
    KeyIndex ->
    (Address, RedeemScript)
derivePathMSAddr :: [XPubKey] -> SoftPath -> Int -> KeyIndex -> (Address, RedeemScript)
derivePathMSAddr [XPubKey]
keys SoftPath
path =
    [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript)
deriveMSAddr ([XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript))
-> [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript)
forall a b. (a -> b) -> a -> b
$ (XPubKey -> XPubKey) -> [XPubKey] -> [XPubKey]
forall a b. (a -> b) -> [a] -> [b]
map (SoftPath -> XPubKey -> XPubKey
derivePubPath SoftPath
path) [XPubKey]
keys

{- | Cyclic list of all multisig addresses derived from a given parent path and
 starting from the given offset index. The number of required signatures
 (m in m of n) is also needed.
-}
derivePathMSAddrs ::
    [XPubKey] ->
    SoftPath ->
    Int ->
    KeyIndex ->
    [(Address, RedeemScript, KeyIndex)]
derivePathMSAddrs :: [XPubKey]
-> SoftPath
-> Int
-> KeyIndex
-> [(Address, RedeemScript, KeyIndex)]
derivePathMSAddrs [XPubKey]
keys SoftPath
path =
    [XPubKey] -> Int -> KeyIndex -> [(Address, RedeemScript, KeyIndex)]
deriveMSAddrs ([XPubKey]
 -> Int -> KeyIndex -> [(Address, RedeemScript, KeyIndex)])
-> [XPubKey]
-> Int
-> KeyIndex
-> [(Address, RedeemScript, KeyIndex)]
forall a b. (a -> b) -> a -> b
$ (XPubKey -> XPubKey) -> [XPubKey] -> [XPubKey]
forall a b. (a -> b) -> [a] -> [b]
map (SoftPath -> XPubKey -> XPubKey
derivePubPath SoftPath
path) [XPubKey]
keys

{- Utilities for extended keys -}

-- | De-serialize HDW-specific private key.
getPadPrvKey :: MonadGet m => m SecKey
getPadPrvKey :: m SecKey
getPadPrvKey = do
    Word8
pad <- m Word8
forall (m :: * -> *). MonadGet m => m Word8
getWord8
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
pad Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x00) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Private key must be padded with 0x00"
    ByteString
bs <- Int -> m ByteString
forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString Int
32
    case Get SecKey -> ByteString -> Either String SecKey
forall a. Get a -> ByteString -> Either String a
runGetS Get SecKey
forall t. Serialize t => Get t
S.get ByteString
bs of
        Left String
e -> String -> m SecKey
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
        Right SecKey
x -> SecKey -> m SecKey
forall (m :: * -> *) a. Monad m => a -> m a
return SecKey
x

-- | Serialize HDW-specific private key.
putPadPrvKey :: MonadPut m => SecKey -> m ()
putPadPrvKey :: SecKey -> m ()
putPadPrvKey SecKey
p = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString (Put -> ByteString
runPutS (Putter SecKey
forall t. Serialize t => Putter t
S.put SecKey
p))

bsPadPrvKey :: SecKey -> ByteString
bsPadPrvKey :: SecKey -> ByteString
bsPadPrvKey = Put -> ByteString
runPutS (Put -> ByteString) -> Putter SecKey -> SecKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter SecKey
forall (m :: * -> *). MonadPut m => SecKey -> m ()
putPadPrvKey