commit 22d85c57b6174e31d98b0016dd942bea7edabf41
parent 5c34038ac1fc4a2f5cfdeb4b38c62c2d657caff6
Author: Jared Tobin <jared@jtobin.io>
Date: Mon, 17 Feb 2025 09:52:11 +0400
lib: skeleton
Diffstat:
4 files changed, 200 insertions(+), 5 deletions(-)
diff --git a/.gitignore b/.gitignore
@@ -0,0 +1 @@
+dist-newstyle/
diff --git a/flake.lock b/flake.lock
@@ -185,11 +185,11 @@
]
},
"locked": {
- "lastModified": 1737570265,
- "narHash": "sha256-yQD42hLD2H56Xv9AJxtClDZmjVkuMC1nEbsb4vJYeCc=",
+ "lastModified": 1739709462,
+ "narHash": "sha256-bgdKy8Cx67DeNxIANAxFnelovj2LP4opaprkWp5KwA4=",
"ref": "master",
- "rev": "2d95f50b098af1b5ca1fa321eed86b0e7c7780b5",
- "revCount": 136,
+ "rev": "0c075b2ca6b95f98924fa76b278402f089e33f71",
+ "revCount": 138,
"type": "git",
"url": "git://git.ppad.tech/secp256k1.git"
},
diff --git a/lib/Crypto/HDKey/BIP32.hs b/lib/Crypto/HDKey/BIP32.hs
@@ -1,5 +1,199 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BinaryLiterals #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+
module Crypto.HDKey.BIP32 where
+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.Bits as B
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base58 as B58
+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 = fromIntegral
+{-# INLINE fi #-}
+
+-- big-endian bytestring encoding
+unroll :: Integer -> BS.ByteString
+unroll i = case i of
+ 0 -> BS.singleton 0
+ _ -> BS.reverse $ BS.unfoldr step i
+ where
+ step 0 = Nothing
+ step m = Just (fi m, m .>>. 8)
+
+-- parse 32 bytes to a 256-bit integer
+parse256 :: BS.ByteString -> Maybe Integer
+parse256 bs@(BI.PS _ _ l)
+ | l == 32 = pure $! (BS.foldl' alg 0 bs)
+ | otherwise = Nothing
+ where
+ alg !a (fi -> !b) = (a .<<. 8) .|. 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 (unroll -> u@(BI.PS _ _ l))
+ | l < 32 = BS.replicate (32 - l) 0 <> u
+ | otherwise = u
+
+-- serialize a 32-bit word, MSB first
+ser32 :: Word32 -> BS.ByteString
+ser32 w =
+ let !mask = 0b00000000_00000000_00000000_11111111
+ !w0 = fi (w .>>. 24) .&. mask
+ !w1 = fi (w .>>. 16) .&. mask
+ !w2 = fi (w .>>. 08) .&. mask
+ !w3 = fi w .&. mask
+ in BS.cons w0 (BS.cons w1 (BS.cons w2 (BS.singleton w3))) -- XX
+
+-- extended keys --------------------------------------------------------------
+
+data X a = X !a !BS.ByteString
+ deriving (Eq, Show)
+
+newtype XPub = XPub (X Secp256k1.Projective)
+ deriving (Eq, Show)
+
+newtype XPrv = XPrv (X Integer)
+ deriving (Eq, Show)
+
+class Extended k where
+ identifier :: k -> BS.ByteString
+
+ fingerprint :: k -> BS.ByteString
+ fingerprint = BS.take 32 . identifier
+
+instance Extended XPub where
+ identifier (XPub (X pub _)) =
+ let ser = Secp256k1.serialize_point pub
+ in RIPEMD160.hash (SHA256.hash ser)
+
+instance Extended XPrv where
+ identifier (XPrv (X sec _)) =
+ let p = Secp256k1.mul Secp256k1._CURVE_G sec
+ ser = Secp256k1.serialize_point p
+ in RIPEMD160.hash (SHA256.hash ser)
+
+-- key derivation functions ---------------------------------------------------
+
+hardened :: Word32 -> Bool
+hardened = (>= 0x8000_0000)
+
+_master :: BS.ByteString -> Maybe XPrv
+_master seed@(BI.PS _ _ l)
+ | l < 16 = Nothing
+ | l > 64 = Nothing
+ | otherwise = do
+ let i = SHA512.hmac "Bitcoin seed" seed
+ (il, c) = BS.splitAt 32 i
+ s <- parse256 il
+ pure $! (XPrv (X s c))
+
+-- private parent key -> private child key
+ckd_priv :: XPrv -> Word32 -> Maybe XPrv
+ckd_priv xprv@(XPrv (X sec cod)) i = do
+ let l = SHA512.hmac cod dat
+ (il, ci) = BS.splitAt 32 l
+ pil <- parse256 il
+ let ki = Secp256k1.modQ (pil + sec)
+ if pil >= Secp256k1._CURVE_Q || ki == 0 -- negligible probability
+ then ckd_priv xprv (succ i)
+ else pure $! XPrv (X ki ci)
+ where
+ dat | hardened i = BS.singleton 0x00 <> ser256 sec <> ser32 i
+ | otherwise =
+ let p = Secp256k1.mul Secp256k1._CURVE_G sec
+ in Secp256k1.serialize_point p <> ser32 i
+
+-- public parent key -> public child key
+ckd_pub :: XPub -> Word32 -> Maybe XPub
+ckd_pub xpub@(XPub (X pub cod)) i
+ | hardened i = Nothing
+ | otherwise = do
+ let dat = Secp256k1.serialize_point pub <> ser32 i
+ l = SHA512.hmac cod dat
+ (il, ci) = BS.splitAt 32 l
+ pil <- parse256 il
+ let ki = Secp256k1.mul Secp256k1._CURVE_G pil `Secp256k1.add` pub
+ if pil >= Secp256k1._CURVE_Q || ki == Secp256k1._CURVE_ZERO
+ then ckd_pub xpub (succ i)
+ else pure (XPub (X ki ci))
+
+-- private parent key -> public child key
+n :: XPrv -> XPub
+n (XPrv (X sec cod)) =
+ let p = Secp256k1.mul Secp256k1._CURVE_G sec
+ in XPub (X p cod)
+
+-- wallets --------------------------------------------------------------------
+
+data ExtendedKey = ExtendedKey {
+ ek_pair :: !(Either XPub XPrv)
+ , ek_depth :: !Word8
+ , ek_parent :: !(Maybe BS.ByteString) -- parent fingerprint
+ , ek_child :: !Word32
+ }
+
+serialize_mainnet :: ExtendedKey -> BS.ByteString
+serialize_mainnet x@ExtendedKey {..} =
+ let pay = BS.toStrict . BSB.toLazyByteString $ case ek_pair of
+ Left _ -> _serialize _MAINNET_PUBLIC x
+ Right _ -> _serialize _MAINNET_PRIVATE x
+ kek = BS.take 4 (SHA256.hash (SHA256.hash pay))
+ in B58.encode (pay <> kek)
+ where
+ _MAINNET_PUBLIC = 0x0488B21E
+ _MAINNET_PRIVATE = 0x0488ADE4
+
+serialize_testnet :: ExtendedKey -> BS.ByteString
+serialize_testnet x@ExtendedKey {..} =
+ let pay = BS.toStrict . BSB.toLazyByteString $ case ek_pair of
+ Left _ -> _serialize _TESTNET_PUBLIC x
+ Right _ -> _serialize _TESTNET_PRIVATE x
+ kek = BS.take 4 (SHA256.hash (SHA256.hash pay))
+ in B58.encode (pay <> kek)
+ where
+ _TESTNET_PUBLIC = 0x043587CF
+ _TESTNET_PRIVATE = 0x04358394
+
+_serialize :: Word32 -> ExtendedKey -> BSB.Builder
+_serialize version ExtendedKey {..} =
+ BSB.word32BE version
+ <> BSB.word8 ek_depth
+ <> case ek_parent of
+ Nothing -> BSB.word32BE 0x0000_0000
+ Just k -> BSB.byteString k
+ <> BSB.word32BE ek_child
+ <> case ek_pair of
+ Left (XPub (X pub cod)) ->
+ BSB.byteString cod
+ <> BSB.byteString (Secp256k1.serialize_point pub)
+ Right (XPrv (X sec cod)) ->
+ BSB.byteString cod
+ <> BSB.word8 0x00
+ <> BSB.byteString (ser256 sec)
+master :: BS.ByteString -> Maybe ExtendedKey
+master seed = do
+ m <- _master seed
+ pure $! ExtendedKey {
+ ek_pair = Right m
+ , ek_depth = 0
+ , ek_parent = Nothing
+ , ek_child = 0
+ }
diff --git a/ppad-bip32.cabal b/ppad-bip32.cabal
@@ -29,7 +29,7 @@ library
, bytestring >= 0.9 && < 0.13
, ppad-base58
, ppad-ripemd160
- , ppad-secp256k1
+ , ppad-secp256k1 >= 0.2.2 && < 0.3
, ppad-sha256
, ppad-sha512
