bolt7

Routing gossip protocol, per BOLT #7 (docs.ppad.tech/bolt7).
git clone git://git.ppad.tech/bolt7.git
Log | Files | Refs | README | LICENSE

Codec.hs (23024B)


      1 {-# OPTIONS_HADDOCK prune #-}
      2 
      3 {-# LANGUAGE BangPatterns #-}
      4 {-# LANGUAGE DeriveGeneric #-}
      5 
      6 -- |
      7 -- Module: Lightning.Protocol.BOLT7.Codec
      8 -- Copyright: (c) 2025 Jared Tobin
      9 -- License: MIT
     10 -- Maintainer: Jared Tobin <jared@ppad.tech>
     11 --
     12 -- Encoding and decoding for BOLT #7 gossip messages.
     13 
     14 module Lightning.Protocol.BOLT7.Codec (
     15   -- * Error types
     16     EncodeError(..)
     17   , DecodeError(..)
     18 
     19   -- * Channel announcement
     20   , encodeChannelAnnouncement
     21   , decodeChannelAnnouncement
     22 
     23   -- * Node announcement
     24   , encodeNodeAnnouncement
     25   , decodeNodeAnnouncement
     26 
     27   -- * Channel update
     28   , encodeChannelUpdate
     29   , decodeChannelUpdate
     30 
     31   -- * Announcement signatures
     32   , encodeAnnouncementSignatures
     33   , decodeAnnouncementSignatures
     34 
     35   -- * Query messages
     36   , encodeQueryShortChannelIds
     37   , decodeQueryShortChannelIds
     38   , encodeReplyShortChannelIdsEnd
     39   , decodeReplyShortChannelIdsEnd
     40   , encodeQueryChannelRange
     41   , decodeQueryChannelRange
     42   , encodeReplyChannelRange
     43   , decodeReplyChannelRange
     44   , encodeGossipTimestampFilter
     45   , decodeGossipTimestampFilter
     46 
     47   -- * Short channel ID encoding
     48   , encodeShortChannelIdList
     49   , decodeShortChannelIdList
     50   ) where
     51 
     52 import Control.DeepSeq (NFData)
     53 import Data.ByteString (ByteString)
     54 import qualified Data.ByteString as BS
     55 import Data.Word (Word8, Word16, Word32, Word64)
     56 import GHC.Generics (Generic)
     57 import Lightning.Protocol.BOLT1 (unsafeTlvStream)
     58 import qualified Lightning.Protocol.BOLT1.Prim as Prim
     59 import qualified Lightning.Protocol.BOLT1.TLV as TLV
     60 import Lightning.Protocol.BOLT7.Messages
     61 import Lightning.Protocol.BOLT7.Types
     62 
     63 -- Error types -----------------------------------------------------------------
     64 
     65 -- | Encoding errors.
     66 data EncodeError
     67   = EncodeLengthOverflow  -- ^ Field too large for u16 length prefix
     68   deriving (Eq, Show, Generic)
     69 
     70 instance NFData EncodeError
     71 
     72 -- | Decoding errors.
     73 data DecodeError
     74   = DecodeInsufficientBytes          -- ^ Not enough bytes
     75   | DecodeInvalidSignature           -- ^ Invalid signature field
     76   | DecodeInvalidChainHash           -- ^ Invalid chain hash field
     77   | DecodeInvalidShortChannelId      -- ^ Invalid short channel ID field
     78   | DecodeInvalidChannelId           -- ^ Invalid channel ID field
     79   | DecodeInvalidNodeId              -- ^ Invalid node ID field
     80   | DecodeInvalidPoint               -- ^ Invalid point field
     81   | DecodeInvalidRgbColor            -- ^ Invalid RGB color field
     82   | DecodeInvalidAlias               -- ^ Invalid alias field
     83   | DecodeInvalidAddress             -- ^ Invalid address encoding
     84   | DecodeTlvError                   -- ^ TLV decoding error
     85   deriving (Eq, Show, Generic)
     86 
     87 instance NFData DecodeError
     88 
     89 -- Primitive helpers -----------------------------------------------------------
     90 
     91 -- | Decode u8.
     92 decodeU8 :: ByteString -> Either DecodeError (Word8, ByteString)
     93 decodeU8 bs
     94   | BS.null bs = Left DecodeInsufficientBytes
     95   | otherwise = Right (BS.index bs 0, BS.drop 1 bs)
     96 {-# INLINE decodeU8 #-}
     97 
     98 -- | Decode u16 (big-endian).
     99 decodeU16 :: ByteString -> Either DecodeError (Word16, ByteString)
    100 decodeU16 bs = case Prim.decodeU16 bs of
    101   Nothing -> Left DecodeInsufficientBytes
    102   Just r  -> Right r
    103 {-# INLINE decodeU16 #-}
    104 
    105 -- | Decode u32 (big-endian).
    106 decodeU32 :: ByteString -> Either DecodeError (Word32, ByteString)
    107 decodeU32 bs = case Prim.decodeU32 bs of
    108   Nothing -> Left DecodeInsufficientBytes
    109   Just r  -> Right r
    110 {-# INLINE decodeU32 #-}
    111 
    112 -- | Decode u64 (big-endian).
    113 decodeU64 :: ByteString -> Either DecodeError (Word64, ByteString)
    114 decodeU64 bs = case Prim.decodeU64 bs of
    115   Nothing -> Left DecodeInsufficientBytes
    116   Just r  -> Right r
    117 {-# INLINE decodeU64 #-}
    118 
    119 -- | Decode fixed-length bytes.
    120 decodeBytes :: Int -> ByteString -> Either DecodeError (ByteString, ByteString)
    121 decodeBytes n bs
    122   | BS.length bs < n = Left DecodeInsufficientBytes
    123   | otherwise = Right (BS.splitAt n bs)
    124 {-# INLINE decodeBytes #-}
    125 
    126 -- | Decode length-prefixed bytes (u16 prefix).
    127 decodeLenPrefixed :: ByteString
    128                   -> Either DecodeError (ByteString, ByteString)
    129 decodeLenPrefixed bs = do
    130   (len, rest) <- decodeU16 bs
    131   let n = fromIntegral len
    132   if BS.length rest < n
    133     then Left DecodeInsufficientBytes
    134     else Right (BS.splitAt n rest)
    135 {-# INLINE decodeLenPrefixed #-}
    136 
    137 -- | Encode with u16 length prefix.
    138 encodeLenPrefixed :: ByteString -> ByteString
    139 encodeLenPrefixed bs = Prim.encodeU16 (fromIntegral $ BS.length bs) <> bs
    140 {-# INLINE encodeLenPrefixed #-}
    141 
    142 -- | Decode fixed-length validated type.
    143 decodeFixed :: Int -> DecodeError -> (ByteString -> Maybe a)
    144             -> ByteString -> Either DecodeError (a, ByteString)
    145 decodeFixed len err mkVal bs = do
    146   (bytes, rest) <- decodeBytes len bs
    147   case mkVal bytes of
    148     Nothing -> Left err
    149     Just v  -> Right (v, rest)
    150 {-# INLINE decodeFixed #-}
    151 
    152 -- Type-specific decoders ------------------------------------------------------
    153 
    154 -- | Decode Signature (64 bytes).
    155 decodeSignature :: ByteString -> Either DecodeError (Signature, ByteString)
    156 decodeSignature = decodeFixed signatureLen DecodeInvalidSignature signature
    157 {-# INLINE decodeSignature #-}
    158 
    159 -- | Decode ChainHash (32 bytes).
    160 decodeChainHash :: ByteString -> Either DecodeError (ChainHash, ByteString)
    161 decodeChainHash = decodeFixed chainHashLen DecodeInvalidChainHash chainHash
    162 {-# INLINE decodeChainHash #-}
    163 
    164 -- | Decode ShortChannelId (8 bytes).
    165 decodeShortChannelId :: ByteString
    166                      -> Either DecodeError (ShortChannelId, ByteString)
    167 decodeShortChannelId =
    168   decodeFixed shortChannelIdLen DecodeInvalidShortChannelId shortChannelId
    169 {-# INLINE decodeShortChannelId #-}
    170 
    171 -- | Decode ChannelId (32 bytes).
    172 decodeChannelId :: ByteString -> Either DecodeError (ChannelId, ByteString)
    173 decodeChannelId = decodeFixed channelIdLen DecodeInvalidChannelId channelId
    174 {-# INLINE decodeChannelId #-}
    175 
    176 -- | Decode NodeId (33 bytes).
    177 decodeNodeId :: ByteString -> Either DecodeError (NodeId, ByteString)
    178 decodeNodeId = decodeFixed nodeIdLen DecodeInvalidNodeId nodeId
    179 {-# INLINE decodeNodeId #-}
    180 
    181 -- | Decode Point (33 bytes).
    182 decodePoint :: ByteString -> Either DecodeError (Point, ByteString)
    183 decodePoint = decodeFixed pointLen DecodeInvalidPoint point
    184 {-# INLINE decodePoint #-}
    185 
    186 -- | Decode RgbColor (3 bytes).
    187 decodeRgbColor :: ByteString -> Either DecodeError (RgbColor, ByteString)
    188 decodeRgbColor = decodeFixed rgbColorLen DecodeInvalidRgbColor rgbColor
    189 {-# INLINE decodeRgbColor #-}
    190 
    191 -- | Decode Alias (32 bytes).
    192 decodeAlias :: ByteString -> Either DecodeError (Alias, ByteString)
    193 decodeAlias = decodeFixed aliasLen DecodeInvalidAlias alias
    194 {-# INLINE decodeAlias #-}
    195 
    196 -- | Decode FeatureBits (length-prefixed).
    197 decodeFeatureBits :: ByteString -> Either DecodeError (FeatureBits, ByteString)
    198 decodeFeatureBits bs = do
    199   (bytes, rest) <- decodeLenPrefixed bs
    200   Right (featureBits bytes, rest)
    201 {-# INLINE decodeFeatureBits #-}
    202 
    203 -- | Decode addresses list (length-prefixed).
    204 decodeAddresses :: ByteString -> Either DecodeError ([Address], ByteString)
    205 decodeAddresses bs = do
    206   (addrData, rest) <- decodeLenPrefixed bs
    207   addrs <- parseAddrs addrData
    208   Right (addrs, rest)
    209   where
    210     parseAddrs :: ByteString -> Either DecodeError [Address]
    211     parseAddrs !d
    212       | BS.null d = Right []
    213       | otherwise = do
    214           (addr, d') <- parseOneAddr d
    215           addrs <- parseAddrs d'
    216           Right (addr : addrs)
    217 
    218     parseOneAddr :: ByteString -> Either DecodeError (Address, ByteString)
    219     parseOneAddr d = do
    220       (typ, d1) <- decodeU8 d
    221       case typ of
    222         1 -> do  -- IPv4
    223           (addrBytes, d2) <- decodeBytes ipv4AddrLen d1
    224           (port, d3) <- decodeU16 d2
    225           case ipv4Addr addrBytes of
    226             Nothing -> Left DecodeInvalidAddress
    227             Just a  -> Right (AddrIPv4 a port, d3)
    228         2 -> do  -- IPv6
    229           (addrBytes, d2) <- decodeBytes ipv6AddrLen d1
    230           (port, d3) <- decodeU16 d2
    231           case ipv6Addr addrBytes of
    232             Nothing -> Left DecodeInvalidAddress
    233             Just a  -> Right (AddrIPv6 a port, d3)
    234         4 -> do  -- Tor v3
    235           (addrBytes, d2) <- decodeBytes torV3AddrLen d1
    236           (port, d3) <- decodeU16 d2
    237           case torV3Addr addrBytes of
    238             Nothing -> Left DecodeInvalidAddress
    239             Just a  -> Right (AddrTorV3 a port, d3)
    240         5 -> do  -- DNS hostname
    241           (hostLen, d2) <- decodeU8 d1
    242           (hostBytes, d3) <- decodeBytes (fromIntegral hostLen) d2
    243           (port, d4) <- decodeU16 d3
    244           Right (AddrDNS hostBytes port, d4)
    245         _ -> Left DecodeInvalidAddress  -- Unknown address type
    246 
    247 -- Channel announcement --------------------------------------------------------
    248 
    249 -- | Encode channel_announcement message.
    250 encodeChannelAnnouncement :: ChannelAnnouncement -> ByteString
    251 encodeChannelAnnouncement msg = mconcat
    252   [ getSignature (channelAnnNodeSig1 msg)
    253   , getSignature (channelAnnNodeSig2 msg)
    254   , getSignature (channelAnnBitcoinSig1 msg)
    255   , getSignature (channelAnnBitcoinSig2 msg)
    256   , encodeLenPrefixed (getFeatureBits (channelAnnFeatures msg))
    257   , getChainHash (channelAnnChainHash msg)
    258   , getShortChannelId (channelAnnShortChanId msg)
    259   , getNodeId (channelAnnNodeId1 msg)
    260   , getNodeId (channelAnnNodeId2 msg)
    261   , getPoint (channelAnnBitcoinKey1 msg)
    262   , getPoint (channelAnnBitcoinKey2 msg)
    263   ]
    264 
    265 -- | Decode channel_announcement message.
    266 decodeChannelAnnouncement :: ByteString
    267                           -> Either DecodeError (ChannelAnnouncement, ByteString)
    268 decodeChannelAnnouncement bs = do
    269   (nodeSig1, bs1)    <- decodeSignature bs
    270   (nodeSig2, bs2)    <- decodeSignature bs1
    271   (btcSig1, bs3)     <- decodeSignature bs2
    272   (btcSig2, bs4)     <- decodeSignature bs3
    273   (features, bs5)    <- decodeFeatureBits bs4
    274   (chainH, bs6)      <- decodeChainHash bs5
    275   (scid, bs7)        <- decodeShortChannelId bs6
    276   (nid1, bs8)        <- decodeNodeId bs7
    277   (nid2, bs9)        <- decodeNodeId bs8
    278   (btcKey1, bs10)    <- decodePoint bs9
    279   (btcKey2, rest)    <- decodePoint bs10
    280   let msg = ChannelAnnouncement
    281         { channelAnnNodeSig1    = nodeSig1
    282         , channelAnnNodeSig2    = nodeSig2
    283         , channelAnnBitcoinSig1 = btcSig1
    284         , channelAnnBitcoinSig2 = btcSig2
    285         , channelAnnFeatures    = features
    286         , channelAnnChainHash   = chainH
    287         , channelAnnShortChanId = scid
    288         , channelAnnNodeId1     = nid1
    289         , channelAnnNodeId2     = nid2
    290         , channelAnnBitcoinKey1 = btcKey1
    291         , channelAnnBitcoinKey2 = btcKey2
    292         }
    293   Right (msg, rest)
    294 
    295 -- Node announcement -----------------------------------------------------------
    296 
    297 -- | Encode node_announcement message.
    298 encodeNodeAnnouncement :: NodeAnnouncement -> Either EncodeError ByteString
    299 encodeNodeAnnouncement msg = do
    300   addrData <- encodeAddresses (nodeAnnAddresses msg)
    301   let features = getFeatureBits (nodeAnnFeatures msg)
    302   if BS.length features > 65535
    303     then Left EncodeLengthOverflow
    304     else Right $ mconcat
    305       [ getSignature (nodeAnnSignature msg)
    306       , encodeLenPrefixed features
    307       , Prim.encodeU32 (nodeAnnTimestamp msg)
    308       , getNodeId (nodeAnnNodeId msg)
    309       , getRgbColor (nodeAnnRgbColor msg)
    310       , getAlias (nodeAnnAlias msg)
    311       , encodeLenPrefixed addrData
    312       ]
    313 
    314 -- | Encode address list.
    315 encodeAddresses :: [Address] -> Either EncodeError ByteString
    316 encodeAddresses addrs = Right $ mconcat (map encodeAddress addrs)
    317   where
    318     encodeAddress :: Address -> ByteString
    319     encodeAddress (AddrIPv4 a port) = mconcat
    320       [ BS.singleton 1
    321       , getIPv4Addr a
    322       , Prim.encodeU16 port
    323       ]
    324     encodeAddress (AddrIPv6 a port) = mconcat
    325       [ BS.singleton 2
    326       , getIPv6Addr a
    327       , Prim.encodeU16 port
    328       ]
    329     encodeAddress (AddrTorV3 a port) = mconcat
    330       [ BS.singleton 4
    331       , getTorV3Addr a
    332       , Prim.encodeU16 port
    333       ]
    334     encodeAddress (AddrDNS host port) = mconcat
    335       [ BS.singleton 5
    336       , BS.singleton (fromIntegral $ BS.length host)
    337       , host
    338       , Prim.encodeU16 port
    339       ]
    340 
    341 -- | Decode node_announcement message.
    342 decodeNodeAnnouncement :: ByteString
    343                        -> Either DecodeError (NodeAnnouncement, ByteString)
    344 decodeNodeAnnouncement bs = do
    345   (sig, bs1)       <- decodeSignature bs
    346   (features, bs2)  <- decodeFeatureBits bs1
    347   (timestamp, bs3) <- decodeU32 bs2
    348   (nid, bs4)       <- decodeNodeId bs3
    349   (color, bs5)     <- decodeRgbColor bs4
    350   (al, bs6)        <- decodeAlias bs5
    351   (addrs, rest)    <- decodeAddresses bs6
    352   let msg = NodeAnnouncement
    353         { nodeAnnSignature = sig
    354         , nodeAnnFeatures  = features
    355         , nodeAnnTimestamp = timestamp
    356         , nodeAnnNodeId    = nid
    357         , nodeAnnRgbColor  = color
    358         , nodeAnnAlias     = al
    359         , nodeAnnAddresses = addrs
    360         }
    361   Right (msg, rest)
    362 
    363 -- Channel update --------------------------------------------------------------
    364 
    365 -- | Encode channel_update message.
    366 encodeChannelUpdate :: ChannelUpdate -> ByteString
    367 encodeChannelUpdate msg = mconcat
    368   [ getSignature (chanUpdateSignature msg)
    369   , getChainHash (chanUpdateChainHash msg)
    370   , getShortChannelId (chanUpdateShortChanId msg)
    371   , Prim.encodeU32 (chanUpdateTimestamp msg)
    372   , BS.singleton (encodeMessageFlags (chanUpdateMsgFlags msg))
    373   , BS.singleton (encodeChannelFlags (chanUpdateChanFlags msg))
    374   , Prim.encodeU16 (getCltvExpiryDelta (chanUpdateCltvExpDelta msg))
    375   , Prim.encodeU64 (getHtlcMinimumMsat (chanUpdateHtlcMinMsat msg))
    376   , Prim.encodeU32 (getFeeBaseMsat (chanUpdateFeeBaseMsat msg))
    377   , Prim.encodeU32 (getFeeProportionalMillionths (chanUpdateFeeProportional msg))
    378   , case chanUpdateHtlcMaxMsat msg of
    379       Nothing -> BS.empty
    380       Just m  -> Prim.encodeU64 (getHtlcMaximumMsat m)
    381   ]
    382 
    383 -- | Decode channel_update message.
    384 decodeChannelUpdate :: ByteString
    385                     -> Either DecodeError (ChannelUpdate, ByteString)
    386 decodeChannelUpdate bs = do
    387   (sig, bs1)         <- decodeSignature bs
    388   (chainH, bs2)      <- decodeChainHash bs1
    389   (scid, bs3)        <- decodeShortChannelId bs2
    390   (timestamp, bs4)   <- decodeU32 bs3
    391   (msgFlagsRaw, bs5) <- decodeU8 bs4
    392   (chanFlagsRaw, bs6) <- decodeU8 bs5
    393   (cltvDelta, bs7)   <- decodeU16 bs6
    394   (htlcMin, bs8)     <- decodeU64 bs7
    395   (feeBase, bs9)     <- decodeU32 bs8
    396   (feeProp, bs10)    <- decodeU32 bs9
    397   let msgFlags' = decodeMessageFlags msgFlagsRaw
    398       chanFlags' = decodeChannelFlags chanFlagsRaw
    399   -- htlc_maximum_msat is present if message_flags bit 0 is set
    400   (htlcMax, rest) <- if mfHtlcMaxPresent msgFlags'
    401     then do
    402       (m, r) <- decodeU64 bs10
    403       Right (Just (HtlcMaximumMsat m), r)
    404     else Right (Nothing, bs10)
    405   let msg = ChannelUpdate
    406         { chanUpdateSignature       = sig
    407         , chanUpdateChainHash       = chainH
    408         , chanUpdateShortChanId     = scid
    409         , chanUpdateTimestamp       = timestamp
    410         , chanUpdateMsgFlags        = msgFlags'
    411         , chanUpdateChanFlags       = chanFlags'
    412         , chanUpdateCltvExpDelta    = CltvExpiryDelta cltvDelta
    413         , chanUpdateHtlcMinMsat     = HtlcMinimumMsat htlcMin
    414         , chanUpdateFeeBaseMsat     = FeeBaseMsat feeBase
    415         , chanUpdateFeeProportional = FeeProportionalMillionths feeProp
    416         , chanUpdateHtlcMaxMsat     = htlcMax
    417         }
    418   Right (msg, rest)
    419 
    420 -- Announcement signatures -----------------------------------------------------
    421 
    422 -- | Encode announcement_signatures message.
    423 encodeAnnouncementSignatures :: AnnouncementSignatures -> ByteString
    424 encodeAnnouncementSignatures msg = mconcat
    425   [ getChannelId (annSigChannelId msg)
    426   , getShortChannelId (annSigShortChanId msg)
    427   , getSignature (annSigNodeSig msg)
    428   , getSignature (annSigBitcoinSig msg)
    429   ]
    430 
    431 -- | Decode announcement_signatures message.
    432 decodeAnnouncementSignatures :: ByteString
    433                              -> Either DecodeError
    434                                   (AnnouncementSignatures, ByteString)
    435 decodeAnnouncementSignatures bs = do
    436   (cid, bs1)     <- decodeChannelId bs
    437   (scid, bs2)    <- decodeShortChannelId bs1
    438   (nodeSig, bs3) <- decodeSignature bs2
    439   (btcSig, rest) <- decodeSignature bs3
    440   let msg = AnnouncementSignatures
    441         { annSigChannelId   = cid
    442         , annSigShortChanId = scid
    443         , annSigNodeSig     = nodeSig
    444         , annSigBitcoinSig  = btcSig
    445         }
    446   Right (msg, rest)
    447 
    448 -- Query messages --------------------------------------------------------------
    449 
    450 -- | Encode query_short_channel_ids message.
    451 encodeQueryShortChannelIds :: QueryShortChannelIds
    452                            -> Either EncodeError ByteString
    453 encodeQueryShortChannelIds msg = do
    454   let scidData = queryScidsData msg
    455   if BS.length scidData > 65535
    456     then Left EncodeLengthOverflow
    457     else Right $ mconcat
    458       [ getChainHash (queryScidsChainHash msg)
    459       , encodeLenPrefixed scidData
    460       , TLV.encodeTlvStream (queryScidsTlvs msg)
    461       ]
    462 
    463 -- | Decode query_short_channel_ids message.
    464 decodeQueryShortChannelIds :: ByteString
    465                            -> Either DecodeError
    466                                 (QueryShortChannelIds, ByteString)
    467 decodeQueryShortChannelIds bs = do
    468   (chainH, bs1)   <- decodeChainHash bs
    469   (scidData, bs2) <- decodeLenPrefixed bs1
    470   let tlvs = case TLV.decodeTlvStreamRaw bs2 of
    471         Left _  -> unsafeTlvStream []
    472         Right t -> t
    473   let msg = QueryShortChannelIds
    474         { queryScidsChainHash = chainH
    475         , queryScidsData      = scidData
    476         , queryScidsTlvs      = tlvs
    477         }
    478   Right (msg, BS.empty)
    479 
    480 -- | Encode reply_short_channel_ids_end message.
    481 encodeReplyShortChannelIdsEnd :: ReplyShortChannelIdsEnd -> ByteString
    482 encodeReplyShortChannelIdsEnd msg = mconcat
    483   [ getChainHash (replyScidsChainHash msg)
    484   , BS.singleton (replyScidsFullInfo msg)
    485   ]
    486 
    487 -- | Decode reply_short_channel_ids_end message.
    488 decodeReplyShortChannelIdsEnd :: ByteString
    489                               -> Either DecodeError
    490                                    (ReplyShortChannelIdsEnd, ByteString)
    491 decodeReplyShortChannelIdsEnd bs = do
    492   (chainH, bs1)    <- decodeChainHash bs
    493   (fullInfo, rest) <- decodeU8 bs1
    494   let msg = ReplyShortChannelIdsEnd
    495         { replyScidsChainHash = chainH
    496         , replyScidsFullInfo  = fullInfo
    497         }
    498   Right (msg, rest)
    499 
    500 -- | Encode query_channel_range message.
    501 encodeQueryChannelRange :: QueryChannelRange -> ByteString
    502 encodeQueryChannelRange msg = mconcat
    503   [ getChainHash (queryRangeChainHash msg)
    504   , Prim.encodeU32 (queryRangeFirstBlock msg)
    505   , Prim.encodeU32 (queryRangeNumBlocks msg)
    506   , TLV.encodeTlvStream (queryRangeTlvs msg)
    507   ]
    508 
    509 -- | Decode query_channel_range message.
    510 decodeQueryChannelRange :: ByteString
    511                         -> Either DecodeError (QueryChannelRange, ByteString)
    512 decodeQueryChannelRange bs = do
    513   (chainH, bs1)     <- decodeChainHash bs
    514   (firstBlock, bs2) <- decodeU32 bs1
    515   (numBlocks, bs3)  <- decodeU32 bs2
    516   let tlvs = case TLV.decodeTlvStreamRaw bs3 of
    517         Left _  -> unsafeTlvStream []
    518         Right t -> t
    519   let msg = QueryChannelRange
    520         { queryRangeChainHash  = chainH
    521         , queryRangeFirstBlock = firstBlock
    522         , queryRangeNumBlocks  = numBlocks
    523         , queryRangeTlvs       = tlvs
    524         }
    525   Right (msg, BS.empty)
    526 
    527 -- | Encode reply_channel_range message.
    528 encodeReplyChannelRange :: ReplyChannelRange -> Either EncodeError ByteString
    529 encodeReplyChannelRange msg = do
    530   let rangeData = replyRangeData msg
    531   if BS.length rangeData > 65535
    532     then Left EncodeLengthOverflow
    533     else Right $ mconcat
    534       [ getChainHash (replyRangeChainHash msg)
    535       , Prim.encodeU32 (replyRangeFirstBlock msg)
    536       , Prim.encodeU32 (replyRangeNumBlocks msg)
    537       , BS.singleton (replyRangeSyncComplete msg)
    538       , encodeLenPrefixed rangeData
    539       , TLV.encodeTlvStream (replyRangeTlvs msg)
    540       ]
    541 
    542 -- | Decode reply_channel_range message.
    543 decodeReplyChannelRange :: ByteString
    544                         -> Either DecodeError (ReplyChannelRange, ByteString)
    545 decodeReplyChannelRange bs = do
    546   (chainH, bs1)       <- decodeChainHash bs
    547   (firstBlock, bs2)   <- decodeU32 bs1
    548   (numBlocks, bs3)    <- decodeU32 bs2
    549   (syncComplete, bs4) <- decodeU8 bs3
    550   (rangeData, bs5)    <- decodeLenPrefixed bs4
    551   let tlvs = case TLV.decodeTlvStreamRaw bs5 of
    552         Left _  -> unsafeTlvStream []
    553         Right t -> t
    554   let msg = ReplyChannelRange
    555         { replyRangeChainHash    = chainH
    556         , replyRangeFirstBlock   = firstBlock
    557         , replyRangeNumBlocks    = numBlocks
    558         , replyRangeSyncComplete = syncComplete
    559         , replyRangeData         = rangeData
    560         , replyRangeTlvs         = tlvs
    561         }
    562   Right (msg, BS.empty)
    563 
    564 -- | Encode gossip_timestamp_filter message.
    565 encodeGossipTimestampFilter :: GossipTimestampFilter -> ByteString
    566 encodeGossipTimestampFilter msg = mconcat
    567   [ getChainHash (gossipFilterChainHash msg)
    568   , Prim.encodeU32 (gossipFilterFirstTimestamp msg)
    569   , Prim.encodeU32 (gossipFilterTimestampRange msg)
    570   ]
    571 
    572 -- | Decode gossip_timestamp_filter message.
    573 decodeGossipTimestampFilter :: ByteString
    574                             -> Either DecodeError
    575                                  (GossipTimestampFilter, ByteString)
    576 decodeGossipTimestampFilter bs = do
    577   (chainH, bs1)   <- decodeChainHash bs
    578   (firstTs, bs2)  <- decodeU32 bs1
    579   (tsRange, rest) <- decodeU32 bs2
    580   let msg = GossipTimestampFilter
    581         { gossipFilterChainHash      = chainH
    582         , gossipFilterFirstTimestamp = firstTs
    583         , gossipFilterTimestampRange = tsRange
    584         }
    585   Right (msg, rest)
    586 
    587 -- Short channel ID list encoding -----------------------------------------------
    588 
    589 -- | Encode a list of short channel IDs as concatenated 8-byte values.
    590 --
    591 -- This produces encoded_short_ids data with encoding type 0 (uncompressed).
    592 -- The first byte is the encoding type (0), followed by the concatenated SCIDs.
    593 --
    594 -- Note: This does NOT sort the SCIDs. The caller should ensure they are in
    595 -- ascending order if that's required by the protocol context.
    596 encodeShortChannelIdList :: [ShortChannelId] -> ByteString
    597 encodeShortChannelIdList scids = BS.cons 0 $
    598   mconcat (map getShortChannelId scids)
    599 {-# INLINE encodeShortChannelIdList #-}
    600 
    601 -- | Decode a list of short channel IDs from encoded_short_ids data.
    602 --
    603 -- Supports encoding type 0 (uncompressed). Other encoding types will fail.
    604 decodeShortChannelIdList :: ByteString
    605                          -> Either DecodeError [ShortChannelId]
    606 decodeShortChannelIdList bs
    607   | BS.null bs = Left DecodeInsufficientBytes
    608   | otherwise = do
    609       let encType = BS.index bs 0
    610           payload = BS.drop 1 bs
    611       case encType of
    612         0 -> decodeUncompressedScids payload
    613         _ -> Left DecodeInvalidShortChannelId  -- Unsupported encoding type
    614   where
    615     decodeUncompressedScids :: ByteString -> Either DecodeError [ShortChannelId]
    616     decodeUncompressedScids !d
    617       | BS.null d = Right []
    618       | BS.length d < shortChannelIdLen = Left DecodeInsufficientBytes
    619       | otherwise = do
    620           let (scidBytes, rest) = BS.splitAt shortChannelIdLen d
    621           case shortChannelId scidBytes of
    622             Nothing -> Left DecodeInvalidShortChannelId
    623             Just scid -> do
    624               scids <- decodeUncompressedScids rest
    625               Right (scid : scids)
    626 {-# INLINE decodeShortChannelIdList #-}