bolt4

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

Error.hs (4278B)

      1 {-# OPTIONS_HADDOCK hide #-}
      2 {-# LANGUAGE DeriveGeneric #-}
      3 
      4 -- |
      5 -- Module: Lightning.Protocol.BOLT4.Error
      6 -- Copyright: (c) 2025 Jared Tobin
      7 -- License: MIT
      8 -- Maintainer: Jared Tobin <jared@ppad.tech>
      9 --
     10 -- Returning errors: construction, wrapping and attribution of return
     11 -- packets.
     12 
     13 module Lightning.Protocol.BOLT4.Error (
     14     ErrorPacket(..)
     15   , Attribution(..)
     16   , construct_error
     17   , wrap_error
     18   , unwrap_error
     19   ) where
     20 
     21 import Control.DeepSeq (NFData)
     22 import qualified Data.ByteString as BS
     23 import GHC.Generics (Generic)
     24 import qualified Lightning.Protocol.BOLT1 as BOLT1
     25 import Lightning.Protocol.BOLT4.Codec
     26 import Lightning.Protocol.BOLT4.Prim
     27 import Lightning.Protocol.BOLT4.Types
     28 
     29 -- | An obfuscated return packet (the @reason@ of @update_fail_htlc@).
     30 newtype ErrorPacket = ErrorPacket BS.ByteString
     31   deriving (Eq, Show, Generic)
     32 
     33 instance NFData ErrorPacket
     34 
     35 -- | The origin of a return packet, as found by 'unwrap_error'.
     36 data Attribution
     37   = Attributed {-# UNPACK #-} !Int !FailureMessage
     38     -- ^ the hop with this index (from 0, in route order) returned the
     39     --   failure
     40   | MalformedFailure {-# UNPACK #-} !Int
     41     -- ^ the hop with this index returned the packet, but its failure
     42     --   message can't be decoded
     43   | UnknownOrigin
     44     -- ^ no hop's HMAC matches
     45   deriving (Eq, Show, Generic)
     46 
     47 instance NFData Attribution
     48 
     49 -- | Construct a return packet at the failing node, given the shared
     50 --   secret from processing the onion and the failure.
     51 --
     52 --   The failure message is padded so that its length plus that of the
     53 --   padding is at least 256 bytes. Fails if the failure message can't
     54 --   be encoded, or exceeds 65535 bytes.
     55 --
     56 --   >>> let Just ss = shared_secret (BS.replicate 32 0x01)
     57 --   >>> let fm = FailureMessage TemporaryNodeFailure BOLT1.empty_tlv_stream
     58 --   >>> let Right (ErrorPacket pkt) = construct_error ss fm
     59 --   >>> BS.length pkt
     60 --   292
     61 construct_error
     62   :: SharedSecret
     63   -> FailureMessage
     64   -> Either EncodeError ErrorPacket
     65 construct_error ss fm = do
     66   msg <- encode_failure_message fm
     67   let len = BS.length msg
     68   if len > 65535
     69     then Left FieldTooLong
     70     else do
     71       let pad  = max 0 (256 - len)
     72           body = BS.concat
     73             [ BOLT1.encode_u16 (fromIntegral len), msg
     74             , BOLT1.encode_u16 (fromIntegral pad), BS.replicate pad 0 ]
     75           mac  = hmac (derive_um ss) body
     76       pure (wrap_error ss (ErrorPacket (mac <> body)))
     77 
     78 -- | Wrap a return packet from downstream at an intermediate node, given
     79 --   the shared secret from processing the onion.
     80 --
     81 --   >>> let Just ss = shared_secret (BS.replicate 32 0x01)
     82 --   >>> wrap_error ss (wrap_error ss (ErrorPacket "packet"))
     83 --   ErrorPacket "packet"
     84 wrap_error :: SharedSecret -> ErrorPacket -> ErrorPacket
     85 wrap_error ss (ErrorPacket p) =
     86   ErrorPacket (xor_bytes p (keystream (derive_ammag ss) (BS.length p)))
     87 
     88 -- | Find the origin of a return packet at the origin node, given the
     89 --   shared secrets from 'Lightning.Protocol.BOLT4.construct', in route
     90 --   order.
     91 --
     92 --   >>> let Just ss0 = shared_secret (BS.replicate 32 0x01)
     93 --   >>> let Just ss1 = shared_secret (BS.replicate 32 0x02)
     94 --   >>> let fm = FailureMessage TemporaryNodeFailure BOLT1.empty_tlv_stream
     95 --   >>> let Right pkt = construct_error ss1 fm
     96 --   >>> unwrap_error [ss0, ss1] (wrap_error ss0 pkt) == Attributed 1 fm
     97 --   True
     98 --   >>> unwrap_error [ss0] (wrap_error ss0 pkt)
     99 --   UnknownOrigin
    100 unwrap_error :: [SharedSecret] -> ErrorPacket -> Attribution
    101 unwrap_error = go 0
    102   where
    103     go _ [] _ = UnknownOrigin
    104     go i (ss : rest) p =
    105       let ErrorPacket q = wrap_error ss p
    106           (mac, body) = BS.splitAt 32 q
    107       in  if   ct_eq mac (hmac (derive_um ss) body)
    108           then either (const (MalformedFailure i)) (Attributed i)
    109                  (failure_message body)
    110           else go (i + 1) rest (ErrorPacket q)
    111 
    112 -- The failure message of a return packet (after its HMAC).
    113 failure_message :: BS.ByteString -> Either DecodeError FailureMessage
    114 failure_message body = case BOLT1.decode_u16 body of
    115   Just (len, r0)
    116     | BS.length r0 >= fromIntegral len
    117     , let (msg, r1) = BS.splitAt (fromIntegral len) r0
    118     , Just (pad, r2) <- BOLT1.decode_u16 r1
    119     , BS.length r2 >= fromIntegral pad
    120     -> decode_failure_message msg
    121   _ -> Left InvalidLength