Prim.hs (6880B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE OverloadedStrings #-} 4 5 -- | 6 -- Module: Lightning.Protocol.BOLT4.Prim 7 -- Copyright: (c) 2025 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Low-level cryptographic primitives for BOLT4 onion routing. 12 13 module Lightning.Protocol.BOLT4.Prim ( 14 -- * Types 15 SharedSecret(..) 16 , DerivedKey(..) 17 , BlindingFactor(..) 18 19 -- * Key derivation 20 , deriveRho 21 , deriveMu 22 , deriveUm 23 , derivePad 24 , deriveAmmag 25 26 -- * Shared secret computation 27 , computeSharedSecret 28 29 -- * Blinding factor computation 30 , computeBlindingFactor 31 32 -- * Key blinding 33 , blindPubKey 34 , blindSecKey 35 36 -- * Stream generation 37 , generateStream 38 39 -- * HMAC operations 40 , computeHmac 41 , verifyHmac 42 ) where 43 44 import qualified Crypto.Cipher.ChaCha20 as ChaCha 45 import qualified Crypto.Curve.Secp256k1 as Secp256k1 46 import qualified Crypto.Hash.SHA256 as SHA256 47 import Data.Bits (xor) 48 import qualified Data.ByteString as BS 49 import qualified Data.List as L 50 import Data.Word (Word8, Word32) 51 import qualified Numeric.Montgomery.Secp256k1.Scalar as S 52 53 -- | 32-byte shared secret derived from ECDH. 54 newtype SharedSecret = SharedSecret BS.ByteString 55 deriving (Eq, Show) 56 57 -- | 32-byte derived key (rho, mu, um, pad, ammag). 58 newtype DerivedKey = DerivedKey BS.ByteString 59 deriving (Eq, Show) 60 61 -- | 32-byte blinding factor for ephemeral key updates. 62 newtype BlindingFactor = BlindingFactor BS.ByteString 63 deriving (Eq, Show) 64 65 -- Key derivation ------------------------------------------------------------ 66 67 -- | Derive rho key for obfuscation stream generation. 68 -- 69 -- @rho = HMAC-SHA256(key="rho", data=shared_secret)@ 70 deriveRho :: SharedSecret -> DerivedKey 71 deriveRho = deriveKey "rho" 72 {-# INLINE deriveRho #-} 73 74 -- | Derive mu key for HMAC computation. 75 -- 76 -- @mu = HMAC-SHA256(key="mu", data=shared_secret)@ 77 deriveMu :: SharedSecret -> DerivedKey 78 deriveMu = deriveKey "mu" 79 {-# INLINE deriveMu #-} 80 81 -- | Derive um key for return error HMAC. 82 -- 83 -- @um = HMAC-SHA256(key="um", data=shared_secret)@ 84 deriveUm :: SharedSecret -> DerivedKey 85 deriveUm = deriveKey "um" 86 {-# INLINE deriveUm #-} 87 88 -- | Derive pad key for filler generation. 89 -- 90 -- @pad = HMAC-SHA256(key="pad", data=shared_secret)@ 91 derivePad :: SharedSecret -> DerivedKey 92 derivePad = deriveKey "pad" 93 {-# INLINE derivePad #-} 94 95 -- | Derive ammag key for error obfuscation. 96 -- 97 -- @ammag = HMAC-SHA256(key="ammag", data=shared_secret)@ 98 deriveAmmag :: SharedSecret -> DerivedKey 99 deriveAmmag = deriveKey "ammag" 100 {-# INLINE deriveAmmag #-} 101 102 -- Internal helper for key derivation. 103 deriveKey :: BS.ByteString -> SharedSecret -> DerivedKey 104 deriveKey !keyType (SharedSecret !ss) = 105 let SHA256.MAC !result = SHA256.hmac keyType ss 106 in DerivedKey result 107 {-# INLINE deriveKey #-} 108 109 -- Shared secret computation ------------------------------------------------- 110 111 -- | Compute shared secret from ECDH. 112 -- 113 -- Takes a 32-byte secret key and a public key. 114 -- Returns SHA256 of the compressed ECDH point (33 bytes). 115 computeSharedSecret 116 :: BS.ByteString -- ^ 32-byte secret key 117 -> Secp256k1.Projective -- ^ public key 118 -> Maybe SharedSecret 119 computeSharedSecret !secBs !pub = do 120 sec <- Secp256k1.roll32 secBs 121 ecdhPoint <- Secp256k1.mul pub sec 122 let !compressed = Secp256k1.serialize_point ecdhPoint 123 !ss = SHA256.hash compressed 124 pure $! SharedSecret ss 125 {-# INLINE computeSharedSecret #-} 126 127 -- Blinding factor ----------------------------------------------------------- 128 129 -- | Compute blinding factor for ephemeral key updates. 130 -- 131 -- @blinding_factor = SHA256(ephemeral_pubkey || shared_secret)@ 132 computeBlindingFactor 133 :: Secp256k1.Projective -- ^ ephemeral public key 134 -> SharedSecret -- ^ shared secret 135 -> BlindingFactor 136 computeBlindingFactor !pub (SharedSecret !ss) = 137 let !pubBytes = Secp256k1.serialize_point pub 138 !combined = pubBytes <> ss 139 !hashed = SHA256.hash combined 140 in BlindingFactor hashed 141 {-# INLINE computeBlindingFactor #-} 142 143 -- Key blinding -------------------------------------------------------------- 144 145 -- | Blind a public key by multiplying with blinding factor. 146 -- 147 -- @new_pubkey = pubkey * blinding_factor@ 148 blindPubKey 149 :: Secp256k1.Projective 150 -> BlindingFactor 151 -> Maybe Secp256k1.Projective 152 blindPubKey !pub (BlindingFactor !bf) = do 153 sk <- Secp256k1.roll32 bf 154 Secp256k1.mul pub sk 155 {-# INLINE blindPubKey #-} 156 157 -- | Blind a secret key by multiplying with blinding factor (mod curve order). 158 -- 159 -- @new_seckey = seckey * blinding_factor (mod q)@ 160 -- 161 -- Uses Montgomery multiplication from ppad-fixed for efficiency. 162 -- Takes a 32-byte secret key and returns a 32-byte blinded secret key. 163 blindSecKey 164 :: BS.ByteString -- ^ 32-byte secret key 165 -> BlindingFactor -- ^ blinding factor 166 -> Maybe BS.ByteString -- ^ 32-byte blinded secret key 167 blindSecKey !secBs (BlindingFactor !bf) 168 | BS.length secBs /= 32 = Nothing 169 | BS.length bf /= 32 = Nothing 170 | otherwise = 171 let !secW = Secp256k1.unsafe_roll32 secBs 172 !bfW = Secp256k1.unsafe_roll32 bf 173 !secM = S.to secW 174 !bfM = S.to bfW 175 !resultM = S.mul secM bfM 176 !resultW = S.retr resultM 177 in Just $! Secp256k1.unroll32 resultW 178 {-# INLINE blindSecKey #-} 179 180 -- Stream generation --------------------------------------------------------- 181 182 -- | Generate pseudo-random byte stream using ChaCha20. 183 -- 184 -- Uses derived key as ChaCha20 key, 96-bit zero nonce, counter=0. 185 -- Encrypts zeros to produce keystream. 186 generateStream 187 :: DerivedKey -- ^ rho or ammag key 188 -> Int -- ^ desired length 189 -> BS.ByteString 190 generateStream (DerivedKey !key) !len = 191 let !nonce = BS.replicate 12 0 192 !zeros = BS.replicate len 0 193 in either (const (BS.replicate len 0)) id 194 (ChaCha.cipher key (0 :: Word32) nonce zeros) 195 {-# INLINE generateStream #-} 196 197 -- HMAC operations ----------------------------------------------------------- 198 199 -- | Compute HMAC-SHA256 for packet integrity. 200 computeHmac 201 :: DerivedKey -- ^ mu key 202 -> BS.ByteString -- ^ hop_payloads 203 -> BS.ByteString -- ^ associated_data 204 -> BS.ByteString -- ^ 32-byte HMAC 205 computeHmac (DerivedKey !key) !payloads !assocData = 206 let SHA256.MAC !result = SHA256.hmac key (payloads <> assocData) 207 in result 208 {-# INLINE computeHmac #-} 209 210 -- | Constant-time HMAC comparison. 211 verifyHmac 212 :: BS.ByteString -- ^ expected 213 -> BS.ByteString -- ^ computed 214 -> Bool 215 verifyHmac !expected !computed 216 | BS.length expected /= BS.length computed = False 217 | otherwise = constantTimeEq expected computed 218 {-# INLINE verifyHmac #-} 219 220 -- Constant-time equality comparison. 221 constantTimeEq :: BS.ByteString -> BS.ByteString -> Bool 222 constantTimeEq !a !b = 223 let !diff = L.foldl' (\acc (x, y) -> acc `xor` (x `xor` y)) (0 :: Word8) 224 (BS.zip a b) 225 in diff == 0 226 {-# INLINE constantTimeEq #-}