bolt4

Onion routing protocol, per BOLT #4 (docs.ppad.tech/bolt4).
git clone git://git.ppad.tech/bolt4.git
Log | Files | Refs | README | LICENSE

Process.hs (6480B)

      1 {-# OPTIONS_HADDOCK hide #-}
      2 {-# LANGUAGE DeriveGeneric #-}
      3 
      4 -- |
      5 -- Module: Lightning.Protocol.BOLT4.Process
      6 -- Copyright: (c) 2025 Jared Tobin
      7 -- License: MIT
      8 -- Maintainer: Jared Tobin <jared@ppad.tech>
      9 --
     10 -- Onion packet processing.
     11 
     12 module Lightning.Protocol.BOLT4.Process (
     13     ProcessResult(..)
     14   , ForwardInfo(..)
     15   , ReceiveInfo(..)
     16   , process
     17   ) where
     18 
     19 import Control.DeepSeq (NFData)
     20 import qualified Crypto.Curve.Secp256k1 as Secp256k1
     21 import qualified Data.ByteString as BS
     22 import GHC.Generics (Generic)
     23 import qualified Lightning.Protocol.BOLT1 as BOLT1
     24 import Lightning.Protocol.BOLT4.Blinding (unblind)
     25 import Lightning.Protocol.BOLT4.Codec (decode_hop_payload)
     26 import Lightning.Protocol.BOLT4.Prim
     27 import Lightning.Protocol.BOLT4.Types
     28 
     29 -- | The result of processing an onion packet.
     30 data ProcessResult
     31   = Forward !ForwardInfo
     32     -- ^ forward the onion to the next hop
     33   | Receive !ReceiveInfo
     34     -- ^ this node is the onion's final hop
     35   deriving (Eq, Show, Generic)
     36 
     37 instance NFData ProcessResult
     38 
     39 -- | What a forwarding node learns from an onion.
     40 data ForwardInfo = ForwardInfo
     41   { fwd_payload       :: !HopPayload
     42     -- ^ this node's payload
     43   , fwd_blinded       :: !(Maybe BlindedInfo)
     44     -- ^ the decrypted @encrypted_recipient_data@ and next path key, in
     45     --   a blinded route
     46   , fwd_next_packet   :: !OnionPacket
     47     -- ^ the onion for the next hop
     48   , fwd_shared_secret :: !SharedSecret
     49     -- ^ the shared secret, to wrap returned errors with
     50   } deriving (Eq, Show, Generic)
     51 
     52 instance NFData ForwardInfo
     53 
     54 -- | What the final node learns from an onion.
     55 data ReceiveInfo = ReceiveInfo
     56   { rcv_payload       :: !HopPayload
     57     -- ^ this node's payload
     58   , rcv_blinded       :: !(Maybe BlindedInfo)
     59     -- ^ the decrypted @encrypted_recipient_data@, in a blinded route
     60   , rcv_shared_secret :: !SharedSecret
     61     -- ^ the shared secret, to construct errors with
     62   } deriving (Eq, Show, Generic)
     63 
     64 instance NFData ReceiveInfo
     65 
     66 -- | Process an onion packet, given this node's private key, the packet,
     67 --   its associated data (the payment hash, for a payment), and the
     68 --   @path_key@ received with it (in @update_add_htlc@), if any.
     69 --
     70 --   In a blinded route, the onion is encrypted to this node's blinded
     71 --   node id: given a @path_key@, the matching private key is derived
     72 --   from it. The @encrypted_recipient_data@ in the payload is decrypted
     73 --   with the @path_key@, or, at the introduction node, with the
     74 --   payload's @current_path_key@; a path key without
     75 --   @encrypted_recipient_data@, or both kinds of path key, are
     76 --   rejected.
     77 --
     78 --   The payload is otherwise returned as is. The caller must apply the
     79 --   remaining reader requirements of BOLT #4: the presence of the
     80 --   fields required for forwarding or receiving, the HTLC amount and
     81 --   expiry checks (in a blinded route, against @payment_relay@ and
     82 --   @payment_constraints@), @allowed_features@, the rule that
     83 --   @encrypted_recipient_data@ hold only one of @short_channel_id@ and
     84 --   @next_node_id@, and the rejection of replayed HMACs.
     85 --
     86 --   >>> let Just session = secret_key (BS.replicate 32 0x41)
     87 --   >>> let Just node = secret_key (BS.replicate 32 0x42)
     88 --   >>> let pl = empty_hop_payload { hp_outgoing_cltv_value = Just 144 }
     89 --   >>> let ad = BS.replicate 32 0
     90 --   >>> let Right (pkt, _) = construct session [Hop (public_key node) pl] ad
     91 --   >>> let Right (Receive info) = process node pkt ad Nothing
     92 --   >>> hp_outgoing_cltv_value (rcv_payload info)
     93 --   Just 144
     94 process
     95   :: SecretKey
     96   -> OnionPacket
     97   -> BS.ByteString
     98   -> Maybe BOLT1.Point
     99   -> Either ProcessError ProcessResult
    100 process sk pkt ad mpk = do
    101   let ver = onion_version pkt
    102   if ver /= 0 then Left (InvalidVersion ver) else Right ()
    103   eph <- note InvalidPublicKey (from_point (onion_public_key pkt))
    104   -- with a path_key, the onion is encrypted to the blinded node id
    105   blinding <- traverse path_secret mpk
    106   key <- case blinding of
    107     Nothing -> Right (sk_bytes sk)
    108     Just (_, bss) ->
    109       note InvalidPathKey (blind_scalar (sk_bytes sk) (blinded_node_tweak bss))
    110   ss <- note InvalidPublicKey (ecdh key eph)
    111   let payloads = un_hop_payloads (onion_hop_payloads pkt)
    112       mac = hmac (derive_mu ss) (payloads <> ad)
    113   if   ct_eq mac (un_hmac32 (onion_hmac pkt))
    114   then Right ()
    115   else Left HmacMismatch
    116   let plain = xor_bytes (payloads <> BS.replicate 1300 0)
    117                         (keystream (derive_rho ss) 2600)
    118   (pl, next_mac, rest) <- split_payload plain
    119   hp <- either (Left . InvalidPayload) Right (decode_hop_payload pl)
    120   binfo <- case (hp_encrypted_data hp, blinding, hp_current_path_key hp) of
    121     (Nothing, Nothing, Nothing) -> Right Nothing
    122     (Nothing, _, _)             -> Left UnexpectedPathKey
    123     (Just _, Just _, Just _)    -> Left UnexpectedPathKey
    124     (Just _, Nothing, Nothing)  -> Left MissingPathKey
    125     (Just enc, Just (e, bss), Nothing) -> Just <$> unblind bss e enc
    126     (Just enc, Nothing, Just cpk) -> do
    127       (e, bss) <- path_secret cpk
    128       Just <$> unblind bss e enc
    129   if BS.all (== 0) next_mac
    130     then Right (Receive (ReceiveInfo hp binfo ss))
    131     else do
    132       eph' <- note InvalidPublicKey
    133                 (blind_pub eph (blinding_factor eph ss) >>= to_point)
    134       let next = OnionPacket 0 eph' (HopPayloads rest) (Hmac32 next_mac)
    135       Right (Forward (ForwardInfo hp binfo next ss))
    136   where
    137     note :: ProcessError -> Maybe a -> Either ProcessError a
    138     note e = maybe (Left e) Right
    139 
    140     -- a path key, and its shared secret with this node
    141     path_secret
    142       :: BOLT1.Point
    143       -> Either ProcessError (Secp256k1.Projective, SharedSecret)
    144     path_secret pk = do
    145       e <- note InvalidPathKey (from_point pk)
    146       bss <- note InvalidPathKey (ecdh (sk_bytes sk) e)
    147       Right (e, bss)
    148 
    149 -- Split the decrypted 2600-byte buffer into the payload, the next HMAC
    150 -- and the next hop_payloads. The length prefix, payload and HMAC must
    151 -- fit in the 1300-byte hop_payloads.
    152 split_payload
    153   :: BS.ByteString
    154   -> Either ProcessError (BS.ByteString, BS.ByteString, BS.ByteString)
    155 split_payload plain = case BOLT1.decode_bigsize plain of
    156   Nothing -> Left InvalidPayloadLength
    157   Just (len, r0)
    158     | len < 2   -> Left InvalidPayloadLength
    159     | len > fromIntegral (1300 - prefix - 32) -> Left InvalidPayloadLength
    160     | otherwise ->
    161         let (pl, r1)  = BS.splitAt (fromIntegral len) r0
    162             (mac, r2) = BS.splitAt 32 r1
    163         in  Right (pl, mac, BS.take 1300 r2)
    164     where
    165       prefix = BS.length plain - BS.length r0