{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- Module      : Haskoin.Keys.Extended
-- Copyright   : No rights reserved
-- License     : MIT
-- Maintainer  : jprupp@protonmail.ch
-- Stability   : experimental
-- Portability : POSIX
--
-- BIP-32 extended keys.
module Haskoin.Crypto.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,
    xPrvExport,
    xPubImport,
    xPrvImport,
    xPrvWif,

    -- ** 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 Aeson
  ( FromJSON,
    ToJSON (..),
    Value (String),
    parseJSON,
    toJSON,
    withText,
  )
import Data.Aeson.Encoding (Encoding, string, text)
import Data.Aeson.Types (Parser)
import Data.Binary (Binary (get, put))
import Data.Bits (clearBit, setBit, testBit)
import Data.ByteString (ByteString)
import Data.ByteString qualified as B
import Data.Bytes.Get
  ( MonadGet
      ( getByteString,
        getWord32be,
        getWord8
      ),
    runGetS,
  )
import Data.Bytes.Put
  ( MonadPut
      ( putByteString,
        putWord32be,
        putWord8
      ),
    runPutS,
  )
import Data.Bytes.Serial (Serial (..))
import Data.Either (fromRight)
import Data.Hashable (Hashable)
import Data.List (foldl')
import Data.List.Split (splitOn)
import Data.Maybe (fromMaybe)
import Data.Serialize (Serialize (..))
import Data.Serialize qualified as S
import Data.String (IsString, fromString)
import Data.String.Conversions (cs)
import Data.Text qualified as Text
import Data.Typeable (Typeable)
import Data.Word (Word32, Word8)
import GHC.Generics (Generic)
import Haskoin.Address
import Haskoin.Crypto.Hash
import Haskoin.Crypto.Keys.Common
import Haskoin.Crypto.Keys.Extended.Internal
import Haskoin.Network.Data
import Haskoin.Script.Standard
import Haskoin.Util
import Text.Read as Read
  ( Lexeme (Ident, Number, String),
    Read (readPrec),
    lexP,
    parens,
    pfail,
  )
import Text.Read.Lex (numberToInteger)

-- | 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
$c== :: DerivationException -> DerivationException -> Bool
== :: DerivationException -> DerivationException -> Bool
$c/= :: DerivationException -> DerivationException -> Bool
/= :: 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
$creadsPrec :: Int -> ReadS DerivationException
readsPrec :: Int -> ReadS DerivationException
$creadList :: ReadS [DerivationException]
readList :: ReadS [DerivationException]
$creadPrec :: ReadPrec DerivationException
readPrec :: ReadPrec DerivationException
$creadListPrec :: ReadPrec [DerivationException]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> DerivationException -> ShowS
showsPrec :: Int -> DerivationException -> ShowS
$cshow :: DerivationException -> String
show :: DerivationException -> String
$cshowList :: [DerivationException] -> ShowS
showList :: [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
$cfrom :: forall x. DerivationException -> Rep DerivationException x
from :: forall x. DerivationException -> Rep DerivationException x
$cto :: forall x. Rep DerivationException x -> DerivationException
to :: forall x. Rep DerivationException x -> DerivationException
Generic)
  deriving newtype (DerivationException -> ()
(DerivationException -> ()) -> NFData DerivationException
forall a. (a -> ()) -> NFData a
$crnf :: DerivationException -> ()
rnf :: 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
depth :: !Word8,
    -- | fingerprint of parent
    XPrvKey -> Fingerprint
parent :: !Fingerprint,
    -- | derivation index
    XPrvKey -> Word32
index :: !KeyIndex,
    -- | chain code
    XPrvKey -> Hash256
chain :: !ChainCode,
    -- | private key of this node
    XPrvKey -> SecKey
key :: !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
$cfrom :: forall x. XPrvKey -> Rep XPrvKey x
from :: forall x. XPrvKey -> Rep XPrvKey x
$cto :: forall x. Rep XPrvKey x -> XPrvKey
to :: forall x. Rep XPrvKey x -> XPrvKey
Generic, XPrvKey -> XPrvKey -> Bool
(XPrvKey -> XPrvKey -> Bool)
-> (XPrvKey -> XPrvKey -> Bool) -> Eq XPrvKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPrvKey -> XPrvKey -> Bool
== :: XPrvKey -> XPrvKey -> Bool
$c/= :: XPrvKey -> XPrvKey -> Bool
/= :: 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
$cshowsPrec :: Int -> XPrvKey -> ShowS
showsPrec :: Int -> XPrvKey -> ShowS
$cshow :: XPrvKey -> String
show :: XPrvKey -> String
$cshowList :: [XPrvKey] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS XPrvKey
readsPrec :: Int -> ReadS XPrvKey
$creadList :: ReadS [XPrvKey]
readList :: ReadS [XPrvKey]
$creadPrec :: ReadPrec XPrvKey
readPrec :: ReadPrec XPrvKey
$creadListPrec :: ReadPrec [XPrvKey]
readListPrec :: ReadPrec [XPrvKey]
Read, XPrvKey -> ()
(XPrvKey -> ()) -> NFData XPrvKey
forall a. (a -> ()) -> NFData a
$crnf :: XPrvKey -> ()
rnf :: XPrvKey -> ()
NFData, Eq XPrvKey
Eq XPrvKey =>
(Int -> XPrvKey -> Int) -> (XPrvKey -> Int) -> Hashable XPrvKey
Int -> XPrvKey -> Int
XPrvKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> XPrvKey -> Int
hashWithSalt :: Int -> XPrvKey -> Int
$chash :: XPrvKey -> Int
hash :: XPrvKey -> Int
Hashable)

instance Marshal Network XPrvKey where
  marshalGet :: forall (m :: * -> *). MonadGet m => Network -> m XPrvKey
marshalGet Network
net = do
    Word32
ver <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
ver Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Network
net.xPrvPrefix) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Get: Invalid version for extended private key"
    Word8 -> Fingerprint -> Word32 -> Hash256 -> SecKey -> XPrvKey
XPrvKey
      (Word8 -> Fingerprint -> Word32 -> Hash256 -> SecKey -> XPrvKey)
-> m Word8
-> m (Fingerprint -> Word32 -> Hash256 -> 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 -> Word32 -> Hash256 -> SecKey -> XPrvKey)
-> m Fingerprint -> m (Word32 -> Hash256 -> SecKey -> XPrvKey)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Fingerprint
deserialize
      m (Word32 -> Hash256 -> SecKey -> XPrvKey)
-> m Word32 -> m (Hash256 -> SecKey -> XPrvKey)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
      m (Hash256 -> SecKey -> XPrvKey)
-> m Hash256 -> m (SecKey -> XPrvKey)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash256
deserialize
      m (SecKey -> XPrvKey) -> m SecKey -> m XPrvKey
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m SecKey
forall (m :: * -> *). MonadGet m => m SecKey
getPadPrvKey

  marshalPut :: forall (m :: * -> *). MonadPut m => Network -> XPrvKey -> m ()
marshalPut Network
net XPrvKey
k = do
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Network
net.xPrvPrefix
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 XPrvKey
k.depth
    Fingerprint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
serialize XPrvKey
k.parent
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be XPrvKey
k.index
    Hash256 -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize (Hash256 -> m ()) -> Hash256 -> m ()
forall a b. (a -> b) -> a -> b
$ XPrvKey
k.chain
    SecKey -> m ()
forall (m :: * -> *). MonadPut m => SecKey -> m ()
putPadPrvKey XPrvKey
k.key

instance MarshalJSON Network XPrvKey where
  marshalValue :: Network -> XPrvKey -> Value
marshalValue Network
net = Text -> Value
Aeson.String (Text -> Value) -> (XPrvKey -> Text) -> XPrvKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> XPrvKey -> Text
xPrvExport Network
net

  marshalEncoding :: Network -> XPrvKey -> Encoding
marshalEncoding 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

  unmarshalValue :: Network -> Value -> Parser XPrvKey
unmarshalValue Network
net =
    String -> (Text -> Parser XPrvKey) -> Value -> Parser XPrvKey
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"XPrvKey" ((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 a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not read xprv"
        Just XPrvKey
x -> XPrvKey -> Parser XPrvKey
forall a. a -> Parser a
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
depth :: !Word8,
    -- | fingerprint of parent
    XPubKey -> Fingerprint
parent :: !Fingerprint,
    -- | derivation index
    XPubKey -> Word32
index :: !KeyIndex,
    -- | chain code
    XPubKey -> Hash256
chain :: !ChainCode,
    -- | public key of this node
    XPubKey -> PubKey
key :: !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
$cfrom :: forall x. XPubKey -> Rep XPubKey x
from :: forall x. XPubKey -> Rep XPubKey x
$cto :: forall x. Rep XPubKey x -> XPubKey
to :: forall x. Rep XPubKey x -> XPubKey
Generic, XPubKey -> XPubKey -> Bool
(XPubKey -> XPubKey -> Bool)
-> (XPubKey -> XPubKey -> Bool) -> Eq XPubKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPubKey -> XPubKey -> Bool
== :: XPubKey -> XPubKey -> Bool
$c/= :: XPubKey -> XPubKey -> Bool
/= :: 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
$cshowsPrec :: Int -> XPubKey -> ShowS
showsPrec :: Int -> XPubKey -> ShowS
$cshow :: XPubKey -> String
show :: XPubKey -> String
$cshowList :: [XPubKey] -> ShowS
showList :: [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
$creadsPrec :: Int -> ReadS XPubKey
readsPrec :: Int -> ReadS XPubKey
$creadList :: ReadS [XPubKey]
readList :: ReadS [XPubKey]
$creadPrec :: ReadPrec XPubKey
readPrec :: ReadPrec XPubKey
$creadListPrec :: ReadPrec [XPubKey]
readListPrec :: ReadPrec [XPubKey]
Read, Eq XPubKey
Eq XPubKey =>
(Int -> XPubKey -> Int) -> (XPubKey -> Int) -> Hashable XPubKey
Int -> XPubKey -> Int
XPubKey -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> XPubKey -> Int
hashWithSalt :: Int -> XPubKey -> Int
$chash :: XPubKey -> Int
hash :: XPubKey -> Int
Hashable, XPubKey -> ()
(XPubKey -> ()) -> NFData XPubKey
forall a. (a -> ()) -> NFData a
$crnf :: XPubKey -> ()
rnf :: XPubKey -> ()
NFData)

instance Marshal (Network, Ctx) XPubKey where
  marshalGet :: forall (m :: * -> *). MonadGet m => (Network, Ctx) -> m XPubKey
marshalGet (Network
net, Ctx
ctx) = do
    Word32
ver <- m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word32
ver Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Network
net.xPubPrefix) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      String -> m ()
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Get: Invalid version for extended public key"
    Word8 -> Fingerprint -> Word32 -> Hash256 -> PubKey -> XPubKey
XPubKey
      (Word8 -> Fingerprint -> Word32 -> Hash256 -> PubKey -> XPubKey)
-> m Word8
-> m (Fingerprint -> Word32 -> Hash256 -> 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 -> Word32 -> Hash256 -> PubKey -> XPubKey)
-> m Fingerprint -> m (Word32 -> Hash256 -> PubKey -> XPubKey)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Fingerprint
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Fingerprint
deserialize
      m (Word32 -> Hash256 -> PubKey -> XPubKey)
-> m Word32 -> m (Hash256 -> PubKey -> XPubKey)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
      m (Hash256 -> PubKey -> XPubKey)
-> m Hash256 -> m (PubKey -> XPubKey)
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Hash256
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
forall (m :: * -> *). MonadGet m => m Hash256
deserialize
      m (PubKey -> XPubKey) -> m PubKey -> m XPubKey
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((\PublicKey {PubKey
point :: PubKey
$sel:point:PublicKey :: PublicKey -> PubKey
point} -> PubKey
point) (PublicKey -> PubKey) -> m PublicKey -> m PubKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ctx -> m PublicKey
forall s a (m :: * -> *). (Marshal s a, MonadGet m) => s -> m a
forall (m :: * -> *). MonadGet m => Ctx -> m PublicKey
marshalGet Ctx
ctx)

  marshalPut :: forall (m :: * -> *).
MonadPut m =>
(Network, Ctx) -> XPubKey -> m ()
marshalPut (Network
net, Ctx
ctx) XPubKey
k = do
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be Network
net.xPubPrefix
    Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 XPubKey
k.depth
    Fingerprint -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Fingerprint -> m ()
serialize XPubKey
k.parent
    Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be XPubKey
k.index
    Hash256 -> m ()
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize XPubKey
k.chain
    Ctx -> PublicKey -> m ()
forall s a (m :: * -> *).
(Marshal s a, MonadPut m) =>
s -> a -> m ()
forall (m :: * -> *). MonadPut m => Ctx -> PublicKey -> m ()
marshalPut Ctx
ctx (PublicKey -> m ()) -> PublicKey -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> PubKey -> PublicKey
wrapPubKey Bool
True XPubKey
k.key

instance MarshalJSON (Network, Ctx) XPubKey where
  unmarshalValue :: (Network, Ctx) -> Value -> Parser XPubKey
unmarshalValue (Network
net, Ctx
ctx) =
    String -> (Text -> Parser XPubKey) -> Value -> Parser XPubKey
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"XPubKey" ((Text -> Parser XPubKey) -> Value -> Parser XPubKey)
-> (Text -> Parser XPubKey) -> Value -> Parser XPubKey
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Network -> Ctx -> Text -> Maybe XPubKey
xPubImport Network
net Ctx
ctx Text
t of
        Maybe XPubKey
Nothing -> String -> Parser XPubKey
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"could not read xpub"
        Just XPubKey
x -> XPubKey -> Parser XPubKey
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return XPubKey
x

  marshalValue :: (Network, Ctx) -> XPubKey -> Value
marshalValue (Network
net, Ctx
ctx) = Text -> Value
Aeson.String (Text -> Value) -> (XPubKey -> Text) -> XPubKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Network -> Ctx -> XPubKey -> Text
xPubExport Network
net Ctx
ctx

  marshalEncoding :: (Network, Ctx) -> XPubKey -> Encoding
marshalEncoding (Network
net, Ctx
ctx) = 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 -> Ctx -> XPubKey -> Text
xPubExport Network
net Ctx
ctx

-- | 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 -> Word32 -> Hash256 -> SecKey -> XPrvKey
XPrvKey Word8
0 (Word32 -> Fingerprint
Fingerprint Word32
0) Word32
0 Hash256
c SecKey
k
  where
    (Hash256
p, Hash256
c) = Hash512 -> (Hash256, Hash256)
split512 (Hash512 -> (Hash256, Hash256)) -> Hash512 -> (Hash256, Hash256)
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 (Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize Hash256
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 :: Ctx -> XPrvKey -> XPubKey
deriveXPubKey :: Ctx -> XPrvKey -> XPubKey
deriveXPubKey Ctx
ctx (XPrvKey Word8
d Fingerprint
p Word32
i Hash256
c SecKey
k) = Word8 -> Fingerprint -> Word32 -> Hash256 -> PubKey -> XPubKey
XPubKey Word8
d Fingerprint
p Word32
i Hash256
c (Ctx -> SecKey -> PubKey
derivePubKey Ctx
ctx 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 ::
  Ctx ->
  -- | extended parent private key
  XPrvKey ->
  -- | child derivation index
  KeyIndex ->
  -- | extended child private key
  XPrvKey
prvSubKey :: Ctx -> XPrvKey -> Word32 -> XPrvKey
prvSubKey Ctx
ctx XPrvKey
xkey Word32
child
  | Word32
child Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
0 Bool -> Bool -> Bool
&& Word32
child Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
0x80000000 =
      Word8 -> Fingerprint -> Word32 -> Hash256 -> SecKey -> XPrvKey
XPrvKey (XPrvKey
xkey.depth Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) (Ctx -> XPrvKey -> Fingerprint
xPrvFP Ctx
ctx XPrvKey
xkey) Word32
child Hash256
c SecKey
k
  | Bool
otherwise = String -> XPrvKey
forall a. HasCallStack => String -> a
error String
"Invalid child derivation index"
  where
    pK :: PubKey
pK = (Ctx -> XPrvKey -> XPubKey
deriveXPubKey Ctx
ctx XPrvKey
xkey).key
    m :: ByteString
m = ByteString -> ByteString -> ByteString
B.append (Ctx -> Bool -> PubKey -> ByteString
exportPubKey Ctx
ctx Bool
True PubKey
pK) (Put -> ByteString
runPutS (Word32 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
serialize Word32
child))
    (Hash256
a, Hash256
c) = Hash512 -> (Hash256, Hash256)
split512 (Hash512 -> (Hash256, Hash256)) -> Hash512 -> (Hash256, Hash256)
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
$ Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize XPrvKey
xkey.chain) 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
$ Ctx -> SecKey -> Hash256 -> Maybe SecKey
tweakSecKey Ctx
ctx XPrvKey
xkey.key Hash256
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 ::
  Ctx ->
  -- | extended parent public key
  XPubKey ->
  -- | child derivation index
  KeyIndex ->
  -- | extended child public key
  XPubKey
pubSubKey :: Ctx -> XPubKey -> Word32 -> XPubKey
pubSubKey Ctx
ctx XPubKey
xKey Word32
child
  | Word32
child Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
0 Bool -> Bool -> Bool
&& Word32
child Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
0x80000000 =
      Word8 -> Fingerprint -> Word32 -> Hash256 -> PubKey -> XPubKey
XPubKey (XPubKey
xKey.depth Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) (Ctx -> XPubKey -> Fingerprint
xPubFP Ctx
ctx XPubKey
xKey) Word32
child Hash256
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 (Ctx -> Bool -> PubKey -> ByteString
exportPubKey Ctx
ctx Bool
True XPubKey
xKey.key) (Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
serialize Word32
child)
    (Hash256
a, Hash256
c) = Hash512 -> (Hash256, Hash256)
split512 (Hash512 -> (Hash256, Hash256)) -> Hash512 -> (Hash256, Hash256)
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
$ Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize XPubKey
xKey.chain) 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
$ Ctx -> PubKey -> Hash256 -> Maybe PubKey
tweakPubKey Ctx
ctx XPubKey
xKey.key Hash256
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 ::
  Ctx ->
  -- | extended parent private key
  XPrvKey ->
  -- | child derivation index
  KeyIndex ->
  -- | extended child private key
  XPrvKey
hardSubKey :: Ctx -> XPrvKey -> Word32 -> XPrvKey
hardSubKey Ctx
ctx XPrvKey
xkey Word32
child
  | Word32
child Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
0 Bool -> Bool -> Bool
&& Word32
child Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
0x80000000 =
      Word8 -> Fingerprint -> Word32 -> Hash256 -> SecKey -> XPrvKey
XPrvKey (XPrvKey
xkey.depth Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1) (Ctx -> XPrvKey -> Fingerprint
xPrvFP Ctx
ctx XPrvKey
xkey) Word32
i Hash256
c SecKey
k
  | Bool
otherwise = String -> XPrvKey
forall a. HasCallStack => String -> a
error String
"Invalid child derivation index"
  where
    i :: Word32
i = Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
setBit Word32
child Int
31
    m :: ByteString
m = ByteString -> ByteString -> ByteString
B.append (SecKey -> ByteString
bsPadPrvKey XPrvKey
xkey.key) (Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
serialize Word32
i)
    (Hash256
a, Hash256
c) = Hash512 -> (Hash256, Hash256)
split512 (Hash512 -> (Hash256, Hash256)) -> Hash512 -> (Hash256, Hash256)
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
$ Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize XPrvKey
xkey.chain) 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
$ Ctx -> SecKey -> Hash256 -> Maybe SecKey
tweakSecKey Ctx
ctx XPrvKey
xkey.key Hash256
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 = Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit XPrvKey
k.index Int
31

-- | Returns true if the extended public key was derived through a hard
-- derivation.
xPubIsHard :: XPubKey -> Bool
xPubIsHard :: XPubKey -> Bool
xPubIsHard XPubKey
k = Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit XPubKey
k.index Int
31

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

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

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

-- | Computes the key identifier of an extended public key.
xPubID :: Ctx -> XPubKey -> Hash160
xPubID :: Ctx -> XPubKey -> Hash160
xPubID Ctx
ctx =
  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) -> (XPubKey -> Put) -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash256 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash256 -> m ()
serialize
    (Hash256 -> Put) -> (XPubKey -> Hash256) -> XPubKey -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Hash256
forall b. ByteArrayAccess b => b -> Hash256
sha256
    (ByteString -> Hash256)
-> (XPubKey -> ByteString) -> XPubKey -> Hash256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> Bool -> PubKey -> ByteString
exportPubKey Ctx
ctx Bool
True
    (PubKey -> ByteString)
-> (XPubKey -> PubKey) -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.key)

-- | Computes the key fingerprint of an extended private key.
xPrvFP :: Ctx -> XPrvKey -> Fingerprint
xPrvFP :: Ctx -> XPrvKey -> Fingerprint
xPrvFP Ctx
ctx =
  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
forall (m :: * -> *). MonadGet m => m Fingerprint
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) -> (XPrvKey -> Put) -> XPrvKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize
    (Hash160 -> Put) -> (XPrvKey -> Hash160) -> XPrvKey -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> XPrvKey -> Hash160
xPrvID Ctx
ctx
  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 :: Ctx -> XPubKey -> Fingerprint
xPubFP :: Ctx -> XPubKey -> Fingerprint
xPubFP Ctx
ctx =
  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
forall (m :: * -> *). MonadGet m => m Fingerprint
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) -> (XPubKey -> Put) -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
forall (m :: * -> *). MonadPut m => Hash160 -> m ()
serialize
    (Hash160 -> Put) -> (XPubKey -> Hash160) -> XPubKey -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ctx -> XPubKey -> Hash160
xPubID Ctx
ctx
  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 :: Ctx -> XPubKey -> Address
xPubAddr :: Ctx -> XPubKey -> Address
xPubAddr Ctx
ctx XPubKey
xkey = Ctx -> PublicKey -> Address
pubKeyAddr Ctx
ctx (Bool -> PubKey -> PublicKey
wrapPubKey Bool
True XPubKey
xkey.key)

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

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

-- | 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
. Network -> XPrvKey -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Network
net

-- | Exports an extended public key to the BIP32 key export format ('Base58').
xPubExport :: Network -> Ctx -> XPubKey -> Base58
xPubExport :: Network -> Ctx -> XPubKey -> Text
xPubExport Network
net Ctx
ctx = ByteString -> Text
encodeBase58Check (ByteString -> Text) -> (XPubKey -> ByteString) -> XPubKey -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Network, Ctx) -> XPubKey -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal (Network
net, Ctx
ctx)

-- | 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
. Network -> ByteString -> Either String XPrvKey
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal 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 -> Ctx -> Base58 -> Maybe XPubKey
xPubImport :: Network -> Ctx -> Text -> Maybe XPubKey
xPubImport Network
net Ctx
ctx =
  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
. (Network, Ctx) -> ByteString -> Either String XPubKey
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal (Network
net, Ctx
ctx) (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 -> PrivateKey -> Text
toWif Network
net (Bool -> SecKey -> PrivateKey
wrapSecKey Bool
True XPrvKey
xkey.key)

{- Derivation helpers -}

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

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

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

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

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

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

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

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

-- | Cyclic list of all backwards-compatible SegWit P2SH-P2WPKH addresses
-- derived from a public key starting from an offset index.
deriveCompatWitnessAddrs ::
  Ctx -> XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]
deriveCompatWitnessAddrs :: Ctx -> XPubKey -> Word32 -> [(Address, PubKey, Word32)]
deriveCompatWitnessAddrs Ctx
ctx XPubKey
k =
  (Word32 -> (Address, PubKey, Word32))
-> [Word32] -> [(Address, PubKey, Word32)]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> (Address, PubKey, Word32)
f ([Word32] -> [(Address, PubKey, Word32)])
-> (Word32 -> [Word32]) -> Word32 -> [(Address, PubKey, Word32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [Word32]
cycleIndex
  where
    f :: Word32 -> (Address, PubKey, Word32)
f Word32
i = let (Address
a, PubKey
key) = Ctx -> XPubKey -> Word32 -> (Address, PubKey)
deriveCompatWitnessAddr Ctx
ctx XPubKey
k Word32
i in (Address
a, PubKey
key, Word32
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 ::
  Ctx -> [XPubKey] -> Int -> KeyIndex -> (Address, RedeemScript)
deriveMSAddr :: Ctx -> [XPubKey] -> Int -> Word32 -> (Address, RedeemScript)
deriveMSAddr Ctx
ctx [XPubKey]
keys Int
m Word32
i = (Ctx -> RedeemScript -> Address
payToScriptAddress Ctx
ctx RedeemScript
rdm, RedeemScript
rdm)
  where
    rdm :: RedeemScript
rdm = Ctx -> RedeemScript -> RedeemScript
sortMulSig Ctx
ctx (RedeemScript -> RedeemScript) -> RedeemScript -> RedeemScript
forall a b. (a -> b) -> a -> b
$ [PublicKey] -> Int -> RedeemScript
PayMulSig [PublicKey]
k Int
m
    k :: [PublicKey]
k = (XPubKey -> PublicKey) -> [XPubKey] -> [PublicKey]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> PubKey -> PublicKey
wrapPubKey Bool
True (PubKey -> PublicKey)
-> (XPubKey -> PubKey) -> XPubKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.key) (XPubKey -> PubKey) -> (XPubKey -> XPubKey) -> XPubKey -> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubKey -> Word32 -> XPubKey) -> Word32 -> XPubKey -> XPubKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Ctx -> XPubKey -> Word32 -> XPubKey
pubSubKey Ctx
ctx) Word32
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 ::
  Ctx ->
  [XPubKey] ->
  Int ->
  KeyIndex ->
  [(Address, RedeemScript, KeyIndex)]
deriveMSAddrs :: Ctx
-> [XPubKey] -> Int -> Word32 -> [(Address, RedeemScript, Word32)]
deriveMSAddrs Ctx
ctx [XPubKey]
keys Int
m = (Word32 -> (Address, RedeemScript, Word32))
-> [Word32] -> [(Address, RedeemScript, Word32)]
forall a b. (a -> b) -> [a] -> [b]
map Word32 -> (Address, RedeemScript, Word32)
f ([Word32] -> [(Address, RedeemScript, Word32)])
-> (Word32 -> [Word32])
-> Word32
-> [(Address, RedeemScript, Word32)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> [Word32]
cycleIndex
  where
    f :: Word32 -> (Address, RedeemScript, Word32)
f Word32
i =
      let (Address
a, RedeemScript
rdm) = Ctx -> [XPubKey] -> Int -> Word32 -> (Address, RedeemScript)
deriveMSAddr Ctx
ctx [XPubKey]
keys Int
m Word32
i
       in (Address
a, RedeemScript
rdm, Word32
i)

-- | Helper function to go through derivation indices.
cycleIndex :: KeyIndex -> [KeyIndex]
cycleIndex :: Word32 -> [Word32]
cycleIndex Word32
i
  | Word32
i Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
0 = [Word32] -> [Word32]
forall a. HasCallStack => [a] -> [a]
cycle [Word32
0 .. Word32
0x7fffffff]
  | Word32
i Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
0x80000000 = [Word32] -> [Word32]
forall a. HasCallStack => [a] -> [a]
cycle ([Word32] -> [Word32]) -> [Word32] -> [Word32]
forall a b. (a -> b) -> a -> b
$ [Word32
i .. Word32
0x7fffffff] [Word32] -> [Word32] -> [Word32]
forall a. [a] -> [a] -> [a]
++ [Word32
0 .. (Word32
i Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
1)]
  | Bool
otherwise = String -> [Word32]
forall a. HasCallStack => String -> a
error (String -> [Word32]) -> String -> [Word32]
forall a b. (a -> b) -> a -> b
$ String
"cycleIndex: invalid index " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> String
forall a. Show a => a -> String
show Word32
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
$cfrom :: forall x. HardDeriv -> Rep HardDeriv x
from :: forall x. HardDeriv -> Rep HardDeriv x
$cto :: forall x. Rep HardDeriv x -> HardDeriv
to :: forall x. Rep HardDeriv x -> HardDeriv
Generic, HardDeriv -> ()
(HardDeriv -> ()) -> NFData HardDeriv
forall a. (a -> ()) -> NFData a
$crnf :: HardDeriv -> ()
rnf :: 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
$cfrom :: forall x. AnyDeriv -> Rep AnyDeriv x
from :: forall x. AnyDeriv -> Rep AnyDeriv x
$cto :: forall x. Rep AnyDeriv x -> AnyDeriv
to :: forall x. Rep AnyDeriv x -> AnyDeriv
Generic, AnyDeriv -> ()
(AnyDeriv -> ()) -> NFData AnyDeriv
forall a. (a -> ()) -> NFData a
$crnf :: AnyDeriv -> ()
rnf :: 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
$cfrom :: forall x. SoftDeriv -> Rep SoftDeriv x
from :: forall x. SoftDeriv -> Rep SoftDeriv x
$cto :: forall x. Rep SoftDeriv x -> SoftDeriv
to :: forall x. Rep SoftDeriv x -> SoftDeriv
Generic, SoftDeriv -> ()
(SoftDeriv -> ()) -> NFData SoftDeriv
forall a. (a -> ()) -> NFData a
$crnf :: SoftDeriv -> ()
rnf :: 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 :| Word32
b) = DerivPathI t -> ()
forall a. NFData a => a -> ()
rnf DerivPathI t
a () -> () -> ()
forall a b. a -> b -> b
`seq` Word32 -> ()
forall a. NFData a => a -> ()
rnf Word32
b
  rnf (DerivPathI t
a :/ Word32
b) = DerivPathI t -> ()
forall a. NFData a => a -> ()
rnf DerivPathI t
a () -> () -> ()
forall a b. a -> b -> b
`seq` Word32 -> ()
forall a. NFData a => a -> ()
rnf Word32
b
  rnf DerivPathI t
Deriv = ()

instance Eq (DerivPathI t) where
  (DerivPathI t
nextA :| Word32
iA) == :: DerivPathI t -> DerivPathI t -> Bool
== (DerivPathI t
nextB :| Word32
iB) = Word32
iA Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
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 :/ Word32
iA) == (DerivPathI t
nextB :/ Word32
iB) = Word32
iA Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
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 :| Word32
iA) compare :: DerivPathI t -> DerivPathI t -> Ordering
`compare` (DerivPathI t
nextB :| Word32
iB) =
    if DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Bool
forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then Word32
iA Word32 -> Word32 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word32
iB else DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` DerivPathI t
nextB
  (DerivPathI t
nextA :/ Word32
iA) `compare` (DerivPathI t
nextB :/ Word32
iB) =
    if DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Bool
forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then Word32
iA Word32 -> Word32 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Word32
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 :/ Word32
_iA) `compare` (DerivPathI t
nextB :| Word32
_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 :| Word32
_iA) `compare` (DerivPathI t
nextB :/ Word32
_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 :: forall (m :: * -> *). MonadGet m => m (DerivPathI AnyDeriv)
deserialize = [Word32] -> DerivPathI AnyDeriv
listToPath ([Word32] -> DerivPathI AnyDeriv)
-> m [Word32] -> m (DerivPathI AnyDeriv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Word32 -> m [Word32]
forall (m :: * -> *) a. MonadGet m => m a -> m [a]
getList m Word32
forall (m :: * -> *). MonadGet m => m Word32
getWord32be
  serialize :: forall (m :: * -> *). MonadPut m => DerivPathI AnyDeriv -> m ()
serialize = (Word32 -> m ()) -> [Word32] -> m ()
forall (m :: * -> *) a. MonadPut m => (a -> m ()) -> [a] -> m ()
putList Word32 -> m ()
forall (m :: * -> *). MonadPut m => Word32 -> m ()
putWord32be ([Word32] -> m ())
-> (DerivPathI AnyDeriv -> [Word32]) -> DerivPathI AnyDeriv -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPathI AnyDeriv -> [Word32]
forall t. DerivPathI t -> [Word32]
pathToList

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

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

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

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

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

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

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

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

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

-- | Convert a list of derivation indices to a derivation path.
listToPath :: [KeyIndex] -> DerivPath
listToPath :: [Word32] -> DerivPathI AnyDeriv
listToPath =
  [Word32] -> DerivPathI AnyDeriv
forall {t}. (HardOrAny t, AnyOrSoft t) => [Word32] -> DerivPathI t
go ([Word32] -> DerivPathI AnyDeriv)
-> ([Word32] -> [Word32]) -> [Word32] -> DerivPathI AnyDeriv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word32] -> [Word32]
forall a. [a] -> [a]
reverse
  where
    go :: [Word32] -> DerivPathI t
go (Word32
i : [Word32]
is)
      | Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
i Int
31 = [Word32] -> DerivPathI t
go [Word32]
is DerivPathI t -> Word32 -> DerivPathI t
forall t. HardOrAny t => DerivPathI t -> Word32 -> DerivPathI t
:| Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
clearBit Word32
i Int
31
      | Bool
otherwise = [Word32] -> DerivPathI t
go [Word32]
is DerivPathI t -> Word32 -> DerivPathI t
forall t. AnyOrSoft t => DerivPathI t -> Word32 -> DerivPathI t
:/ Word32
i
    go [] = DerivPathI t
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 :| Word32
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
"/", Word32 -> String
forall a. Show a => a -> String
show Word32
i, String
"'"]
    DerivPathI t
next :/ Word32
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
"/", Word32 -> String
forall a. Show a => a -> String
show Word32
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 :| Word32
i -> (HardPath -> Word32 -> HardPath
forall t. HardOrAny t => DerivPathI t -> Word32 -> DerivPathI t
:| Word32
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 :: forall t. DerivPathI t -> Maybe SoftPath
toSoft DerivPathI t
p = case DerivPathI t
p of
  DerivPathI t
next :/ Word32
i -> (SoftPath -> Word32 -> SoftPath
forall t. AnyOrSoft t => DerivPathI t -> Word32 -> DerivPathI t
:/ Word32
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 :: forall t. DerivPathI t -> DerivPathI AnyDeriv
toGeneric DerivPathI t
p = case DerivPathI t
p of
  DerivPathI t
next :/ Word32
i -> DerivPathI t -> DerivPathI AnyDeriv
forall t. DerivPathI t -> DerivPathI AnyDeriv
toGeneric DerivPathI t
next DerivPathI AnyDeriv -> Word32 -> DerivPathI AnyDeriv
forall t. AnyOrSoft t => DerivPathI t -> Word32 -> DerivPathI t
:/ Word32
i
  DerivPathI t
next :| Word32
i -> DerivPathI t -> DerivPathI AnyDeriv
forall t. DerivPathI t -> DerivPathI AnyDeriv
toGeneric DerivPathI t
next DerivPathI AnyDeriv -> Word32 -> DerivPathI AnyDeriv
forall t. HardOrAny t => DerivPathI t -> Word32 -> DerivPathI t
:| Word32
i
  DerivPathI t
Deriv -> DerivPathI AnyDeriv
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 -> DerivPathI AnyDeriv
(++/) DerivPathI t1
p1 DerivPathI t2
p2 =
  (DerivPathI AnyDeriv -> DerivPathI AnyDeriv)
-> DerivPathI AnyDeriv
-> DerivPathI AnyDeriv
-> DerivPathI AnyDeriv
forall {t} {c}.
(AnyOrSoft t, HardOrAny t) =>
(DerivPathI t -> c) -> DerivPathI AnyDeriv -> DerivPathI t -> c
go DerivPathI AnyDeriv -> DerivPathI AnyDeriv
forall a. a -> a
id (DerivPathI t2 -> DerivPathI AnyDeriv
forall t. DerivPathI t -> DerivPathI AnyDeriv
toGeneric DerivPathI t2
p2) (DerivPathI AnyDeriv -> DerivPathI AnyDeriv)
-> DerivPathI AnyDeriv -> DerivPathI AnyDeriv
forall a b. (a -> b) -> a -> b
$ DerivPathI t1 -> DerivPathI AnyDeriv
forall t. DerivPathI t -> DerivPathI AnyDeriv
toGeneric DerivPathI t1
p1
  where
    go :: (DerivPathI t -> c) -> DerivPathI AnyDeriv -> DerivPathI t -> c
go DerivPathI t -> c
f DerivPathI AnyDeriv
p = case DerivPathI AnyDeriv
p of
      DerivPathI AnyDeriv
next :/ Word32
i -> (DerivPathI t -> c) -> DerivPathI AnyDeriv -> 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 -> Word32 -> DerivPathI t
forall t. AnyOrSoft t => DerivPathI t -> Word32 -> DerivPathI t
:/ Word32
i)) (DerivPathI AnyDeriv -> DerivPathI t -> c)
-> DerivPathI AnyDeriv -> DerivPathI t -> c
forall a b. (a -> b) -> a -> b
$ DerivPathI AnyDeriv -> DerivPathI AnyDeriv
forall t. DerivPathI t -> DerivPathI AnyDeriv
toGeneric DerivPathI AnyDeriv
next
      DerivPathI AnyDeriv
next :| Word32
i -> (DerivPathI t -> c) -> DerivPathI AnyDeriv -> 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 -> Word32 -> DerivPathI t
forall t. HardOrAny t => DerivPathI t -> Word32 -> DerivPathI t
:| Word32
i)) (DerivPathI AnyDeriv -> DerivPathI t -> c)
-> DerivPathI AnyDeriv -> DerivPathI t -> c
forall a b. (a -> b) -> a -> b
$ DerivPathI AnyDeriv -> DerivPathI AnyDeriv
forall t. DerivPathI t -> DerivPathI AnyDeriv
toGeneric DerivPathI AnyDeriv
next
      DerivPathI AnyDeriv
_ -> DerivPathI t -> c
f

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

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

instance Show DerivPath where
  showsPrec :: Int -> DerivPathI AnyDeriv -> ShowS
showsPrec Int
d DerivPathI AnyDeriv
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 (DerivPathI AnyDeriv -> String
forall t. DerivPathI t -> String
pathToStr DerivPathI AnyDeriv
p)

instance Read DerivPath where
  readPrec :: ReadPrec (DerivPathI AnyDeriv)
readPrec = ReadPrec (DerivPathI AnyDeriv) -> ReadPrec (DerivPathI AnyDeriv)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (DerivPathI AnyDeriv) -> ReadPrec (DerivPathI AnyDeriv))
-> ReadPrec (DerivPathI AnyDeriv) -> ReadPrec (DerivPathI AnyDeriv)
forall a b. (a -> b) -> a -> b
$ do
    Ident String
"DerivPath" <- ReadPrec Lexeme
lexP
    Read.String String
str <- ReadPrec Lexeme
lexP
    ReadPrec (DerivPathI AnyDeriv)
-> (ParsedPath -> ReadPrec (DerivPathI AnyDeriv))
-> Maybe ParsedPath
-> ReadPrec (DerivPathI AnyDeriv)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ReadPrec (DerivPathI AnyDeriv)
forall a. ReadPrec a
pfail (DerivPathI AnyDeriv -> ReadPrec (DerivPathI AnyDeriv)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (DerivPathI AnyDeriv -> ReadPrec (DerivPathI AnyDeriv))
-> (ParsedPath -> DerivPathI AnyDeriv)
-> ParsedPath
-> ReadPrec (DerivPathI AnyDeriv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get)) (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
    Ident String
"HardPath" <- ReadPrec Lexeme
lexP
    Read.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 a. a -> ReadPrec a
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
    Ident String
"SoftPath" <- ReadPrec Lexeme
lexP
    Read.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 a. a -> ReadPrec a
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 -> DerivPathI AnyDeriv
fromString =
    (.get) (ParsedPath -> DerivPathI AnyDeriv)
-> (String -> ParsedPath) -> String -> DerivPathI AnyDeriv
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 a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedPath
p
    Maybe ParsedPath
_ -> Parser ParsedPath
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance FromJSON DerivPath where
  parseJSON :: Value -> Parser (DerivPathI AnyDeriv)
parseJSON = String
-> (Text -> Parser (DerivPathI AnyDeriv))
-> Value
-> Parser (DerivPathI AnyDeriv)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"DerivPath" ((Text -> Parser (DerivPathI AnyDeriv))
 -> Value -> Parser (DerivPathI AnyDeriv))
-> (Text -> Parser (DerivPathI AnyDeriv))
-> Value
-> Parser (DerivPathI AnyDeriv)
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 -> DerivPathI AnyDeriv -> Parser (DerivPathI AnyDeriv)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedPath
p.get
    Maybe ParsedPath
_ -> Parser (DerivPathI AnyDeriv)
forall a. Parser a
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 a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return HardPath
p
    Maybe HardPath
_ -> Parser HardPath
forall a. Parser a
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 a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return SoftPath
p
    Maybe SoftPath
_ -> Parser SoftPath
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance ToJSON (DerivPathI t) where
  toJSON :: DerivPathI t -> Value
toJSON = Text -> Value
Aeson.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 = String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding)
-> (DerivPathI t -> String) -> DerivPathI t -> Encoding
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 DerivPathI AnyDeriv
p) = Text -> Value
Aeson.String (Text -> Value)
-> (DerivPathI AnyDeriv -> Text) -> DerivPathI AnyDeriv -> 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 AnyDeriv -> String) -> DerivPathI AnyDeriv -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"m" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> (DerivPathI AnyDeriv -> String) -> DerivPathI AnyDeriv -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPathI AnyDeriv -> String
forall t. DerivPathI t -> String
pathToStr (DerivPathI AnyDeriv -> Value) -> DerivPathI AnyDeriv -> Value
forall a b. (a -> b) -> a -> b
$ DerivPathI AnyDeriv
p
  toJSON (ParsedPub DerivPathI AnyDeriv
p) = Text -> Value
Aeson.String (Text -> Value)
-> (DerivPathI AnyDeriv -> Text) -> DerivPathI AnyDeriv -> 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 AnyDeriv -> String) -> DerivPathI AnyDeriv -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"M" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> (DerivPathI AnyDeriv -> String) -> DerivPathI AnyDeriv -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPathI AnyDeriv -> String
forall t. DerivPathI t -> String
pathToStr (DerivPathI AnyDeriv -> Value) -> DerivPathI AnyDeriv -> Value
forall a b. (a -> b) -> a -> b
$ DerivPathI AnyDeriv
p
  toJSON (ParsedEmpty DerivPathI AnyDeriv
p) = Text -> Value
Aeson.String (Text -> Value)
-> (DerivPathI AnyDeriv -> Text) -> DerivPathI AnyDeriv -> 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 AnyDeriv -> String) -> DerivPathI AnyDeriv -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> (DerivPathI AnyDeriv -> String) -> DerivPathI AnyDeriv -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPathI AnyDeriv -> String
forall t. DerivPathI t -> String
pathToStr (DerivPathI AnyDeriv -> Value) -> DerivPathI AnyDeriv -> Value
forall a b. (a -> b) -> a -> b
$ DerivPathI AnyDeriv
p
  toEncoding :: ParsedPath -> Encoding
toEncoding (ParsedPrv DerivPathI AnyDeriv
p) = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding)
-> (DerivPathI AnyDeriv -> Text) -> DerivPathI AnyDeriv -> 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 AnyDeriv -> String) -> DerivPathI AnyDeriv -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"m" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> (DerivPathI AnyDeriv -> String) -> DerivPathI AnyDeriv -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPathI AnyDeriv -> String
forall t. DerivPathI t -> String
pathToStr (DerivPathI AnyDeriv -> Encoding)
-> DerivPathI AnyDeriv -> Encoding
forall a b. (a -> b) -> a -> b
$ DerivPathI AnyDeriv
p
  toEncoding (ParsedPub DerivPathI AnyDeriv
p) = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding)
-> (DerivPathI AnyDeriv -> Text) -> DerivPathI AnyDeriv -> 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 AnyDeriv -> String) -> DerivPathI AnyDeriv -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"M" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> (DerivPathI AnyDeriv -> String) -> DerivPathI AnyDeriv -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPathI AnyDeriv -> String
forall t. DerivPathI t -> String
pathToStr (DerivPathI AnyDeriv -> Encoding)
-> DerivPathI AnyDeriv -> Encoding
forall a b. (a -> b) -> a -> b
$ DerivPathI AnyDeriv
p
  toEncoding (ParsedEmpty DerivPathI AnyDeriv
p) = Text -> Encoding
forall a. Text -> Encoding' a
text (Text -> Encoding)
-> (DerivPathI AnyDeriv -> Text) -> DerivPathI AnyDeriv -> 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 AnyDeriv -> String) -> DerivPathI AnyDeriv -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS
-> (DerivPathI AnyDeriv -> String) -> DerivPathI AnyDeriv -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPathI AnyDeriv -> String
forall t. DerivPathI t -> String
pathToStr (DerivPathI AnyDeriv -> Encoding)
-> DerivPathI AnyDeriv -> Encoding
forall a b. (a -> b) -> a -> b
$ DerivPathI AnyDeriv
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 -> DerivPathI AnyDeriv
get :: !DerivPath}
  | ParsedPub {get :: !DerivPath}
  | ParsedEmpty {get :: !DerivPath}
  deriving (ParsedPath -> ParsedPath -> Bool
(ParsedPath -> ParsedPath -> Bool)
-> (ParsedPath -> ParsedPath -> Bool) -> Eq ParsedPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParsedPath -> ParsedPath -> Bool
== :: ParsedPath -> ParsedPath -> Bool
$c/= :: ParsedPath -> ParsedPath -> Bool
/= :: 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
$cfrom :: forall x. ParsedPath -> Rep ParsedPath x
from :: forall x. ParsedPath -> Rep ParsedPath x
$cto :: forall x. Rep ParsedPath x -> ParsedPath
to :: forall x. Rep ParsedPath x -> ParsedPath
Generic, ParsedPath -> ()
(ParsedPath -> ()) -> NFData ParsedPath
forall a. (a -> ()) -> NFData a
$crnf :: ParsedPath -> ()
rnf :: 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 DerivPathI AnyDeriv
d' -> String
"m" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DerivPathI AnyDeriv -> String
forall t. DerivPathI t -> String
pathToStr DerivPathI AnyDeriv
d'
          ParsedPub DerivPathI AnyDeriv
d' -> String
"M" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DerivPathI AnyDeriv -> String
forall t. DerivPathI t -> String
pathToStr DerivPathI AnyDeriv
d'
          ParsedEmpty DerivPathI AnyDeriv
d' -> DerivPathI AnyDeriv -> String
forall t. DerivPathI t -> String
pathToStr DerivPathI AnyDeriv
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
    Ident String
"ParsedPath" <- ReadPrec Lexeme
lexP
    Read.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 a. a -> ReadPrec a
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
  DerivPathI AnyDeriv
res <- [Bip32PathIndex] -> DerivPathI AnyDeriv
concatBip32Segments ([Bip32PathIndex] -> DerivPathI AnyDeriv)
-> Maybe [Bip32PathIndex] -> Maybe (DerivPathI AnyDeriv)
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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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
$ DerivPathI AnyDeriv -> ParsedPath
ParsedPrv DerivPathI AnyDeriv
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
$ DerivPathI AnyDeriv -> ParsedPath
ParsedPub DerivPathI AnyDeriv
res
    String
"" -> ParsedPath -> Maybe ParsedPath
forall a. a -> Maybe a
Just (ParsedPath -> Maybe ParsedPath) -> ParsedPath -> Maybe ParsedPath
forall a b. (a -> b) -> a -> b
$ DerivPathI AnyDeriv -> ParsedPath
ParsedEmpty DerivPathI AnyDeriv
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] -> DerivPathI AnyDeriv
concatBip32Segments = (DerivPathI AnyDeriv -> Bip32PathIndex -> DerivPathI AnyDeriv)
-> DerivPathI AnyDeriv -> [Bip32PathIndex] -> DerivPathI AnyDeriv
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' DerivPathI AnyDeriv -> Bip32PathIndex -> DerivPathI AnyDeriv
appendBip32Segment DerivPathI AnyDeriv
forall t. DerivPathI t
Deriv

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

-- | Parse a BIP32 derivation path index element from a string.
parseBip32PathIndex :: String -> Maybe Bip32PathIndex
parseBip32PathIndex :: String -> Maybe Bip32PathIndex
parseBip32PathIndex String
segment = case ReadS Word32
forall a. Read a => ReadS a
reads String
segment of
  [(Word32
i, String
"")] -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word32 -> Bool
forall a. Integral a => a -> Bool
is31Bit Word32
i) Maybe () -> Maybe Bip32PathIndex -> Maybe Bip32PathIndex
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bip32PathIndex -> Maybe Bip32PathIndex
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Bip32PathIndex
Bip32SoftIndex Word32
i)
  [(Word32
i, String
"'")] -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word32 -> Bool
forall a. Integral a => a -> Bool
is31Bit Word32
i) Maybe () -> Maybe Bip32PathIndex -> Maybe Bip32PathIndex
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bip32PathIndex -> Maybe Bip32PathIndex
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> Bip32PathIndex
Bip32HardIndex Word32
i)
  [(Word32, 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
$c== :: Bip32PathIndex -> Bip32PathIndex -> Bool
== :: Bip32PathIndex -> Bip32PathIndex -> Bool
$c/= :: Bip32PathIndex -> Bip32PathIndex -> Bool
/= :: 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
$cfrom :: forall x. Bip32PathIndex -> Rep Bip32PathIndex x
from :: forall x. Bip32PathIndex -> Rep Bip32PathIndex x
$cto :: forall x. Rep Bip32PathIndex x -> Bip32PathIndex
to :: forall x. Rep Bip32PathIndex x -> Bip32PathIndex
Generic, Bip32PathIndex -> ()
(Bip32PathIndex -> ()) -> NFData Bip32PathIndex
forall a. (a -> ()) -> NFData a
$crnf :: Bip32PathIndex -> ()
rnf :: Bip32PathIndex -> ()
NFData)

instance Show Bip32PathIndex where
  showsPrec :: Int -> Bip32PathIndex -> ShowS
showsPrec Int
d (Bip32HardIndex Word32
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
. Word32 -> ShowS
forall a. Show a => a -> ShowS
shows Word32
i
  showsPrec Int
d (Bip32SoftIndex Word32
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
. Word32 -> ShowS
forall a. Show a => a -> ShowS
shows Word32
i

instance Read Bip32PathIndex where
  readPrec :: ReadPrec Bip32PathIndex
readPrec = ReadPrec Bip32PathIndex
h ReadPrec Bip32PathIndex
-> ReadPrec Bip32PathIndex -> ReadPrec Bip32PathIndex
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
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
          Ident String
"Bip32HardIndex" <- ReadPrec Lexeme
lexP
          Number Number
n <- ReadPrec Lexeme
lexP
          ReadPrec Bip32PathIndex
-> (Integer -> ReadPrec Bip32PathIndex)
-> Maybe Integer
-> ReadPrec Bip32PathIndex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            ReadPrec Bip32PathIndex
forall a. ReadPrec a
pfail
            (Bip32PathIndex -> ReadPrec Bip32PathIndex
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bip32PathIndex -> ReadPrec Bip32PathIndex)
-> (Integer -> Bip32PathIndex)
-> Integer
-> ReadPrec Bip32PathIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Bip32PathIndex
Bip32HardIndex (Word32 -> Bip32PathIndex)
-> (Integer -> Word32) -> Integer -> Bip32PathIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
            (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
          Ident String
"Bip32SoftIndex" <- ReadPrec Lexeme
lexP
          Number Number
n <- ReadPrec Lexeme
lexP
          ReadPrec Bip32PathIndex
-> (Integer -> ReadPrec Bip32PathIndex)
-> Maybe Integer
-> ReadPrec Bip32PathIndex
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            ReadPrec Bip32PathIndex
forall a. ReadPrec a
pfail
            (Bip32PathIndex -> ReadPrec Bip32PathIndex
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bip32PathIndex -> ReadPrec Bip32PathIndex)
-> (Integer -> Bip32PathIndex)
-> Integer
-> ReadPrec Bip32PathIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Bip32PathIndex
Bip32SoftIndex (Word32 -> Bip32PathIndex)
-> (Integer -> Word32) -> Integer -> Bip32PathIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
            (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 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 = DerivPathI AnyDeriv -> Maybe HardPath
forall t. DerivPathI t -> Maybe HardPath
toHard (DerivPathI AnyDeriv -> Maybe HardPath)
-> (ParsedPath -> DerivPathI AnyDeriv)
-> ParsedPath
-> Maybe HardPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get) (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 = DerivPathI AnyDeriv -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft (DerivPathI AnyDeriv -> Maybe SoftPath)
-> (ParsedPath -> DerivPathI AnyDeriv)
-> ParsedPath
-> Maybe SoftPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.get) (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
xprv :: !XPrvKey,
        XKey -> Network
net :: !Network
      }
  | XPub
      { XKey -> XPubKey
xpub :: !XPubKey,
        net :: !Network
      }
  deriving (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
$cshowsPrec :: Int -> XKey -> ShowS
showsPrec :: Int -> XKey -> ShowS
$cshow :: XKey -> String
show :: XKey -> String
$cshowList :: [XKey] -> ShowS
showList :: [XKey] -> ShowS
Show, ReadPrec [XKey]
ReadPrec XKey
Int -> ReadS XKey
ReadS [XKey]
(Int -> ReadS XKey)
-> ReadS [XKey] -> ReadPrec XKey -> ReadPrec [XKey] -> Read XKey
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS XKey
readsPrec :: Int -> ReadS XKey
$creadList :: ReadS [XKey]
readList :: ReadS [XKey]
$creadPrec :: ReadPrec XKey
readPrec :: ReadPrec XKey
$creadListPrec :: ReadPrec [XKey]
readListPrec :: ReadPrec [XKey]
Read, XKey -> XKey -> Bool
(XKey -> XKey -> Bool) -> (XKey -> XKey -> Bool) -> Eq XKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XKey -> XKey -> Bool
== :: XKey -> XKey -> Bool
$c/= :: XKey -> XKey -> Bool
/= :: XKey -> XKey -> Bool
Eq, (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
$cfrom :: forall x. XKey -> Rep XKey x
from :: forall x. XKey -> Rep XKey x
$cto :: forall x. Rep XKey x -> XKey
to :: forall x. Rep XKey x -> XKey
Generic, XKey -> ()
(XKey -> ()) -> NFData XKey
forall a. (a -> ()) -> NFData a
$crnf :: XKey -> ()
rnf :: 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 :: Ctx -> ParsedPath -> XKey -> Either String XKey
applyPath :: Ctx -> ParsedPath -> XKey -> Either String XKey
applyPath Ctx
ctx ParsedPath
path XKey
key =
  case (ParsedPath
path, XKey
key) of
    (ParsedPrv DerivPathI AnyDeriv
_, XPrv XPrvKey
k Network
n) -> XKey -> Either String XKey
forall a. a -> Either String a
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 DerivPathI AnyDeriv
_, XPub {}) -> String -> Either String XKey
forall a b. a -> Either a b
Left String
"applyPath: Invalid public key"
    (ParsedPub DerivPathI AnyDeriv
_, XPrv XPrvKey
k Network
n) -> XKey -> Either String XKey
forall a. a -> Either String a
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 (Ctx -> XPrvKey -> XPubKey
deriveXPubKey Ctx
ctx (XPrvKey -> XPrvKey
derivPrvF XPrvKey
k)) Network
n
    (ParsedPub DerivPathI AnyDeriv
_, XPub XPubKey
k Network
n) -> Either String (XPubKey -> XPubKey)
derivPubFE Either String (XPubKey -> XPubKey)
-> ((XPubKey -> XPubKey) -> Either String XKey)
-> Either String XKey
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \XPubKey -> XPubKey
f -> XKey -> Either String XKey
forall a. a -> Either String a
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 DerivPathI AnyDeriv
_, XPrv XPrvKey
k Network
n) -> XKey -> Either String XKey
forall a. a -> Either String a
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 DerivPathI AnyDeriv
_, XPub XPubKey
k Network
n) -> Either String (XPubKey -> XPubKey)
derivPubFE Either String (XPubKey -> XPubKey)
-> ((XPubKey -> XPubKey) -> Either String XKey)
-> Either String XKey
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \XPubKey -> XPubKey
f -> XKey -> Either String XKey
forall a. a -> Either String a
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) -> DerivPathI AnyDeriv -> XPrvKey -> XPrvKey
goPrv XPrvKey -> XPrvKey
forall a. a -> a
id ParsedPath
path.get
    derivPubFE :: Either String (XPubKey -> XPubKey)
derivPubFE = (XPubKey -> XPubKey)
-> DerivPathI AnyDeriv -> Either String (XPubKey -> XPubKey)
goPubE XPubKey -> XPubKey
forall a. a -> a
id ParsedPath
path.get
    -- Build the full private derivation function starting from the end
    goPrv :: (XPrvKey -> XPrvKey) -> DerivPathI AnyDeriv -> XPrvKey -> XPrvKey
goPrv XPrvKey -> XPrvKey
f DerivPathI AnyDeriv
p =
      case DerivPathI AnyDeriv
p of
        DerivPathI AnyDeriv
next :| Word32
i -> (XPrvKey -> XPrvKey) -> DerivPathI AnyDeriv -> XPrvKey -> XPrvKey
goPrv (XPrvKey -> XPrvKey
f (XPrvKey -> XPrvKey) -> (XPrvKey -> XPrvKey) -> XPrvKey -> XPrvKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPrvKey -> Word32 -> XPrvKey) -> Word32 -> XPrvKey -> XPrvKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Ctx -> XPrvKey -> Word32 -> XPrvKey
hardSubKey Ctx
ctx) Word32
i) DerivPathI AnyDeriv
next
        DerivPathI AnyDeriv
next :/ Word32
i -> (XPrvKey -> XPrvKey) -> DerivPathI AnyDeriv -> XPrvKey -> XPrvKey
goPrv (XPrvKey -> XPrvKey
f (XPrvKey -> XPrvKey) -> (XPrvKey -> XPrvKey) -> XPrvKey -> XPrvKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPrvKey -> Word32 -> XPrvKey) -> Word32 -> XPrvKey -> XPrvKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Ctx -> XPrvKey -> Word32 -> XPrvKey
prvSubKey Ctx
ctx) Word32
i) DerivPathI AnyDeriv
next
        DerivPathI AnyDeriv
Deriv -> XPrvKey -> XPrvKey
f
    -- Build the full public derivation function starting from the end
    goPubE :: (XPubKey -> XPubKey)
-> DerivPathI AnyDeriv -> Either String (XPubKey -> XPubKey)
goPubE XPubKey -> XPubKey
f DerivPathI AnyDeriv
p =
      case DerivPathI AnyDeriv
p of
        DerivPathI AnyDeriv
next :/ Word32
i -> (XPubKey -> XPubKey)
-> DerivPathI AnyDeriv -> Either String (XPubKey -> XPubKey)
goPubE (XPubKey -> XPubKey
f (XPubKey -> XPubKey) -> (XPubKey -> XPubKey) -> XPubKey -> XPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPubKey -> Word32 -> XPubKey) -> Word32 -> XPubKey -> XPubKey
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Ctx -> XPubKey -> Word32 -> XPubKey
pubSubKey Ctx
ctx) Word32
i) DerivPathI AnyDeriv
next
        DerivPathI AnyDeriv
Deriv -> (XPubKey -> XPubKey) -> Either String (XPubKey -> XPubKey)
forall a b. b -> Either a b
Right XPubKey -> XPubKey
f
        DerivPathI AnyDeriv
_ -> String -> Either String (XPubKey -> XPubKey)
forall a b. a -> Either a b
Left String
"applyPath: Invalid hard derivation"

{- Helpers for derivation paths and addresses -}

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

-- | Cyclic list of all addresses derived from a given parent path and starting
-- from the given offset index.
derivePathAddrs ::
  Ctx -> XPubKey -> SoftPath -> KeyIndex -> [(Address, PubKey, KeyIndex)]
derivePathAddrs :: Ctx -> XPubKey -> SoftPath -> Word32 -> [(Address, PubKey, Word32)]
derivePathAddrs Ctx
ctx XPubKey
key SoftPath
path = Ctx -> XPubKey -> Word32 -> [(Address, PubKey, Word32)]
deriveAddrs Ctx
ctx (Ctx -> SoftPath -> XPubKey -> XPubKey
derivePubPath Ctx
ctx 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 ::
  Ctx ->
  [XPubKey] ->
  SoftPath ->
  Int ->
  KeyIndex ->
  (Address, RedeemScript)
derivePathMSAddr :: Ctx
-> [XPubKey]
-> SoftPath
-> Int
-> Word32
-> (Address, RedeemScript)
derivePathMSAddr Ctx
ctx [XPubKey]
keys SoftPath
path =
  Ctx -> [XPubKey] -> Int -> Word32 -> (Address, RedeemScript)
deriveMSAddr Ctx
ctx ([XPubKey] -> Int -> Word32 -> (Address, RedeemScript))
-> [XPubKey] -> Int -> Word32 -> (Address, RedeemScript)
forall a b. (a -> b) -> a -> b
$ (XPubKey -> XPubKey) -> [XPubKey] -> [XPubKey]
forall a b. (a -> b) -> [a] -> [b]
map (Ctx -> SoftPath -> XPubKey -> XPubKey
derivePubPath Ctx
ctx 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 ::
  Ctx ->
  [XPubKey] ->
  SoftPath ->
  Int ->
  KeyIndex ->
  [(Address, RedeemScript, KeyIndex)]
derivePathMSAddrs :: Ctx
-> [XPubKey]
-> SoftPath
-> Int
-> Word32
-> [(Address, RedeemScript, Word32)]
derivePathMSAddrs Ctx
ctx [XPubKey]
keys SoftPath
path =
  Ctx
-> [XPubKey] -> Int -> Word32 -> [(Address, RedeemScript, Word32)]
deriveMSAddrs Ctx
ctx ([XPubKey] -> Int -> Word32 -> [(Address, RedeemScript, Word32)])
-> [XPubKey] -> Int -> Word32 -> [(Address, RedeemScript, Word32)]
forall a b. (a -> b) -> a -> b
$ (XPubKey -> XPubKey) -> [XPubKey] -> [XPubKey]
forall a b. (a -> b) -> [a] -> [b]
map (Ctx -> SoftPath -> XPubKey -> XPubKey
derivePubPath Ctx
ctx 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 <- 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 a. String -> m a
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 ByteString -> Maybe SecKey
secKey ByteString
bs of
    Maybe SecKey
Nothing -> String -> m SecKey
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m SecKey) -> String -> m SecKey
forall a b. (a -> b) -> a -> b
$ String
"Could not decode secret key: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text
encodeHex ByteString
bs)
    Just SecKey
x -> SecKey -> m SecKey
forall a. a -> m a
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 = Word8 -> m ()
forall (m :: * -> *). MonadPut m => Word8 -> m ()
putWord8 Word8
0x00 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ByteString -> m ()
forall (m :: * -> *). MonadPut m => ByteString -> m ()
putByteString SecKey
p.get

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