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