{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StrictData #-}

-- | [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)
-- Hierarchical Deterministic Wallets, for bitcoin and other cryptocurrencies.
module BIP32
  ( -- * Base58 serialization
    encodeXPrv
  , encodeXPub
  , decodeXPrv
  , decodeXPub
  , decode

    -- * Raw serialization
  , encodeXPrvRaw
  , encodeXPubRaw
  , decodeXPrvRaw
  , decodeXPubRaw
  , decodeRaw

    -- * Private key
  , XPrv(..)
  , xprvToXPub
    -- ** Single private subkey
  , subXPrvXPrv
  , subPrvPrv
    -- ** Multiple private subkeys
  , subsXPrvXPrv
  , subsPrvPrv
    -- ** Single public subkey
  , subXPrvXPub
  , subPrvPub
    -- ** Multiple public subkeys
  , subsXPrvXPub
  , subsPrvPub

    -- * Public key
  , XPub(..)
    -- ** Single public subkey
  , subXPubXPub
  , subPubPub
    -- ** Multiple public subkeys
  , subsXPubXPub
  , subsPubPub

    -- * Chain code
  , Chain
  , chain
  , unChain

    -- * Derivation path
  , Index(..)
  , indexIsHardened
  , indexNext

    -- * Depth
  , Depth(..)

    -- * Fingerprint
  , Fingerprint(..)
  , fingerprint

    -- * Version
  , Version(..)
    -- ** Example versions
  , version_xprv
  , version_xpub
  , version_tprv
  , version_tpub
  , version_Ltpv
  , version_Ltub
  , version_ttpv
  , version_ttub
  ) where

import Bitcoin.Hash (hash160, check32)
import Bitcoin.Hash.Prim (hmacSHA512)
import qualified Bitcoin.Keys as K
import Control.Applicative
import Control.Monad
import Data.Bits
import Data.Maybe
import qualified Data.Binary.Get as Bin
import qualified Data.ByteString as B
import qualified Data.ByteString.Base58 as B58
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Word

--------------------------------------------------------------------------------

-- | Extended private key.
data XPrv = XPrv
  { XPrv -> Version
xprv_version     :: Version
  , XPrv -> Depth
xprv_depth       :: Depth
  , XPrv -> Fingerprint
xprv_fingerprint :: Fingerprint
  , XPrv -> Index
xprv_index       :: Index
  , XPrv -> Chain
xprv_chain       :: Chain
  , XPrv -> Prv
xprv_prv         :: K.Prv
  } deriving (XPrv -> XPrv -> Bool
(XPrv -> XPrv -> Bool) -> (XPrv -> XPrv -> Bool) -> Eq XPrv
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPrv -> XPrv -> Bool
$c/= :: XPrv -> XPrv -> Bool
== :: XPrv -> XPrv -> Bool
$c== :: XPrv -> XPrv -> Bool
Eq, Int -> XPrv -> ShowS
[XPrv] -> ShowS
XPrv -> String
(Int -> XPrv -> ShowS)
-> (XPrv -> String) -> ([XPrv] -> ShowS) -> Show XPrv
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPrv] -> ShowS
$cshowList :: [XPrv] -> ShowS
show :: XPrv -> String
$cshow :: XPrv -> String
showsPrec :: Int -> XPrv -> ShowS
$cshowsPrec :: Int -> XPrv -> ShowS
Show)

-- | Obtain the 'XPub' corresponding to a particular 'XPrv', at a particular
-- 'Version'.
xprvToXPub :: Version -> XPrv -> XPub
xprvToXPub :: Version -> XPrv -> XPub
xprvToXPub v :: Version
v (XPrv _ d :: Depth
d f :: Fingerprint
f i :: Index
i c :: Chain
c prv :: Prv
prv) = Version -> Depth -> Fingerprint -> Index -> Chain -> Pub -> XPub
XPub Version
v Depth
d Fingerprint
f Index
i Chain
c (Prv -> Pub
K.prvToPub Prv
prv)

--------------------------------------------------------------------------------

-- | Extended private key.
data XPub = XPub
  { XPub -> Version
xpub_version     :: Version
  , XPub -> Depth
xpub_depth       :: Depth
  , XPub -> Fingerprint
xpub_fingerprint :: Fingerprint
  , XPub -> Index
xpub_index       :: Index
  , XPub -> Chain
xpub_chain       :: Chain
  , XPub -> Pub
xpub_pub         :: K.Pub
  } deriving (XPub -> XPub -> Bool
(XPub -> XPub -> Bool) -> (XPub -> XPub -> Bool) -> Eq XPub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPub -> XPub -> Bool
$c/= :: XPub -> XPub -> Bool
== :: XPub -> XPub -> Bool
$c== :: XPub -> XPub -> Bool
Eq, Int -> XPub -> ShowS
[XPub] -> ShowS
XPub -> String
(Int -> XPub -> ShowS)
-> (XPub -> String) -> ([XPub] -> ShowS) -> Show XPub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPub] -> ShowS
$cshowList :: [XPub] -> ShowS
show :: XPub -> String
$cshow :: XPub -> String
showsPrec :: Int -> XPub -> ShowS
$cshowsPrec :: Int -> XPub -> ShowS
Show)

--------------------------------------------------------------------------------

-- | The 33-byte serialized contents of either 'K.Pub' or 'K.Prv'.
newtype Key = Key B.ByteString

keyPub :: K.Pub -> Key
{-# INLINE keyPub #-}
keyPub :: Pub -> Key
keyPub = ByteString -> Key
Key (ByteString -> Key) -> (Pub -> ByteString) -> Pub -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pub -> ByteString
K.pubCompressed

keyPrv :: K.Prv -> Key
{-# INLINE keyPrv #-}
keyPrv :: Prv -> Key
keyPrv = ByteString -> Key
Key (ByteString -> Key) -> (Prv -> ByteString) -> Prv -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> ByteString
B.cons 0 (ByteString -> ByteString)
-> (Prv -> ByteString) -> Prv -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prv -> ByteString
K.prvRaw

--------------------------------------------------------------------------------

-- | Version bytes.
newtype Version = Version { Version -> Word32
unVersion :: Word32 }
  deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c== :: Version -> Version -> Bool
Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> String
(Int -> Version -> ShowS)
-> (Version -> String) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Version] -> ShowS
$cshowList :: [Version] -> ShowS
show :: Version -> String
$cshow :: Version -> String
showsPrec :: Int -> Version -> ShowS
$cshowsPrec :: Int -> Version -> ShowS
Show)

-- | @0x0488ade4@, “xprv”, Bitcoin mainnet private.
version_xprv :: Version
version_xprv :: Version
version_xprv = Word32 -> Version
Version 0x0488ade4
{-# INLINE version_xprv #-}

-- | @0x0488b21e@, “xpub”, Bitcoin mainnet public.
version_xpub :: Version
version_xpub :: Version
version_xpub = Word32 -> Version
Version 0x0488b21e
{-# INLINE version_xpub #-}

-- | @0x04358394@, “tprv”, Bitcoin testnet private.
version_tprv :: Version
version_tprv :: Version
version_tprv = Word32 -> Version
Version 0x04358394
{-# INLINE version_tprv #-}

-- | @0x043587cf@, “tpub”, Bitcoin testnet public.
version_tpub :: Version
version_tpub :: Version
version_tpub = Word32 -> Version
Version 0x043587cf
{-# INLINE version_tpub #-}

-- | @0x019d9cfe@, “Ltpv”, Litecoin mainnet private.
version_Ltpv :: Version
version_Ltpv :: Version
version_Ltpv = Word32 -> Version
Version 0x019d9cfe
{-# INLINE version_Ltpv #-}

-- | @0x019da462@, “Ltub”, Litecoin mainnet public.
version_Ltub :: Version
version_Ltub :: Version
version_Ltub = Word32 -> Version
Version 0x019da462
{-# INLINE version_Ltub #-}

-- | @0x0436ef7d@, “ttpv”, Litecoin testnet private.
version_ttpv :: Version
version_ttpv :: Version
version_ttpv = Word32 -> Version
Version 0x0436ef7d
{-# INLINE version_ttpv #-}

-- | @0x0436f6e1@, “ttub”, Litecoin testnet public.
version_ttub :: Version
version_ttub :: Version
version_ttub = Word32 -> Version
Version 0x0436f6e1
{-# INLINE version_ttub #-}

--------------------------------------------------------------------------------

-- | Derivation path depth.
--
-- * @0@ for master nodes — @m@
--
-- * @1@ for level-1 derived keys — @m\/0'@, or @m\/13@, or …
--
-- * @2@ for level-2 derived keys — @m\/0'\/28@, or @m\/44'/0'@, or …
--
-- * … up to @255@.
newtype Depth = Depth { Depth -> Word8
unDepth :: Word8 }
  deriving (Depth -> Depth -> Bool
(Depth -> Depth -> Bool) -> (Depth -> Depth -> Bool) -> Eq Depth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Depth -> Depth -> Bool
$c/= :: Depth -> Depth -> Bool
== :: Depth -> Depth -> Bool
$c== :: Depth -> Depth -> Bool
Eq, Int -> Depth -> ShowS
[Depth] -> ShowS
Depth -> String
(Int -> Depth -> ShowS)
-> (Depth -> String) -> ([Depth] -> ShowS) -> Show Depth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Depth] -> ShowS
$cshowList :: [Depth] -> ShowS
show :: Depth -> String
$cshow :: Depth -> String
showsPrec :: Int -> Depth -> ShowS
$cshowsPrec :: Int -> Depth -> ShowS
Show)

depthNext :: Depth -> Maybe Depth
{-# INLINE depthNext #-}
depthNext :: Depth -> Maybe Depth
depthNext (Depth w :: Word8
w) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= 0xFF)
  Depth -> Maybe Depth
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word8 -> Depth
Depth (Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ 1))

--------------------------------------------------------------------------------

-- | 4-byte fingerprint of a 'K.Pub' key.
newtype Fingerprint = Fingerprint { Fingerprint -> Word32
unFingerprint :: Word32 }
  deriving (Fingerprint -> Fingerprint -> Bool
(Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool) -> Eq Fingerprint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fingerprint -> Fingerprint -> Bool
$c/= :: Fingerprint -> Fingerprint -> Bool
== :: Fingerprint -> Fingerprint -> Bool
$c== :: Fingerprint -> Fingerprint -> Bool
Eq, Int -> Fingerprint -> ShowS
[Fingerprint] -> ShowS
Fingerprint -> String
(Int -> Fingerprint -> ShowS)
-> (Fingerprint -> String)
-> ([Fingerprint] -> ShowS)
-> Show Fingerprint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Fingerprint] -> ShowS
$cshowList :: [Fingerprint] -> ShowS
show :: Fingerprint -> String
$cshow :: Fingerprint -> String
showsPrec :: Int -> Fingerprint -> ShowS
$cshowsPrec :: Int -> Fingerprint -> ShowS
Show)

fingerprint :: K.Pub -> Fingerprint
{-# INLINE fingerprint #-}
fingerprint :: Pub -> Fingerprint
fingerprint = KeyId -> Fingerprint
fingerprint' (KeyId -> Fingerprint) -> (Pub -> KeyId) -> Pub -> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pub -> KeyId
keyId

fingerprint' :: KeyId -> Fingerprint
{-# INLINE fingerprint' #-}
fingerprint' :: KeyId -> Fingerprint
fingerprint' (KeyId x :: ByteString
x) =
  let b :: ByteString
b = Int -> ByteString -> ByteString
B.take 4 ByteString
x :: B.ByteString
  in Word32 -> Fingerprint
Fingerprint (Word32 -> Fingerprint) -> Word32 -> Fingerprint
forall a b. (a -> b) -> a -> b
$! Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.index ByteString
b 0)) 24 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                    Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.index ByteString
b 1)) 16 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                    Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.index ByteString
b 2))  8 Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
                                  Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
B.index ByteString
b 3)

--------------------------------------------------------------------------------

-- | 20-byte key identifier.
newtype KeyId = KeyId B.ByteString

keyId :: K.Pub -> KeyId
{-# INLINE keyId #-}
keyId :: Pub -> KeyId
keyId = ByteString -> KeyId
KeyId (ByteString -> KeyId) -> (Pub -> ByteString) -> Pub -> KeyId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
hash160 (ByteString -> ByteString)
-> (Pub -> ByteString) -> Pub -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pub -> ByteString
K.pubCompressed

--------------------------------------------------------------------------------

-- | Chain code.
--
-- Construct with 'chain'.
newtype Chain = Chain B.ByteString
  deriving (Chain -> Chain -> Bool
(Chain -> Chain -> Bool) -> (Chain -> Chain -> Bool) -> Eq Chain
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chain -> Chain -> Bool
$c/= :: Chain -> Chain -> Bool
== :: Chain -> Chain -> Bool
$c== :: Chain -> Chain -> Bool
Eq)

instance Show Chain where
  showsPrec :: Int -> Chain -> ShowS
showsPrec n :: Int
n (Chain b :: ByteString
b) = Bool -> ShowS -> ShowS
showParen (Int
n 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 "Chain " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (ByteString -> String
BL8.unpack (Builder -> ByteString
BB.toLazyByteString (ByteString -> Builder
BB.byteStringHex ByteString
b)))

-- | Construct a 'Chain' code.
--
-- See Bitcoin's [BIP-0032](https://github.com/bitcoin/bips/blob/master/bip-0032.mediawiki)
-- for details.
--
-- 'Nothing' if the 'B.ByteString' length is not 32.
chain :: B.ByteString -> Maybe Chain
{-# INLINE chain #-}
chain :: ByteString -> Maybe Chain
chain x :: ByteString
x = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
B.length ByteString
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 32)
  Chain -> Maybe Chain
forall a. a -> Maybe a
Just (ByteString -> Chain
Chain ByteString
x)

-- | Obtain the 32 raw bytes inside a 'Chain'.
unChain :: Chain -> B.ByteString
{-# INLINE unChain #-}
unChain :: Chain -> ByteString
unChain (Chain x :: ByteString
x) = ByteString
x

--------------------------------------------------------------------------------

-- | A derivation path 'Index'.
newtype Index = Index { Index -> Word32
unIndex :: Word32 }
  deriving (Index -> Index -> Bool
(Index -> Index -> Bool) -> (Index -> Index -> Bool) -> Eq Index
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c== :: Index -> Index -> Bool
Eq, Eq Index
Eq Index =>
(Index -> Index -> Ordering)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Index)
-> (Index -> Index -> Index)
-> Ord Index
Index -> Index -> Bool
Index -> Index -> Ordering
Index -> Index -> Index
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Index -> Index -> Index
$cmin :: Index -> Index -> Index
max :: Index -> Index -> Index
$cmax :: Index -> Index -> Index
>= :: Index -> Index -> Bool
$c>= :: Index -> Index -> Bool
> :: Index -> Index -> Bool
$c> :: Index -> Index -> Bool
<= :: Index -> Index -> Bool
$c<= :: Index -> Index -> Bool
< :: Index -> Index -> Bool
$c< :: Index -> Index -> Bool
compare :: Index -> Index -> Ordering
$ccompare :: Index -> Index -> Ordering
$cp1Ord :: Eq Index
Ord, Int -> Index -> ShowS
[Index] -> ShowS
Index -> String
(Int -> Index -> ShowS)
-> (Index -> String) -> ([Index] -> ShowS) -> Show Index
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Index] -> ShowS
$cshowList :: [Index] -> ShowS
show :: Index -> String
$cshow :: Index -> String
showsPrec :: Int -> Index -> ShowS
$cshowsPrec :: Int -> Index -> ShowS
Show)

-- | Whether a derivation path 'Index' is hardened. That is, \(2^{31}\) or
-- larger.
indexIsHardened :: Index -> Bool
{-# INLINE indexIsHardened #-}
indexIsHardened :: Index -> Bool
indexIsHardened (Index w :: Word32
w) = Word32
w Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= 0x80000000

-- | Increment the given 'Index' by one, but only if doing so would result in a
-- new 'Index' in the same index group (normal vs. hardened). Otherwise, returns
-- 'Nothing'.
indexNext :: Index -> Maybe Index
{-# INLINE indexNext #-}
indexNext :: Index -> Maybe Index
indexNext (Index w :: Word32
w) = case Word32
w of
  0xffffffff -> Maybe Index
forall a. Maybe a
Nothing -- Would be a normal to hardened transition
  0x7fffffff -> Maybe Index
forall a. Maybe a
Nothing -- Would be a hardened to normal transition
  _          -> Index -> Maybe Index
forall a. a -> Maybe a
Just (Word32 -> Index
Index (Word32
w Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ 1))

--------------------------------------------------------------------------------

-- | Derive a 'XPrv' subkey from a parent 'XPrv' key.
--
-- Returns 'Nothing' if the given inputs result in an invalid key.
subXPrvXPrv :: XPrv -> Index -> Maybe XPrv
subXPrvXPrv :: XPrv -> Index -> Maybe XPrv
subXPrvXPrv (XPrv v :: Version
v d0 :: Depth
d0 _ _ ch0 :: Chain
ch0 prv0 :: Prv
prv0) i1 :: Index
i1 = do
  Depth
d1 <- Depth -> Maybe Depth
depthNext Depth
d0
  (ch1 :: Chain
ch1, prv1 :: Prv
prv1) <- Chain -> Prv -> Index -> Maybe (Chain, Prv)
subPrvPrv Chain
ch0 Prv
prv0 Index
i1
  let f1 :: Fingerprint
f1 = Pub -> Fingerprint
fingerprint (Prv -> Pub
K.prvToPub Prv
prv0)
  XPrv -> Maybe XPrv
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrv -> Maybe XPrv) -> XPrv -> Maybe XPrv
forall a b. (a -> b) -> a -> b
$ Version -> Depth -> Fingerprint -> Index -> Chain -> Prv -> XPrv
XPrv Version
v Depth
d1 Fingerprint
f1 Index
i1 Chain
ch1 Prv
prv1

-- | Derive a 'XPub' subkey from a parent 'XPub' key.
--
-- The given 'Index' is expected to /not/ be hardened.
--
-- Returns 'Nothing' if the given inputs result in an invalid key.
subXPubXPub :: XPub -> Index -> Maybe XPub
subXPubXPub :: XPub -> Index -> Maybe XPub
subXPubXPub (XPub v :: Version
v d0 :: Depth
d0 _ _ ch0 :: Chain
ch0 pub0 :: Pub
pub0) i1 :: Index
i1 = do
  Depth
d1 <- Depth -> Maybe Depth
depthNext Depth
d0
  (ch1 :: Chain
ch1, pub1 :: Pub
pub1) <- Chain -> Pub -> Index -> Maybe (Chain, Pub)
subPubPub Chain
ch0 Pub
pub0 Index
i1
  let f1 :: Fingerprint
f1 = Pub -> Fingerprint
fingerprint Pub
pub0
  XPub -> Maybe XPub
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPub -> Maybe XPub) -> XPub -> Maybe XPub
forall a b. (a -> b) -> a -> b
$ Version -> Depth -> Fingerprint -> Index -> Chain -> Pub -> XPub
XPub Version
v Depth
d1 Fingerprint
f1 Index
i1 Chain
ch1 Pub
pub1

-- | Derive 'XPub' subkey from a parent 'XPrv' key.
--
-- Notice that while @'subXPubXPub' ('xprvToXPub' v) xprv i@ will fail with a
-- hardened 'Index', @'subXPrvXPub' v xprv i@ may succeed.
--
-- Returns 'Nothing' if the given inputs result in an invalid key.
subXPrvXPub :: Version -> XPrv -> Index -> Maybe XPub
subXPrvXPub :: Version -> XPrv -> Index -> Maybe XPub
subXPrvXPub v :: Version
v xprv :: XPrv
xprv i1 :: Index
i1 = Version -> XPrv -> XPub
xprvToXPub Version
v (XPrv -> XPub) -> Maybe XPrv -> Maybe XPub
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPrv -> Index -> Maybe XPrv
subXPrvXPrv XPrv
xprv Index
i1

--------------------------------------------------------------------------------

-- | Behaves exactly like 'subXPrvXPrv', but deals with 'Chain' and
-- 'K.Prv', rather than an 'XPrv'.
subPrvPrv :: Chain -> K.Prv -> Index -> Maybe (Chain, K.Prv)
subPrvPrv :: Chain -> Prv -> Index -> Maybe (Chain, Prv)
subPrvPrv (Chain ch0 :: ByteString
ch0) prv0 :: Prv
prv0 i1 :: Index
i1@(Index i1w :: Word32
i1w) = do
  let pub0 :: Pub
pub0 = Prv -> Pub
K.prvToPub Prv
prv0
      x :: ByteString
x = ByteString -> ByteString -> ByteString
hmacSHA512 ByteString
ch0 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ if Index -> Bool
indexIsHardened Index
i1
            then [Word8 -> ByteString
B.singleton 0, Prv -> ByteString
K.prvRaw Prv
prv0, Word32 -> ByteString
word32BE Word32
i1w]
            else [Pub -> ByteString
K.pubCompressed Pub
pub0, Word32 -> ByteString
word32BE Word32
i1w]
      (xl :: ByteString
xl, xr :: ByteString
xr) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt 32 ByteString
x
  Prv
prv1 <- (Tweak -> Prv -> Maybe Prv) -> Prv -> Tweak -> Maybe Prv
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tweak -> Prv -> Maybe Prv
K.prvAddTweak Prv
prv0 (Tweak -> Maybe Prv) -> Maybe Tweak -> Maybe Prv
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Maybe Tweak
K.parseTweak ByteString
xl
  Chain
ch1 <- ByteString -> Maybe Chain
chain ByteString
xr
  (Chain, Prv) -> Maybe (Chain, Prv)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chain
ch1, Prv
prv1)

-- | Behaves exactly like 'subXPubXPub', but deals with 'Chain' and
-- 'K.Pub', rather than an 'XPub'.
subPubPub :: Chain -> K.Pub -> Index -> Maybe (Chain, K.Pub)
subPubPub :: Chain -> Pub -> Index -> Maybe (Chain, Pub)
subPubPub (Chain ch0 :: ByteString
ch0) pub0 :: Pub
pub0 i1 :: Index
i1@(Index i1w :: Word32
i1w) = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Index -> Bool
indexIsHardened Index
i1))
  let x :: ByteString
x = ByteString -> ByteString -> ByteString
hmacSHA512 ByteString
ch0 (Pub -> ByteString
K.pubCompressed Pub
pub0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word32 -> ByteString
word32BE Word32
i1w)
      (xl :: ByteString
xl, xr :: ByteString
xr) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt 32 ByteString
x
  Pub
pub1 <- (Tweak -> Pub -> Maybe Pub) -> Pub -> Tweak -> Maybe Pub
forall a b c. (a -> b -> c) -> b -> a -> c
flip Tweak -> Pub -> Maybe Pub
K.pubAddTweak Pub
pub0 (Tweak -> Maybe Pub) -> Maybe Tweak -> Maybe Pub
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Maybe Tweak
K.parseTweak ByteString
xl
  Chain
ch1 <- ByteString -> Maybe Chain
chain ByteString
xr
  (Chain, Pub) -> Maybe (Chain, Pub)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Chain
ch1, Pub
pub1)

-- | Behaves exactly like 'subXPrvXPub', but deals with 'Chain', 'K.Prv' and
-- 'K.Pub', rather than an 'XPrv' and 'XPub'.
subPrvPub :: Chain -> K.Prv -> Index -> Maybe (Chain, K.Pub)
subPrvPub :: Chain -> Prv -> Index -> Maybe (Chain, Pub)
subPrvPub ch0 :: Chain
ch0 prv0 :: Prv
prv0 i1 :: Index
i1 = (Prv -> Pub) -> (Chain, Prv) -> (Chain, Pub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prv -> Pub
K.prvToPub ((Chain, Prv) -> (Chain, Pub))
-> Maybe (Chain, Prv) -> Maybe (Chain, Pub)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Chain -> Prv -> Index -> Maybe (Chain, Prv)
subPrvPrv Chain
ch0 Prv
prv0 Index
i1

--------------------------------------------------------------------------------

-- | Lazily derive all the child 'XPrv' subkeys from a parent's 'XPrv'.
--
-- The first child returned is the one at the given 'Index', if any, and the
-- subsequent childs are those immediately after it (see 'indexNext').
--
-- The returned 'Index'es are not necessarily consecutive, since not all
-- 'XPrv' and 'Index' combinations are able to derive valid keys.
-- However, the produced 'Index'es do increase monotonically.
--
-- If the given 'Index' is hardened, then all produced children will have
-- hardened 'Index'es too. If the given 'Index' is normal, then all children
-- will have normal 'Index'es too. That is, this function will never produce
-- children with 'Index'es belonging to another group (normal vs. hardened).
subsXPrvXPrv :: XPrv -> Index -> [XPrv]
subsXPrvXPrv :: XPrv -> Index -> [XPrv]
subsXPrvXPrv (XPrv v :: Version
v d0 :: Depth
d0 _ _ ch0 :: Chain
ch0 prv0 :: Prv
prv0) i :: Index
i = do
  Depth
d1 <- Maybe Depth -> [Depth]
forall a. Maybe a -> [a]
maybeToList (Maybe Depth -> [Depth]) -> Maybe Depth -> [Depth]
forall a b. (a -> b) -> a -> b
$ Depth -> Maybe Depth
depthNext Depth
d0
  let f1 :: Fingerprint
f1 = Pub -> Fingerprint
fingerprint (Prv -> Pub
K.prvToPub Prv
prv0)
  (i1 :: Index
i1, ch1 :: Chain
ch1, prv1 :: Prv
prv1) <- Chain -> Prv -> Index -> [(Index, Chain, Prv)]
subsPrvPrv Chain
ch0 Prv
prv0 Index
i
  XPrv -> [XPrv]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPrv -> [XPrv]) -> XPrv -> [XPrv]
forall a b. (a -> b) -> a -> b
$ Version -> Depth -> Fingerprint -> Index -> Chain -> Prv -> XPrv
XPrv Version
v Depth
d1 Fingerprint
f1 Index
i1 Chain
ch1 Prv
prv1

-- | Lazily derive all the 'XPub' subkeys from a parent's 'XPub'.
--
-- The first child returned is the one at the given 'Index', if any, and the
-- subsequent childs are those immediately after it (see 'indexNext').
--
-- The returned 'Index'es are not necessarily consecutive, since not all
-- 'XPub' and 'Index' combinations are able to derive valid keys.
-- However, the produced 'Index'es do increase monotonically.
--
-- The produced list will never include a hardened 'Index'. If a hardened
-- 'Index' is provided as input, the produced list will be empty.
subsXPubXPub :: XPub -> Index -> [XPub]
subsXPubXPub :: XPub -> Index -> [XPub]
subsXPubXPub (XPub v :: Version
v d0 :: Depth
d0 _ _ ch0 :: Chain
ch0 pub0 :: Pub
pub0) i :: Index
i = do
  Depth
d1 <- Maybe Depth -> [Depth]
forall a. Maybe a -> [a]
maybeToList (Maybe Depth -> [Depth]) -> Maybe Depth -> [Depth]
forall a b. (a -> b) -> a -> b
$ Depth -> Maybe Depth
depthNext Depth
d0
  let f1 :: Fingerprint
f1 = Pub -> Fingerprint
fingerprint Pub
pub0
  (i1 :: Index
i1, ch1 :: Chain
ch1, pub1 :: Pub
pub1) <- Chain -> Pub -> Index -> [(Index, Chain, Pub)]
subsPubPub Chain
ch0 Pub
pub0 Index
i
  XPub -> [XPub]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (XPub -> [XPub]) -> XPub -> [XPub]
forall a b. (a -> b) -> a -> b
$ Version -> Depth -> Fingerprint -> Index -> Chain -> Pub -> XPub
XPub Version
v Depth
d1 Fingerprint
f1 Index
i1 Chain
ch1 Pub
pub1

-- | Lazily derive all the 'XPub' subkeys from a parent 'XPrv' key.
--
-- The first child returned is the one at the given 'Index', if any, and the
-- subsequent childs are those immediately after it (see 'indexNext').
--
-- The returned 'Index'es are not necessarily consecutive, since not all
-- 'XPrv' and 'Index' combinations are able to derive valid keys.
-- However, the produced 'Index'es do increase monotonically.
--
-- If the given 'Index' is hardened, then all produced children will have
-- hardened 'Index'es too. If the given 'Index' is normal, then all children
-- will have normal 'Index'es too. That is, this function will never produce
-- children with 'Index'es belonging to another group (normal vs. hardened).
--
-- /Notice/ that while @'subsXPubXPub' ('xprvToXPub' v) xprv i@ will fail with a
-- hardened 'Index', @'subsXPrvXPub' v xprv i@ may succeed.
subsXPrvXPub :: Version -> XPrv -> Index -> [XPub]
subsXPrvXPub :: Version -> XPrv -> Index -> [XPub]
subsXPrvXPub v :: Version
v xprv :: XPrv
xprv i1 :: Index
i1 = Version -> XPrv -> XPub
xprvToXPub Version
v (XPrv -> XPub) -> [XPrv] -> [XPub]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XPrv -> Index -> [XPrv]
subsXPrvXPrv XPrv
xprv Index
i1

----------------------------------------------------------------------------------

-- | Behaves exactly like 'subsXPrvXPrv', but deals with 'Chain' and
-- 'K.Prv', rather than an 'XPrv'.
subsPrvPrv :: Chain -> K.Prv -> Index -> [(Index, Chain, K.Prv)]
subsPrvPrv :: Chain -> Prv -> Index -> [(Index, Chain, Prv)]
subsPrvPrv ch0 :: Chain
ch0 prv0 :: Prv
prv0 = Index -> [(Index, Chain, Prv)]
go
  where
    go :: Index -> [(Index, Chain, K.Prv)]
    go :: Index -> [(Index, Chain, Prv)]
go i :: Index
i = let rest :: [(Index, Chain, Prv)]
rest = [(Index, Chain, Prv)]
-> (Index -> [(Index, Chain, Prv)])
-> Maybe Index
-> [(Index, Chain, Prv)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Index -> [(Index, Chain, Prv)]
go (Index -> Maybe Index
indexNext Index
i)
           in case Chain -> Prv -> Index -> Maybe (Chain, Prv)
subPrvPrv Chain
ch0 Prv
prv0 Index
i of
                Just (ch1 :: Chain
ch1, prv1 :: Prv
prv1) -> (Index
i, Chain
ch1, Prv
prv1) (Index, Chain, Prv)
-> [(Index, Chain, Prv)] -> [(Index, Chain, Prv)]
forall a. a -> [a] -> [a]
: [(Index, Chain, Prv)]
rest
                Nothing          -> [(Index, Chain, Prv)]
rest

-- | Behaves exactly like 'subsXPubXPub', but deals with 'Chain' and
-- 'K.Pub', rather than an 'XPub'.
subsPubPub :: Chain -> K.Pub -> Index -> [(Index, Chain, K.Pub)]
subsPubPub :: Chain -> Pub -> Index -> [(Index, Chain, Pub)]
subsPubPub ch0 :: Chain
ch0 pub0 :: Pub
pub0 i0 :: Index
i0
  | Index -> Bool
indexIsHardened Index
i0 = []
  | Bool
otherwise          = Index -> [(Index, Chain, Pub)]
go Index
i0
  where
    go :: Index -> [(Index, Chain, K.Pub)]
    go :: Index -> [(Index, Chain, Pub)]
go i :: Index
i = let rest :: [(Index, Chain, Pub)]
rest = [(Index, Chain, Pub)]
-> (Index -> [(Index, Chain, Pub)])
-> Maybe Index
-> [(Index, Chain, Pub)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Index -> [(Index, Chain, Pub)]
go (Index -> Maybe Index
indexNext Index
i)
           in case Chain -> Pub -> Index -> Maybe (Chain, Pub)
subPubPub Chain
ch0 Pub
pub0 Index
i of
                Just (ch1 :: Chain
ch1, pub1 :: Pub
pub1) -> (Index
i, Chain
ch1, Pub
pub1) (Index, Chain, Pub)
-> [(Index, Chain, Pub)] -> [(Index, Chain, Pub)]
forall a. a -> [a] -> [a]
: [(Index, Chain, Pub)]
rest
                Nothing          -> [(Index, Chain, Pub)]
rest

-- | Behaves exactly like 'subsXPrvXPub', but deals with 'Chain', 'K.Prv' and
-- 'K.Pub', rather than an 'XPrv' and 'XPub'.
subsPrvPub :: Chain -> K.Prv-> Index -> [(Index, Chain, K.Pub)]
subsPrvPub :: Chain -> Prv -> Index -> [(Index, Chain, Pub)]
subsPrvPub ch0 :: Chain
ch0 prv0 :: Prv
prv0 i0 :: Index
i0 = do
  (i1 :: Index
i1, ch1 :: Chain
ch1, prv1 :: Prv
prv1) <- Chain -> Prv -> Index -> [(Index, Chain, Prv)]
subsPrvPrv Chain
ch0 Prv
prv0 Index
i0
  (Index, Chain, Pub) -> [(Index, Chain, Pub)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Index
i1, Chain
ch1, Prv -> Pub
K.prvToPub Prv
prv1)

--------------------------------------------------------------------------------

-- | Obtain the Base58 representation for an 'XPub'.
--
-- It can be either 111 or 112 bytes in length, and when rendered as ASCII it
-- looks something like this:
--
-- @
-- xpub661MyMwAqRbcFtXgS5sYJABqqG9YLmC4Q1Rdap9gSE8NqtwybGhePY2gZ29ESFjqJoCu1Rupje8YtGqsefD265TMg7usUDFdp6W1EGMcet8
-- @
encodeXPub :: XPub -> B.ByteString
{-# INLINE encodeXPub #-}
encodeXPub :: XPub -> ByteString
encodeXPub a :: XPub
a = ByteString -> ByteString
base58EncodeWithChecksum (XPub -> ByteString
encodeXPubRaw XPub
a)

-- | Obtain the Base58 representation for an 'XPrv'.
--
-- It can be either 111 or 112 bytes in length, and when rendered as ASCII it
-- looks something like this:
--
-- @
-- xprv9s21ZrQH143K3QTDL4LXw2F7HEK3wJUD2nW2nRk4stbPy6cq3jPPqjiChkVvvNKmPGJxWUtg6LnF5kejMRNNU3TGtRBeJgk33yuGBxrMPHi
-- @
encodeXPrv :: XPrv -> B.ByteString
{-# INLINE encodeXPrv #-}
encodeXPrv :: XPrv -> ByteString
encodeXPrv a :: XPrv
a = ByteString -> ByteString
base58EncodeWithChecksum (XPrv -> ByteString
encodeXPrvRaw XPrv
a)

base58EncodeWithChecksum :: B.ByteString -> B.ByteString
{-# INLINE base58EncodeWithChecksum #-}
base58EncodeWithChecksum :: ByteString -> ByteString
base58EncodeWithChecksum a :: ByteString
a =
  Alphabet -> ByteString -> ByteString
B58.encodeBase58 Alphabet
B58.bitcoinAlphabet (ByteString
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
check32 ByteString
a)

--------------------------------------------------------------------------------

-- | Encode the 78 raw 'XPub' bytes.
encodeXPubRaw :: XPub -> B.ByteString
{-# INLINE encodeXPubRaw #-}
encodeXPubRaw :: XPub -> ByteString
encodeXPubRaw (XPub v :: Version
v d :: Depth
d f :: Fingerprint
f i :: Index
i c :: Chain
c p :: Pub
p) = Version
-> Depth -> Fingerprint -> Index -> Chain -> Key -> ByteString
encodeRaw Version
v Depth
d Fingerprint
f Index
i Chain
c (Pub -> Key
keyPub Pub
p)

-- | Encode the 78 raw 'XPrv' bytes.
encodeXPrvRaw :: XPrv -> B.ByteString
{-# INLINE encodeXPrvRaw #-}
encodeXPrvRaw :: XPrv -> ByteString
encodeXPrvRaw (XPrv v :: Version
v d :: Depth
d f :: Fingerprint
f i :: Index
i c :: Chain
c p :: Prv
p) = Version
-> Depth -> Fingerprint -> Index -> Chain -> Key -> ByteString
encodeRaw Version
v Depth
d Fingerprint
f Index
i Chain
c (Prv -> Key
keyPrv Prv
p)

-- | Encode the 78 raw extended key bytes.
encodeRaw
  :: Version -> Depth -> Fingerprint -> Index -> Chain -> Key -> B.ByteString
encodeRaw :: Version
-> Depth -> Fingerprint -> Index -> Chain -> Key -> ByteString
encodeRaw (Version v :: Word32
v) (Depth d :: Word8
d) (Fingerprint f :: Word32
f) (Index i :: Word32
i) (Chain c :: ByteString
c) (Key k :: ByteString
k) =
  ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
    Word32 -> Builder
BB.word32BE Word32
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Word8 -> Builder
BB.word8 Word8
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Word32 -> Builder
BB.word32BE Word32
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Word32 -> Builder
BB.word32BE Word32
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> Builder
BB.byteString ByteString
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    ByteString -> Builder
BB.byteString ByteString
k

--------------------------------------------------------------------------------

-- | Decode the Base58-encoded 'XPub' representation. See 'encodeXPub'.
decodeXPub :: B.ByteString -> Maybe XPub
{-# INLINE decodeXPub #-}
decodeXPub :: ByteString -> Maybe XPub
decodeXPub = ByteString -> Maybe XPub
decodeXPubRaw (ByteString -> Maybe XPub)
-> (ByteString -> Maybe ByteString) -> ByteString -> Maybe XPub
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe ByteString
base58DecodeWithChecksum

-- | Decode the Base58-encoded 'XPrv' representation. See 'encodeXPrv'.
decodeXPrv :: B.ByteString -> Maybe XPrv
{-# INLINE decodeXPrv #-}
decodeXPrv :: ByteString -> Maybe XPrv
decodeXPrv = ByteString -> Maybe XPrv
decodeXPrvRaw (ByteString -> Maybe XPrv)
-> (ByteString -> Maybe ByteString) -> ByteString -> Maybe XPrv
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe ByteString
base58DecodeWithChecksum

-- | Decode the Base58-encoded representation of either and 'XPub' or an 'XPub'.
decode :: B.ByteString -> Maybe (Either XPub XPrv)
{-# INLINE decode #-}
decode :: ByteString -> Maybe (Either XPub XPrv)
decode = ByteString -> Maybe (Either XPub XPrv)
decodeRaw (ByteString -> Maybe (Either XPub XPrv))
-> (ByteString -> Maybe ByteString)
-> ByteString
-> Maybe (Either XPub XPrv)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe ByteString
base58DecodeWithChecksum

base58DecodeWithChecksum :: B.ByteString -> Maybe B.ByteString
{-# INLINE base58DecodeWithChecksum #-}
base58DecodeWithChecksum :: ByteString -> Maybe ByteString
base58DecodeWithChecksum = \a :: ByteString
a -> do
  ByteString
b <- Alphabet -> ByteString -> Maybe ByteString
B58.decodeBase58 Alphabet
B58.bitcoinAlphabet ByteString
a
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
B.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 78 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 4)
  let (raw :: ByteString
raw, ch :: ByteString
ch) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt 78 ByteString
b
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString
ch ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
check32 ByteString
raw)
  ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
raw

--------------------------------------------------------------------------------

-- | Decode the 78 raw 'XPub' bytes.
decodeXPubRaw :: B.ByteString -> Maybe XPub
{-# INLINE decodeXPubRaw #-}
decodeXPubRaw :: ByteString -> Maybe XPub
decodeXPubRaw = (XPub -> Maybe XPub)
-> (XPrv -> Maybe XPub) -> Either XPub XPrv -> Maybe XPub
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either XPub -> Maybe XPub
forall a. a -> Maybe a
Just (\_ -> Maybe XPub
forall a. Maybe a
Nothing) (Either XPub XPrv -> Maybe XPub)
-> (ByteString -> Maybe (Either XPub XPrv))
-> ByteString
-> Maybe XPub
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe (Either XPub XPrv)
decodeRaw

-- | Decode the 78 raw 'XPrv' bytes.
decodeXPrvRaw :: B.ByteString -> Maybe XPrv
{-# INLINE decodeXPrvRaw #-}
decodeXPrvRaw :: ByteString -> Maybe XPrv
decodeXPrvRaw = (XPub -> Maybe XPrv)
-> (XPrv -> Maybe XPrv) -> Either XPub XPrv -> Maybe XPrv
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\_ -> Maybe XPrv
forall a. Maybe a
Nothing) XPrv -> Maybe XPrv
forall a. a -> Maybe a
Just (Either XPub XPrv -> Maybe XPrv)
-> (ByteString -> Maybe (Either XPub XPrv))
-> ByteString
-> Maybe XPrv
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe (Either XPub XPrv)
decodeRaw

-- | Encode the 78 raw 'XPub' or 'XPrv' bytes.
decodeRaw :: B.ByteString -> Maybe (Either XPub XPrv)
decodeRaw :: ByteString -> Maybe (Either XPub XPrv)
decodeRaw = \b :: ByteString
b -> do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ByteString -> Int
B.length ByteString
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 78)
  case Get (Either XPub XPrv)
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, Either XPub XPrv)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Bin.runGetOrFail Get (Either XPub XPrv)
getX (ByteString -> ByteString
BL.fromStrict ByteString
b) of
    Right (lo :: ByteString
lo, 78, ex :: Either XPub XPrv
ex) | ByteString -> Bool
BL.null ByteString
lo -> Either XPub XPrv -> Maybe (Either XPub XPrv)
forall a. a -> Maybe a
Just Either XPub XPrv
ex
    _ -> Maybe (Either XPub XPrv)
forall a. Maybe a
Nothing

getX :: Bin.Get (Either XPub XPrv)
getX :: Get (Either XPub XPrv)
getX = do
  Version
v <- Word32 -> Version
Version (Word32 -> Version) -> Get Word32 -> Get Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Bin.getWord32be
  Depth
d <- Word8 -> Depth
Depth (Word8 -> Depth) -> Get Word8 -> Get Depth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
Bin.getWord8
  Fingerprint
f <- Word32 -> Fingerprint
Fingerprint (Word32 -> Fingerprint) -> Get Word32 -> Get Fingerprint
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Bin.getWord32be
  Index
i <- Word32 -> Index
Index (Word32 -> Index) -> Get Word32 -> Get Index
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
Bin.getWord32be
  Chain
c <- ByteString -> Chain
Chain (ByteString -> Chain) -> Get ByteString -> Get Chain
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
Bin.getByteString 32
  Either Pub Prv
ek <- (Pub -> Either Pub Prv) -> Get Pub -> Get (Either Pub Prv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pub -> Either Pub Prv
forall a b. a -> Either a b
Left Get Pub
getPub Get (Either Pub Prv)
-> Get (Either Pub Prv) -> Get (Either Pub Prv)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Prv -> Either Pub Prv) -> Get Prv -> Get (Either Pub Prv)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prv -> Either Pub Prv
forall a b. b -> Either a b
Right Get Prv
getPrv
  Either XPub XPrv -> Get (Either XPub XPrv)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either XPub XPrv -> Get (Either XPub XPrv))
-> Either XPub XPrv -> Get (Either XPub XPrv)
forall a b. (a -> b) -> a -> b
$ case Either Pub Prv
ek of
    Left  k :: Pub
k -> XPub -> Either XPub XPrv
forall a b. a -> Either a b
Left  (Version -> Depth -> Fingerprint -> Index -> Chain -> Pub -> XPub
XPub Version
v Depth
d Fingerprint
f Index
i Chain
c Pub
k)
    Right k :: Prv
k -> XPrv -> Either XPub XPrv
forall a b. b -> Either a b
Right (Version -> Depth -> Fingerprint -> Index -> Chain -> Prv -> XPrv
XPrv Version
v Depth
d Fingerprint
f Index
i Chain
c Prv
k)

getPrv :: Bin.Get K.Prv
getPrv :: Get Prv
getPrv = do
  Word8
0 <- Get Word8
Bin.getWord8
  ByteString
a <- Int -> Get ByteString
Bin.getByteString 32
  case ByteString -> Maybe Prv
K.parsePrv ByteString
a of
    Just b :: Prv
b -> Prv -> Get Prv
forall (f :: * -> *) a. Applicative f => a -> f a
pure Prv
b
    Nothing -> String -> Get Prv
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Bad private key"

getPub :: Bin.Get K.Pub
getPub :: Get Pub
getPub = do
  ByteString
a <- Int -> Get ByteString
Bin.getByteString 33
  case ByteString -> Maybe Pub
K.parsePub ByteString
a of
    Just b :: Pub
b -> Pub -> Get Pub
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pub
b
    Nothing -> String -> Get Pub
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Bad public key"

--------------------------------------------------------------------------------

word32BE :: Word32 -> B.ByteString -- ^ 4 bytes.
{-# INLINE word32BE #-}
word32BE :: Word32 -> ByteString
word32BE = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Word32 -> ByteString) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Word32 -> Builder) -> Word32 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Builder
BB.word32BE