Keys.hs (14455B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE DeriveGeneric #-} 4 5 -- | 6 -- Module: Lightning.Protocol.BOLT3.Keys 7 -- Copyright: (c) 2025 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Per-commitment key derivation per BOLT #3. 12 -- 13 -- Implements key derivation formulas: 14 -- 15 -- @ 16 -- pubkey = basepoint + SHA256(per_commitment_point || basepoint) * G 17 -- revocationpubkey = revocation_basepoint * SHA256(revocation_basepoint 18 -- || per_commitment_point) 19 -- + per_commitment_point * SHA256(per_commitment_point 20 -- || revocation_basepoint) 21 -- @ 22 23 module Lightning.Protocol.BOLT3.Keys ( 24 -- * Per-commitment point derivation 25 derive_per_commitment_point 26 27 -- * Key derivation 28 , derive_pubkey 29 , derive_localpubkey 30 , derive_local_htlcpubkey 31 , derive_remote_htlcpubkey 32 , derive_local_delayedpubkey 33 , derive_remote_delayedpubkey 34 35 -- * Revocation key derivation 36 , derive_revocationpubkey 37 38 -- * Per-commitment secret generation 39 , generate_from_seed 40 , derive_secret 41 42 -- * Per-commitment secret storage 43 , SecretStore(..) 44 , SecretEntry(..) 45 , empty_store 46 , insert_secret 47 , derive_old_secret 48 49 -- * Commitment number obscuring 50 , obscured_commitment_number 51 ) where 52 53 import Data.Bits ((.&.), xor, shiftL, testBit, complementBit) 54 import qualified Data.ByteString as BS 55 import Data.Word (Word64) 56 import GHC.Generics (Generic) 57 import qualified Crypto.Curve.Secp256k1 as S 58 import qualified Crypto.Hash.SHA256 as SHA256 59 import Lightning.Protocol.BOLT3.Types 60 61 -- Per-commitment point derivation ---------------------------------------- 62 63 -- | Derive the per-commitment point from a per-commitment secret. 64 -- 65 -- @per_commitment_point = per_commitment_secret * G@ 66 -- 67 -- >>> let secret = PerCommitmentSecret (BS.replicate 32 0x01) 68 -- >>> derive_per_commitment_point secret 69 -- Just (PerCommitmentPoint ...) 70 derive_per_commitment_point 71 :: PerCommitmentSecret 72 -> Maybe PerCommitmentPoint 73 derive_per_commitment_point (PerCommitmentSecret sec) = do 74 sk <- S.parse_int256 sec 75 pk <- S.derive_pub sk 76 let !bs = S.serialize_point pk 77 pure $! PerCommitmentPoint (Point bs) 78 {-# INLINE derive_per_commitment_point #-} 79 80 -- Key derivation --------------------------------------------------------- 81 82 -- | Derive a pubkey from a basepoint and per-commitment point. 83 -- 84 -- @pubkey = basepoint + SHA256(per_commitment_point || basepoint) * G@ 85 -- 86 -- This is the general derivation formula used for localpubkey, 87 -- local_htlcpubkey, remote_htlcpubkey, local_delayedpubkey, and 88 -- remote_delayedpubkey. 89 -- 90 -- >>> derive_pubkey basepoint per_commitment_point 91 -- Just (Pubkey ...) 92 derive_pubkey 93 :: Point -- ^ basepoint 94 -> PerCommitmentPoint -- ^ per_commitment_point 95 -> Maybe Pubkey 96 derive_pubkey (Point basepointBs) (PerCommitmentPoint (Point pcpBs)) = do 97 basepoint <- S.parse_point basepointBs 98 -- SHA256(per_commitment_point || basepoint) 99 let !h = SHA256.hash (pcpBs <> basepointBs) 100 -- Treat hash as scalar and multiply by G 101 tweak <- S.parse_int256 h 102 tweakPoint <- S.derive_pub tweak 103 -- Add basepoint + tweak*G 104 let !result = S.add basepoint tweakPoint 105 !bs = S.serialize_point result 106 pure $! Pubkey bs 107 {-# INLINE derive_pubkey #-} 108 109 -- | Derive localpubkey from payment_basepoint and per_commitment_point. 110 -- 111 -- >>> derive_localpubkey payment_basepoint per_commitment_point 112 -- Just (LocalPubkey ...) 113 derive_localpubkey 114 :: PaymentBasepoint 115 -> PerCommitmentPoint 116 -> Maybe LocalPubkey 117 derive_localpubkey (PaymentBasepoint pt) pcp = 118 LocalPubkey <$> derive_pubkey pt pcp 119 {-# INLINE derive_localpubkey #-} 120 121 -- | Derive local_htlcpubkey from htlc_basepoint and per_commitment_point. 122 -- 123 -- >>> derive_local_htlcpubkey htlc_basepoint per_commitment_point 124 -- Just (LocalHtlcPubkey ...) 125 derive_local_htlcpubkey 126 :: HtlcBasepoint 127 -> PerCommitmentPoint 128 -> Maybe LocalHtlcPubkey 129 derive_local_htlcpubkey (HtlcBasepoint pt) pcp = 130 LocalHtlcPubkey <$> derive_pubkey pt pcp 131 {-# INLINE derive_local_htlcpubkey #-} 132 133 -- | Derive remote_htlcpubkey from htlc_basepoint and per_commitment_point. 134 -- 135 -- >>> derive_remote_htlcpubkey htlc_basepoint per_commitment_point 136 -- Just (RemoteHtlcPubkey ...) 137 derive_remote_htlcpubkey 138 :: HtlcBasepoint 139 -> PerCommitmentPoint 140 -> Maybe RemoteHtlcPubkey 141 derive_remote_htlcpubkey (HtlcBasepoint pt) pcp = 142 RemoteHtlcPubkey <$> derive_pubkey pt pcp 143 {-# INLINE derive_remote_htlcpubkey #-} 144 145 -- | Derive local_delayedpubkey from delayed_payment_basepoint and 146 -- per_commitment_point. 147 -- 148 -- >>> derive_local_delayedpubkey delayed_payment_basepoint per_commitment_point 149 -- Just (LocalDelayedPubkey ...) 150 derive_local_delayedpubkey 151 :: DelayedPaymentBasepoint 152 -> PerCommitmentPoint 153 -> Maybe LocalDelayedPubkey 154 derive_local_delayedpubkey (DelayedPaymentBasepoint pt) pcp = 155 LocalDelayedPubkey <$> derive_pubkey pt pcp 156 {-# INLINE derive_local_delayedpubkey #-} 157 158 -- | Derive remote_delayedpubkey from delayed_payment_basepoint and 159 -- per_commitment_point. 160 -- 161 -- >>> derive_remote_delayedpubkey delayed_payment_basepoint pcp 162 -- Just (RemoteDelayedPubkey ...) 163 derive_remote_delayedpubkey 164 :: DelayedPaymentBasepoint 165 -> PerCommitmentPoint 166 -> Maybe RemoteDelayedPubkey 167 derive_remote_delayedpubkey (DelayedPaymentBasepoint pt) pcp = 168 RemoteDelayedPubkey <$> derive_pubkey pt pcp 169 {-# INLINE derive_remote_delayedpubkey #-} 170 171 -- Revocation key derivation ---------------------------------------------- 172 173 -- | Derive revocationpubkey from revocation_basepoint and 174 -- per_commitment_point. 175 -- 176 -- @ 177 -- revocationpubkey = revocation_basepoint 178 -- * SHA256(revocation_basepoint || per_commitment_point) 179 -- + per_commitment_point 180 -- * SHA256(per_commitment_point || revocation_basepoint) 181 -- @ 182 -- 183 -- >>> derive_revocationpubkey revocation_basepoint per_commitment_point 184 -- Just (RevocationPubkey ...) 185 derive_revocationpubkey 186 :: RevocationBasepoint 187 -> PerCommitmentPoint 188 -> Maybe RevocationPubkey 189 derive_revocationpubkey 190 (RevocationBasepoint (Point rbpBs)) 191 (PerCommitmentPoint (Point pcpBs)) = do 192 rbp <- S.parse_point rbpBs 193 pcp <- S.parse_point pcpBs 194 -- SHA256(revocation_basepoint || per_commitment_point) 195 let !h1 = SHA256.hash (rbpBs <> pcpBs) 196 -- SHA256(per_commitment_point || revocation_basepoint) 197 let !h2 = SHA256.hash (pcpBs <> rbpBs) 198 -- Multiply points by their respective scalars 199 s1 <- S.parse_int256 h1 200 s2 <- S.parse_int256 h2 201 p1 <- S.mul rbp s1 -- revocation_basepoint * h1 202 p2 <- S.mul pcp s2 -- per_commitment_point * h2 203 -- Add the two points 204 let !result = S.add p1 p2 205 !bs = S.serialize_point result 206 pure $! RevocationPubkey (Pubkey bs) 207 {-# INLINE derive_revocationpubkey #-} 208 209 -- Per-commitment secret generation --------------------------------------- 210 211 -- | Generate the I'th per-commitment secret from a seed. 212 -- 213 -- Implements the generate_from_seed algorithm from BOLT #3: 214 -- 215 -- @ 216 -- generate_from_seed(seed, I): 217 -- P = seed 218 -- for B in 47 down to 0: 219 -- if B set in I: 220 -- flip(B) in P 221 -- P = SHA256(P) 222 -- return P 223 -- @ 224 -- 225 -- >>> generate_from_seed seed 281474976710655 226 -- <32-byte secret> 227 generate_from_seed 228 :: BS.ByteString -- ^ seed (32 bytes) 229 -> Word64 -- ^ index I (max 2^48 - 1) 230 -> BS.ByteString -- ^ per-commitment secret (32 bytes) 231 generate_from_seed seed idx = go 47 seed where 232 go :: Int -> BS.ByteString -> BS.ByteString 233 go !b !p 234 | b < 0 = p 235 | testBit idx b = 236 let !p' = flip_bit b p 237 !p'' = SHA256.hash p' 238 in go (b - 1) p'' 239 | otherwise = go (b - 1) p 240 {-# INLINE generate_from_seed #-} 241 242 -- | Derive a secret from a base secret. 243 -- 244 -- This is a generalization of generate_from_seed used for efficient 245 -- secret storage. Given a base secret whose index has bits..47 the same 246 -- as target index I, derive the I'th secret. 247 -- 248 -- @ 249 -- derive_secret(base, bits, I): 250 -- P = base 251 -- for B in bits - 1 down to 0: 252 -- if B set in I: 253 -- flip(B) in P 254 -- P = SHA256(P) 255 -- return P 256 -- @ 257 derive_secret 258 :: BS.ByteString -- ^ base secret 259 -> Int -- ^ bits (number of trailing bits to process) 260 -> Word64 -- ^ target index I 261 -> BS.ByteString -- ^ derived secret 262 derive_secret base bits idx = go (bits - 1) base where 263 go :: Int -> BS.ByteString -> BS.ByteString 264 go !b !p 265 | b < 0 = p 266 | testBit idx b = 267 let !p' = flip_bit b p 268 !p'' = SHA256.hash p' 269 in go (b - 1) p'' 270 | otherwise = go (b - 1) p 271 {-# INLINE derive_secret #-} 272 273 -- | Flip bit B in a 32-byte bytestring. 274 -- 275 -- "flip(B)" alternates the (B mod 8) bit of the (B div 8) byte. 276 flip_bit :: Int -> BS.ByteString -> BS.ByteString 277 flip_bit b bs = 278 let !byteIdx = b `div` 8 279 !bitIdx = b `mod` 8 280 !len = BS.length bs 281 in if byteIdx >= len 282 then bs 283 else 284 let !prefix = BS.take byteIdx bs 285 !byte = BS.index bs byteIdx 286 !byte' = complementBit byte bitIdx 287 !suffix = BS.drop (byteIdx + 1) bs 288 in prefix <> BS.singleton byte' <> suffix 289 {-# INLINE flip_bit #-} 290 291 -- Per-commitment secret storage ------------------------------------------ 292 293 -- | Entry in the secret store: (bucket, index, secret). 294 data SecretEntry = SecretEntry 295 { se_bucket :: {-# UNPACK #-} !Int 296 , se_index :: {-# UNPACK #-} !Word64 297 , se_secret :: !BS.ByteString 298 } deriving (Eq, Show, Generic) 299 300 -- | Compact storage for per-commitment secrets. 301 -- 302 -- Stores up to 49 (value, index) pairs, allowing efficient derivation 303 -- of any previously-received secret. This is possible because for a 304 -- given secret on a 2^X boundary, all secrets up to the next 2^X 305 -- boundary can be derived from it. 306 newtype SecretStore = SecretStore { unSecretStore :: [SecretEntry] } 307 deriving (Eq, Show, Generic) 308 309 -- | Empty secret store. 310 empty_store :: SecretStore 311 empty_store = SecretStore [] 312 {-# INLINE empty_store #-} 313 314 -- | Determine which bucket to store a secret in based on its index. 315 -- 316 -- Counts trailing zeros in the index. Returns 0-47 for normal indices, 317 -- or 48 if index is 0 (the seed). 318 where_to_put_secret :: Word64 -> Int 319 where_to_put_secret idx = go 0 where 320 go !b 321 | b > 47 = 48 -- index 0, this is the seed 322 | testBit idx b = b 323 | otherwise = go (b + 1) 324 {-# INLINE where_to_put_secret #-} 325 326 -- | Insert a secret into the store, validating against existing secrets. 327 -- 328 -- Returns Nothing if the secret doesn't derive correctly from known 329 -- secrets (indicating the secrets weren't generated from the same seed). 330 -- 331 -- >>> insert_secret secret 281474976710655 empty_store 332 -- Just (SecretStore ...) 333 insert_secret 334 :: BS.ByteString -- ^ secret (32 bytes) 335 -> Word64 -- ^ index 336 -> SecretStore -- ^ current store 337 -> Maybe SecretStore 338 insert_secret secret idx (SecretStore known) = do 339 let !bucket = where_to_put_secret idx 340 -- Validate: for each bucket < this bucket, check we can derive 341 validated <- validateBuckets bucket known 342 if validated 343 then 344 -- Remove entries at bucket >= this bucket, then insert 345 let !known' = filter (\e -> se_bucket e < bucket) known 346 !entry = SecretEntry bucket idx secret 347 in pure $! SecretStore (known' ++ [entry]) 348 else Nothing 349 where 350 validateBuckets :: Int -> [SecretEntry] -> Maybe Bool 351 validateBuckets b entries = go entries where 352 go [] = Just True 353 go (SecretEntry entryBucket knownIdx knownSecret : rest) 354 | entryBucket >= b = go rest -- skip entries at higher buckets 355 | otherwise = 356 -- Check if we can derive the known secret from the new one 357 let !derived = derive_secret secret b knownIdx 358 in if derived == knownSecret 359 then go rest 360 else Nothing 361 {-# INLINE insert_secret #-} 362 363 -- | Derive a previously-received secret from the store. 364 -- 365 -- Iterates over known secrets to find one whose index is a prefix of 366 -- the target index, then derives the target secret from it. 367 -- 368 -- >>> derive_old_secret 281474976710654 store 369 -- Just <32-byte secret> 370 derive_old_secret 371 :: Word64 -- ^ target index 372 -> SecretStore -- ^ store 373 -> Maybe BS.ByteString 374 derive_old_secret targetIdx (SecretStore known) = go known where 375 go :: [SecretEntry] -> Maybe BS.ByteString 376 go [] = Nothing 377 go (SecretEntry bucket knownIdx knownSecret : rest) = 378 -- Mask off the non-zero prefix of the index using the entry's bucket 379 let !mask = complement ((1 `shiftL` bucket) - 1) 380 in if (targetIdx .&. mask) == knownIdx 381 then Just $! derive_secret knownSecret bucket targetIdx 382 else go rest 383 384 complement :: Word64 -> Word64 385 complement x = x `xor` 0xFFFFFFFFFFFFFFFF 386 {-# INLINE derive_old_secret #-} 387 388 -- Commitment number obscuring -------------------------------------------- 389 390 -- | Calculate the obscured commitment number. 391 -- 392 -- The 48-bit commitment number is obscured by XOR with the lower 48 bits 393 -- of SHA256(payment_basepoint from open_channel 394 -- || payment_basepoint from accept_channel). 395 -- 396 -- >>> obscured_commitment_number local_payment_bp remote_payment_bp cn 397 -- <obscured value> 398 obscured_commitment_number 399 :: PaymentBasepoint -- ^ opener's payment_basepoint 400 -> PaymentBasepoint -- ^ accepter's payment_basepoint 401 -> CommitmentNumber -- ^ commitment number (48-bit) 402 -> Word64 -- ^ obscured commitment number 403 obscured_commitment_number 404 (PaymentBasepoint (Point openerBs)) 405 (PaymentBasepoint (Point accepterBs)) 406 (CommitmentNumber cn) = 407 let !h = SHA256.hash (openerBs <> accepterBs) 408 -- Extract lower 48 bits (6 bytes) from the hash 409 !lower48 = extractLower48 h 410 -- Mask commitment number to 48 bits 411 !cn48 = cn .&. 0xFFFFFFFFFFFF 412 in cn48 `xor` lower48 413 {-# INLINE obscured_commitment_number #-} 414 415 -- | Extract lower 48 bits from a 32-byte hash. 416 -- 417 -- Takes bytes 26-31 (last 6 bytes) and interprets as big-endian Word64. 418 extractLower48 :: BS.ByteString -> Word64 419 extractLower48 h = 420 let !b0 = fromIntegral (BS.index h 26) `shiftL` 40 421 !b1 = fromIntegral (BS.index h 27) `shiftL` 32 422 !b2 = fromIntegral (BS.index h 28) `shiftL` 24 423 !b3 = fromIntegral (BS.index h 29) `shiftL` 16 424 !b4 = fromIntegral (BS.index h 30) `shiftL` 8 425 !b5 = fromIntegral (BS.index h 31) 426 in b0 + b1 + b2 + b3 + b4 + b5 427 {-# INLINE extractLower48 #-}