Prim.hs (7970B)
1 {-# OPTIONS_HADDOCK hide #-} 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 -- Keys, secrets and the cryptographic primitives of BOLT #4. 12 13 module Lightning.Protocol.BOLT4.Prim ( 14 -- * Secret keys 15 SecretKey 16 , secret_key 17 , public_key 18 , sk_bytes 19 , sk_pub 20 21 -- * Shared secrets 22 , SharedSecret 23 , shared_secret 24 , un_shared_secret 25 , ecdh 26 27 -- * Derived keys 28 , DerivedKey 29 , un_derived_key 30 , derive_rho 31 , derive_mu 32 , derive_um 33 , derive_ammag 34 , derive_pad 35 36 -- * Blinding 37 , blinding_factor 38 , blinded_node_tweak 39 , blind_pub 40 , blind_scalar 41 42 -- * Points 43 , to_point 44 , from_point 45 46 -- * Streams and MACs 47 , keystream 48 , hmac 49 , ct_eq 50 , xor_bytes 51 ) where 52 53 import Control.DeepSeq (NFData(..)) 54 import qualified Crypto.Cipher.ChaCha20 as ChaCha 55 import qualified Crypto.Curve.Secp256k1 as Secp256k1 56 import qualified Crypto.Hash.SHA256 as SHA256 57 import Data.Bits (xor) 58 import qualified Data.ByteString as BS 59 import qualified Lightning.Protocol.BOLT1 as BOLT1 60 import qualified Numeric.Montgomery.Secp256k1.Scalar as S 61 62 -- secret keys ---------------------------------------------------------------- 63 64 -- | A secp256k1 secret key: a session key, a node's private key, or the 65 -- seed of a blinded path. 66 -- 67 -- This is secret material: its 'Show' instance is redacted and it 68 -- has no 'Eq' instance. 69 data SecretKey = SecretKey 70 !BS.ByteString -- the key 71 !Secp256k1.Projective -- its public key 72 !BOLT1.Point -- its serialized public key 73 74 instance Show SecretKey where 75 showsPrec d _ = showParen (d > 10) $ 76 showString "SecretKey <redacted>" 77 78 instance NFData SecretKey where 79 rnf (SecretKey k p q) = rnf k `seq` p `seq` rnf q 80 81 -- | Construct a t'SecretKey' from exactly 32 big-endian bytes encoding an 82 -- integer in [1, n - 1], where n is the secp256k1 group order. 83 -- 84 -- >>> secret_key (BS.replicate 32 0x41) 85 -- Just (SecretKey <redacted>) 86 -- >>> secret_key (BS.replicate 32 0x00) 87 -- Nothing 88 -- >>> secret_key (BS.replicate 31 0x41) 89 -- Nothing 90 secret_key :: BS.ByteString -> Maybe SecretKey 91 secret_key bs 92 | BS.length bs /= 32 = Nothing 93 | otherwise = do 94 pub <- Secp256k1.derive_pub (Secp256k1.unsafe_roll32 bs) 95 pt <- to_point pub 96 pure $! SecretKey bs pub pt 97 98 -- | The public key of a t'SecretKey'. 99 -- 100 -- >>> let Just sk = secret_key (BS.replicate 32 0x41) 101 -- >>> BS.length (BOLT1.un_point (public_key sk)) 102 -- 33 103 public_key :: SecretKey -> BOLT1.Point 104 public_key (SecretKey _ _ p) = p 105 {-# INLINE public_key #-} 106 107 sk_bytes :: SecretKey -> BS.ByteString 108 sk_bytes (SecretKey k _ _) = k 109 {-# INLINE sk_bytes #-} 110 111 sk_pub :: SecretKey -> Secp256k1.Projective 112 sk_pub (SecretKey _ p _) = p 113 {-# INLINE sk_pub #-} 114 115 -- shared secrets ------------------------------------------------------------- 116 117 -- | A 32-byte shared secret, established between the origin of an onion 118 -- and one of its hops. 119 -- 120 -- This is secret material: its 'Show' instance is redacted and its 121 -- 'Eq' instance runs in constant time. 122 newtype SharedSecret = SharedSecret BS.ByteString 123 124 instance Eq SharedSecret where 125 SharedSecret a == SharedSecret b = ct_eq a b 126 127 instance Show SharedSecret where 128 showsPrec d _ = showParen (d > 10) $ 129 showString "SharedSecret <redacted>" 130 131 instance NFData SharedSecret where 132 rnf (SharedSecret bs) = rnf bs 133 134 -- | Construct a t'SharedSecret' from exactly 32 bytes (e.g. to restore one 135 -- that was stored with 'un_shared_secret'). 136 -- 137 -- >>> let Just ss = shared_secret (BS.replicate 32 0x01) 138 -- >>> BS.length (un_shared_secret ss) 139 -- 32 140 -- >>> shared_secret "too short" 141 -- Nothing 142 shared_secret :: BS.ByteString -> Maybe SharedSecret 143 shared_secret bs 144 | BS.length bs == 32 = Just (SharedSecret bs) 145 | otherwise = Nothing 146 {-# INLINE shared_secret #-} 147 148 -- | The bytes of a t'SharedSecret'. 149 un_shared_secret :: SharedSecret -> BS.ByteString 150 un_shared_secret (SharedSecret bs) = bs 151 {-# INLINE un_shared_secret #-} 152 153 -- | ECDH per BOLT #4: SHA256 of the compressed product of a point and a 154 -- 32-byte scalar. Fails if the scalar is not in [1, n - 1]. 155 ecdh :: BS.ByteString -> Secp256k1.Projective -> Maybe SharedSecret 156 ecdh k pub = do 157 pt <- Secp256k1.mul pub (Secp256k1.unsafe_roll32 k) 158 pure $! SharedSecret (SHA256.hash (Secp256k1.serialize_point pt)) 159 160 -- derived keys --------------------------------------------------------------- 161 162 -- A 32-byte key derived from a shared secret. 163 newtype DerivedKey = DerivedKey BS.ByteString 164 165 un_derived_key :: DerivedKey -> BS.ByteString 166 un_derived_key (DerivedKey k) = k 167 {-# INLINE un_derived_key #-} 168 169 derive :: BS.ByteString -> BS.ByteString -> DerivedKey 170 derive label ss = 171 let SHA256.MAC k = SHA256.hmac label ss 172 in DerivedKey k 173 {-# INLINE derive #-} 174 175 derive_rho :: SharedSecret -> DerivedKey 176 derive_rho (SharedSecret ss) = derive "rho" ss 177 178 derive_mu :: SharedSecret -> DerivedKey 179 derive_mu (SharedSecret ss) = derive "mu" ss 180 181 derive_um :: SharedSecret -> DerivedKey 182 derive_um (SharedSecret ss) = derive "um" ss 183 184 derive_ammag :: SharedSecret -> DerivedKey 185 derive_ammag (SharedSecret ss) = derive "ammag" ss 186 187 -- The pad key is derived from the session key itself. 188 derive_pad :: SecretKey -> DerivedKey 189 derive_pad (SecretKey k _ _) = derive "pad" k 190 191 -- blinding ------------------------------------------------------------------- 192 193 -- SHA256(E || ss), the factor by which ephemeral keys are blinded. 194 blinding_factor :: Secp256k1.Projective -> SharedSecret -> BS.ByteString 195 blinding_factor e (SharedSecret ss) = 196 SHA256.hash (Secp256k1.serialize_point e <> ss) 197 198 -- HMAC256("blinded_node_id", ss), the factor by which node ids are 199 -- blinded in a blinded route. 200 blinded_node_tweak :: SharedSecret -> BS.ByteString 201 blinded_node_tweak (SharedSecret ss) = 202 let SHA256.MAC t = SHA256.hmac "blinded_node_id" ss 203 in t 204 205 -- Multiply a point by a 32-byte factor. 206 blind_pub 207 :: Secp256k1.Projective -> BS.ByteString -> Maybe Secp256k1.Projective 208 blind_pub p t = Secp256k1.mul p (Secp256k1.unsafe_roll32 t) 209 210 -- Multiply a 32-byte scalar by a 32-byte factor, mod n. Fails if the 211 -- product is zero. 212 blind_scalar :: BS.ByteString -> BS.ByteString -> Maybe BS.ByteString 213 blind_scalar k t = 214 let !r = S.retr (S.mul (S.to (Secp256k1.unsafe_roll32 k)) 215 (S.to (Secp256k1.unsafe_roll32 t))) 216 in if Secp256k1.ge r 217 then Just $! Secp256k1.unroll32 r 218 else Nothing 219 220 -- points --------------------------------------------------------------------- 221 222 to_point :: Secp256k1.Projective -> Maybe BOLT1.Point 223 to_point = BOLT1.point . Secp256k1.serialize_point 224 {-# INLINE to_point #-} 225 226 from_point :: BOLT1.Point -> Maybe Secp256k1.Projective 227 from_point = Secp256k1.parse_point . BOLT1.un_point 228 {-# INLINE from_point #-} 229 230 -- streams and MACs ----------------------------------------------------------- 231 232 -- The ChaCha20 keystream of the given length under a derived key, with 233 -- an all-zero nonce. The cipher fails only for a key or nonce of the 234 -- wrong length, or past 256 GiB of output, none of which can occur 235 -- here; the empty result in that case truncates any output XORed with 236 -- it, rather than leaving it unencrypted. 237 keystream :: DerivedKey -> Int -> BS.ByteString 238 keystream (DerivedKey k) n = 239 case ChaCha.cipher k 0 (BS.replicate 12 0) (BS.replicate n 0) of 240 Right s -> s 241 Left _ -> BS.empty 242 243 -- HMAC-SHA256 under a derived key. 244 hmac :: DerivedKey -> BS.ByteString -> BS.ByteString 245 hmac (DerivedKey k) m = 246 let SHA256.MAC h = SHA256.hmac k m 247 in h 248 {-# INLINE hmac #-} 249 250 -- Constant-time equality (variable-time only in the lengths). 251 ct_eq :: BS.ByteString -> BS.ByteString -> Bool 252 ct_eq a b = SHA256.MAC a == SHA256.MAC b 253 {-# INLINE ct_eq #-} 254 255 -- XOR, truncated to the shorter input. 256 xor_bytes :: BS.ByteString -> BS.ByteString -> BS.ByteString 257 xor_bytes = BS.packZipWith xor 258 {-# INLINE xor_bytes #-}