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