Types.hs

{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module: Lightning.Protocol.BOLT4.Types
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Data types for BOLT #4.

module Lightning.Protocol.BOLT4.Types (
  -- * Onion packets
    OnionPacket(..)
  , HopPayloads(..)
  , hop_payloads
  , un_hop_payloads
  , Hmac32(..)
  , hmac32
  , un_hmac32

  -- * Hop payloads
  , HopPayload(..)
  , empty_hop_payload
  , PaymentData(..)
  , PaymentSecret(..)
  , payment_secret
  , un_payment_secret

  -- * Route blinding
  , BlindedPath(..)
  , BlindedHop(..)
  , BlindedHopData(..)
  , empty_blinded_hop_data
  , PaymentRelay(..)
  , PaymentConstraints(..)
  , BlindedInfo(..)

  -- * Failure messages
  , FailureMessage(..)
  , Failure(..)
  , OnionHash(..)
  , onion_hash
  , un_onion_hash
  , failure_code
  , is_badonion
  , is_perm
  , is_node
  , is_update

  -- * Errors
  , DecodeError(..)
  , EncodeError(..)
  , ProcessError(..)
  ) where

import Control.DeepSeq (NFData(..))
import Data.Bits ((.&.))
import qualified Data.ByteString as BS
import Data.Word (Word8, Word16, Word32, Word64)
import GHC.Generics (Generic)
import qualified Lightning.Protocol.BOLT1 as BOLT1
import qualified Lightning.Protocol.BOLT4.Prim as P
import qualified Lightning.Protocol.BOLT9 as BOLT9

-- onion packets --------------------------------------------------------------

-- | An onion packet (@onion_packet@): 1366 bytes on the wire.
data OnionPacket = OnionPacket
  { onion_version      :: {-# UNPACK #-} !Word8
    -- ^ the version byte; 0 in this version of the protocol
  , onion_public_key   :: !BOLT1.Point
    -- ^ the ephemeral public key
  , onion_hop_payloads :: !HopPayloads
    -- ^ the obfuscated hop payloads
  , onion_hmac         :: !Hmac32
    -- ^ the HMAC authenticating the packet
  } deriving (Eq, Show, Generic)

instance NFData OnionPacket

-- | The 1300-byte @hop_payloads@ field of an onion packet.
newtype HopPayloads = HopPayloads BS.ByteString
  deriving (Eq, Show, Generic)

instance NFData HopPayloads

-- | Construct t'HopPayloads' from exactly 1300 bytes.
--
--   >>> let Just hp = hop_payloads (BS.replicate 1300 0)
--   >>> BS.length (un_hop_payloads hp)
--   1300
--   >>> hop_payloads (BS.replicate 1299 0)
--   Nothing
hop_payloads :: BS.ByteString -> Maybe HopPayloads
hop_payloads bs
  | BS.length bs == 1300 = Just (HopPayloads bs)
  | otherwise            = Nothing
{-# INLINE hop_payloads #-}

-- | The bytes of t'HopPayloads'.
un_hop_payloads :: HopPayloads -> BS.ByteString
un_hop_payloads (HopPayloads bs) = bs
{-# INLINE un_hop_payloads #-}

-- | A 32-byte HMAC.
newtype Hmac32 = Hmac32 BS.ByteString
  deriving (Eq, Show, Generic)

instance NFData Hmac32

-- | Construct an t'Hmac32' from exactly 32 bytes.
--
--   >>> fmap (BS.length . un_hmac32) (hmac32 (BS.replicate 32 0))
--   Just 32
--   >>> hmac32 "too short"
--   Nothing
hmac32 :: BS.ByteString -> Maybe Hmac32
hmac32 bs
  | BS.length bs == 32 = Just (Hmac32 bs)
  | otherwise          = Nothing
{-# INLINE hmac32 #-}

-- | The bytes of an t'Hmac32'.
un_hmac32 :: Hmac32 -> BS.ByteString
un_hmac32 (Hmac32 bs) = bs
{-# INLINE un_hmac32 #-}

-- hop payloads ---------------------------------------------------------------

-- | A hop's @payload@ TLV stream.
--
--   Each known record has a typed field. 'hp_extra' holds the remaining
--   records: decoding fills it with the unknown odd records (unknown even
--   records are rejected), and encoding accepts any record in it whose
--   type isn't one of the known ones.
data HopPayload = HopPayload
  { hp_amt_to_forward      :: !(Maybe BOLT1.MilliSatoshi)
    -- ^ type 2: @amt_to_forward@
  , hp_outgoing_cltv_value :: !(Maybe Word32)
    -- ^ type 4: @outgoing_cltv_value@
  , hp_short_channel_id    :: !(Maybe BOLT1.ShortChannelId)
    -- ^ type 6: @short_channel_id@
  , hp_payment_data        :: !(Maybe PaymentData)
    -- ^ type 8: @payment_data@
  , hp_encrypted_data      :: !(Maybe BS.ByteString)
    -- ^ type 10: @encrypted_recipient_data@
  , hp_current_path_key    :: !(Maybe BOLT1.Point)
    -- ^ type 12: @current_path_key@
  , hp_payment_metadata    :: !(Maybe BS.ByteString)
    -- ^ type 16: @payment_metadata@
  , hp_total_amount_msat   :: !(Maybe BOLT1.MilliSatoshi)
    -- ^ type 18: @total_amount_msat@
  , hp_extra               :: !BOLT1.TlvStream
    -- ^ other records
  } deriving (Eq, Show, Generic)

instance NFData HopPayload

-- | The empty t'HopPayload', to be updated with record syntax.
--
--   >>> let Just amt = BOLT1.milli_satoshi 1000
--   >>> let hp = empty_hop_payload { hp_amt_to_forward = Just amt }
--   >>> encode_hop_payload hp
--   Right "\STX\STX\ETX\232"
empty_hop_payload :: HopPayload
empty_hop_payload = HopPayload
  Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
  BOLT1.empty_tlv_stream

-- | The @payment_data@ record of a final hop's payload.
data PaymentData = PaymentData
  { pd_payment_secret :: !PaymentSecret
  , pd_total_msat     :: !BOLT1.MilliSatoshi
  } deriving (Eq, Show, Generic)

instance NFData PaymentData

-- | A 32-byte payment secret.
--
--   Its 'Show' instance is redacted and its 'Eq' instance runs in
--   constant time.
newtype PaymentSecret = PaymentSecret BS.ByteString

instance Eq PaymentSecret where
  PaymentSecret a == PaymentSecret b = P.ct_eq a b

instance Show PaymentSecret where
  showsPrec d _ = showParen (d > 10) $
    showString "PaymentSecret <redacted>"

instance NFData PaymentSecret where
  rnf (PaymentSecret bs) = rnf bs

-- | Construct a t'PaymentSecret' from exactly 32 bytes.
--
--   >>> payment_secret (BS.replicate 32 0x01)
--   Just (PaymentSecret <redacted>)
--   >>> payment_secret (BS.replicate 16 0x01)
--   Nothing
payment_secret :: BS.ByteString -> Maybe PaymentSecret
payment_secret bs
  | BS.length bs == 32 = Just (PaymentSecret bs)
  | otherwise          = Nothing
{-# INLINE payment_secret #-}

-- | The bytes of a t'PaymentSecret'.
un_payment_secret :: PaymentSecret -> BS.ByteString
un_payment_secret (PaymentSecret bs) = bs
{-# INLINE un_payment_secret #-}

-- route blinding -------------------------------------------------------------

-- | A blinded route (@blinded_path@), as created by a recipient.
data BlindedPath = BlindedPath
  { bp_first_node_id  :: !BOLT1.Point
    -- ^ the (unblinded) introduction node
  , bp_first_path_key :: !BOLT1.Point
    -- ^ the path key for the introduction node
  , bp_hops           :: ![BlindedHop]
    -- ^ the blinded hops, starting with the introduction node
  } deriving (Eq, Show, Generic)

instance NFData BlindedPath

-- | A hop of a blinded route (@blinded_path_hop@).
data BlindedHop = BlindedHop
  { bh_blinded_node_id :: !BOLT1.Point
    -- ^ the hop's blinded node id
  , bh_encrypted_data  :: !BS.ByteString
    -- ^ the hop's @encrypted_recipient_data@
  } deriving (Eq, Show, Generic)

instance NFData BlindedHop

-- | The @encrypted_data_tlv@ stream carried, encrypted, in a hop's
--   @encrypted_recipient_data@.
--
--   'bhd_extra' plays the same role as 'hp_extra' in t'HopPayload'.
data BlindedHopData = BlindedHopData
  { bhd_padding                :: !(Maybe BS.ByteString)
    -- ^ type 1: @padding@
  , bhd_short_channel_id       :: !(Maybe BOLT1.ShortChannelId)
    -- ^ type 2: @short_channel_id@
  , bhd_next_node_id           :: !(Maybe BOLT1.Point)
    -- ^ type 4: @next_node_id@
  , bhd_path_id                :: !(Maybe BS.ByteString)
    -- ^ type 6: @path_id@
  , bhd_next_path_key_override :: !(Maybe BOLT1.Point)
    -- ^ type 8: @next_path_key_override@
  , bhd_payment_relay          :: !(Maybe PaymentRelay)
    -- ^ type 10: @payment_relay@
  , bhd_payment_constraints    :: !(Maybe PaymentConstraints)
    -- ^ type 12: @payment_constraints@
  , bhd_allowed_features       :: !(Maybe BOLT9.FeatureVector)
    -- ^ type 14: @allowed_features@
  , bhd_extra                  :: !BOLT1.TlvStream
    -- ^ other records
  } deriving (Eq, Show, Generic)

instance NFData BlindedHopData

-- | The empty t'BlindedHopData', to be updated with record syntax.
--
--   >>> let bhd = empty_blinded_hop_data { bhd_path_id = Just "path id" }
--   >>> encode_blinded_hop_data bhd
--   Right "\ACK\apath id"
empty_blinded_hop_data :: BlindedHopData
empty_blinded_hop_data = BlindedHopData
  Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
  BOLT1.empty_tlv_stream

-- | The @payment_relay@ record of t'BlindedHopData'.
data PaymentRelay = PaymentRelay
  { pr_cltv_expiry_delta           :: {-# UNPACK #-} !Word16
  , pr_fee_proportional_millionths :: {-# UNPACK #-} !Word32
  , pr_fee_base_msat               :: {-# UNPACK #-} !Word32
  } deriving (Eq, Show, Generic)

instance NFData PaymentRelay

-- | The @payment_constraints@ record of t'BlindedHopData'.
data PaymentConstraints = PaymentConstraints
  { pc_max_cltv_expiry   :: {-# UNPACK #-} !Word32
  , pc_htlc_minimum_msat :: !BOLT1.MilliSatoshi
  } deriving (Eq, Show, Generic)

instance NFData PaymentConstraints

-- | What a node in a blinded route learns from its
--   @encrypted_recipient_data@.
data BlindedInfo = BlindedInfo
  { bi_data          :: !BlindedHopData
    -- ^ the decrypted @encrypted_data_tlv@
  , bi_next_path_key :: !BOLT1.Point
    -- ^ the @path_key@ to send to the next node
  } deriving (Eq, Show, Generic)

instance NFData BlindedInfo

-- failure messages -----------------------------------------------------------

-- | A failure message (@failuremsg@): a failure, followed by an optional
--   TLV stream.
data FailureMessage = FailureMessage
  { fm_failure :: !Failure
  , fm_tlvs    :: !BOLT1.TlvStream
  } deriving (Eq, Show, Generic)

instance NFData FailureMessage

-- | A failure: a failure code and its data.
--
--   A @channel_update@ field holds the raw bytes of the update; it is
--   empty when the update is omitted.
data Failure
  = TemporaryNodeFailure
    -- ^ NODE|2
  | PermanentNodeFailure
    -- ^ PERM|NODE|2
  | RequiredNodeFeatureMissing
    -- ^ PERM|NODE|3
  | InvalidOnionVersion !OnionHash
    -- ^ BADONION|PERM|4: @sha256_of_onion@
  | InvalidOnionHmac !OnionHash
    -- ^ BADONION|PERM|5: @sha256_of_onion@
  | InvalidOnionKey !OnionHash
    -- ^ BADONION|PERM|6: @sha256_of_onion@
  | TemporaryChannelFailure !BS.ByteString
    -- ^ UPDATE|7: @channel_update@
  | PermanentChannelFailure
    -- ^ PERM|8
  | RequiredChannelFeatureMissing
    -- ^ PERM|9
  | UnknownNextPeer
    -- ^ PERM|10
  | AmountBelowMinimum !BOLT1.MilliSatoshi !BS.ByteString
    -- ^ UPDATE|11: @htlc_msat@, @channel_update@
  | FeeInsufficient !BOLT1.MilliSatoshi !BS.ByteString
    -- ^ UPDATE|12: @htlc_msat@, @channel_update@
  | IncorrectCltvExpiry {-# UNPACK #-} !Word32 !BS.ByteString
    -- ^ UPDATE|13: @cltv_expiry@, @channel_update@
  | ExpiryTooSoon !BS.ByteString
    -- ^ UPDATE|14: @channel_update@
  | IncorrectOrUnknownPaymentDetails !BOLT1.MilliSatoshi
                                     {-# UNPACK #-} !Word32
    -- ^ PERM|15: @htlc_msat@, @height@
  | FinalIncorrectCltvExpiry {-# UNPACK #-} !Word32
    -- ^ 18: @cltv_expiry@
  | FinalIncorrectHtlcAmount !BOLT1.MilliSatoshi
    -- ^ 19: @incoming_htlc_amt@
  | ChannelDisabled {-# UNPACK #-} !Word16 !BS.ByteString
    -- ^ UPDATE|20: @disabled_flags@, @channel_update@
  | ExpiryTooFar
    -- ^ 21
  | InvalidOnionPayload !(Maybe (Word64, Word16))
    -- ^ PERM|22: the optional @type@ and @offset@
  | MppTimeout
    -- ^ 23
  | InvalidOnionBlinding !OnionHash
    -- ^ BADONION|PERM|24: @sha256_of_onion@
  | UnknownFailure {-# UNPACK #-} !Word16 !BS.ByteString
    -- ^ a failure code not defined above, and the bytes following it
  deriving (Eq, Show, Generic)

instance NFData Failure

-- | A 32-byte @sha256_of_onion@.
newtype OnionHash = OnionHash BS.ByteString
  deriving (Eq, Show, Generic)

instance NFData OnionHash

-- | Construct an t'OnionHash' from exactly 32 bytes.
--
--   >>> fmap (BS.length . un_onion_hash) (onion_hash (BS.replicate 32 0))
--   Just 32
onion_hash :: BS.ByteString -> Maybe OnionHash
onion_hash bs
  | BS.length bs == 32 = Just (OnionHash bs)
  | otherwise          = Nothing
{-# INLINE onion_hash #-}

-- | The bytes of an t'OnionHash'.
un_onion_hash :: OnionHash -> BS.ByteString
un_onion_hash (OnionHash bs) = bs
{-# INLINE un_onion_hash #-}

-- | The @failure_code@ of a 'Failure'.
--
--   >>> failure_code TemporaryNodeFailure
--   8194
--   >>> failure_code (UnknownFailure 0x1234 mempty)
--   4660
failure_code :: Failure -> Word16
failure_code f = case f of
  TemporaryNodeFailure                 -> 0x2002
  PermanentNodeFailure                 -> 0x6002
  RequiredNodeFeatureMissing           -> 0x6003
  InvalidOnionVersion _                -> 0xc004
  InvalidOnionHmac _                   -> 0xc005
  InvalidOnionKey _                    -> 0xc006
  TemporaryChannelFailure _            -> 0x1007
  PermanentChannelFailure              -> 0x4008
  RequiredChannelFeatureMissing        -> 0x4009
  UnknownNextPeer                      -> 0x400a
  AmountBelowMinimum _ _               -> 0x100b
  FeeInsufficient _ _                  -> 0x100c
  IncorrectCltvExpiry _ _              -> 0x100d
  ExpiryTooSoon _                      -> 0x100e
  IncorrectOrUnknownPaymentDetails _ _ -> 0x400f
  FinalIncorrectCltvExpiry _           -> 0x0012
  FinalIncorrectHtlcAmount _           -> 0x0013
  ChannelDisabled _ _                  -> 0x1014
  ExpiryTooFar                         -> 0x0015
  InvalidOnionPayload _                -> 0x4016
  MppTimeout                           -> 0x0017
  InvalidOnionBlinding _               -> 0xc018
  UnknownFailure c _                   -> c

-- | Is the BADONION flag (0x8000) set: was the onion unparsable?
--
--   >>> is_badonion TemporaryNodeFailure
--   False
is_badonion :: Failure -> Bool
is_badonion f = failure_code f .&. 0x8000 /= 0
{-# INLINE is_badonion #-}

-- | Is the PERM flag (0x4000) set: is the failure permanent?
--
--   >>> is_perm PermanentNodeFailure
--   True
is_perm :: Failure -> Bool
is_perm f = failure_code f .&. 0x4000 /= 0
{-# INLINE is_perm #-}

-- | Is the NODE flag (0x2000) set: is it a node (not channel) failure?
--
--   >>> is_node TemporaryNodeFailure
--   True
is_node :: Failure -> Bool
is_node f = failure_code f .&. 0x2000 /= 0
{-# INLINE is_node #-}

-- | Is the UPDATE flag (0x1000) set: was a channel forwarding parameter
--   violated?
--
--   >>> is_update (ExpiryTooSoon mempty)
--   True
is_update :: Failure -> Bool
is_update f = failure_code f .&. 0x1000 /= 0
{-# INLINE is_update #-}

-- errors ---------------------------------------------------------------------

-- | Why a decoder failed.
data DecodeError
  = InvalidLength
    -- ^ the input has the wrong length
  | InvalidPoint
    -- ^ a point lacks a compressed-encoding prefix
  | InvalidTlvStream !BOLT1.TlvError
    -- ^ the TLV stream is malformed, or has an unknown even type
  | InvalidTlvValue {-# UNPACK #-} !Word64
    -- ^ the value of the record of this type is malformed
  | InvalidFailureData {-# UNPACK #-} !Word16
    -- ^ the data of a failure with this code is malformed
  deriving (Eq, Show, Generic)

instance NFData DecodeError

-- | Why an encoder failed.
data EncodeError
  = ConflictingTlv
    -- ^ an extra TLV record has the type of a known record
  | FieldTooLong
    -- ^ a length-prefixed field exceeds its maximum length
  deriving (Eq, Show, Generic)

instance NFData EncodeError

-- | Why an onion packet was rejected.
data ProcessError
  = InvalidVersion {-# UNPACK #-} !Word8
    -- ^ the version byte is not 0
  | InvalidPublicKey
    -- ^ the ephemeral public key is not a valid point
  | HmacMismatch
    -- ^ the packet's HMAC is wrong
  | InvalidPayloadLength
    -- ^ the payload length is malformed, below 2, or past the end of
    --   @hop_payloads@
  | InvalidPayload !DecodeError
    -- ^ the payload is not a valid @payload@ TLV stream
  | InvalidPathKey
    -- ^ the path key is not a valid point
  | UnexpectedPathKey
    -- ^ a path key was given with no @encrypted_recipient_data@, or
    --   both a @path_key@ and a @current_path_key@ were given
  | MissingPathKey
    -- ^ @encrypted_recipient_data@ was given with no path key
  | InvalidRecipientData
    -- ^ the @encrypted_recipient_data@ doesn't decrypt to a valid
    --   @encrypted_data_tlv@ stream
  deriving (Eq, Show, Generic)

instance NFData ProcessError