{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Module: Crypto.HDKey.BIP32
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- [BIP32](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)
-- hierarchical deterministic wallets and extended keys, with support for
-- serialization and parsing.

module Crypto.HDKey.BIP32 (
  -- * Hierarchical deterministic keys
    HDKey(..)
  , master

  -- * Extended keys
  , Extended(..)
  , XPub(..)
  , XPrv(..)
  , X(..)
  , ckd_pub
  , ckd_priv
  , n

  -- * Child derivation via path
  , derive
  , derive_partial

  -- * Serialization
  , xpub
  , xprv
  , tpub
  , tprv

  -- * Parsing
  , parse

  -- * Child key derivation functions
  , derive_child_pub
  , derive_child_priv
  ) where

import Control.Monad (guard)
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Crypto.Hash.SHA512 as SHA512
import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
import qualified Crypto.Curve.Secp256k1 as Secp256k1
import Data.Bits ((.<<.), (.>>.), (.|.), (.&.))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Base58Check as B58C
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Internal as BI
import Data.Word (Word8, Word32)

-- utilities ------------------------------------------------------------------

fi :: (Integral a, Num b) => a -> b
fi :: forall a b. (Integral a, Num b) => a -> b
fi = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE fi #-}

-- big-endian bytestring encoding
unroll :: Integer -> BS.ByteString
unroll :: Integer -> ByteString
unroll Integer
i = case Integer
i of
    Integer
0 -> Word8 -> ByteString
BS.singleton Word8
0
    Integer
_ -> ByteString -> ByteString
BS.reverse (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ (Integer -> Maybe (Word8, Integer)) -> Integer -> ByteString
forall a. (a -> Maybe (Word8, a)) -> a -> ByteString
BS.unfoldr Integer -> Maybe (Word8, Integer)
forall {b} {a}. (Integral b, Num a, Bits b) => b -> Maybe (a, b)
coalg Integer
i
  where
    coalg :: b -> Maybe (a, b)
coalg b
0 = Maybe (a, b)
forall a. Maybe a
Nothing
    coalg b
m = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (b -> a
forall a b. (Integral a, Num b) => a -> b
fi b
m, b
m b -> Int -> b
forall a. Bits a => a -> Int -> a
.>>. Int
8)

-- parse 32 bytes to a 256-bit integer
parse256 :: BS.ByteString -> Integer
parse256 :: ByteString -> Integer
parse256 bs :: ByteString
bs@(BI.PS ForeignPtr Word8
_ Int
_ Int
l)
    | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32   = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' Integer -> Word8 -> Integer
forall {a} {a}. (Integral a, Bits a, Num a) => a -> a -> a
alg Integer
0 ByteString
bs
    | Bool
otherwise = [Char] -> Integer
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-bip32 (parse256): invalid input"
  where
    alg :: a -> a -> a
alg !a
a (a -> a
forall a b. (Integral a, Num b) => a -> b
fi -> !a
b) = (a
a a -> Int -> a
forall a. Bits a => a -> Int -> a
.<<. Int
8) a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
b

-- serialize a 256-bit integer to 32 bytes, left-padding with zeros if
-- necessary. the size of the integer is not checked.
ser256 :: Integer -> BS.ByteString
ser256 :: Integer -> ByteString
ser256 (Integer -> ByteString
unroll -> u :: ByteString
u@(BI.PS ForeignPtr Word8
_ Int
_ Int
l))
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
32 = Int -> Word8 -> ByteString
BS.replicate (Int
32 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) Word8
0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
u
  | Bool
otherwise = ByteString
u

-- serialize a 32-bit word, MSB first
ser32 :: Word32 -> BS.ByteString
ser32 :: Word32 -> ByteString
ser32 Word32
w =
  let !mask :: Word8
mask = Word8
0b00000000_00000000_00000000_11111111
      !w0 :: Word8
w0 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
.>>. Int
24) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
mask
      !w1 :: Word8
w1 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
.>>. Int
16) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
mask
      !w2 :: Word8
w2 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
.>>. Int
08) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
mask
      !w3 :: Word8
w3 = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fi Word32
w Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
mask
  in  Word8 -> ByteString -> ByteString
BS.cons Word8
w0 (Word8 -> ByteString -> ByteString
BS.cons Word8
w1 (Word8 -> ByteString -> ByteString
BS.cons Word8
w2 (Word8 -> ByteString
BS.singleton Word8
w3)))

-- extended keys --------------------------------------------------------------

-- | An extended public key.
newtype XPub = XPub (X Secp256k1.Projective)
  deriving (XPub -> XPub -> Bool
(XPub -> XPub -> Bool) -> (XPub -> XPub -> Bool) -> Eq XPub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPub -> XPub -> Bool
== :: XPub -> XPub -> Bool
$c/= :: XPub -> XPub -> Bool
/= :: XPub -> XPub -> Bool
Eq, Int -> XPub -> ShowS
[XPub] -> ShowS
XPub -> [Char]
(Int -> XPub -> ShowS)
-> (XPub -> [Char]) -> ([XPub] -> ShowS) -> Show XPub
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XPub -> ShowS
showsPrec :: Int -> XPub -> ShowS
$cshow :: XPub -> [Char]
show :: XPub -> [Char]
$cshowList :: [XPub] -> ShowS
showList :: [XPub] -> ShowS
Show)

-- | An extended private key.
newtype XPrv = XPrv (X Integer)
  deriving (XPrv -> XPrv -> Bool
(XPrv -> XPrv -> Bool) -> (XPrv -> XPrv -> Bool) -> Eq XPrv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XPrv -> XPrv -> Bool
== :: XPrv -> XPrv -> Bool
$c/= :: XPrv -> XPrv -> Bool
/= :: XPrv -> XPrv -> Bool
Eq, Int -> XPrv -> ShowS
[XPrv] -> ShowS
XPrv -> [Char]
(Int -> XPrv -> ShowS)
-> (XPrv -> [Char]) -> ([XPrv] -> ShowS) -> Show XPrv
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> XPrv -> ShowS
showsPrec :: Int -> XPrv -> ShowS
$cshow :: XPrv -> [Char]
show :: XPrv -> [Char]
$cshowList :: [XPrv] -> ShowS
showList :: [XPrv] -> ShowS
Show)

-- | A public or private key, extended with a chain code.
data X a = X !a !BS.ByteString
  deriving (X a -> X a -> Bool
(X a -> X a -> Bool) -> (X a -> X a -> Bool) -> Eq (X a)
forall a. Eq a => X a -> X a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => X a -> X a -> Bool
== :: X a -> X a -> Bool
$c/= :: forall a. Eq a => X a -> X a -> Bool
/= :: X a -> X a -> Bool
Eq, Int -> X a -> ShowS
[X a] -> ShowS
X a -> [Char]
(Int -> X a -> ShowS)
-> (X a -> [Char]) -> ([X a] -> ShowS) -> Show (X a)
forall a. Show a => Int -> X a -> ShowS
forall a. Show a => [X a] -> ShowS
forall a. Show a => X a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> X a -> ShowS
showsPrec :: Int -> X a -> ShowS
$cshow :: forall a. Show a => X a -> [Char]
show :: X a -> [Char]
$cshowList :: forall a. Show a => [X a] -> ShowS
showList :: [X a] -> ShowS
Show)

-- | Key types supporting identifier/fingerprint calculation.
--
--   >>> let Just hd = master "my very secret entropy"
--   >>> let Right my_xprv = hd_key hd
--   >>> let my_xpub = n k
--   >>> -- all have the same fingerprint
--   >>> fingerprint hd
--   "G\157\&8\146"
--   >>> fingerprint my_xprv
--   "G\157\&8\146"
--   >>> fingerprint my_xpub
--   "G\157\&8\146"
class Extended k where
  -- | Calculate the identifier for an extended key.
  identifier  :: k -> BS.ByteString

  -- | Calculate the fingerprint of an extended key.
  fingerprint :: k -> BS.ByteString
  fingerprint = Int -> ByteString -> ByteString
BS.take Int
4 (ByteString -> ByteString) -> (k -> ByteString) -> k -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> ByteString
forall k. Extended k => k -> ByteString
identifier

instance Extended XPub where
  identifier :: XPub -> ByteString
identifier (XPub (X Projective
pub ByteString
_)) =
    let ser :: ByteString
ser = Projective -> ByteString
Secp256k1.serialize_point Projective
pub
    in  ByteString -> ByteString
RIPEMD160.hash (ByteString -> ByteString
SHA256.hash ByteString
ser)

instance Extended XPrv where
  identifier :: XPrv -> ByteString
identifier (XPrv (X Integer
sec ByteString
_)) =
    let p :: Projective
p = Projective -> Integer -> Projective
Secp256k1.mul Projective
Secp256k1._CURVE_G Integer
sec
        ser :: ByteString
ser = Projective -> ByteString
Secp256k1.serialize_point Projective
p
    in  ByteString -> ByteString
RIPEMD160.hash (ByteString -> ByteString
SHA256.hash ByteString
ser)

-- internal key derivation functions-------------------------------------------

hardened :: Word32 -> Bool
hardened :: Word32 -> Bool
hardened = (Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
0x8000_0000)

-- master xprv from seed
_master :: BS.ByteString -> Maybe XPrv
_master :: ByteString -> Maybe XPrv
_master seed :: ByteString
seed@(BI.PS ForeignPtr Word8
_ Int
_ Int
l)
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16 = Maybe XPrv
forall a. Maybe a
Nothing
  | Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
64 = Maybe XPrv
forall a. Maybe a
Nothing
  | Bool
otherwise = do
      let i :: ByteString
i = ByteString -> ByteString -> ByteString
SHA512.hmac ByteString
"Bitcoin seed" ByteString
seed
          (ByteString
il, ByteString
c) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
32 ByteString
i
          s :: Integer
s = ByteString -> Integer
parse256 ByteString
il
      XPrv -> Maybe XPrv
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrv -> Maybe XPrv) -> XPrv -> Maybe XPrv
forall a b. (a -> b) -> a -> b
$! (X Integer -> XPrv
XPrv (Integer -> ByteString -> X Integer
forall a. a -> ByteString -> X a
X Integer
s ByteString
c))

-- private parent key -> private child key
ckd_priv :: XPrv -> Word32 -> XPrv
ckd_priv :: XPrv -> Word32 -> XPrv
ckd_priv _xprv :: XPrv
_xprv@(XPrv (X Integer
sec ByteString
cod)) Word32
i =
    let l :: ByteString
l = ByteString -> ByteString -> ByteString
SHA512.hmac ByteString
cod ByteString
dat
        (ByteString
il, ByteString
ci) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
32 ByteString
l
        pil :: Integer
pil = ByteString -> Integer
parse256 ByteString
il
        ki :: Integer
ki  = Integer -> Integer
Secp256k1.modQ (Integer
pil Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
sec)
    in  if   Integer
pil Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
Secp256k1._CURVE_Q Bool -> Bool -> Bool
|| Integer
ki Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 -- negl
        then XPrv -> Word32 -> XPrv
ckd_priv XPrv
_xprv (Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
i)
        else X Integer -> XPrv
XPrv (Integer -> ByteString -> X Integer
forall a. a -> ByteString -> X a
X Integer
ki ByteString
ci)
  where
    dat :: ByteString
dat | Word32 -> Bool
hardened Word32
i = Word8 -> ByteString
BS.singleton Word8
0x00 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Integer -> ByteString
ser256 Integer
sec ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word32 -> ByteString
ser32 Word32
i
        | Bool
otherwise  =
            let p :: Projective
p = Projective -> Integer -> Projective
Secp256k1.mul Projective
Secp256k1._CURVE_G Integer
sec
            in  Projective -> ByteString
Secp256k1.serialize_point Projective
p ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word32 -> ByteString
ser32 Word32
i

-- public parent key -> public child key
ckd_pub :: XPub -> Word32 -> Maybe XPub
ckd_pub :: XPub -> Word32 -> Maybe XPub
ckd_pub _xpub :: XPub
_xpub@(XPub (X Projective
pub ByteString
cod)) Word32
i
  | Word32 -> Bool
hardened Word32
i = Maybe XPub
forall a. Maybe a
Nothing
  | Bool
otherwise = do
      let dat :: ByteString
dat = Projective -> ByteString
Secp256k1.serialize_point Projective
pub ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word32 -> ByteString
ser32 Word32
i
          l :: ByteString
l   = ByteString -> ByteString -> ByteString
SHA512.hmac ByteString
cod ByteString
dat
          (ByteString
il, ByteString
ci) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
32 ByteString
l
          pil :: Integer
pil = ByteString -> Integer
parse256 ByteString
il
          ki :: Projective
ki = Projective -> Integer -> Projective
Secp256k1.mul_unsafe Projective
Secp256k1._CURVE_G Integer
pil Projective -> Projective -> Projective
`Secp256k1.add` Projective
pub
      if   Integer
pil Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
Secp256k1._CURVE_Q Bool -> Bool -> Bool
|| Projective
ki Projective -> Projective -> Bool
forall a. Eq a => a -> a -> Bool
== Projective
Secp256k1._CURVE_ZERO -- negl
      then XPub -> Word32 -> Maybe XPub
ckd_pub XPub
_xpub (Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
i)
      else XPub -> Maybe XPub
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (X Projective -> XPub
XPub (Projective -> ByteString -> X Projective
forall a. a -> ByteString -> X a
X Projective
ki ByteString
ci))

-- private parent key -> public child key
n :: XPrv -> XPub
n :: XPrv -> XPub
n (XPrv (X Integer
sec ByteString
cod)) =
  let p :: Projective
p = Projective -> Integer -> Projective
Secp256k1.mul Projective
Secp256k1._CURVE_G Integer
sec
  in  X Projective -> XPub
XPub (Projective -> ByteString -> X Projective
forall a. a -> ByteString -> X a
X Projective
p ByteString
cod)

-- hierarchical deterministic keys --------------------------------------------

-- | A BIP32 hierarchical deterministic key.
--
--   This differs from lower-level "extended" keys in that it carries all
--   information required for serialization.
data HDKey = HDKey {
    HDKey -> Either XPub XPrv
hd_key    :: !(Either XPub XPrv) -- ^ extended public or private key
  , HDKey -> Word8
hd_depth  :: !Word8              -- ^ key depth
  , HDKey -> ByteString
hd_parent :: !BS.ByteString      -- ^ parent fingerprint
  , HDKey -> ByteString
hd_child  :: !BS.ByteString      -- ^ index or child number
  }
  deriving (HDKey -> HDKey -> Bool
(HDKey -> HDKey -> Bool) -> (HDKey -> HDKey -> Bool) -> Eq HDKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HDKey -> HDKey -> Bool
== :: HDKey -> HDKey -> Bool
$c/= :: HDKey -> HDKey -> Bool
/= :: HDKey -> HDKey -> Bool
Eq, Int -> HDKey -> ShowS
[HDKey] -> ShowS
HDKey -> [Char]
(Int -> HDKey -> ShowS)
-> (HDKey -> [Char]) -> ([HDKey] -> ShowS) -> Show HDKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HDKey -> ShowS
showsPrec :: Int -> HDKey -> ShowS
$cshow :: HDKey -> [Char]
show :: HDKey -> [Char]
$cshowList :: [HDKey] -> ShowS
showList :: [HDKey] -> ShowS
Show)

instance Extended HDKey where
  identifier :: HDKey -> ByteString
identifier (HDKey Either XPub XPrv
ekey Word8
_ ByteString
_ ByteString
_) = case Either XPub XPrv
ekey of
    Left XPub
l -> XPub -> ByteString
forall k. Extended k => k -> ByteString
identifier XPub
l
    Right XPrv
r -> XPrv -> ByteString
forall k. Extended k => k -> ByteString
identifier XPrv
r

-- | Derive a master 'HDKey' from a master seed.
--
--   Fails with 'Nothing' if the provided seed has an invalid length.
--
---  >>> let Just hd = master "my very secret entropy"
--   >>> xpub hd
--   "xpub661MyMwAqRbcGTJPtZRqZyrvjxHCfhqXeiqb5GVU3EGuFBy4QxT3yt8iiHwZTiCzZFyuyNiqXB3eqzqFZ8z4L6HCrPSkDVFNuW59LXYvMjs"
master :: BS.ByteString -> Maybe HDKey
master :: ByteString -> Maybe HDKey
master ByteString
seed = do
  XPrv
m <- ByteString -> Maybe XPrv
_master ByteString
seed
  HDKey -> Maybe HDKey
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HDKey -> Maybe HDKey) -> HDKey -> Maybe HDKey
forall a b. (a -> b) -> a -> b
$! HDKey {
      hd_key :: Either XPub XPrv
hd_key = XPrv -> Either XPub XPrv
forall a b. b -> Either a b
Right XPrv
m
    , hd_depth :: Word8
hd_depth = Word8
0
    , hd_parent :: ByteString
hd_parent = ByteString
"\NUL\NUL\NUL\NUL" -- 0x0000_0000
    , hd_child :: ByteString
hd_child = Word32 -> ByteString
ser32 Word32
0
    }

-- | Derive a private child node at the provided index.
--
--   Fails with 'Nothing' if derivation is impossible.
--
--   >>> let Just child_prv = derive_child_priv hd 0
--   >>> xpub child_prv
--   "xpub68R2ZbtFeJTFJApdEdPqW5cy3d5wF96tTfJErhu3mTi2Ttaqvc88BMPrgS3hQSrHj91kRbzVLM9pue9f8219szRKZuTAx1LWbdLDLFDm6Ly"
derive_child_priv :: HDKey -> Word32 -> Maybe HDKey
derive_child_priv :: HDKey -> Word32 -> Maybe HDKey
derive_child_priv HDKey {Word8
Either XPub XPrv
ByteString
hd_key :: HDKey -> Either XPub XPrv
hd_depth :: HDKey -> Word8
hd_parent :: HDKey -> ByteString
hd_child :: HDKey -> ByteString
hd_key :: Either XPub XPrv
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
..} Word32
i = case Either XPub XPrv
hd_key of
  Left XPub
_ -> Maybe HDKey
forall a. Maybe a
Nothing
  Right XPrv
_xprv -> HDKey -> Maybe HDKey
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HDKey -> Maybe HDKey) -> HDKey -> Maybe HDKey
forall a b. (a -> b) -> a -> b
$!
    let key :: Either a XPrv
key   = XPrv -> Either a XPrv
forall a b. b -> Either a b
Right (XPrv -> Word32 -> XPrv
ckd_priv XPrv
_xprv Word32
i)
        depth :: Word8
depth = Word8
hd_depth Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1
        parent :: ByteString
parent = XPrv -> ByteString
forall k. Extended k => k -> ByteString
fingerprint XPrv
_xprv
        child :: ByteString
child = Word32 -> ByteString
ser32 Word32
i
    in  Either XPub XPrv -> Word8 -> ByteString -> ByteString -> HDKey
HDKey Either XPub XPrv
forall {a}. Either a XPrv
key Word8
depth ByteString
parent ByteString
child

-- | Derive a public child node at the provided index.
--
--   Fails with 'Nothing' if derivation is impossible.
--
--   >>> :set -XNumericUnderscores
--   >>> let Just child_pub = derive_child_pub child_prv 0x8000_0000
--   >>> xpub child_pub
--   "xpub6B6LoU83Cpyx1UVMwuoQdQvY2BuGbPd2xsEVxCnj85UGgDN9bRz82hQhe9UFmyo4Pokuhjc8M1Cfc8ufLxcL6FkCF7Zc2eajEfWfZwMFF6X"
derive_child_pub :: HDKey -> Word32 -> Maybe HDKey
derive_child_pub :: HDKey -> Word32 -> Maybe HDKey
derive_child_pub HDKey {Word8
Either XPub XPrv
ByteString
hd_key :: HDKey -> Either XPub XPrv
hd_depth :: HDKey -> Word8
hd_parent :: HDKey -> ByteString
hd_child :: HDKey -> ByteString
hd_key :: Either XPub XPrv
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
..} Word32
i = do
  (XPub
key, ByteString
parent) <- case Either XPub XPrv
hd_key of
    Left XPub
_xpub  -> do
      XPub
pub <- XPub -> Word32 -> Maybe XPub
ckd_pub XPub
_xpub Word32
i
      (XPub, ByteString) -> Maybe (XPub, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((XPub, ByteString) -> Maybe (XPub, ByteString))
-> (XPub, ByteString) -> Maybe (XPub, ByteString)
forall a b. (a -> b) -> a -> b
$! (XPub
pub, XPub -> ByteString
forall k. Extended k => k -> ByteString
fingerprint XPub
_xpub)
    Right XPrv
_xprv ->
      let pub :: XPub
pub = XPrv -> XPub
n (XPrv -> Word32 -> XPrv
ckd_priv XPrv
_xprv Word32
i)
      in  (XPub, ByteString) -> Maybe (XPub, ByteString)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((XPub, ByteString) -> Maybe (XPub, ByteString))
-> (XPub, ByteString) -> Maybe (XPub, ByteString)
forall a b. (a -> b) -> a -> b
$! (XPub
pub, XPrv -> ByteString
forall k. Extended k => k -> ByteString
fingerprint XPrv
_xprv)
  let depth :: Word8
depth = Word8
hd_depth Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
1
      child :: ByteString
child = Word32 -> ByteString
ser32 Word32
i
  HDKey -> Maybe HDKey
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HDKey -> Maybe HDKey) -> HDKey -> Maybe HDKey
forall a b. (a -> b) -> a -> b
$! Either XPub XPrv -> Word8 -> ByteString -> ByteString -> HDKey
HDKey (XPub -> Either XPub XPrv
forall a b. a -> Either a b
Left XPub
key) Word8
depth ByteString
parent ByteString
child

-- derivation path expression -------------------------------------------------

-- recursive derivation path
data Path =
    M
  | !Path :| !Word32 -- hardened
  | !Path :/ !Word32
  deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> [Char]
(Int -> Path -> ShowS)
-> (Path -> [Char]) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> [Char]
show :: Path -> [Char]
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
Show)

parse_path :: BS.ByteString -> Maybe Path
parse_path :: ByteString -> Maybe Path
parse_path ByteString
bs = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs of
    Maybe (Word8, ByteString)
Nothing -> Maybe Path
forall a. Maybe a
Nothing
    Just (Word8
h, ByteString
t)
      | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
109  -> Path -> ByteString -> Maybe Path
go Path
M ByteString
t -- == 'm'
      | Bool
otherwise -> Maybe Path
forall a. Maybe a
Nothing
  where
    child :: Path -> BS.ByteString -> Maybe (Path, BS.ByteString)
    child :: Path -> ByteString -> Maybe (Path, ByteString)
child Path
pat ByteString
b = case ByteString -> Maybe (Int, ByteString)
B8.readInt ByteString
b of
      Maybe (Int, ByteString)
Nothing -> Maybe (Path, ByteString)
forall a. Maybe a
Nothing
      Just (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fi -> Word32
i, ByteString
etc) -> case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
etc of
        Maybe (Word8, ByteString)
Nothing -> (Path, ByteString) -> Maybe (Path, ByteString)
forall a. a -> Maybe a
Just ((Path, ByteString) -> Maybe (Path, ByteString))
-> (Path, ByteString) -> Maybe (Path, ByteString)
forall a b. (a -> b) -> a -> b
$! (Path
pat Path -> Word32 -> Path
:/ Word32
i, ByteString
forall a. Monoid a => a
mempty)
        Just (Word8
h, ByteString
t)
          | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
39 -> (Path, ByteString) -> Maybe (Path, ByteString)
forall a. a -> Maybe a
Just ((Path, ByteString) -> Maybe (Path, ByteString))
-> (Path, ByteString) -> Maybe (Path, ByteString)
forall a b. (a -> b) -> a -> b
$! (Path
pat Path -> Word32 -> Path
:| Word32
i, ByteString
t) -- '
          | Bool
otherwise -> (Path, ByteString) -> Maybe (Path, ByteString)
forall a. a -> Maybe a
Just ((Path, ByteString) -> Maybe (Path, ByteString))
-> (Path, ByteString) -> Maybe (Path, ByteString)
forall a b. (a -> b) -> a -> b
$! (Path
pat Path -> Word32 -> Path
:/ Word32
i, ByteString
etc)

    go :: Path -> ByteString -> Maybe Path
go Path
pat ByteString
b = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
b of
      Maybe (Word8, ByteString)
Nothing -> Path -> Maybe Path
forall a. a -> Maybe a
Just Path
pat
      Just (Word8
h, ByteString
t)
        | Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
47 -> do -- /
            (Path
npat, ByteString
etc) <- Path -> ByteString -> Maybe (Path, ByteString)
child Path
pat ByteString
t
            Path -> ByteString -> Maybe Path
go Path
npat ByteString
etc
        | Bool
otherwise ->
            Maybe Path
forall a. Maybe a
Nothing

-- | Derive a child node via the provided derivation path.
--
--   Fails with 'Nothing' if derivation is impossible, or if the
--   provided path is invalid.
--
--   >>> let Just hd = master "my very secret master seed"
--   >>> let Just child = derive hd "m/44'/0'/0'/0/0"
--   >>> xpub child
--   "xpub6FvaeGNFmCkLky6jwefrUfyH7gCGSAUckRBANT6wLQkm4eWZApsf4LqAadtbM8EBFfuKGFgzhgta4ByP6xnBodk2EV7BiwxCPLgu13oYWGp"
derive
  :: HDKey
  -> BS.ByteString -- ^ derivation path
  -> Maybe HDKey
derive :: HDKey -> ByteString -> Maybe HDKey
derive HDKey
hd ByteString
pat = case ByteString -> Maybe Path
parse_path ByteString
pat of
    Maybe Path
Nothing -> Maybe HDKey
forall a. Maybe a
Nothing
    Just Path
p  -> Path -> Maybe HDKey
go Path
p
  where
    go :: Path -> Maybe HDKey
go = \case
      Path
M -> HDKey -> Maybe HDKey
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HDKey
hd
      Path
p :| Word32
i -> do
        HDKey
hdkey <- Path -> Maybe HDKey
go Path
p
        HDKey -> Word32 -> Maybe HDKey
derive_child_priv HDKey
hdkey (Word32
0x8000_0000 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
i) -- 2 ^ 31
      Path
p :/ Word32
i -> do
        HDKey
hdkey <- Path -> Maybe HDKey
go Path
p
        HDKey -> Word32 -> Maybe HDKey
derive_child_priv HDKey
hdkey Word32
i

-- | Derive a child node via the provided derivation path.
--
--   Fails with 'error' if derivation is impossible, or if the provided
--   path is invalid.
--
--   >>> let Just other_child = derive hd "m/44'/0'/0'/0/1"
--   >>> xpub other_child
--   "xpub6FvaeGNFmCkLpkT3uahJnGPTfEX62PtH7uZAyjtru8S2FvPuYTQKn8ct6CNQAwHMXaGN6EYuwi1Tz2VD7msftH8VTAtzgNra9CForA9FBP4"
derive_partial
  :: HDKey
  -> BS.ByteString
  -> HDKey
derive_partial :: HDKey -> ByteString -> HDKey
derive_partial HDKey
hd ByteString
pat = case HDKey -> ByteString -> Maybe HDKey
derive HDKey
hd ByteString
pat of
  Maybe HDKey
Nothing -> [Char] -> HDKey
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-bip32 (derive_partial): couldn't derive extended key"
  Just HDKey
hdkey -> HDKey
hdkey

-- serialization --------------------------------------------------------------

_MAINNET_PUB, _MAINNET_PRV :: Word32
_TESTNET_PUB, _TESTNET_PRV :: Word32

_MAINNET_PUB_BYTES, _MAINNET_PRV_BYTES :: BS.ByteString
_TESTNET_PUB_BYTES, _TESTNET_PRV_BYTES :: BS.ByteString

_MAINNET_PUB :: Word32
_MAINNET_PUB = Word32
0x0488B21E
_MAINNET_PUB_BYTES :: ByteString
_MAINNET_PUB_BYTES = ByteString
"\EOT\136\178\RS"

_MAINNET_PRV :: Word32
_MAINNET_PRV = Word32
0x0488ADE4
_MAINNET_PRV_BYTES :: ByteString
_MAINNET_PRV_BYTES = ByteString
"\EOT\136\173\228"

_TESTNET_PUB :: Word32
_TESTNET_PUB = Word32
0x043587CF
_TESTNET_PUB_BYTES :: ByteString
_TESTNET_PUB_BYTES = ByteString
"\EOT5\135\207"

_TESTNET_PRV :: Word32
_TESTNET_PRV = Word32
0x04358394
_TESTNET_PRV_BYTES :: ByteString
_TESTNET_PRV_BYTES = ByteString
"\EOT5\131\148"

-- | Serialize a mainnet extended public key in base58check format.
--
--   >>> let Just hd = master "my very secret entropy"
--   >>> xpub hd
--   "xpub661MyMwAqRbcGTJPtZRqZyrvjxHCfhqXeiqb5GVU3EGuFBy4QxT3yt8iiHwZTiCzZFyuyNiqXB3eqzqFZ8z4L6HCrPSkDVFNuW59LXYvMjs"
xpub :: HDKey -> BS.ByteString
xpub :: HDKey -> ByteString
xpub x :: HDKey
x@HDKey {Word8
Either XPub XPrv
ByteString
hd_key :: HDKey -> Either XPub XPrv
hd_depth :: HDKey -> Word8
hd_parent :: HDKey -> ByteString
hd_child :: HDKey -> ByteString
hd_key :: Either XPub XPrv
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
..} = ByteString -> ByteString
B58C.encode (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
  case Either XPub XPrv
hd_key of
    Left XPub
_  -> Word32 -> HDKey -> Builder
_serialize Word32
_MAINNET_PUB HDKey
x
    Right XPrv
e -> Word32 -> HDKey -> Builder
_serialize Word32
_MAINNET_PUB HDKey {
        hd_key :: Either XPub XPrv
hd_key = XPub -> Either XPub XPrv
forall a b. a -> Either a b
Left (XPrv -> XPub
n XPrv
e)
      , Word8
ByteString
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
..
      }

-- | Serialize a mainnet extended private key in base58check format.
--
--   >>> xprv hd
--   "xprv9s21ZrQH143K3yDvnXtqCqvCBvSiGF7gHVuzGt5rUtjvNPdusR8oS5pErywDM1jDDTcLpNNCbg9a9NuidBczRzSUp7seDeu8am64h6nfdrg"
xprv :: HDKey -> BS.ByteString
xprv :: HDKey -> ByteString
xprv x :: HDKey
x@HDKey {Word8
Either XPub XPrv
ByteString
hd_key :: HDKey -> Either XPub XPrv
hd_depth :: HDKey -> Word8
hd_parent :: HDKey -> ByteString
hd_child :: HDKey -> ByteString
hd_key :: Either XPub XPrv
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
..} = ByteString -> ByteString
B58C.encode (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
  case Either XPub XPrv
hd_key of
    Left XPub
_  -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-bip32 (xprv): no private key"
    Right XPrv
_ -> Word32 -> HDKey -> Builder
_serialize Word32
_MAINNET_PRV HDKey
x

-- | Serialize a testnet extended public key in base58check format.
--
--   >>> tpub hd
--   "tpubD6NzVbkrYhZ4YFVFLkQvmuCJ55Nrf6LbCMRtRpYcP92nzUdmVBJ98KoYxL2LzDAEMAWpaxEi4GshYBKrwzqJDXjVuzC3u1ucVTfZ6ZD415x"
tpub :: HDKey -> BS.ByteString
tpub :: HDKey -> ByteString
tpub x :: HDKey
x@HDKey {Word8
Either XPub XPrv
ByteString
hd_key :: HDKey -> Either XPub XPrv
hd_depth :: HDKey -> Word8
hd_parent :: HDKey -> ByteString
hd_child :: HDKey -> ByteString
hd_key :: Either XPub XPrv
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
..} = ByteString -> ByteString
B58C.encode (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
  case Either XPub XPrv
hd_key of
    Left XPub
_  -> Word32 -> HDKey -> Builder
_serialize Word32
_TESTNET_PUB HDKey
x
    Right XPrv
e -> Word32 -> HDKey -> Builder
_serialize Word32
_TESTNET_PUB HDKey {
      hd_key :: Either XPub XPrv
hd_key = XPub -> Either XPub XPrv
forall a b. a -> Either a b
Left (XPrv -> XPub
n XPrv
e)
      , Word8
ByteString
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
..
      }

-- | Serialize a testnet extended private key in base58check format.
--
--   >>> tprv hd
--   "tprv8ZgxMBicQKsPenTTT6kLNVYBW3rvVm9gd3q79JWJxsEQ9zNzrnUYwqBgnA6sMP7Xau97pTyxm2jNcETTkPxwF3i5Lm5wt1dBVrqV8kKi5v5"
tprv :: HDKey -> BS.ByteString
tprv :: HDKey -> ByteString
tprv x :: HDKey
x@HDKey {Word8
Either XPub XPrv
ByteString
hd_key :: HDKey -> Either XPub XPrv
hd_depth :: HDKey -> Word8
hd_parent :: HDKey -> ByteString
hd_child :: HDKey -> ByteString
hd_key :: Either XPub XPrv
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
..} = ByteString -> ByteString
B58C.encode (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BS.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
  case Either XPub XPrv
hd_key of
    Left XPub
_  -> [Char] -> Builder
forall a. HasCallStack => [Char] -> a
error [Char]
"ppad-bip32 (tprv): no private key"
    Right XPrv
_ -> Word32 -> HDKey -> Builder
_serialize Word32
_TESTNET_PRV HDKey
x

_serialize :: Word32 -> HDKey -> BSB.Builder
_serialize :: Word32 -> HDKey -> Builder
_serialize Word32
version HDKey {Word8
Either XPub XPrv
ByteString
hd_key :: HDKey -> Either XPub XPrv
hd_depth :: HDKey -> Word8
hd_parent :: HDKey -> ByteString
hd_child :: HDKey -> ByteString
hd_key :: Either XPub XPrv
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
..} =
     Word32 -> Builder
BSB.word32BE Word32
version
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
hd_depth
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
hd_parent
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
hd_child
  Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> case Either XPub XPrv
hd_key of
       Left (XPub (X Projective
pub ByteString
cod)) ->
            ByteString -> Builder
BSB.byteString ByteString
cod
         Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString (Projective -> ByteString
Secp256k1.serialize_point Projective
pub)
       Right (XPrv (X Integer
sec ByteString
cod)) ->
            ByteString -> Builder
BSB.byteString ByteString
cod
         Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
BSB.word8 Word8
0x00
         Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString (Integer -> ByteString
ser256 Integer
sec)

-- parsing --------------------------------------------------------------------

data KeyType =
    Pub
  | Prv

-- | Parse a base58check-encoded 'ByteString' into a 'HDKey'.
--
--   Fails with 'Nothing' if the provided key is invalid.
--
--   >>> let Just hd = master "my very secret entropy"
--   >>> let Just my_xprv = parse (xprv hd)
--   >>> my_xprv == hd
--   True
parse :: BS.ByteString -> Maybe HDKey
parse :: ByteString -> Maybe HDKey
parse ByteString
b58 = do
    ByteString
bs <- ByteString -> Maybe ByteString
B58C.decode ByteString
b58
    case Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
4 ByteString
bs of
      (ByteString
version, ByteString
etc)
        | ByteString
version ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
_MAINNET_PUB_BYTES Bool -> Bool -> Bool
|| ByteString
version ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
_TESTNET_PUB_BYTES ->
            ByteString -> Maybe HDKey
parse_pub ByteString
etc
        | ByteString
version ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
_MAINNET_PRV_BYTES Bool -> Bool -> Bool
|| ByteString
version ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
_TESTNET_PRV_BYTES ->
            ByteString -> Maybe HDKey
parse_prv ByteString
etc
        | Bool
otherwise ->
            Maybe HDKey
forall a. Maybe a
Nothing
  where
    parse_pub :: ByteString -> Maybe HDKey
parse_pub = KeyType -> ByteString -> Maybe HDKey
_parse KeyType
Pub
    parse_prv :: ByteString -> Maybe HDKey
parse_prv = KeyType -> ByteString -> Maybe HDKey
_parse KeyType
Prv

    _parse :: KeyType -> ByteString -> Maybe HDKey
_parse KeyType
ktype ByteString
bs = do
      (Word8
hd_depth, ByteString
etc0) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs
      let (ByteString
hd_parent, ByteString
etc1) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
4 ByteString
etc0
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
hd_parent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4)
      let (ByteString
hd_child, ByteString
etc2) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
4 ByteString
etc1
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
hd_child Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4)
      let (ByteString
cod, ByteString
etc3) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
32 ByteString
etc2
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
cod Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32)
      let (ByteString
key, ByteString
etc4) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
33 ByteString
etc3
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
key Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
33)
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
BS.length ByteString
etc4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
      HDKey
hd <- case KeyType
ktype of
        KeyType
Pub -> do
          Projective
pub <- ByteString -> Maybe Projective
Secp256k1.parse_point ByteString
key
          let hd_key :: Either XPub b
hd_key = XPub -> Either XPub b
forall a b. a -> Either a b
Left (X Projective -> XPub
XPub (Projective -> ByteString -> X Projective
forall a. a -> ByteString -> X a
X Projective
pub ByteString
cod))
          HDKey -> Maybe HDKey
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HDKey {Word8
Either XPub XPrv
ByteString
forall {b}. Either XPub b
hd_key :: Either XPub XPrv
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
hd_key :: forall {b}. Either XPub b
..}
        KeyType
Prv -> do
          (Word8
b, ByteString -> Integer
parse256 -> Integer
prv) <- ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
key
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0)
          Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Integer
prv Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 Bool -> Bool -> Bool
&& Integer
prv Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
Secp256k1._CURVE_Q)
          let hd_key :: Either a XPrv
hd_key = XPrv -> Either a XPrv
forall a b. b -> Either a b
Right (X Integer -> XPrv
XPrv (Integer -> ByteString -> X Integer
forall a. a -> ByteString -> X a
X Integer
prv ByteString
cod))
          HDKey -> Maybe HDKey
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HDKey {Word8
Either XPub XPrv
ByteString
forall {a}. Either a XPrv
hd_key :: Either XPub XPrv
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
hd_key :: forall {a}. Either a XPrv
..}
      Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (HDKey -> Bool
valid_lineage HDKey
hd)
      HDKey -> Maybe HDKey
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HDKey
hd
    {-# INLINE _parse #-}

valid_lineage :: HDKey -> Bool
valid_lineage :: HDKey -> Bool
valid_lineage HDKey {Word8
Either XPub XPrv
ByteString
hd_key :: HDKey -> Either XPub XPrv
hd_depth :: HDKey -> Word8
hd_parent :: HDKey -> ByteString
hd_child :: HDKey -> ByteString
hd_key :: Either XPub XPrv
hd_depth :: Word8
hd_parent :: ByteString
hd_child :: ByteString
..}
  | Word8
hd_depth Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 =
         ByteString
hd_parent ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\NUL\NUL\NUL\NUL"
      Bool -> Bool -> Bool
&& ByteString
hd_child ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\NUL\NUL\NUL\NUL"
  | Bool
otherwise = Bool
True