commit 6f3327fe2856fded5511e8f8db21a44361d4c8c5
parent 421a8f1fdcb26858af29340431bd6c8a22bce76d
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 25 Jan 2026 15:24:27 +0400
merge: impl1 cryptographic primitives
Diffstat:
6 files changed, 832 insertions(+), 51 deletions(-)
diff --git a/flake.lock b/flake.lock
@@ -0,0 +1,424 @@
+{
+ "nodes": {
+ "flake-utils": {
+ "inputs": {
+ "systems": "systems"
+ },
+ "locked": {
+ "lastModified": 1731533236,
+ "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
+ "type": "github"
+ },
+ "original": {
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "type": "github"
+ }
+ },
+ "nixpkgs": {
+ "locked": {
+ "lastModified": 1766840161,
+ "narHash": "sha256-Ss/LHpJJsng8vz1Pe33RSGIWUOcqM1fjrehjUkdrWio=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "3edc4a30ed3903fdf6f90c837f961fa6b49582d1",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "ref": "nixpkgs-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "ppad-base16": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1768109471,
+ "narHash": "sha256-92oKD2q3sm7wV0lysOTSALjvFOy8couvEt6Q/Kziyc4=",
+ "path": "/Users/jtobin/src/ppad/base16",
+ "type": "path"
+ },
+ "original": {
+ "path": "/Users/jtobin/src/ppad/base16",
+ "type": "path"
+ }
+ },
+ "ppad-base16_2": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-chacha",
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-chacha",
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-chacha",
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1766934151,
+ "narHash": "sha256-BUFpuLfrGXE2xi3Wa9TYCEhhRhFp175Ghxnr0JRbG2I=",
+ "ref": "master",
+ "rev": "58dfb7922401a60d5de76825fcd5f6ecbcd7afe0",
+ "revCount": 26,
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ }
+ },
+ "ppad-base16_3": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-secp256k1",
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-secp256k1",
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-secp256k1",
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1766934151,
+ "narHash": "sha256-BUFpuLfrGXE2xi3Wa9TYCEhhRhFp175Ghxnr0JRbG2I=",
+ "ref": "master",
+ "rev": "58dfb7922401a60d5de76825fcd5f6ecbcd7afe0",
+ "revCount": 26,
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ }
+ },
+ "ppad-base16_4": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-sha256",
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-sha256",
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-sha256",
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1766934151,
+ "narHash": "sha256-BUFpuLfrGXE2xi3Wa9TYCEhhRhFp175Ghxnr0JRbG2I=",
+ "ref": "master",
+ "rev": "58dfb7922401a60d5de76825fcd5f6ecbcd7afe0",
+ "revCount": 26,
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ }
+ },
+ "ppad-chacha": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-chacha",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-chacha",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-base16": "ppad-base16_2",
+ "ppad-nixpkgs": [
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1766957050,
+ "narHash": "sha256-q/0TK1DwvAcEhtM4UySJ55AwdTR6hxkF38NRm/D85ug=",
+ "path": "/Users/jtobin/src/ppad/chacha",
+ "type": "path"
+ },
+ "original": {
+ "path": "/Users/jtobin/src/ppad/chacha",
+ "type": "path"
+ }
+ },
+ "ppad-fixed": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-secp256k1",
+ "ppad-fixed",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-secp256k1",
+ "ppad-fixed",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-secp256k1",
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1767278248,
+ "narHash": "sha256-ynF6Tyew83dDr3dFWdTdgK3N5WEkLSCQ/uHHTxb5J1s=",
+ "ref": "master",
+ "rev": "ae6f5d732d69e6e2bb70ea9da18e2a8060ca9aeb",
+ "revCount": 290,
+ "type": "git",
+ "url": "git://git.ppad.tech/fixed.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/fixed.git"
+ }
+ },
+ "ppad-hmac-drbg": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-secp256k1",
+ "ppad-hmac-drbg",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-secp256k1",
+ "ppad-hmac-drbg",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-base16": [
+ "ppad-secp256k1",
+ "ppad-base16"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-secp256k1",
+ "ppad-nixpkgs"
+ ],
+ "ppad-sha256": [
+ "ppad-secp256k1",
+ "ppad-sha256"
+ ],
+ "ppad-sha512": [
+ "ppad-secp256k1",
+ "ppad-sha512"
+ ]
+ },
+ "locked": {
+ "lastModified": 1768057958,
+ "narHash": "sha256-Csrv+J0WnGankFhvEMQsHnLd3h8zVpmTKV5WaHD5LoM=",
+ "owner": "ppad-tech",
+ "repo": "hmac-drbg",
+ "rev": "c6487458ef620c4f83bdbc7494f5f48c989133b6",
+ "type": "github"
+ },
+ "original": {
+ "owner": "ppad-tech",
+ "repo": "hmac-drbg",
+ "type": "github"
+ }
+ },
+ "ppad-nixpkgs": {
+ "inputs": {
+ "flake-utils": "flake-utils",
+ "nixpkgs": "nixpkgs"
+ },
+ "locked": {
+ "lastModified": 1766932228,
+ "narHash": "sha256-2n//FLwATkcCl68QokSqWKTcuYgEavUNe30YeUtWoo8=",
+ "path": "/Users/jtobin/src/ppad/nixpkgs",
+ "type": "path"
+ },
+ "original": {
+ "path": "/Users/jtobin/src/ppad/nixpkgs",
+ "type": "path"
+ }
+ },
+ "ppad-secp256k1": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-secp256k1",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-secp256k1",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-base16": "ppad-base16_3",
+ "ppad-fixed": "ppad-fixed",
+ "ppad-hmac-drbg": "ppad-hmac-drbg",
+ "ppad-nixpkgs": [
+ "ppad-nixpkgs"
+ ],
+ "ppad-sha256": [
+ "ppad-sha256"
+ ],
+ "ppad-sha512": "ppad-sha512"
+ },
+ "locked": {
+ "lastModified": 1768116040,
+ "narHash": "sha256-YoYNcaqL9xRJNHlh5nmkhvuR2KWsLCL5crpt3RNPaWc=",
+ "path": "/Users/jtobin/src/ppad/secp256k1",
+ "type": "path"
+ },
+ "original": {
+ "path": "/Users/jtobin/src/ppad/secp256k1",
+ "type": "path"
+ }
+ },
+ "ppad-sha256": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-sha256",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-sha256",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-base16": "ppad-base16_4",
+ "ppad-nixpkgs": [
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1769322968,
+ "narHash": "sha256-KPDjM3GzQj63xSm23ZD9o6rMuKZs6+2BJxnwIpvkIaA=",
+ "path": "/Users/jtobin/src/ppad/sha256",
+ "type": "path"
+ },
+ "original": {
+ "path": "/Users/jtobin/src/ppad/sha256",
+ "type": "path"
+ }
+ },
+ "ppad-sha512": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-secp256k1",
+ "ppad-sha512",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-secp256k1",
+ "ppad-sha512",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-base16": [
+ "ppad-secp256k1",
+ "ppad-base16"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-secp256k1",
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1768045869,
+ "narHash": "sha256-ySqv5fQRz+/9X54yXCuck2QnGyuIqRLpRzanh+Ehl88=",
+ "ref": "master",
+ "rev": "0fbaba3c091692622744d30016e36ca6b726a819",
+ "revCount": 42,
+ "type": "git",
+ "url": "git://git.ppad.tech/sha512.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/sha512.git"
+ }
+ },
+ "root": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-base16": "ppad-base16",
+ "ppad-chacha": "ppad-chacha",
+ "ppad-nixpkgs": "ppad-nixpkgs",
+ "ppad-secp256k1": "ppad-secp256k1",
+ "ppad-sha256": "ppad-sha256"
+ }
+ },
+ "systems": {
+ "locked": {
+ "lastModified": 1681028828,
+ "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+ "owner": "nix-systems",
+ "repo": "default",
+ "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+ "type": "github"
+ },
+ "original": {
+ "owner": "nix-systems",
+ "repo": "default",
+ "type": "github"
+ }
+ }
+ },
+ "root": "root",
+ "version": 7
+}
diff --git a/flake.nix b/flake.nix
@@ -2,49 +2,27 @@
description = "A Haskell implementation of BOLT4 (onion routing).";
inputs = {
- ppad-base16 = {
- type = "git";
- url = "git://git.ppad.tech/base16.git";
- ref = "master";
- inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
- };
- ppad-chacha = {
- type = "git";
- url = "git://git.ppad.tech/chacha.git";
- ref = "master";
- inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
- };
- ppad-hmac-sha256 = {
- type = "git";
- url = "git://git.ppad.tech/hmac-sha256.git";
- ref = "master";
- inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
- inputs.ppad-sha256.follows = "ppad-sha256";
- };
- ppad-secp256k1 = {
- type = "git";
- url = "git://git.ppad.tech/secp256k1.git";
- ref = "master";
- inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
- inputs.ppad-sha256.follows = "ppad-sha256";
- };
- ppad-sha256 = {
- type = "git";
- url = "git://git.ppad.tech/sha256.git";
- ref = "master";
- inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
- };
- ppad-nixpkgs = {
- type = "git";
- url = "git://git.ppad.tech/nixpkgs.git";
- ref = "master";
- };
+ ppad-base16.url = "path:/Users/jtobin/src/ppad/base16";
+ ppad-base16.inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
+
+ ppad-chacha.url = "path:/Users/jtobin/src/ppad/chacha";
+ ppad-chacha.inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
+
+ ppad-secp256k1.url = "path:/Users/jtobin/src/ppad/secp256k1";
+ ppad-secp256k1.inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
+ ppad-secp256k1.inputs.ppad-sha256.follows = "ppad-sha256";
+
+ ppad-sha256.url = "path:/Users/jtobin/src/ppad/sha256";
+ ppad-sha256.inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
+
+ ppad-nixpkgs.url = "path:/Users/jtobin/src/ppad/nixpkgs";
+
flake-utils.follows = "ppad-nixpkgs/flake-utils";
nixpkgs.follows = "ppad-nixpkgs/nixpkgs";
};
outputs = { self, nixpkgs, flake-utils, ppad-nixpkgs
- , ppad-base16, ppad-chacha, ppad-hmac-sha256
+ , ppad-base16, ppad-chacha
, ppad-secp256k1, ppad-sha256
}:
flake-utils.lib.eachDefaultSystem (system:
@@ -68,12 +46,6 @@
(hlib.enableCabalFlag chacha "llvm")
[ llvm clang ];
- hmac-sha256 = ppad-hmac-sha256.packages.${system}.default;
- hmac-sha256-llvm =
- hlib.addBuildTools
- (hlib.enableCabalFlag hmac-sha256 "llvm")
- [ llvm clang ];
-
secp256k1 = ppad-secp256k1.packages.${system}.default;
secp256k1-llvm =
hlib.addBuildTools
@@ -89,13 +61,11 @@
hpkgs = pkgs.haskell.packages.ghc910.extend (new: old: {
ppad-base16 = base16-llvm;
ppad-chacha = chacha-llvm;
- ppad-hmac-sha256 = hmac-sha256-llvm;
ppad-secp256k1 = secp256k1-llvm;
ppad-sha256 = sha256-llvm;
${lib} = new.callCabal2nix lib ./. {
ppad-base16 = new.ppad-base16;
ppad-chacha = new.ppad-chacha;
- ppad-hmac-sha256 = new.ppad-hmac-sha256;
ppad-secp256k1 = new.ppad-secp256k1;
ppad-sha256 = new.ppad-sha256;
};
diff --git a/lib/Lightning/Protocol/BOLT4/Prim.hs b/lib/Lightning/Protocol/BOLT4/Prim.hs
@@ -0,0 +1,239 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module: Lightning.Protocol.BOLT4.Prim
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Low-level cryptographic primitives for BOLT4 onion routing.
+
+module Lightning.Protocol.BOLT4.Prim (
+ -- * Types
+ SharedSecret(..)
+ , DerivedKey(..)
+ , BlindingFactor(..)
+
+ -- * Key derivation
+ , deriveRho
+ , deriveMu
+ , deriveUm
+ , derivePad
+ , deriveAmmag
+
+ -- * Shared secret computation
+ , computeSharedSecret
+
+ -- * Blinding factor computation
+ , computeBlindingFactor
+
+ -- * Key blinding
+ , blindPubKey
+ , blindSecKey
+
+ -- * Stream generation
+ , generateStream
+
+ -- * HMAC operations
+ , computeHmac
+ , verifyHmac
+ ) where
+
+import qualified Crypto.Cipher.ChaCha20 as ChaCha
+import qualified Crypto.Curve.Secp256k1 as Secp256k1
+import qualified Crypto.Hash.SHA256 as SHA256
+import Data.Bits (xor)
+import qualified Data.ByteString as BS
+import qualified Data.List as L
+import Data.Word (Word8, Word32)
+
+-- | 32-byte shared secret derived from ECDH.
+newtype SharedSecret = SharedSecret BS.ByteString
+ deriving (Eq, Show)
+
+-- | 32-byte derived key (rho, mu, um, pad, ammag).
+newtype DerivedKey = DerivedKey BS.ByteString
+ deriving (Eq, Show)
+
+-- | 32-byte blinding factor for ephemeral key updates.
+newtype BlindingFactor = BlindingFactor BS.ByteString
+ deriving (Eq, Show)
+
+-- Key derivation ------------------------------------------------------------
+
+-- | Derive rho key for obfuscation stream generation.
+--
+-- @rho = HMAC-SHA256(key="rho", data=shared_secret)@
+deriveRho :: SharedSecret -> DerivedKey
+deriveRho = deriveKey "rho"
+{-# INLINE deriveRho #-}
+
+-- | Derive mu key for HMAC computation.
+--
+-- @mu = HMAC-SHA256(key="mu", data=shared_secret)@
+deriveMu :: SharedSecret -> DerivedKey
+deriveMu = deriveKey "mu"
+{-# INLINE deriveMu #-}
+
+-- | Derive um key for return error HMAC.
+--
+-- @um = HMAC-SHA256(key="um", data=shared_secret)@
+deriveUm :: SharedSecret -> DerivedKey
+deriveUm = deriveKey "um"
+{-# INLINE deriveUm #-}
+
+-- | Derive pad key for filler generation.
+--
+-- @pad = HMAC-SHA256(key="pad", data=shared_secret)@
+derivePad :: SharedSecret -> DerivedKey
+derivePad = deriveKey "pad"
+{-# INLINE derivePad #-}
+
+-- | Derive ammag key for error obfuscation.
+--
+-- @ammag = HMAC-SHA256(key="ammag", data=shared_secret)@
+deriveAmmag :: SharedSecret -> DerivedKey
+deriveAmmag = deriveKey "ammag"
+{-# INLINE deriveAmmag #-}
+
+-- Internal helper for key derivation.
+deriveKey :: BS.ByteString -> SharedSecret -> DerivedKey
+deriveKey !keyType (SharedSecret !ss) =
+ let SHA256.MAC !result = SHA256.hmac keyType ss
+ in DerivedKey result
+{-# INLINE deriveKey #-}
+
+-- Shared secret computation -------------------------------------------------
+
+-- | Compute shared secret from ECDH.
+--
+-- Takes a 32-byte secret key and a public key.
+-- Returns SHA256 of the compressed ECDH point (33 bytes).
+computeSharedSecret
+ :: BS.ByteString -- ^ 32-byte secret key
+ -> Secp256k1.Projective -- ^ public key
+ -> Maybe SharedSecret
+computeSharedSecret !secBs !pub = do
+ sec <- Secp256k1.roll32 secBs
+ ecdhPoint <- Secp256k1.mul pub sec
+ let !compressed = Secp256k1.serialize_point ecdhPoint
+ !ss = SHA256.hash compressed
+ pure $! SharedSecret ss
+{-# INLINE computeSharedSecret #-}
+
+-- Blinding factor -----------------------------------------------------------
+
+-- | Compute blinding factor for ephemeral key updates.
+--
+-- @blinding_factor = SHA256(ephemeral_pubkey || shared_secret)@
+computeBlindingFactor
+ :: Secp256k1.Projective -- ^ ephemeral public key
+ -> SharedSecret -- ^ shared secret
+ -> BlindingFactor
+computeBlindingFactor !pub (SharedSecret !ss) =
+ let !pubBytes = Secp256k1.serialize_point pub
+ !combined = pubBytes <> ss
+ !hashed = SHA256.hash combined
+ in BlindingFactor hashed
+{-# INLINE computeBlindingFactor #-}
+
+-- Key blinding --------------------------------------------------------------
+
+-- | Blind a public key by multiplying with blinding factor.
+--
+-- @new_pubkey = pubkey * blinding_factor@
+blindPubKey
+ :: Secp256k1.Projective
+ -> BlindingFactor
+ -> Maybe Secp256k1.Projective
+blindPubKey !pub (BlindingFactor !bf) = do
+ sk <- Secp256k1.roll32 bf
+ Secp256k1.mul pub sk
+{-# INLINE blindPubKey #-}
+
+-- | Blind a secret key by multiplying with blinding factor (mod curve order).
+--
+-- @new_seckey = seckey * blinding_factor (mod q)@
+--
+-- Takes a 32-byte secret key and returns a 32-byte blinded secret key.
+blindSecKey
+ :: BS.ByteString -- ^ 32-byte secret key
+ -> BlindingFactor -- ^ blinding factor
+ -> Maybe BS.ByteString -- ^ 32-byte blinded secret key
+blindSecKey !secBs (BlindingFactor !bf)
+ | BS.length secBs /= 32 = Nothing
+ | BS.length bf /= 32 = Nothing
+ | otherwise =
+ -- Convert to Integer, multiply, reduce mod q, convert back
+ let !secInt = bsToInteger secBs
+ !bfInt = bsToInteger bf
+ -- secp256k1 curve order
+ !qInt = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEBAAEDCE6AF48A03BBFD25E8CD0364141
+ !resultInt = (secInt * bfInt) `mod` qInt
+ !resultBs = integerToBS32 resultInt
+ in Just resultBs
+{-# INLINE blindSecKey #-}
+
+-- Convert big-endian ByteString to Integer.
+bsToInteger :: BS.ByteString -> Integer
+bsToInteger = BS.foldl' (\acc b -> acc * 256 + fromIntegral b) 0
+{-# INLINE bsToInteger #-}
+
+-- Convert Integer to 32-byte big-endian ByteString.
+integerToBS32 :: Integer -> BS.ByteString
+integerToBS32 n = BS.pack (go 32 n [])
+ where
+ go :: Int -> Integer -> [Word8] -> [Word8]
+ go 0 _ acc = acc
+ go i x acc = go (i - 1) (x `div` 256) (fromIntegral (x `mod` 256) : acc)
+{-# INLINE integerToBS32 #-}
+
+-- Stream generation ---------------------------------------------------------
+
+-- | Generate pseudo-random byte stream using ChaCha20.
+--
+-- Uses derived key as ChaCha20 key, 96-bit zero nonce, counter=0.
+-- Encrypts zeros to produce keystream.
+generateStream
+ :: DerivedKey -- ^ rho or ammag key
+ -> Int -- ^ desired length
+ -> BS.ByteString
+generateStream (DerivedKey !key) !len =
+ let !nonce = BS.replicate 12 0
+ !zeros = BS.replicate len 0
+ in either (const (BS.replicate len 0)) id
+ (ChaCha.cipher key (0 :: Word32) nonce zeros)
+{-# INLINE generateStream #-}
+
+-- HMAC operations -----------------------------------------------------------
+
+-- | Compute HMAC-SHA256 for packet integrity.
+computeHmac
+ :: DerivedKey -- ^ mu key
+ -> BS.ByteString -- ^ hop_payloads
+ -> BS.ByteString -- ^ associated_data
+ -> BS.ByteString -- ^ 32-byte HMAC
+computeHmac (DerivedKey !key) !payloads !assocData =
+ let SHA256.MAC !result = SHA256.hmac key (payloads <> assocData)
+ in result
+{-# INLINE computeHmac #-}
+
+-- | Constant-time HMAC comparison.
+verifyHmac
+ :: BS.ByteString -- ^ expected
+ -> BS.ByteString -- ^ computed
+ -> Bool
+verifyHmac !expected !computed
+ | BS.length expected /= BS.length computed = False
+ | otherwise = constantTimeEq expected computed
+{-# INLINE verifyHmac #-}
+
+-- Constant-time equality comparison.
+constantTimeEq :: BS.ByteString -> BS.ByteString -> Bool
+constantTimeEq !a !b =
+ let !diff = L.foldl' (\acc (x, y) -> acc `xor` (x `xor` y)) (0 :: Word8)
+ (BS.zip a b)
+ in diff == 0
+{-# INLINE constantTimeEq #-}
diff --git a/plans/IMPL1.md b/plans/IMPL1.md
@@ -143,7 +143,7 @@ From BOLT4 spec, using session key 0x4141...41 (32 bytes of 0x41):
```
hop 0 pubkey: 02eec7245d6b7d2ccb30380bfbe2a3648cd7a942653f5aa340edcea1f283686619
hop 0 shared secret: 53eb63ea8a3fec3b3cd433b85cd62a4b145e1dda09391b348c4e1cd36a03ea66
-hop 0 blinding factor: 2ec2e5da605776054187180c226f3738...
+hop 0 blinding factor: 2ec2e5da605776054187180343287683aa6a51b4...
```
Verify shared secret and blinding factor computations match spec.
diff --git a/ppad-bolt4.cabal b/ppad-bolt4.cabal
@@ -25,13 +25,13 @@ library
exposed-modules:
Lightning.Protocol.BOLT4
Lightning.Protocol.BOLT4.Codec
+ Lightning.Protocol.BOLT4.Prim
Lightning.Protocol.BOLT4.Types
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
- , ppad-chacha >= 0.1 && < 0.2
- , ppad-hmac-sha256 >= 0.1 && < 0.2
- , ppad-secp256k1 >= 0.3 && < 0.6
+ , ppad-chacha >= 0.2 && < 0.3
+ , ppad-secp256k1 >= 0.5 && < 0.6
, ppad-sha256 >= 0.3 && < 0.4
test-suite bolt4-tests
@@ -46,6 +46,7 @@ test-suite bolt4-tests
, bytestring
, ppad-base16
, ppad-bolt4
+ , ppad-secp256k1
, tasty
, tasty-hunit
, tasty-quickcheck
diff --git a/test/Main.hs b/test/Main.hs
@@ -3,7 +3,10 @@
module Main where
import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as B16
+import qualified Crypto.Curve.Secp256k1 as Secp256k1
import Lightning.Protocol.BOLT4.Codec
+import Lightning.Protocol.BOLT4.Prim
import Lightning.Protocol.BOLT4.Types
import Test.Tasty
import Test.Tasty.HUnit
@@ -11,7 +14,10 @@ import Test.Tasty.QuickCheck
main :: IO ()
main = defaultMain $ testGroup "ppad-bolt4" [
- testGroup "BigSize" [
+ testGroup "Prim" [
+ primTests
+ ]
+ , testGroup "BigSize" [
bigsizeTests
, bigsizeRoundtripProp
]
@@ -174,3 +180,144 @@ onionPacketTests = testGroup "encoding/decoding" [
let decoded = decodeOnionPacket (BS.replicate 1000 0x00)
decoded @?= Nothing
]
+
+-- Prim tests -----------------------------------------------------------------
+
+-- BOLT4 spec test vectors using session key 0x4141...41 (32 bytes of 0x41).
+sessionKey :: BS.ByteString
+sessionKey = BS.replicate 32 0x41
+
+hop0PubKeyHex :: BS.ByteString
+hop0PubKeyHex =
+ "02eec7245d6b7d2ccb30380bfbe2a3648cd7a942653f5aa340edcea1f283686619"
+
+hop0SharedSecretHex :: BS.ByteString
+hop0SharedSecretHex =
+ "53eb63ea8a3fec3b3cd433b85cd62a4b145e1dda09391b348c4e1cd36a03ea66"
+
+hop0BlindingFactorHex :: BS.ByteString
+hop0BlindingFactorHex =
+ "2ec2e5da605776054187180343287683aa6a51b4b1c04d6dd49c45d8cffb3c36"
+
+-- Parse hex helper
+fromHex :: BS.ByteString -> BS.ByteString
+fromHex h = case B16.decode h of
+ Just bs -> bs
+ Nothing -> error "fromHex: invalid hex"
+
+primTests :: TestTree
+primTests = testGroup "cryptographic primitives" [
+ testSharedSecret
+ , testBlindingFactor
+ , testKeyDerivation
+ , testBlindPubKey
+ , testGenerateStream
+ , testHmacOperations
+ ]
+
+testSharedSecret :: TestTree
+testSharedSecret = testCase "computeSharedSecret (BOLT4 spec hop 0)" $ do
+ let Just pubKey = Secp256k1.parse_point (fromHex hop0PubKeyHex)
+ case computeSharedSecret sessionKey pubKey of
+ Nothing -> assertFailure "computeSharedSecret returned Nothing"
+ Just (SharedSecret computed) -> do
+ let expected = fromHex hop0SharedSecretHex
+ computed @?= expected
+
+testBlindingFactor :: TestTree
+testBlindingFactor = testCase "computeBlindingFactor (BOLT4 spec hop 0)" $ do
+ let Just sk = Secp256k1.roll32 sessionKey
+ Just ephemPubKey = Secp256k1.derive_pub sk
+ Just nodePubKey = Secp256k1.parse_point (fromHex hop0PubKeyHex)
+ case computeSharedSecret sessionKey nodePubKey of
+ Nothing -> assertFailure "computeSharedSecret returned Nothing"
+ Just sharedSecret -> do
+ let BlindingFactor computed =
+ computeBlindingFactor ephemPubKey sharedSecret
+ expected = fromHex hop0BlindingFactorHex
+ computed @?= expected
+
+testKeyDerivation :: TestTree
+testKeyDerivation = testGroup "key derivation" [
+ testCase "deriveRho produces 32 bytes" $ do
+ let ss = SharedSecret (BS.replicate 32 0)
+ DerivedKey rho = deriveRho ss
+ BS.length rho @?= 32
+ , testCase "deriveMu produces 32 bytes" $ do
+ let ss = SharedSecret (BS.replicate 32 0)
+ DerivedKey mu = deriveMu ss
+ BS.length mu @?= 32
+ , testCase "deriveUm produces 32 bytes" $ do
+ let ss = SharedSecret (BS.replicate 32 0)
+ DerivedKey um = deriveUm ss
+ BS.length um @?= 32
+ , testCase "derivePad produces 32 bytes" $ do
+ let ss = SharedSecret (BS.replicate 32 0)
+ DerivedKey pad = derivePad ss
+ BS.length pad @?= 32
+ , testCase "deriveAmmag produces 32 bytes" $ do
+ let ss = SharedSecret (BS.replicate 32 0)
+ DerivedKey ammag = deriveAmmag ss
+ BS.length ammag @?= 32
+ , testCase "different key types produce different results" $ do
+ let ss = SharedSecret (BS.replicate 32 0x42)
+ DerivedKey rho = deriveRho ss
+ DerivedKey mu = deriveMu ss
+ DerivedKey um = deriveUm ss
+ assertBool "rho /= mu" (rho /= mu)
+ assertBool "mu /= um" (mu /= um)
+ assertBool "rho /= um" (rho /= um)
+ ]
+
+testBlindPubKey :: TestTree
+testBlindPubKey = testGroup "key blinding" [
+ testCase "blindPubKey produces valid key" $ do
+ let Just sk = Secp256k1.roll32 sessionKey
+ Just pubKey = Secp256k1.derive_pub sk
+ bf = BlindingFactor (fromHex hop0BlindingFactorHex)
+ case blindPubKey pubKey bf of
+ Nothing -> assertFailure "blindPubKey returned Nothing"
+ Just _blinded -> return ()
+ , testCase "blindSecKey produces valid key" $ do
+ let bf = BlindingFactor (fromHex hop0BlindingFactorHex)
+ case blindSecKey sessionKey bf of
+ Nothing -> assertFailure "blindSecKey returned Nothing"
+ Just _blinded -> return ()
+ ]
+
+testGenerateStream :: TestTree
+testGenerateStream = testGroup "generateStream" [
+ testCase "produces correct length" $ do
+ let dk = DerivedKey (BS.replicate 32 0)
+ stream = generateStream dk 100
+ BS.length stream @?= 100
+ , testCase "1300-byte stream for hop_payloads" $ do
+ let dk = DerivedKey (BS.replicate 32 0x42)
+ stream = generateStream dk 1300
+ BS.length stream @?= 1300
+ , testCase "deterministic output" $ do
+ let dk = DerivedKey (BS.replicate 32 0x55)
+ stream1 = generateStream dk 64
+ stream2 = generateStream dk 64
+ stream1 @?= stream2
+ ]
+
+testHmacOperations :: TestTree
+testHmacOperations = testGroup "HMAC operations" [
+ testCase "computeHmac produces 32 bytes" $ do
+ let dk = DerivedKey (BS.replicate 32 0)
+ hmac = computeHmac dk "payloads" "assocdata"
+ BS.length hmac @?= 32
+ , testCase "verifyHmac succeeds for matching" $ do
+ let dk = DerivedKey (BS.replicate 32 0)
+ hmac = computeHmac dk "payloads" "assocdata"
+ assertBool "verifyHmac should succeed" (verifyHmac hmac hmac)
+ , testCase "verifyHmac fails for different" $ do
+ let dk = DerivedKey (BS.replicate 32 0)
+ hmac1 = computeHmac dk "payloads1" "assocdata"
+ hmac2 = computeHmac dk "payloads2" "assocdata"
+ assertBool "verifyHmac should fail" (not $ verifyHmac hmac1 hmac2)
+ , testCase "verifyHmac fails for different lengths" $ do
+ assertBool "verifyHmac should fail"
+ (not $ verifyHmac "short" "different length")
+ ]
