{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module: Lightning.Protocol.BOLT3.Keys
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Per-commitment key derivation per BOLT #3.
--
-- Implements key derivation formulas:
--
-- @
-- pubkey = basepoint + SHA256(per_commitment_point || basepoint) * G
-- revocationpubkey = revocation_basepoint * SHA256(revocation_basepoint
--                      || per_commitment_point)
--                  + per_commitment_point * SHA256(per_commitment_point
--                      || revocation_basepoint)
-- @

module Lightning.Protocol.BOLT3.Keys (
    -- * Per-commitment point derivation
    derive_per_commitment_point

    -- * Key derivation
  , derive_pubkey
  , derive_localpubkey
  , derive_local_htlcpubkey
  , derive_remote_htlcpubkey
  , derive_local_delayedpubkey
  , derive_remote_delayedpubkey

    -- * Revocation key derivation
  , derive_revocationpubkey

    -- * Per-commitment secret generation
  , generate_from_seed
  , derive_secret

    -- * Per-commitment secret storage
  , SecretStore
  , empty_store
  , insert_secret
  , derive_old_secret

    -- * Commitment number obscuring
  , obscured_commitment_number
  ) where

import Data.Bits ((.&.), xor, shiftL, testBit, complementBit)
import qualified Data.ByteString as BS
import Data.Word (Word64)
import GHC.Generics (Generic)
import qualified Crypto.Curve.Secp256k1 as S
import qualified Crypto.Hash.SHA256 as SHA256
import Lightning.Protocol.BOLT3.Types

-- Per-commitment point derivation ----------------------------------------

-- | Derive the per-commitment point from a per-commitment secret.
--
-- @per_commitment_point = per_commitment_secret * G@
--
-- >>> let secret = PerCommitmentSecret (BS.replicate 32 0x01)
-- >>> derive_per_commitment_point secret
-- Just (PerCommitmentPoint ...)
derive_per_commitment_point
  :: PerCommitmentSecret
  -> Maybe PerCommitmentPoint
derive_per_commitment_point :: PerCommitmentSecret -> Maybe PerCommitmentPoint
derive_per_commitment_point (PerCommitmentSecret ByteString
sec) = do
  sk <- ByteString -> Maybe Wider
S.parse_int256 ByteString
sec
  pk <- S.derive_pub sk
  let !bs = Pub -> ByteString
S.serialize_point Pub
pk
  pure $! PerCommitmentPoint (Point bs)
{-# INLINE derive_per_commitment_point #-}

-- Key derivation ---------------------------------------------------------

-- | Derive a pubkey from a basepoint and per-commitment point.
--
-- @pubkey = basepoint + SHA256(per_commitment_point || basepoint) * G@
--
-- This is the general derivation formula used for localpubkey,
-- local_htlcpubkey, remote_htlcpubkey, local_delayedpubkey, and
-- remote_delayedpubkey.
--
-- >>> derive_pubkey basepoint per_commitment_point
-- Just (Pubkey ...)
derive_pubkey
  :: Point             -- ^ basepoint
  -> PerCommitmentPoint -- ^ per_commitment_point
  -> Maybe Pubkey
derive_pubkey :: Point -> PerCommitmentPoint -> Maybe Pubkey
derive_pubkey (Point ByteString
basepointBs) (PerCommitmentPoint (Point ByteString
pcpBs)) = do
  basepoint <- ByteString -> Maybe Pub
S.parse_point ByteString
basepointBs
  -- SHA256(per_commitment_point || basepoint)
  let !h = ByteString -> ByteString
SHA256.hash (ByteString
pcpBs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
basepointBs)
  -- Treat hash as scalar and multiply by G
  tweak <- S.parse_int256 h
  tweakPoint <- S.derive_pub tweak
  -- Add basepoint + tweak*G
  let !result = Pub -> Pub -> Pub
S.add Pub
basepoint Pub
tweakPoint
      !bs = Pub -> ByteString
S.serialize_point Pub
result
  pure $! Pubkey bs
{-# INLINE derive_pubkey #-}

-- | Derive localpubkey from payment_basepoint and per_commitment_point.
--
-- >>> derive_localpubkey payment_basepoint per_commitment_point
-- Just (LocalPubkey ...)
derive_localpubkey
  :: PaymentBasepoint
  -> PerCommitmentPoint
  -> Maybe LocalPubkey
derive_localpubkey :: PaymentBasepoint -> PerCommitmentPoint -> Maybe LocalPubkey
derive_localpubkey (PaymentBasepoint Point
pt) PerCommitmentPoint
pcp =
  Pubkey -> LocalPubkey
LocalPubkey (Pubkey -> LocalPubkey) -> Maybe Pubkey -> Maybe LocalPubkey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> PerCommitmentPoint -> Maybe Pubkey
derive_pubkey Point
pt PerCommitmentPoint
pcp
{-# INLINE derive_localpubkey #-}

-- | Derive local_htlcpubkey from htlc_basepoint and per_commitment_point.
--
-- >>> derive_local_htlcpubkey htlc_basepoint per_commitment_point
-- Just (LocalHtlcPubkey ...)
derive_local_htlcpubkey
  :: HtlcBasepoint
  -> PerCommitmentPoint
  -> Maybe LocalHtlcPubkey
derive_local_htlcpubkey :: HtlcBasepoint -> PerCommitmentPoint -> Maybe LocalHtlcPubkey
derive_local_htlcpubkey (HtlcBasepoint Point
pt) PerCommitmentPoint
pcp =
  Pubkey -> LocalHtlcPubkey
LocalHtlcPubkey (Pubkey -> LocalHtlcPubkey)
-> Maybe Pubkey -> Maybe LocalHtlcPubkey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> PerCommitmentPoint -> Maybe Pubkey
derive_pubkey Point
pt PerCommitmentPoint
pcp
{-# INLINE derive_local_htlcpubkey #-}

-- | Derive remote_htlcpubkey from htlc_basepoint and per_commitment_point.
--
-- >>> derive_remote_htlcpubkey htlc_basepoint per_commitment_point
-- Just (RemoteHtlcPubkey ...)
derive_remote_htlcpubkey
  :: HtlcBasepoint
  -> PerCommitmentPoint
  -> Maybe RemoteHtlcPubkey
derive_remote_htlcpubkey :: HtlcBasepoint -> PerCommitmentPoint -> Maybe RemoteHtlcPubkey
derive_remote_htlcpubkey (HtlcBasepoint Point
pt) PerCommitmentPoint
pcp =
  Pubkey -> RemoteHtlcPubkey
RemoteHtlcPubkey (Pubkey -> RemoteHtlcPubkey)
-> Maybe Pubkey -> Maybe RemoteHtlcPubkey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> PerCommitmentPoint -> Maybe Pubkey
derive_pubkey Point
pt PerCommitmentPoint
pcp
{-# INLINE derive_remote_htlcpubkey #-}

-- | Derive local_delayedpubkey from delayed_payment_basepoint and
-- per_commitment_point.
--
-- >>> derive_local_delayedpubkey delayed_payment_basepoint per_commitment_point
-- Just (LocalDelayedPubkey ...)
derive_local_delayedpubkey
  :: DelayedPaymentBasepoint
  -> PerCommitmentPoint
  -> Maybe LocalDelayedPubkey
derive_local_delayedpubkey :: DelayedPaymentBasepoint
-> PerCommitmentPoint -> Maybe LocalDelayedPubkey
derive_local_delayedpubkey (DelayedPaymentBasepoint Point
pt) PerCommitmentPoint
pcp =
  Pubkey -> LocalDelayedPubkey
LocalDelayedPubkey (Pubkey -> LocalDelayedPubkey)
-> Maybe Pubkey -> Maybe LocalDelayedPubkey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> PerCommitmentPoint -> Maybe Pubkey
derive_pubkey Point
pt PerCommitmentPoint
pcp
{-# INLINE derive_local_delayedpubkey #-}

-- | Derive remote_delayedpubkey from delayed_payment_basepoint and
-- per_commitment_point.
--
-- >>> derive_remote_delayedpubkey delayed_payment_basepoint pcp
-- Just (RemoteDelayedPubkey ...)
derive_remote_delayedpubkey
  :: DelayedPaymentBasepoint
  -> PerCommitmentPoint
  -> Maybe RemoteDelayedPubkey
derive_remote_delayedpubkey :: DelayedPaymentBasepoint
-> PerCommitmentPoint -> Maybe RemoteDelayedPubkey
derive_remote_delayedpubkey (DelayedPaymentBasepoint Point
pt) PerCommitmentPoint
pcp =
  Pubkey -> RemoteDelayedPubkey
RemoteDelayedPubkey (Pubkey -> RemoteDelayedPubkey)
-> Maybe Pubkey -> Maybe RemoteDelayedPubkey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point -> PerCommitmentPoint -> Maybe Pubkey
derive_pubkey Point
pt PerCommitmentPoint
pcp
{-# INLINE derive_remote_delayedpubkey #-}

-- Revocation key derivation ----------------------------------------------

-- | Derive revocationpubkey from revocation_basepoint and
-- per_commitment_point.
--
-- @
-- revocationpubkey = revocation_basepoint
--                      * SHA256(revocation_basepoint || per_commitment_point)
--                  + per_commitment_point
--                      * SHA256(per_commitment_point || revocation_basepoint)
-- @
--
-- >>> derive_revocationpubkey revocation_basepoint per_commitment_point
-- Just (RevocationPubkey ...)
derive_revocationpubkey
  :: RevocationBasepoint
  -> PerCommitmentPoint
  -> Maybe RevocationPubkey
derive_revocationpubkey :: RevocationBasepoint -> PerCommitmentPoint -> Maybe RevocationPubkey
derive_revocationpubkey
  (RevocationBasepoint (Point ByteString
rbpBs))
  (PerCommitmentPoint (Point ByteString
pcpBs)) = do
    rbp <- ByteString -> Maybe Pub
S.parse_point ByteString
rbpBs
    pcp <- S.parse_point pcpBs
    -- SHA256(revocation_basepoint || per_commitment_point)
    let !h1 = ByteString -> ByteString
SHA256.hash (ByteString
rbpBs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
pcpBs)
    -- SHA256(per_commitment_point || revocation_basepoint)
    let !h2 = ByteString -> ByteString
SHA256.hash (ByteString
pcpBs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
rbpBs)
    -- Multiply points by their respective scalars
    s1 <- S.parse_int256 h1
    s2 <- S.parse_int256 h2
    p1 <- S.mul rbp s1  -- revocation_basepoint * h1
    p2 <- S.mul pcp s2  -- per_commitment_point * h2
    -- Add the two points
    let !result = Pub -> Pub -> Pub
S.add Pub
p1 Pub
p2
        !bs = Pub -> ByteString
S.serialize_point Pub
result
    pure $! RevocationPubkey (Pubkey bs)
{-# INLINE derive_revocationpubkey #-}

-- Per-commitment secret generation ---------------------------------------

-- | Generate the I'th per-commitment secret from a seed.
--
-- Implements the generate_from_seed algorithm from BOLT #3:
--
-- @
-- generate_from_seed(seed, I):
--     P = seed
--     for B in 47 down to 0:
--         if B set in I:
--             flip(B) in P
--             P = SHA256(P)
--     return P
-- @
--
-- >>> generate_from_seed seed 281474976710655
-- <32-byte secret>
generate_from_seed
  :: BS.ByteString  -- ^ seed (32 bytes)
  -> Word64         -- ^ index I (max 2^48 - 1)
  -> BS.ByteString  -- ^ per-commitment secret (32 bytes)
generate_from_seed :: ByteString -> Word64 -> ByteString
generate_from_seed ByteString
seed Word64
idx = Int -> ByteString -> ByteString
go Int
47 ByteString
seed where
  go :: Int -> BS.ByteString -> BS.ByteString
  go :: Int -> ByteString -> ByteString
go !Int
b !ByteString
p
    | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = ByteString
p
    | Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
idx Int
b =
        let !p' :: ByteString
p' = Int -> ByteString -> ByteString
flip_bit Int
b ByteString
p
            !p'' :: ByteString
p'' = ByteString -> ByteString
SHA256.hash ByteString
p'
        in  Int -> ByteString -> ByteString
go (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ByteString
p''
    | Bool
otherwise = Int -> ByteString -> ByteString
go (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ByteString
p
{-# INLINE generate_from_seed #-}

-- | Derive a secret from a base secret.
--
-- This is a generalization of generate_from_seed used for efficient
-- secret storage. Given a base secret whose index has bits..47 the same
-- as target index I, derive the I'th secret.
--
-- @
-- derive_secret(base, bits, I):
--     P = base
--     for B in bits - 1 down to 0:
--         if B set in I:
--             flip(B) in P
--             P = SHA256(P)
--     return P
-- @
derive_secret
  :: BS.ByteString  -- ^ base secret
  -> Int            -- ^ bits (number of trailing bits to process)
  -> Word64         -- ^ target index I
  -> BS.ByteString  -- ^ derived secret
derive_secret :: ByteString -> Int -> Word64 -> ByteString
derive_secret ByteString
base Int
bits Word64
idx = Int -> ByteString -> ByteString
go (Int
bits Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ByteString
base where
  go :: Int -> BS.ByteString -> BS.ByteString
  go :: Int -> ByteString -> ByteString
go !Int
b !ByteString
p
    | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = ByteString
p
    | Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
idx Int
b =
        let !p' :: ByteString
p' = Int -> ByteString -> ByteString
flip_bit Int
b ByteString
p
            !p'' :: ByteString
p'' = ByteString -> ByteString
SHA256.hash ByteString
p'
        in  Int -> ByteString -> ByteString
go (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ByteString
p''
    | Bool
otherwise = Int -> ByteString -> ByteString
go (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ByteString
p
{-# INLINE derive_secret #-}

-- | Flip bit B in a 32-byte bytestring.
--
-- "flip(B)" alternates the (B mod 8) bit of the (B div 8) byte.
flip_bit :: Int -> BS.ByteString -> BS.ByteString
flip_bit :: Int -> ByteString -> ByteString
flip_bit Int
b ByteString
bs =
  let !byteIdx :: Int
byteIdx = Int
b Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
8
      !bitIdx :: Int
bitIdx = Int
b Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8
      !len :: Int
len = ByteString -> Int
BS.length ByteString
bs
  in  if Int
byteIdx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
      then ByteString
bs
      else
        let !prefix :: ByteString
prefix = Int -> ByteString -> ByteString
BS.take Int
byteIdx ByteString
bs
            !byte :: Word8
byte = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
byteIdx
            !byte' :: Word8
byte' = Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
complementBit Word8
byte Int
bitIdx
            !suffix :: ByteString
suffix = Int -> ByteString -> ByteString
BS.drop (Int
byteIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ByteString
bs
        in  ByteString
prefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
BS.singleton Word8
byte' ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
suffix
{-# INLINE flip_bit #-}

-- Per-commitment secret storage ------------------------------------------

-- | Entry in the secret store: (bucket, index, secret).
data SecretEntry = SecretEntry
  { SecretEntry -> Int
se_bucket :: {-# UNPACK #-} !Int
  , SecretEntry -> Word64
se_index  :: {-# UNPACK #-} !Word64
  , SecretEntry -> ByteString
se_secret :: !BS.ByteString
  } deriving (SecretEntry -> SecretEntry -> Bool
(SecretEntry -> SecretEntry -> Bool)
-> (SecretEntry -> SecretEntry -> Bool) -> Eq SecretEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretEntry -> SecretEntry -> Bool
== :: SecretEntry -> SecretEntry -> Bool
$c/= :: SecretEntry -> SecretEntry -> Bool
/= :: SecretEntry -> SecretEntry -> Bool
Eq, Int -> SecretEntry -> ShowS
[SecretEntry] -> ShowS
SecretEntry -> String
(Int -> SecretEntry -> ShowS)
-> (SecretEntry -> String)
-> ([SecretEntry] -> ShowS)
-> Show SecretEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretEntry -> ShowS
showsPrec :: Int -> SecretEntry -> ShowS
$cshow :: SecretEntry -> String
show :: SecretEntry -> String
$cshowList :: [SecretEntry] -> ShowS
showList :: [SecretEntry] -> ShowS
Show, (forall x. SecretEntry -> Rep SecretEntry x)
-> (forall x. Rep SecretEntry x -> SecretEntry)
-> Generic SecretEntry
forall x. Rep SecretEntry x -> SecretEntry
forall x. SecretEntry -> Rep SecretEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecretEntry -> Rep SecretEntry x
from :: forall x. SecretEntry -> Rep SecretEntry x
$cto :: forall x. Rep SecretEntry x -> SecretEntry
to :: forall x. Rep SecretEntry x -> SecretEntry
Generic)

-- | Compact storage for per-commitment secrets.
--
-- Stores up to 49 (value, index) pairs, allowing efficient derivation
-- of any previously-received secret. This is possible because for a
-- given secret on a 2^X boundary, all secrets up to the next 2^X
-- boundary can be derived from it.
newtype SecretStore = SecretStore { SecretStore -> [SecretEntry]
unSecretStore :: [SecretEntry] }
  deriving (SecretStore -> SecretStore -> Bool
(SecretStore -> SecretStore -> Bool)
-> (SecretStore -> SecretStore -> Bool) -> Eq SecretStore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretStore -> SecretStore -> Bool
== :: SecretStore -> SecretStore -> Bool
$c/= :: SecretStore -> SecretStore -> Bool
/= :: SecretStore -> SecretStore -> Bool
Eq, Int -> SecretStore -> ShowS
[SecretStore] -> ShowS
SecretStore -> String
(Int -> SecretStore -> ShowS)
-> (SecretStore -> String)
-> ([SecretStore] -> ShowS)
-> Show SecretStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretStore -> ShowS
showsPrec :: Int -> SecretStore -> ShowS
$cshow :: SecretStore -> String
show :: SecretStore -> String
$cshowList :: [SecretStore] -> ShowS
showList :: [SecretStore] -> ShowS
Show, (forall x. SecretStore -> Rep SecretStore x)
-> (forall x. Rep SecretStore x -> SecretStore)
-> Generic SecretStore
forall x. Rep SecretStore x -> SecretStore
forall x. SecretStore -> Rep SecretStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecretStore -> Rep SecretStore x
from :: forall x. SecretStore -> Rep SecretStore x
$cto :: forall x. Rep SecretStore x -> SecretStore
to :: forall x. Rep SecretStore x -> SecretStore
Generic)

-- | Empty secret store.
empty_store :: SecretStore
empty_store :: SecretStore
empty_store = [SecretEntry] -> SecretStore
SecretStore []
{-# INLINE empty_store #-}

-- | Determine which bucket to store a secret in based on its index.
--
-- Counts trailing zeros in the index. Returns 0-47 for normal indices,
-- or 48 if index is 0 (the seed).
where_to_put_secret :: Word64 -> Int
where_to_put_secret :: Word64 -> Int
where_to_put_secret Word64
idx = Int -> Int
go Int
0 where
  go :: Int -> Int
go !Int
b
    | Int
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
47 = Int
48  -- index 0, this is the seed
    | Word64 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word64
idx Int
b = Int
b
    | Bool
otherwise = Int -> Int
go (Int
b Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
{-# INLINE where_to_put_secret #-}

-- | Insert a secret into the store, validating against existing secrets.
--
-- Returns Nothing if the secret doesn't derive correctly from known
-- secrets (indicating the secrets weren't generated from the same seed).
--
-- >>> insert_secret secret 281474976710655 empty_store
-- Just (SecretStore ...)
insert_secret
  :: BS.ByteString  -- ^ secret (32 bytes)
  -> Word64         -- ^ index
  -> SecretStore    -- ^ current store
  -> Maybe SecretStore
insert_secret :: ByteString -> Word64 -> SecretStore -> Maybe SecretStore
insert_secret ByteString
secret Word64
idx (SecretStore [SecretEntry]
known) = do
  let !bucket :: Int
bucket = Word64 -> Int
where_to_put_secret Word64
idx
  -- Validate: for each bucket < this bucket, check we can derive
  validated <- Int -> [SecretEntry] -> Maybe Bool
validateBuckets Int
bucket [SecretEntry]
known
  if validated
    then
      -- Remove entries at bucket >= this bucket, then insert
      let !known' = (SecretEntry -> Bool) -> [SecretEntry] -> [SecretEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SecretEntry
e -> SecretEntry -> Int
se_bucket SecretEntry
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
bucket) [SecretEntry]
known
          !entry = Int -> Word64 -> ByteString -> SecretEntry
SecretEntry Int
bucket Word64
idx ByteString
secret
      in  pure $! SecretStore (known' ++ [entry])
    else Nothing
  where
    validateBuckets :: Int -> [SecretEntry] -> Maybe Bool
    validateBuckets :: Int -> [SecretEntry] -> Maybe Bool
validateBuckets Int
b [SecretEntry]
entries = [SecretEntry] -> Maybe Bool
go [SecretEntry]
entries where
      go :: [SecretEntry] -> Maybe Bool
go [] = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
      go (SecretEntry Int
entryBucket Word64
knownIdx ByteString
knownSecret : [SecretEntry]
rest)
        | Int
entryBucket Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b = [SecretEntry] -> Maybe Bool
go [SecretEntry]
rest  -- skip entries at higher buckets
        | Bool
otherwise =
            -- Check if we can derive the known secret from the new one
            let !derived :: ByteString
derived = ByteString -> Int -> Word64 -> ByteString
derive_secret ByteString
secret Int
b Word64
knownIdx
            in  if ByteString
derived ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
knownSecret
                then [SecretEntry] -> Maybe Bool
go [SecretEntry]
rest
                else Maybe Bool
forall a. Maybe a
Nothing
{-# INLINE insert_secret #-}

-- | Derive a previously-received secret from the store.
--
-- Iterates over known secrets to find one whose index is a prefix of
-- the target index, then derives the target secret from it.
--
-- >>> derive_old_secret 281474976710654 store
-- Just <32-byte secret>
derive_old_secret
  :: Word64       -- ^ target index
  -> SecretStore  -- ^ store
  -> Maybe BS.ByteString
derive_old_secret :: Word64 -> SecretStore -> Maybe ByteString
derive_old_secret Word64
targetIdx (SecretStore [SecretEntry]
known) = [SecretEntry] -> Maybe ByteString
go [SecretEntry]
known where
  go :: [SecretEntry] -> Maybe BS.ByteString
  go :: [SecretEntry] -> Maybe ByteString
go [] = Maybe ByteString
forall a. Maybe a
Nothing
  go (SecretEntry Int
bucket Word64
knownIdx ByteString
knownSecret : [SecretEntry]
rest) =
    -- Mask off the non-zero prefix of the index using the entry's bucket
    let !mask :: Word64
mask = Word64 -> Word64
complement ((Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
bucket) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
    in  if (Word64
targetIdx Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
mask) Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
knownIdx
        then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$! ByteString -> Int -> Word64 -> ByteString
derive_secret ByteString
knownSecret Int
bucket Word64
targetIdx
        else [SecretEntry] -> Maybe ByteString
go [SecretEntry]
rest

  complement :: Word64 -> Word64
  complement :: Word64 -> Word64
complement Word64
x = Word64
x Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
0xFFFFFFFFFFFFFFFF
{-# INLINE derive_old_secret #-}

-- Commitment number obscuring --------------------------------------------

-- | Calculate the obscured commitment number.
--
-- The 48-bit commitment number is obscured by XOR with the lower 48 bits
-- of SHA256(payment_basepoint from open_channel
--         || payment_basepoint from accept_channel).
--
-- >>> obscured_commitment_number local_payment_bp remote_payment_bp cn
-- <obscured value>
obscured_commitment_number
  :: PaymentBasepoint   -- ^ opener's payment_basepoint
  -> PaymentBasepoint   -- ^ accepter's payment_basepoint
  -> CommitmentNumber   -- ^ commitment number (48-bit)
  -> Word64             -- ^ obscured commitment number
obscured_commitment_number :: PaymentBasepoint -> PaymentBasepoint -> CommitmentNumber -> Word64
obscured_commitment_number
  (PaymentBasepoint (Point ByteString
openerBs))
  (PaymentBasepoint (Point ByteString
accepterBs))
  (CommitmentNumber Word64
cn) =
    let !h :: ByteString
h = ByteString -> ByteString
SHA256.hash (ByteString
openerBs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
accepterBs)
        -- Extract lower 48 bits (6 bytes) from the hash
        !lower48 :: Word64
lower48 = ByteString -> Word64
extractLower48 ByteString
h
        -- Mask commitment number to 48 bits
        !cn48 :: Word64
cn48 = Word64
cn Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xFFFFFFFFFFFF
    in  Word64
cn48 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
lower48
{-# INLINE obscured_commitment_number #-}

-- | Extract lower 48 bits from a 32-byte hash.
--
-- Takes bytes 26-31 (last 6 bytes) and interprets as big-endian Word64.
extractLower48 :: BS.ByteString -> Word64
extractLower48 :: ByteString -> Word64
extractLower48 ByteString
h =
  let !b0 :: Word64
b0 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
h Int
26) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
40
      !b1 :: Word64
b1 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
h Int
27) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
32
      !b2 :: Word64
b2 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
h Int
28) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
24
      !b3 :: Word64
b3 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
h Int
29) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
16
      !b4 :: Word64
b4 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
h Int
30) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` Int
8
      !b5 :: Word64
b5 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
h Int
31)
  in  Word64
b0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
b1 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
b2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
b3 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
b4 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
b5
{-# INLINE extractLower48 #-}