{-# 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
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]
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
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. 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 -> ()
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. 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
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
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]
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: XPrvKey -> ()
$crnf :: XPrvKey -> ()
NFData, Eq XPrvKey
Int -> XPrvKey -> Int
XPrvKey -> Int
forall a. Eq 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 :: forall (m :: * -> *). MonadPut m => XPrvKey -> m ()
serialize XPrvKey
k = do
        forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 forall a b. (a -> b) -> a -> b
$ XPrvKey -> Word8
xPrvDepth XPrvKey
k
        forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ XPrvKey -> Fingerprint
xPrvParent XPrvKey
k
        forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be forall a b. (a -> b) -> a -> b
$ XPrvKey -> KeyIndex
xPrvIndex XPrvKey
k
        forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ XPrvKey -> ChainCode
xPrvChain XPrvKey
k
        forall (m :: * -> *). MonadPut m => SecKey -> m ()
putPadPrvKey forall a b. (a -> b) -> a -> b
$ XPrvKey -> SecKey
xPrvKey XPrvKey
k
    deserialize :: forall (m :: * -> *). MonadGet m => m XPrvKey
deserialize =
        Word8 -> Fingerprint -> KeyIndex -> ChainCode -> SecKey -> XPrvKey
XPrvKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGet m => m Word8
getWord8
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGet m => m SecKey
getPadPrvKey

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

instance Serialize XPrvKey where
    put :: Putter XPrvKey
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get XPrvKey
get = 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 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 = forall a. Text -> Encoding' a
text 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 =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"xprv" forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case Network -> Text -> Maybe XPrvKey
xPrvImport Network
net Text
t of
            Maybe XPrvKey
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not read xprv"
            Just XPrvKey
x -> 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. 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
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
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]
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: XPubKey -> ()
$crnf :: XPubKey -> ()
NFData, Eq XPubKey
Int -> XPubKey -> Int
XPubKey -> Int
forall a. Eq 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 :: forall (m :: * -> *). MonadPut m => XPubKey -> m ()
serialize XPubKey
k = do
        forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 forall a b. (a -> b) -> a -> b
$ XPubKey -> Word8
xPubDepth XPubKey
k
        forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ XPubKey -> Fingerprint
xPubParent XPubKey
k
        forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be forall a b. (a -> b) -> a -> b
$ XPubKey -> KeyIndex
xPubIndex XPubKey
k
        forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ XPubKey -> ChainCode
xPubChain XPubKey
k
        forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ Bool -> PubKey -> PubKeyI
wrapPubKey Bool
True (XPubKey -> PubKey
xPubKey XPubKey
k)
    deserialize :: forall (m :: * -> *). MonadGet m => m XPubKey
deserialize =
        Word8 -> Fingerprint -> KeyIndex -> ChainCode -> PubKey -> XPubKey
XPubKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadGet m => m Word8
getWord8
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PubKeyI -> PubKey
pubKeyPoint forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize)

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

instance Binary XPubKey where
    put :: XPubKey -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get XPubKey
get = 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 =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"xpub" forall a b. (a -> b) -> a -> b
$ \Text
t ->
        case Network -> Text -> Maybe XPubKey
xPubImport Network
net Text
t of
            Maybe XPubKey
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not read xpub"
            Just XPubKey
x -> 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 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 = forall a. Text -> Encoding' a
text 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 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 ByteString
"Bitcoin seed" ByteString
bs
    k :: SecKey
k = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err (ByteString -> Maybe SecKey
secKey (Put -> ByteString
runPutS (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize ChainCode
p)))
    err :: a
err = forall a e. Exception e => e -> a
throw 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 forall a. Ord a => a -> a -> Bool
>= KeyIndex
0 Bool -> Bool -> Bool
&& KeyIndex
child forall a. Ord a => a -> a -> Bool
< KeyIndex
0x80000000 =
        Word8 -> Fingerprint -> KeyIndex -> ChainCode -> SecKey -> XPrvKey
XPrvKey (XPrvKey -> Word8
xPrvDepth XPrvKey
xkey forall a. Num a => a -> a -> a
+ Word8
1) (XPrvKey -> Fingerprint
xPrvFP XPrvKey
xkey) KeyIndex
child ChainCode
c SecKey
k
    | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Invalid child derivation index"
  where
    pK :: PubKey
pK = XPubKey -> PubKey
xPubKey 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 (forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize KeyIndex
child))
    (ChainCode
a, ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 (Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ XPrvKey -> ChainCode
xPrvChain XPrvKey
xkey) ByteString
m
    k :: SecKey
k = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err forall a b. (a -> b) -> a -> b
$ SecKey -> ChainCode -> Maybe SecKey
tweakSecKey (XPrvKey -> SecKey
xPrvKey XPrvKey
xkey) ChainCode
a
    err :: a
err = forall a e. Exception e => e -> a
throw 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 forall a. Ord a => a -> a -> Bool
>= KeyIndex
0 Bool -> Bool -> Bool
&& KeyIndex
child forall a. Ord a => a -> a -> Bool
< KeyIndex
0x80000000 =
        Word8 -> Fingerprint -> KeyIndex -> ChainCode -> PubKey -> XPubKey
XPubKey (XPubKey -> Word8
xPubDepth XPubKey
xKey forall a. Num a => a -> a -> a
+ Word8
1) (XPubKey -> Fingerprint
xPubFP XPubKey
xKey) KeyIndex
child ChainCode
c PubKey
pK
    | Bool
otherwise = 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 forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize KeyIndex
child)
    (ChainCode
a, ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 (Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ XPubKey -> ChainCode
xPubChain XPubKey
xKey) ByteString
m
    pK :: PubKey
pK = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err forall a b. (a -> b) -> a -> b
$ PubKey -> ChainCode -> Maybe PubKey
tweakPubKey (XPubKey -> PubKey
xPubKey XPubKey
xKey) ChainCode
a
    err :: a
err = forall a e. Exception e => e -> a
throw 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 forall a. Ord a => a -> a -> Bool
>= KeyIndex
0 Bool -> Bool -> Bool
&& KeyIndex
child forall a. Ord a => a -> a -> Bool
< KeyIndex
0x80000000 =
        Word8 -> Fingerprint -> KeyIndex -> ChainCode -> SecKey -> XPrvKey
XPrvKey (XPrvKey -> Word8
xPrvDepth XPrvKey
xkey forall a. Num a => a -> a -> a
+ Word8
1) (XPrvKey -> Fingerprint
xPrvFP XPrvKey
xkey) KeyIndex
i ChainCode
c SecKey
k
    | Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Invalid child derivation index"
  where
    i :: KeyIndex
i = forall a. Bits a => a -> Int -> a
setBit KeyIndex
child Int
31
    m :: ByteString
m = ByteString -> ByteString -> ByteString
B.append (SecKey -> ByteString
bsPadPrvKey forall a b. (a -> b) -> a -> b
$ XPrvKey -> SecKey
xPrvKey XPrvKey
xkey) (Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize KeyIndex
i)
    (ChainCode
a, ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 (Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ XPrvKey -> ChainCode
xPrvChain XPrvKey
xkey) ByteString
m
    k :: SecKey
k = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
err forall a b. (a -> b) -> a -> b
$ SecKey -> ChainCode -> Maybe SecKey
tweakSecKey (XPrvKey -> SecKey
xPrvKey XPrvKey
xkey) ChainCode
a
    err :: a
err = forall a e. Exception e => e -> a
throw 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 = 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 = 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 = 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 = 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 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 = forall b. ByteArrayAccess b => b -> Hash160
ripemd160 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. ByteArrayAccess b => b -> ChainCode
sha256 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> PubKey -> ByteString
exportPubKey Bool
True 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 =
    forall b a. b -> Either a b -> b
fromRight forall {a}. a
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrvKey -> Hash160
xPrvID
  where
    err :: a
err = 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 =
    forall b a. b -> Either a b -> b
fromRight forall {a}. a
err forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.take Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> Hash160
xPubID
  where
    err :: a
err = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS (forall (m :: * -> *). MonadGet m => Network -> m XPrvKey
getXPrvKey Network
net) 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 = forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> Either String a
runGetS (forall (m :: * -> *). MonadGet m => Network -> m XPubKey
getXPubKey Network
net) 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 :: forall (m :: * -> *). MonadGet m => Network -> m XPrvKey
getXPrvKey Network
net = do
    KeyIndex
ver <- forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (KeyIndex
ver forall a. Eq a => a -> a -> Bool
== Network -> KeyIndex
getExtSecretPrefix Network
net) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail
            String
"Get: Invalid version for extended private key"
    forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Serialize an extended private key.
putXPrvKey :: MonadPut m => Network -> XPrvKey -> m ()
putXPrvKey :: forall (m :: * -> *). MonadPut m => Network -> XPrvKey -> m ()
putXPrvKey Network
net XPrvKey
k = do
    forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be forall a b. (a -> b) -> a -> b
$ Network -> KeyIndex
getExtSecretPrefix Network
net
    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 :: forall (m :: * -> *). MonadGet m => Network -> m XPubKey
getXPubKey Network
net = do
    KeyIndex
ver <- forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (KeyIndex
ver forall a. Eq a => a -> a -> Bool
== Network -> KeyIndex
getExtPubKeyPrefix Network
net) forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a. MonadFail m => String -> m a
fail
            String
"Get: Invalid version for extended public key"
    forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize

-- | Serialize an extended public key.
putXPubKey :: MonadPut m => Network -> XPubKey -> m ()
putXPubKey :: forall (m :: * -> *). MonadPut m => Network -> XPubKey -> m ()
putXPubKey Network
net XPubKey
k = do
    forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be forall a b. (a -> b) -> a -> b
$ Network -> KeyIndex
getExtPubKeyPrefix Network
net
    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 = forall a b. (a -> b) -> [a] -> [b]
map (\KeyIndex
i -> (XPrvKey -> KeyIndex -> XPrvKey
prvSubKey XPrvKey
k KeyIndex
i, KeyIndex
i)) 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 = forall a b. (a -> b) -> [a] -> [b]
map (\KeyIndex
i -> (XPubKey -> KeyIndex -> XPubKey
pubSubKey XPubKey
k KeyIndex
i, KeyIndex
i)) 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 = forall a b. (a -> b) -> [a] -> [b]
map (\KeyIndex
i -> (XPrvKey -> KeyIndex -> XPrvKey
hardSubKey XPrvKey
k KeyIndex
i, KeyIndex
i)) 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 =
    forall a b. (a -> b) -> [a] -> [b]
map KeyIndex -> (Address, PubKey, KeyIndex)
f 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 =
    forall a b. (a -> b) -> [a] -> [b]
map KeyIndex -> (Address, PubKey, KeyIndex)
f 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 =
    forall a b. (a -> b) -> [a] -> [b]
map KeyIndex -> (Address, PubKey, KeyIndex)
f 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 forall a b. (a -> b) -> a -> b
$ [PubKeyI] -> Int -> RedeemScript
PayMulSig [PubKeyI]
k Int
m
    k :: [PubKeyI]
k = forall a b. (a -> b) -> [a] -> [b]
map (Bool -> PubKey -> PubKeyI
wrapPubKey Bool
True forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> PubKey
xPubKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (a -> b) -> [a] -> [b]
map KeyIndex -> (Address, RedeemScript, KeyIndex)
f 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 forall a. Eq a => a -> a -> Bool
== KeyIndex
0 = forall a. [a] -> [a]
cycle [KeyIndex
0 .. KeyIndex
0x7fffffff]
    | KeyIndex
i forall a. Ord a => a -> a -> Bool
< KeyIndex
0x80000000 = forall a. [a] -> [a]
cycle forall a b. (a -> b) -> a -> b
$ [KeyIndex
i .. KeyIndex
0x7fffffff] forall a. [a] -> [a] -> [a]
++ [KeyIndex
0 .. (KeyIndex
i forall a. Num a => a -> a -> a
- KeyIndex
1)]
    | Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"cycleIndex: invalid index " forall a. [a] -> [a] -> [a]
++ 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. 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 -> ()
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. 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 -> ()
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. 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 -> ()
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) = forall a. NFData a => a -> ()
rnf DerivPathI t
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf KeyIndex
b
    rnf (DerivPathI t
a :/ KeyIndex
b) = forall a. NFData a => a -> ()
rnf DerivPathI t
a seq :: forall a b. a -> b -> b
`seq` 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 forall a. Eq a => a -> a -> Bool
== KeyIndex
iB Bool -> Bool -> Bool
&& DerivPathI t
nextA forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB
    (DerivPathI t
nextA :/ KeyIndex
iA) == (DerivPathI t
nextB :/ KeyIndex
iB) = KeyIndex
iA forall a. Eq a => a -> a -> Bool
== KeyIndex
iB Bool -> Bool -> Bool
&& DerivPathI t
nextA 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 forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then KeyIndex
iA forall a. Ord a => a -> a -> Ordering
`compare` KeyIndex
iB else DerivPathI t
nextA 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 forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then KeyIndex
iA forall a. Ord a => a -> a -> Ordering
`compare` KeyIndex
iB else DerivPathI t
nextA 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 forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then Ordering
LT else DerivPathI t
nextA 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 forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then Ordering
GT else DerivPathI t
nextA 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 :: forall (m :: * -> *). MonadGet m => m DerivPath
deserialize = [KeyIndex] -> DerivPath
listToPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList forall (m :: * -> *). MonadGet m => m KeyIndex
getWord32be
    serialize :: forall (m :: * -> *). MonadPut m => DerivPath -> m ()
serialize = forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList forall (m :: * -> *). MonadPut m => KeyIndex -> m ()
putWord32be forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. DerivPathI t -> [KeyIndex]
pathToList

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

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

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

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

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

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

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

instance Binary SoftPath where
    put :: SoftPath -> Put
put = forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
    get :: Get SoftPath
get = 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 :: forall t. DerivPathI t -> [KeyIndex]
pathToList =
    forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. DerivPathI t -> [KeyIndex]
go
  where
    go :: DerivPathI t -> [KeyIndex]
go (DerivPathI t
next :| KeyIndex
i) = forall a. Bits a => a -> Int -> a
setBit KeyIndex
i Int
31 forall a. a -> [a] -> [a]
: DerivPathI t -> [KeyIndex]
go DerivPathI t
next
    go (DerivPathI t
next :/ KeyIndex
i) = KeyIndex
i 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 =
    forall {t}.
(HardOrAny t, AnyOrSoft t) =>
[KeyIndex] -> DerivPathI t
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
  where
    go :: [KeyIndex] -> DerivPathI t
go (KeyIndex
i : [KeyIndex]
is)
        | forall a. Bits a => a -> Int -> Bool
testBit KeyIndex
i Int
31 = [KeyIndex] -> DerivPathI t
go [KeyIndex]
is forall t. HardOrAny t => DerivPathI t -> KeyIndex -> DerivPathI t
:| forall a. Bits a => a -> Int -> a
clearBit KeyIndex
i Int
31
        | Bool
otherwise = [KeyIndex] -> DerivPathI t
go [KeyIndex]
is forall t. AnyOrSoft t => DerivPathI t -> KeyIndex -> DerivPathI t
:/ KeyIndex
i
    go [] = forall t. DerivPathI t
Deriv

-- | Convert a derivation path to a human-readable string.
pathToStr :: DerivPathI t -> String
pathToStr :: forall t. DerivPathI t -> String
pathToStr DerivPathI t
p =
    case DerivPathI t
p of
        DerivPathI t
next :| KeyIndex
i -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall t. DerivPathI t -> String
pathToStr DerivPathI t
next, String
"/", forall a. Show a => a -> String
show KeyIndex
i, String
"'"]
        DerivPathI t
next :/ KeyIndex
i -> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [forall t. DerivPathI t -> String
pathToStr DerivPathI t
next, 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 :: forall t. DerivPathI t -> Maybe HardPath
toHard DerivPathI t
p = case DerivPathI t
p of
    DerivPathI t
next :| KeyIndex
i -> (forall t. HardOrAny t => DerivPathI t -> KeyIndex -> DerivPathI t
:| KeyIndex
i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. DerivPathI t -> Maybe HardPath
toHard DerivPathI t
next
    DerivPathI t
Deriv -> forall a. a -> Maybe a
Just forall t. DerivPathI t
Deriv
    DerivPathI t
_ -> 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 :: forall t. DerivPathI t -> Maybe SoftPath
toSoft DerivPathI t
p = case DerivPathI t
p of
    DerivPathI t
next :/ KeyIndex
i -> (forall t. AnyOrSoft t => DerivPathI t -> KeyIndex -> DerivPathI t
:/ KeyIndex
i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. DerivPathI t -> Maybe SoftPath
toSoft DerivPathI t
next
    DerivPathI t
Deriv -> forall a. a -> Maybe a
Just forall t. DerivPathI t
Deriv
    DerivPathI t
_ -> forall a. Maybe a
Nothing

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

{- | Append two derivation paths together. The result will be a mixed
 derivation path.
-}
(++/) :: DerivPathI t1 -> DerivPathI t2 -> DerivPath
++/ :: forall t1 t2. DerivPathI t1 -> DerivPathI t2 -> DerivPath
(++/) DerivPathI t1
p1 DerivPathI t2
p2 =
    forall {t} {c}.
(AnyOrSoft t, HardOrAny t) =>
(DerivPathI t -> c) -> DerivPath -> DerivPathI t -> c
go forall a. a -> a
id (forall t. DerivPathI t -> DerivPath
toGeneric DerivPathI t2
p2) forall a b. (a -> b) -> a -> b
$ 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall t. AnyOrSoft t => DerivPathI t -> KeyIndex -> DerivPathI t
:/ KeyIndex
i)) forall a b. (a -> b) -> a -> b
$ forall t. DerivPathI t -> DerivPath
toGeneric DerivPath
next
        DerivPath
next :| KeyIndex
i -> (DerivPathI t -> c) -> DerivPath -> DerivPathI t -> c
go (DerivPathI t -> c
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall t. HardOrAny t => DerivPathI t -> KeyIndex -> DerivPathI t
:| KeyIndex
i)) forall a b. (a -> b) -> a -> b
$ 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 :: forall t. DerivPathI t -> XPrvKey -> XPrvKey
derivePath = forall {c} {t}. (XPrvKey -> c) -> DerivPathI t -> XPrvKey -> c
go 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall {c} {t}. (XPubKey -> c) -> DerivPathI t -> XPubKey -> c
go 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"DerivPath " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall t. DerivPathI t -> String
pathToStr DerivPath
p)

instance Read DerivPath where
    readPrec :: ReadPrec DerivPath
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ do
        R.Ident String
"DerivPath" <- ReadPrec Lexeme
lexP
        R.String String
str <- ReadPrec Lexeme
lexP
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadPrec a
pfail forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ParsedPath -> DerivPath
getParsedPath 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"HardPath " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall t. DerivPathI t -> String
pathToStr HardPath
p)

instance Read HardPath where
    readPrec :: ReadPrec HardPath
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ do
        R.Ident String
"HardPath" <- ReadPrec Lexeme
lexP
        R.String String
str <- ReadPrec Lexeme
lexP
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadPrec a
pfail forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"SoftPath " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (forall t. DerivPathI t -> String
pathToStr SoftPath
p)

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

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

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

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

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

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

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

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

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

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

instance ToJSON ParsedPath where
    toJSON :: ParsedPath -> Value
toJSON (ParsedPrv DerivPath
p) = Text -> Value
A.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertibleStrings a b => a -> b
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"m" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. DerivPathI t -> String
pathToStr forall a b. (a -> b) -> a -> b
$ DerivPath
p
    toJSON (ParsedPub DerivPath
p) = Text -> Value
A.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertibleStrings a b => a -> b
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"M" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. DerivPathI t -> String
pathToStr forall a b. (a -> b) -> a -> b
$ DerivPath
p
    toJSON (ParsedEmpty DerivPath
p) = Text -> Value
A.String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertibleStrings a b => a -> b
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. DerivPathI t -> String
pathToStr forall a b. (a -> b) -> a -> b
$ DerivPath
p
    toEncoding :: ParsedPath -> Encoding
toEncoding (ParsedPrv DerivPath
p) = forall a. Text -> Encoding' a
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertibleStrings a b => a -> b
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"m" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. DerivPathI t -> String
pathToStr forall a b. (a -> b) -> a -> b
$ DerivPath
p
    toEncoding (ParsedPub DerivPath
p) = forall a. Text -> Encoding' a
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertibleStrings a b => a -> b
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"M" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. DerivPathI t -> String
pathToStr forall a b. (a -> b) -> a -> b
$ DerivPath
p
    toEncoding (ParsedEmpty DerivPath
p) = forall a. Text -> Encoding' a
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ConvertibleStrings a b => a -> b
cs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"" forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. DerivPathI t -> String
pathToStr 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
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. 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 -> ()
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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"ParsedPath " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows String
f
      where
        f :: String
f =
            case ParsedPath
p of
                ParsedPrv DerivPath
d' -> String
"m" forall a. Semigroup a => a -> a -> a
<> forall t. DerivPathI t -> String
pathToStr DerivPath
d'
                ParsedPub DerivPath
d' -> String
"M" forall a. Semigroup a => a -> a -> a
<> forall t. DerivPathI t -> String
pathToStr DerivPath
d'
                ParsedEmpty DerivPath
d' -> forall t. DerivPathI t -> String
pathToStr DerivPath
d'

instance Read ParsedPath where
    readPrec :: ReadPrec ParsedPath
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ do
        R.Ident String
"ParsedPath" <- ReadPrec Lexeme
lexP
        R.String String
str <- ReadPrec Lexeme
lexP
        forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadPrec a
pfail forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DerivPath -> ParsedPath
ParsedPrv DerivPath
res
        String
"M" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DerivPath -> ParsedPath
ParsedPub DerivPath
res
        String
"" -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ DerivPath -> ParsedPath
ParsedEmpty DerivPath
res
        String
_ -> forall a. Maybe a
Nothing
  where
    (String
x : [String]
xs) = 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DerivPath -> Bip32PathIndex -> DerivPath
appendBip32Segment 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 forall t. AnyOrSoft t => DerivPathI t -> KeyIndex -> DerivPathI t
:/ KeyIndex
i
appendBip32Segment DerivPath
d (Bip32HardIndex KeyIndex
i) = DerivPath
d 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 forall a. Read a => ReadS a
reads String
segment of
    [(KeyIndex
i, String
"")] -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a. Integral a => a -> Bool
is31Bit KeyIndex
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (KeyIndex -> Bip32PathIndex
Bip32SoftIndex KeyIndex
i)
    [(KeyIndex
i, String
"'")] -> forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall a. Integral a => a -> Bool
is31Bit KeyIndex
i) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return (KeyIndex -> Bip32PathIndex
Bip32HardIndex KeyIndex
i)
    [(KeyIndex, String)]
_ -> forall a. Maybe a
Nothing

-- | Type for BIP32 path index element.
data Bip32PathIndex
    = Bip32HardIndex KeyIndex
    | Bip32SoftIndex KeyIndex
    deriving (Bip32PathIndex -> Bip32PathIndex -> Bool
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. 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 -> ()
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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"Bip32HardIndex " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows KeyIndex
i
    showsPrec Int
d (Bip32SoftIndex KeyIndex
i) =
        Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
            String -> ShowS
showString String
"Bip32SoftIndex " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows KeyIndex
i

instance Read Bip32PathIndex where
    readPrec :: ReadPrec Bip32PathIndex
readPrec = ReadPrec Bip32PathIndex
h forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ReadPrec Bip32PathIndex
s
      where
        h :: ReadPrec Bip32PathIndex
h =
            forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ do
                R.Ident String
"Bip32HardIndex" <- ReadPrec Lexeme
lexP
                R.Number Number
n <- ReadPrec Lexeme
lexP
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadPrec a
pfail forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                    KeyIndex -> Bip32PathIndex
Bip32HardIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Number -> Maybe Integer
numberToInteger Number
n
        s :: ReadPrec Bip32PathIndex
s =
            forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$ do
                R.Ident String
"Bip32SoftIndex" <- ReadPrec Lexeme
lexP
                R.Number Number
n <- ReadPrec Lexeme
lexP
                forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. ReadPrec a
pfail forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                    KeyIndex -> Bip32PathIndex
Bip32SoftIndex forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 :: forall a. Integral a => a -> Bool
is31Bit a
i = a
i forall a. Ord a => a -> a -> Bool
>= a
0 Bool -> Bool -> Bool
&& a
i 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 = forall t. DerivPathI t -> Maybe HardPath
toHard forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedPath -> DerivPath
getParsedPath 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 = forall t. DerivPathI t -> Maybe SoftPath
toSoft forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedPath -> DerivPath
getParsedPath 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
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
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. 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 -> ()
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) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ XPrvKey -> Network -> XKey
XPrv (XPrvKey -> XPrvKey
derivPrvF XPrvKey
k) Network
n
        (ParsedPrv DerivPath
_, XPub{}) -> forall a b. a -> Either a b
Left String
"applyPath: Invalid public key"
        (ParsedPub DerivPath
_, XPrv XPrvKey
k Network
n) -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \XPubKey -> XPubKey
f -> forall (m :: * -> *) a. Monad m => a -> m a
return 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) -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \XPubKey -> XPubKey
f -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ XPubKey -> Network -> XKey
XPub (XPubKey -> XPubKey
f XPubKey
k) Network
n
  where
    derivPrvF :: XPrvKey -> XPrvKey
derivPrvF = forall {c} {t}. (XPrvKey -> c) -> DerivPathI t -> XPrvKey -> c
goPrv forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ ParsedPath -> DerivPath
getParsedPath ParsedPath
path
    derivPubFE :: Either String (XPubKey -> XPubKey)
derivPubFE = forall {a} {c} {t}.
IsString a =>
(XPubKey -> c) -> DerivPathI t -> Either a (XPubKey -> c)
goPubE forall a. a -> a
id 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip XPubKey -> KeyIndex -> XPubKey
pubSubKey KeyIndex
i) DerivPathI t
next
            DerivPathI t
Deriv -> forall a b. b -> Either a b
Right XPubKey -> c
f
            DerivPathI t
_ -> 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *). MonadGet m => m SecKey
getPadPrvKey = do
    Word8
pad <- forall (m :: * -> *). MonadGet m => m Word8
getWord8
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
pad forall a. Eq a => a -> a -> Bool
== Word8
0x00) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Private key must be padded with 0x00"
    ByteString
bs <- forall (m :: * -> *). MonadGet m => Int -> m ByteString
getByteString Int
32
    case forall a. Get a -> ByteString -> Either String a
runGetS forall t. Serialize t => Get t
S.get ByteString
bs of
        Left String
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
        Right SecKey
x -> forall (m :: * -> *) a. Monad m => a -> m a
return SecKey
x

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

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