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