{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Haskoin.Keys.Extended
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX

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

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

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

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

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


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

instance Exception DerivationException

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

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

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

instance Serialize XPrvKey where
    put :: Putter XPrvKey
put k :: XPrvKey
k = do
        Putter Word8
putWord8 Putter Word8 -> Putter Word8
forall a b. (a -> b) -> a -> b
$ XPrvKey -> Word8
xPrvDepth XPrvKey
k
        Putter Fingerprint
putWord32be Putter Fingerprint -> Putter Fingerprint
forall a b. (a -> b) -> a -> b
$ XPrvKey -> Fingerprint
xPrvParent XPrvKey
k
        Putter Fingerprint
putWord32be Putter Fingerprint -> Putter Fingerprint
forall a b. (a -> b) -> a -> b
$ XPrvKey -> Fingerprint
xPrvIndex XPrvKey
k
        Putter ChainCode
forall t. Serialize t => Putter t
put Putter ChainCode -> Putter ChainCode
forall a b. (a -> b) -> a -> b
$ XPrvKey -> ChainCode
xPrvChain XPrvKey
k
        Putter SecKey
putPadPrvKey Putter SecKey -> Putter SecKey
forall a b. (a -> b) -> a -> b
$ XPrvKey -> SecKey
xPrvKey XPrvKey
k
    get :: Get XPrvKey
get =
        Word8
-> Fingerprint -> Fingerprint -> ChainCode -> SecKey -> XPrvKey
XPrvKey (Word8
 -> Fingerprint -> Fingerprint -> ChainCode -> SecKey -> XPrvKey)
-> Get Word8
-> Get
     (Fingerprint -> Fingerprint -> ChainCode -> SecKey -> XPrvKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
                Get (Fingerprint -> Fingerprint -> ChainCode -> SecKey -> XPrvKey)
-> Get Fingerprint
-> Get (Fingerprint -> ChainCode -> SecKey -> XPrvKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Fingerprint
getWord32be
                Get (Fingerprint -> ChainCode -> SecKey -> XPrvKey)
-> Get Fingerprint -> Get (ChainCode -> SecKey -> XPrvKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Fingerprint
getWord32be
                Get (ChainCode -> SecKey -> XPrvKey)
-> Get ChainCode -> Get (SecKey -> XPrvKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ChainCode
forall t. Serialize t => Get t
S.get
                Get (SecKey -> XPrvKey) -> Get SecKey -> Get XPrvKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get SecKey
getPadPrvKey

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

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

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

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

instance Serialize XPubKey where
    put :: Putter XPubKey
put k :: XPubKey
k = do
        Putter Word8
putWord8 Putter Word8 -> Putter Word8
forall a b. (a -> b) -> a -> b
$ XPubKey -> Word8
xPubDepth XPubKey
k
        Putter Fingerprint
putWord32be Putter Fingerprint -> Putter Fingerprint
forall a b. (a -> b) -> a -> b
$ XPubKey -> Fingerprint
xPubParent XPubKey
k
        Putter Fingerprint
putWord32be Putter Fingerprint -> Putter Fingerprint
forall a b. (a -> b) -> a -> b
$ XPubKey -> Fingerprint
xPubIndex XPubKey
k
        Putter ChainCode
forall t. Serialize t => Putter t
put Putter ChainCode -> Putter ChainCode
forall a b. (a -> b) -> a -> b
$ XPubKey -> ChainCode
xPubChain XPubKey
k
        Putter PubKeyI
forall t. Serialize t => Putter t
put Putter PubKeyI -> Putter PubKeyI
forall a b. (a -> b) -> a -> b
$ Bool -> PubKey -> PubKeyI
wrapPubKey Bool
True (XPubKey -> PubKey
xPubKey XPubKey
k)
    get :: Get XPubKey
get =
        Word8
-> Fingerprint -> Fingerprint -> ChainCode -> PubKey -> XPubKey
XPubKey (Word8
 -> Fingerprint -> Fingerprint -> ChainCode -> PubKey -> XPubKey)
-> Get Word8
-> Get
     (Fingerprint -> Fingerprint -> ChainCode -> PubKey -> XPubKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
                Get (Fingerprint -> Fingerprint -> ChainCode -> PubKey -> XPubKey)
-> Get Fingerprint
-> Get (Fingerprint -> ChainCode -> PubKey -> XPubKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Fingerprint
getWord32be
                Get (Fingerprint -> ChainCode -> PubKey -> XPubKey)
-> Get Fingerprint -> Get (ChainCode -> PubKey -> XPubKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get Fingerprint
getWord32be
                Get (ChainCode -> PubKey -> XPubKey)
-> Get ChainCode -> Get (PubKey -> XPubKey)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get ChainCode
forall t. Serialize t => Get t
S.get
                Get (PubKey -> XPubKey) -> Get PubKey -> Get XPubKey
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (PubKeyI -> PubKey
pubKeyPoint (PubKeyI -> PubKey) -> Get PubKeyI -> Get PubKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get PubKeyI
forall t. Serialize t => Get t
S.get)

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

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

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

-- | Build a BIP32 compatible extended private key from a bytestring. This will
-- produce a root node (@depth=0@ and @parent=0@).
makeXPrvKey :: ByteString -> XPrvKey
makeXPrvKey :: ByteString -> XPrvKey
makeXPrvKey bs :: ByteString
bs =
    Word8
-> Fingerprint -> Fingerprint -> ChainCode -> SecKey -> XPrvKey
XPrvKey 0 0 0 ChainCode
c SecKey
k
  where
    (p :: ChainCode
p, c :: ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 (Hash512 -> (ChainCode, ChainCode))
-> Hash512 -> (ChainCode, ChainCode)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 "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 (ChainCode -> ByteString
forall a. Serialize a => a -> ByteString
encode ChainCode
p))
    err :: a
err   = DerivationException -> a
forall a e. Exception e => e -> a
throw (DerivationException -> a) -> DerivationException -> a
forall a b. (a -> b) -> a -> b
$ String -> DerivationException
DerivationException "Invalid seed"

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

-- | Compute a private, soft child key derivation. A private soft derivation
-- will allow the equivalent extended public key to derive the public key for
-- this child. Given a parent key /m/ and a derivation index /i/, this function
-- will compute /m\/i/.
--
-- Soft derivations allow for more flexibility such as read-only wallets.
-- However, care must be taken not the leak both the parent extended public key
-- and one of the extended child private keys as this would compromise the
-- extended parent private key.
prvSubKey :: XPrvKey  -- ^ extended parent private key
          -> KeyIndex -- ^ child derivation index
          -> XPrvKey  -- ^ extended child private key
prvSubKey :: XPrvKey -> Fingerprint -> XPrvKey
prvSubKey xkey :: XPrvKey
xkey child :: Fingerprint
child
    | Fingerprint
child Fingerprint -> Fingerprint -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Fingerprint
child Fingerprint -> Fingerprint -> Bool
forall a. Ord a => a -> a -> Bool
< 0x80000000 =
        Word8
-> Fingerprint -> Fingerprint -> ChainCode -> SecKey -> XPrvKey
XPrvKey (XPrvKey -> Word8
xPrvDepth XPrvKey
xkey Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 1) (XPrvKey -> Fingerprint
xPrvFP XPrvKey
xkey) Fingerprint
child ChainCode
c SecKey
k
    | Bool
otherwise = String -> XPrvKey
forall a. HasCallStack => String -> a
error "Invalid child derivation index"
  where
    pK :: PubKey
pK = XPubKey -> PubKey
xPubKey (XPubKey -> PubKey) -> XPubKey -> PubKey
forall a b. (a -> b) -> a -> b
$ XPrvKey -> XPubKey
deriveXPubKey XPrvKey
xkey
    m :: ByteString
m = ByteString -> ByteString -> ByteString
B.append (Bool -> PubKey -> ByteString
exportPubKey Bool
True PubKey
pK) (Fingerprint -> ByteString
forall a. Serialize a => a -> ByteString
encode Fingerprint
child)
    (a :: ChainCode
a, c :: ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 (Hash512 -> (ChainCode, ChainCode))
-> Hash512 -> (ChainCode, ChainCode)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 (ChainCode -> ByteString
forall a. Serialize a => a -> ByteString
encode (ChainCode -> ByteString) -> ChainCode -> ByteString
forall a b. (a -> b) -> a -> b
$ XPrvKey -> ChainCode
xPrvChain XPrvKey
xkey) ByteString
m
    k :: SecKey
k = SecKey -> Maybe SecKey -> SecKey
forall a. a -> Maybe a -> a
fromMaybe SecKey
forall a. a
err (Maybe SecKey -> SecKey) -> Maybe SecKey -> SecKey
forall a b. (a -> b) -> a -> b
$ SecKey -> ChainCode -> Maybe SecKey
tweakSecKey (XPrvKey -> SecKey
xPrvKey XPrvKey
xkey) ChainCode
a
    err :: a
err = DerivationException -> a
forall a e. Exception e => e -> a
throw (DerivationException -> a) -> DerivationException -> a
forall a b. (a -> b) -> a -> b
$ String -> DerivationException
DerivationException "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 :: XPubKey  -- ^ extended parent public key
          -> KeyIndex -- ^ child derivation index
          -> XPubKey  -- ^ extended child public key
pubSubKey :: XPubKey -> Fingerprint -> XPubKey
pubSubKey xKey :: XPubKey
xKey child :: Fingerprint
child
    | Fingerprint
child Fingerprint -> Fingerprint -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Fingerprint
child Fingerprint -> Fingerprint -> Bool
forall a. Ord a => a -> a -> Bool
< 0x80000000 =
        Word8
-> Fingerprint -> Fingerprint -> ChainCode -> PubKey -> XPubKey
XPubKey (XPubKey -> Word8
xPubDepth XPubKey
xKey Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 1) (XPubKey -> Fingerprint
xPubFP XPubKey
xKey) Fingerprint
child ChainCode
c PubKey
pK
    | Bool
otherwise = String -> XPubKey
forall a. HasCallStack => String -> a
error "Invalid child derivation index"
  where
    m :: ByteString
m = ByteString -> ByteString -> ByteString
B.append (Bool -> PubKey -> ByteString
exportPubKey Bool
True (XPubKey -> PubKey
xPubKey XPubKey
xKey)) (Fingerprint -> ByteString
forall a. Serialize a => a -> ByteString
encode Fingerprint
child)
    (a :: ChainCode
a, c :: ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 (Hash512 -> (ChainCode, ChainCode))
-> Hash512 -> (ChainCode, ChainCode)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 (ChainCode -> ByteString
forall a. Serialize a => a -> ByteString
encode (ChainCode -> ByteString) -> ChainCode -> ByteString
forall a b. (a -> b) -> a -> b
$ XPubKey -> ChainCode
xPubChain XPubKey
xKey) ByteString
m
    pK :: PubKey
pK = PubKey -> Maybe PubKey -> PubKey
forall a. a -> Maybe a -> a
fromMaybe PubKey
forall a. a
err (Maybe PubKey -> PubKey) -> Maybe PubKey -> PubKey
forall a b. (a -> b) -> a -> b
$ PubKey -> ChainCode -> Maybe PubKey
tweakPubKey (XPubKey -> PubKey
xPubKey XPubKey
xKey) ChainCode
a
    err :: a
err = DerivationException -> a
forall a e. Exception e => e -> a
throw (DerivationException -> a) -> DerivationException -> a
forall a b. (a -> b) -> a -> b
$ String -> DerivationException
DerivationException "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 :: XPrvKey  -- ^ extended parent private key
           -> KeyIndex -- ^ child derivation index
           -> XPrvKey  -- ^ extended child private key
hardSubKey :: XPrvKey -> Fingerprint -> XPrvKey
hardSubKey xkey :: XPrvKey
xkey child :: Fingerprint
child
    | Fingerprint
child Fingerprint -> Fingerprint -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Fingerprint
child Fingerprint -> Fingerprint -> Bool
forall a. Ord a => a -> a -> Bool
< 0x80000000 =
        Word8
-> Fingerprint -> Fingerprint -> ChainCode -> SecKey -> XPrvKey
XPrvKey (XPrvKey -> Word8
xPrvDepth XPrvKey
xkey Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 1) (XPrvKey -> Fingerprint
xPrvFP XPrvKey
xkey) Fingerprint
i ChainCode
c SecKey
k
    | Bool
otherwise = String -> XPrvKey
forall a. HasCallStack => String -> a
error "Invalid child derivation index"
  where
    i :: Fingerprint
i = Fingerprint -> Int -> Fingerprint
forall a. Bits a => a -> Int -> a
setBit Fingerprint
child 31
    m :: ByteString
m = ByteString -> ByteString -> ByteString
B.append (SecKey -> ByteString
bsPadPrvKey (SecKey -> ByteString) -> SecKey -> ByteString
forall a b. (a -> b) -> a -> b
$ XPrvKey -> SecKey
xPrvKey XPrvKey
xkey) (Fingerprint -> ByteString
forall a. Serialize a => a -> ByteString
encode Fingerprint
i)
    (a :: ChainCode
a, c :: ChainCode
c) = Hash512 -> (ChainCode, ChainCode)
split512 (Hash512 -> (ChainCode, ChainCode))
-> Hash512 -> (ChainCode, ChainCode)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Hash512
hmac512 (ChainCode -> ByteString
forall a. Serialize a => a -> ByteString
encode (ChainCode -> ByteString) -> ChainCode -> ByteString
forall a b. (a -> b) -> a -> b
$ XPrvKey -> ChainCode
xPrvChain XPrvKey
xkey) ByteString
m
    k :: SecKey
k = SecKey -> Maybe SecKey -> SecKey
forall a. a -> Maybe a -> a
fromMaybe SecKey
forall a. a
err (Maybe SecKey -> SecKey) -> Maybe SecKey -> SecKey
forall a b. (a -> b) -> a -> b
$ SecKey -> ChainCode -> Maybe SecKey
tweakSecKey (XPrvKey -> SecKey
xPrvKey XPrvKey
xkey) ChainCode
a
    err :: a
err = DerivationException -> a
forall a e. Exception e => e -> a
throw (DerivationException -> a) -> DerivationException -> a
forall a b. (a -> b) -> a -> b
$ String -> DerivationException
DerivationException "Invalid hardSubKey derivation"

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

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

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

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

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

-- | Computes the key identifier of an extended public key.
xPubID :: XPubKey -> Hash160
xPubID :: XPubKey -> Hash160
xPubID = ByteString -> Hash160
forall b. ByteArrayAccess b => b -> Hash160
ripemd160 (ByteString -> Hash160)
-> (XPubKey -> ByteString) -> XPubKey -> Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainCode -> ByteString
forall a. Serialize a => a -> ByteString
encode (ChainCode -> ByteString)
-> (XPubKey -> ChainCode) -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ChainCode
forall b. ByteArrayAccess b => b -> ChainCode
sha256 (ByteString -> ChainCode)
-> (XPubKey -> ByteString) -> XPubKey -> ChainCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> PubKey -> ByteString
exportPubKey Bool
True (PubKey -> ByteString)
-> (XPubKey -> PubKey) -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> PubKey
xPubKey

-- | Computes the key fingerprint of an extended private key.
xPrvFP :: XPrvKey -> Fingerprint
xPrvFP :: XPrvKey -> Fingerprint
xPrvFP =
    Fingerprint -> Either String Fingerprint -> Fingerprint
forall b a. b -> Either a b -> b
fromRight Fingerprint
forall a. a
err (Either String Fingerprint -> Fingerprint)
-> (XPrvKey -> Either String Fingerprint) -> XPrvKey -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Fingerprint
forall a. Serialize a => ByteString -> Either String a
decode (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 4 (ByteString -> ByteString)
-> (XPrvKey -> ByteString) -> XPrvKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> ByteString
forall a. Serialize a => a -> ByteString
encode (Hash160 -> ByteString)
-> (XPrvKey -> Hash160) -> XPrvKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPrvKey -> Hash160
xPrvID
  where
    err :: a
err = String -> a
forall a. HasCallStack => String -> a
error "Could not decode xPrvFP"

-- | Computes the key fingerprint of an extended public key.
xPubFP :: XPubKey -> Fingerprint
xPubFP :: XPubKey -> Fingerprint
xPubFP =
    Fingerprint -> Either String Fingerprint -> Fingerprint
forall b a. b -> Either a b -> b
fromRight Fingerprint
forall a. a
err (Either String Fingerprint -> Fingerprint)
-> (XPubKey -> Either String Fingerprint) -> XPubKey -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String Fingerprint
forall a. Serialize a => ByteString -> Either String a
decode (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 4 (ByteString -> ByteString)
-> (XPubKey -> ByteString) -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> ByteString
forall a. Serialize a => a -> ByteString
encode (Hash160 -> ByteString)
-> (XPubKey -> Hash160) -> XPubKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPubKey -> Hash160
xPubID
  where
    err :: a
err = String -> a
forall a. HasCallStack => String -> a
error "Could not decode xPubFP"

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

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

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

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

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

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

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

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

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

-- | Serialize an extended private key.
putXPrvKey :: Network -> Putter XPrvKey
putXPrvKey :: Network -> Putter XPrvKey
putXPrvKey net :: Network
net k :: XPrvKey
k = do
    Putter Fingerprint
putWord32be Putter Fingerprint -> Putter Fingerprint
forall a b. (a -> b) -> a -> b
$ Network -> Fingerprint
getExtSecretPrefix Network
net
    Putter XPrvKey
forall t. Serialize t => Putter t
put XPrvKey
k

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

-- | Serialize an extended public key.
putXPubKey :: Network -> Putter XPubKey
putXPubKey :: Network -> Putter XPubKey
putXPubKey net :: Network
net k :: XPubKey
k = do
    Putter Fingerprint
putWord32be Putter Fingerprint -> Putter Fingerprint
forall a b. (a -> b) -> a -> b
$ Network -> Fingerprint
getExtPubKeyPrefix Network
net
    Putter XPubKey
forall t. Serialize t => Putter t
put XPubKey
k

{- Derivation helpers -}

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

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

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

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

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

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

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

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

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

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

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

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

{- Derivation Paths -}

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

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

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

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

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

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

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

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

-- | Data type representing a derivation path. Two constructors are provided
-- for specifying soft or hard derivations. The path /\/0\/1'\/2/ for example can be
-- expressed as @'Deriv' :\/ 0 :| 1 :\/ 2@. The 'HardOrAny' and 'AnyOrSoft' type
-- classes are used to constrain the valid values for the phantom type /t/. If
-- you mix hard '(:|)' and soft '(:\/)' paths, the only valid type for /t/ is 'AnyDeriv'.
-- Otherwise, /t/ can be 'HardDeriv' if you only have hard derivation or 'SoftDeriv'
-- if you only have soft derivations.
--
-- Using this type is as easy as writing the required derivation like in these
-- example:
--
-- > Deriv :/ 0 :/ 1 :/ 2 :: SoftPath
-- > Deriv :| 0 :| 1 :| 2 :: HardPath
-- > Deriv :| 0 :/ 1 :/ 2 :: DerivPath
data DerivPathI t where
    (:|)  :: HardOrAny t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t
    (:/)  :: AnyOrSoft t => !(DerivPathI t) -> !KeyIndex -> DerivPathI t
    Deriv :: DerivPathI t

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

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

instance Ord (DerivPathI t) where
    -- Same hardness on each side
    (nextA :: DerivPathI t
nextA :| iA :: Fingerprint
iA) compare :: DerivPathI t -> DerivPathI t -> Ordering
`compare` (nextB :: DerivPathI t
nextB :| iB :: Fingerprint
iB) =
        if DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Bool
forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then Fingerprint
iA Fingerprint -> Fingerprint -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Fingerprint
iB else DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` DerivPathI t
nextB
    (nextA :: DerivPathI t
nextA :/ iA :: Fingerprint
iA) `compare` (nextB :: DerivPathI t
nextB :/ iB :: Fingerprint
iB) =
        if DerivPathI t
nextA DerivPathI t -> DerivPathI t -> Bool
forall a. Eq a => a -> a -> Bool
== DerivPathI t
nextB then Fingerprint
iA Fingerprint -> Fingerprint -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Fingerprint
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
    (nextA :: DerivPathI t
nextA :/ _iA :: Fingerprint
_iA) `compare` (nextB :: DerivPathI t
nextB :| _iB :: Fingerprint
_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
    (nextA :: DerivPathI t
nextA :| _iA :: Fingerprint
_iA) `compare` (nextB :: DerivPathI t
nextB :/ _iB :: Fingerprint
_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

    Deriv `compare` Deriv  = Ordering
EQ
    Deriv `compare` _      = Ordering
LT
    _     `compare` Deriv  = Ordering
GT

instance Serialize DerivPath where
    get :: Get DerivPath
get = [Fingerprint] -> DerivPath
listToPath ([Fingerprint] -> DerivPath) -> Get [Fingerprint] -> Get DerivPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Fingerprint]
forall t. Serialize t => Get t
S.get
    put :: Putter DerivPath
put = Putter [Fingerprint]
forall t. Serialize t => Putter t
put Putter [Fingerprint]
-> (DerivPath -> [Fingerprint]) -> Putter DerivPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> [Fingerprint]
forall t. DerivPathI t -> [Fingerprint]
pathToList

instance Serialize HardPath where
    get :: Get HardPath
get = Get HardPath
-> (HardPath -> Get HardPath) -> Maybe HardPath -> Get HardPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Get HardPath
forall (m :: * -> *) a. MonadPlus m => m a
mzero HardPath -> Get HardPath
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe HardPath -> Get HardPath)
-> ([Fingerprint] -> Maybe HardPath)
-> [Fingerprint]
-> Get HardPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> Maybe HardPath
forall t. DerivPathI t -> Maybe HardPath
toHard (DerivPath -> Maybe HardPath)
-> ([Fingerprint] -> DerivPath) -> [Fingerprint] -> Maybe HardPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Fingerprint] -> DerivPath
listToPath ([Fingerprint] -> Get HardPath)
-> Get [Fingerprint] -> Get HardPath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get [Fingerprint]
forall t. Serialize t => Get t
S.get
    put :: Putter HardPath
put = Putter [Fingerprint]
forall t. Serialize t => Putter t
put Putter [Fingerprint]
-> (HardPath -> [Fingerprint]) -> Putter HardPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HardPath -> [Fingerprint]
forall t. DerivPathI t -> [Fingerprint]
pathToList

instance Serialize SoftPath where
    get :: Get SoftPath
get = Get SoftPath
-> (SoftPath -> Get SoftPath) -> Maybe SoftPath -> Get SoftPath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Get SoftPath
forall (m :: * -> *) a. MonadPlus m => m a
mzero SoftPath -> Get SoftPath
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SoftPath -> Get SoftPath)
-> ([Fingerprint] -> Maybe SoftPath)
-> [Fingerprint]
-> Get SoftPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DerivPath -> Maybe SoftPath
forall t. DerivPathI t -> Maybe SoftPath
toSoft (DerivPath -> Maybe SoftPath)
-> ([Fingerprint] -> DerivPath) -> [Fingerprint] -> Maybe SoftPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Fingerprint] -> DerivPath
listToPath ([Fingerprint] -> Get SoftPath)
-> Get [Fingerprint] -> Get SoftPath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get [Fingerprint]
forall t. Serialize t => Get t
S.get
    put :: Putter SoftPath
put = Putter [Fingerprint]
forall t. Serialize t => Putter t
put Putter [Fingerprint]
-> (SoftPath -> [Fingerprint]) -> Putter SoftPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SoftPath -> [Fingerprint]
forall t. DerivPathI t -> [Fingerprint]
pathToList

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

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

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

-- | Turn a derivation path into a hard derivation path. Will fail if the path
-- contains soft derivations.
toHard :: DerivPathI t -> Maybe HardPath
toHard :: DerivPathI t -> Maybe HardPath
toHard p :: DerivPathI t
p = case DerivPathI t
p of
    next :: DerivPathI t
next :| i :: Fingerprint
i -> (HardPath -> Fingerprint -> HardPath
forall t.
HardOrAny t =>
DerivPathI t -> Fingerprint -> DerivPathI t
:| Fingerprint
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
    Deriv     -> HardPath -> Maybe HardPath
forall a. a -> Maybe a
Just HardPath
forall t. DerivPathI t
Deriv
    _         -> Maybe HardPath
forall a. Maybe a
Nothing

-- | Turn a derivation path into a soft derivation path. Will fail if the path
-- has hard derivations.
toSoft :: DerivPathI t -> Maybe SoftPath
toSoft :: DerivPathI t -> Maybe SoftPath
toSoft p :: DerivPathI t
p = case DerivPathI t
p of
    next :: DerivPathI t
next :/ i :: Fingerprint
i -> (SoftPath -> Fingerprint -> SoftPath
forall t.
AnyOrSoft t =>
DerivPathI t -> Fingerprint -> DerivPathI t
:/ Fingerprint
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
    Deriv     -> SoftPath -> Maybe SoftPath
forall a. a -> Maybe a
Just SoftPath
forall t. DerivPathI t
Deriv
    _         -> Maybe SoftPath
forall a. Maybe a
Nothing

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

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

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

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

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

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

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

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

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

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

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

instance IsString DerivPath where
    fromString :: String -> DerivPath
fromString =
        ParsedPath -> DerivPath
getParsedPath (ParsedPath -> DerivPath)
-> (String -> ParsedPath) -> String -> DerivPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsedPath -> Maybe ParsedPath -> ParsedPath
forall a. a -> Maybe a -> a
fromMaybe ParsedPath
forall a. a
e (Maybe ParsedPath -> ParsedPath)
-> (String -> Maybe ParsedPath) -> String -> ParsedPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe ParsedPath
parsePath
      where
        e :: a
e = String -> a
forall a. HasCallStack => String -> a
error "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 "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 "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 "ParsedPath" ((Text -> Parser ParsedPath) -> Value -> Parser ParsedPath)
-> (Text -> Parser ParsedPath) -> Value -> Parser ParsedPath
forall a b. (a -> b) -> a -> b
$ \str :: 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 p :: ParsedPath
p -> ParsedPath -> Parser ParsedPath
forall (m :: * -> *) a. Monad m => a -> m a
return ParsedPath
p
        _      -> Parser ParsedPath
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance FromJSON DerivPath where
    parseJSON :: Value -> Parser DerivPath
parseJSON = String -> (Text -> Parser DerivPath) -> Value -> Parser DerivPath
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "DerivPath" ((Text -> Parser DerivPath) -> Value -> Parser DerivPath)
-> (Text -> Parser DerivPath) -> Value -> Parser DerivPath
forall a b. (a -> b) -> a -> b
$ \str :: 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 p :: ParsedPath
p -> DerivPath -> Parser DerivPath
forall (m :: * -> *) a. Monad m => a -> m a
return (DerivPath -> Parser DerivPath) -> DerivPath -> Parser DerivPath
forall a b. (a -> b) -> a -> b
$ ParsedPath -> DerivPath
getParsedPath ParsedPath
p
        _      -> Parser DerivPath
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance FromJSON HardPath where
    parseJSON :: Value -> Parser HardPath
parseJSON = String -> (Text -> Parser HardPath) -> Value -> Parser HardPath
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "HardPath" ((Text -> Parser HardPath) -> Value -> Parser HardPath)
-> (Text -> Parser HardPath) -> Value -> Parser HardPath
forall a b. (a -> b) -> a -> b
$ \str :: 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 p :: HardPath
p -> HardPath -> Parser HardPath
forall (m :: * -> *) a. Monad m => a -> m a
return HardPath
p
        _      -> Parser HardPath
forall (m :: * -> *) a. MonadPlus m => m a
mzero

instance FromJSON SoftPath where
    parseJSON :: Value -> Parser SoftPath
parseJSON = String -> (Text -> Parser SoftPath) -> Value -> Parser SoftPath
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "SoftPath" ((Text -> Parser SoftPath) -> Value -> Parser SoftPath)
-> (Text -> Parser SoftPath) -> Value -> Parser SoftPath
forall a b. (a -> b) -> a -> b
$ \str :: 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 p :: SoftPath
p -> SoftPath -> Parser SoftPath
forall (m :: * -> *) a. Monad m => a -> m a
return SoftPath
p
        _      -> Parser SoftPath
forall (m :: * -> *) a. MonadPlus m => m a
mzero

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

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

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

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

instance Show ParsedPath where
    showsPrec :: Int -> ParsedPath -> ShowS
showsPrec d :: Int
d p :: ParsedPath
p = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "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 d' :: DerivPath
d'   -> "m" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DerivPath -> String
forall t. DerivPathI t -> String
pathToStr DerivPath
d'
                ParsedPub d' :: DerivPath
d'   -> "M" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DerivPath -> String
forall t. DerivPathI t -> String
pathToStr DerivPath
d'
                ParsedEmpty d' :: DerivPath
d' -> DerivPath -> String
forall t. DerivPathI t -> String
pathToStr DerivPath
d'

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

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

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

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

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

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

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

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

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

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

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

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

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

{- Helpers for derivation paths and addresses -}

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

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

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

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

{- Utilities for extended keys -}

-- | De-serialize HDW-specific private key.
getPadPrvKey :: Get SecKey
getPadPrvKey :: Get SecKey
getPadPrvKey = do
    Word8
pad <- Get Word8
getWord8
    Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word8
pad Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 0x00) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Private key must be padded with 0x00"
    Get SecKey
forall t. Serialize t => Get t
S.get

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

bsPadPrvKey :: SecKey -> ByteString
bsPadPrvKey :: SecKey -> ByteString
bsPadPrvKey = Put -> ByteString
runPut (Put -> ByteString) -> Putter SecKey -> SecKey -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter SecKey
putPadPrvKey