ppad-bolt7 0.0.1 → 0.1.0

raw patch · 14 files changed

+3363/−2915 lines, 14 filesdep +ppad-bolt9dep +ppad-secp256k1dep ~deepseqdep ~ppad-bolt1dep ~ppad-sha256PVP ok

version bump matches the API change (PVP)

Dependencies added: ppad-bolt9, ppad-secp256k1

Dependency ranges changed: deepseq, ppad-bolt1, ppad-sha256

API changes (from Hackage documentation)

Files

• CHANGELOG +38/−0
• bench/Fixtures.hs +116/−0
• bench/Main.hs +44/−343
• bench/Weight.hs +31/−346
• lib/Lightning/Protocol/BOLT7.hs +113/−126
• lib/Lightning/Protocol/BOLT7/CRC32C.hs +29/−29
• lib/Lightning/Protocol/BOLT7/Codec.hs +706/−626
• lib/Lightning/Protocol/BOLT7/Hash.hs +99/−82
• lib/Lightning/Protocol/BOLT7/Messages.hs +130/−171
• lib/Lightning/Protocol/BOLT7/Types.hs +358/−390
• lib/Lightning/Protocol/BOLT7/Validate.hs +75/−109
• ppad-bolt7.cabal +25/−13
• test/Main.hs +1223/−680
• test/Vectors.hs +376/−0

@@ -0,0 +1,38 @@+# Changelog++- 0.1.0 (2026-10-10)+  * A substantial rewrite, with breaking changes throughout:++    * The API is exported from Lightning.Protocol.BOLT7 alone, and uses+      snake_case names (e.g. decode_channel_update, cu_timestamp).++    * Fundamental types come from ppad-bolt1 0.1 (Point, ShortChannelId,+      MilliSatoshi, TLV streams) and feature vectors from ppad-bolt9.+      The local NodeId, FeatureBits, routing-parameter newtypes,+      mainnetChainHash and length constants are gone.++    * Decoders take a whole payload and keep every byte: unassigned+      flag bits, unknown address descriptors and extension TLV records.+      Encoding a decoded message reproduces it, so its signatures still+      verify. channel_update models message_flags (must_be_one,+      dont_forward) and channel_flags (direction, disable).++    * Query messages have typed short channel id lists, query_flags,+      query_option, timestamps and checksums.++    * Signature digests and checksums take typed messages. Adds+      signature verification (via ppad-secp256k1), a message+      dispatcher, and usable_addresses for the receiver's address+      rules.++  * Fixes: htlc_maximum_msat is mandatory; node_announcement accepts+    unknown and deprecated address descriptors; malformed query TLV+    streams, unknown even TLV types and the deprecated zlib encoding are+    rejected; u16 length prefixes no longer wrap; validation no longer+    accepts undecodable data or claims to check feature bits.++  * Tests cover the BOLT #7 extended-queries vectors and real mainnet+    gossip, with signature checks.++- 0.0.1 (2026-04-18)+  * Initial release.

@@ -0,0 +1,116 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module: Fixtures+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Benchmark inputs: real mainnet gossip, a signed node_announcement, and+-- large gossip query replies.++module Fixtures (+    Fixtures(..)+  , fixtures+  ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import qualified Lightning.Protocol.BOLT1 as BOLT1+import Lightning.Protocol.BOLT7++data Fixtures = Fixtures+  { f_ann_bytes  :: !BS.ByteString+  , f_ann        :: !ChannelAnnouncement+  , f_upd_bytes  :: !BS.ByteString+  , f_upd        :: !ChannelUpdate+  , f_upd_key    :: !BOLT1.Point+  , f_node_bytes :: !BS.ByteString+  , f_node       :: !NodeAnnouncement+  , f_qsci_bytes :: !BS.ByteString+  , f_qsci       :: !QueryShortChannelIds+  , f_rcr_bytes  :: !BS.ByteString+  , f_rcr        :: !ReplyChannelRange+  }++-- | The fixtures, or 'Nothing' if one fails to build.+fixtures :: Maybe Fixtures+fixtures = do+  ann_bytes <- B16.decode ann_hex+  ann <- right (decode_channel_announcement ann_bytes)+  upd_bytes <- B16.decode upd_hex+  upd <- right (decode_channel_update upd_bytes)+  node_bytes <- B16.decode node_hex+  node <- right (decode_node_announcement node_bytes)+  ch <- BOLT1.chain_hash (BS.replicate 32 0x6f)+  let ids = [ BOLT1.ShortChannelId (0x0cf88400000000 + 0x10000 * i)+            | i <- [1 .. 1000] ]+      qsci = QueryShortChannelIds ch ids+        (Just (map (\i -> QueryFlags (i `mod` 32)) [1 .. 1000]))+        BOLT1.empty_tlv_stream+      rcr = ReplyChannelRange ch 850000 10000 True ids+        (Just [ ChannelUpdateTimestamps (1776493010 + i) (1776493020 + i)+              | i <- [1 .. 1000] ])+        (Just [ ChannelUpdateChecksums (0x1da953bd + i) (0xf0a89fda + i)+              | i <- [1 .. 1000] ])+        BOLT1.empty_tlv_stream+  qsci_bytes <- right (encode_query_short_channel_ids qsci)+  rcr_bytes <- right (encode_reply_channel_range rcr)+  pure Fixtures+    { f_ann_bytes  = ann_bytes+    , f_ann        = ann+    , f_upd_bytes  = upd_bytes+    , f_upd        = upd+    , f_upd_key    = ca_node_id_1 ann+    , f_node_bytes = node_bytes+    , f_node       = node+    , f_qsci_bytes = qsci_bytes+    , f_qsci       = qsci+    , f_rcr_bytes  = rcr_bytes+    , f_rcr        = rcr+    }+  where+    right :: Either e a -> Maybe a+    right = either (const Nothing) Just++-- channel_announcement for 850052x2992x1+ann_hex :: BS.ByteString+ann_hex = mconcat+  [ "3c256c270126d2c52ab5464fa959d627e9baec8c76bd2b81d34b47c4efb03290"+  , "40126ea7a0f8d31420976dc28ff684dc63f62620fa10dbac4fe3d417ca5690c1"+  , "b7fe1de61f5dd2b8368886d6c98f625c9110198e57c14fac93d4eff34e19ce5f"+  , "5dc6fef4501e8105c8f9b82d6d0b348f5840864445b071ae7a741b5eb92d2ec0"+  , "ab85681e4e1e85144bbbd8757c14cee92468d2c5ac84345cb28931b6fed5e339"+  , "00ed9dd363db630f31248cfa933a3667cbf87bb78a48a442e81c652686355365"+  , "ff33164c7588f0a753d50c4d52dd4a81c611fa47b4e950dfc9e3379a12ef7834"+  , "781c0900b90f56a5a49893446d03c8d283c3c093e3c8c682ff6cb40d70d9eebc"+  , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"+  , "00000cf884000bb0000102bb5e47ee26aca1654ce092d9d06eac15d953210c73"+  , "7f2220e2d7e54c4f108677030b828fd1e42549fbc2f1d0960ec3663362c41777"+  , "d3d87fe1b8e1d4bf063abcaa02bc3f260955062a4f427704edef1864c76d6777"+  , "fe81bed43a5f6297dda1c7ca9203523e164f4f9fbdea978c6570d56b13ca8338"+  , "430e6794ff74cf6aa0dbda71dd2d"+  ]++-- a channel_update for it from node_id_1, with an inbound-fee extension+upd_hex :: BS.ByteString+upd_hex = mconcat+  [ "1c3f0859cb3f4494919c3dcc80d22bbf1e25e378bd95f071530833c2371c33d7"+  , "0766012ebef1cd79b299a54d0d29bea2ef6feca1d6cfa188864c95d7eea7e9a4"+  , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+  , "0cf884000bb000016a0a1c760100006400000000000003e80000000000001388"+  , "00000000b1069a80fdd9030800000000ffffffed"+  ]++-- a node_announcement with one address descriptor of each type+node_hex :: BS.ByteString+node_hex = mconcat+  [ "edbd2df19aee2f072d9665e2d9a2807fbcd4be6876f6863955ea11870e411e66"+  , "063a31dcef14f1983524f87e108ee556b3a6646c873cd4bbcc07512c8f5e8f6a"+  , "000908000000000002aaa26553f1000324653eac434488002cc06bbfb7f10fe1"+  , "8991e35f9fe4302dbea6d2353dc0ab1c314159707061642d626f6c7437000000"+  , "000000000000000000000000000000000000000063017f000001260702000000"+  , "00000000000000000000000001260703aaaaaaaaaaaaaaaaaaaaaaaa04bbbbbb"+  , "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"+  , "2607050e6c6e2e6578616d706c652e636f6d2607060102036503657874"+  ]

@@ -1,361 +1,62 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}- -- | -- Module: Main -- Copyright: (c) 2025 Jared Tobin -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Criterion timing benchmarks for BOLT #7 gossip codecs.+-- Criterion timing benchmarks for ppad-bolt7.  module Main where  import Criterion.Main-import qualified Data.ByteString as BS-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)+import Fixtures import Lightning.Protocol.BOLT7---- Test data construction ---------------------------------------------------------- | 32 zero bytes for chain hashes, etc.-zeroBytes32 :: BS.ByteString-zeroBytes32 = BS.replicate 32 0x00-{-# NOINLINE zeroBytes32 #-}---- | 8 zero bytes for short channel IDs.-zeroBytes8 :: BS.ByteString-zeroBytes8 = BS.replicate 8 0x00-{-# NOINLINE zeroBytes8 #-}---- | 64-byte signature.-testSignature :: Signature-testSignature = case signature (BS.replicate 64 0x01) of-  Just s  -> s-  Nothing -> error "testSignature: invalid"-{-# NOINLINE testSignature #-}---- | 33-byte compressed public key (02 prefix + 32 zero bytes).-testPoint :: Point-testPoint = case point (BS.cons 0x02 zeroBytes32) of-  Just p  -> p-  Nothing -> error "testPoint: invalid"-{-# NOINLINE testPoint #-}---- | 32-byte chain hash.-testChainHash :: ChainHash-testChainHash = case chainHash zeroBytes32 of-  Just h  -> h-  Nothing -> error "testChainHash: invalid"-{-# NOINLINE testChainHash #-}---- | 8-byte short channel ID.-testShortChannelId :: ShortChannelId-testShortChannelId = case shortChannelId zeroBytes8 of-  Just s  -> s-  Nothing -> error "testShortChannelId: invalid"-{-# NOINLINE testShortChannelId #-}---- | 32-byte channel ID.-testChannelId :: ChannelId-testChannelId = case channelId zeroBytes32 of-  Just c  -> c-  Nothing -> error "testChannelId: invalid"-{-# NOINLINE testChannelId #-}---- | 33-byte node ID (03 prefix).-testNodeId :: NodeId-testNodeId = case nodeId (BS.cons 0x03 zeroBytes32) of-  Just n  -> n-  Nothing -> error "testNodeId: invalid"-{-# NOINLINE testNodeId #-}---- | Second node ID (02 prefix, lexicographically smaller).-testNodeId2 :: NodeId-testNodeId2 = case nodeId (BS.cons 0x02 zeroBytes32) of-  Just n  -> n-  Nothing -> error "testNodeId2: invalid"-{-# NOINLINE testNodeId2 #-}---- | RGB color.-testRgbColor :: RgbColor-testRgbColor = case rgbColor (BS.pack [0xff, 0x00, 0x00]) of-  Just c  -> c-  Nothing -> error "testRgbColor: invalid"-{-# NOINLINE testRgbColor #-}---- | 32-byte alias.-testAlias :: Alias-testAlias = case alias zeroBytes32 of-  Just a  -> a-  Nothing -> error "testAlias: invalid"-{-# NOINLINE testAlias #-}---- | IPv4 address.-testIPv4 :: IPv4Addr-testIPv4 = case ipv4Addr (BS.pack [127, 0, 0, 1]) of-  Just a  -> a-  Nothing -> error "testIPv4: invalid"-{-# NOINLINE testIPv4 #-}---- | Empty TLV stream.-emptyTlvs :: TlvStream-emptyTlvs = unsafeTlvStream []-{-# NOINLINE emptyTlvs #-}---- | Empty feature bits.-emptyFeatures :: FeatureBits-emptyFeatures = featureBits BS.empty-{-# NOINLINE emptyFeatures #-}---- | List of test SCIDs for list encoding benchmarks.-testScidList :: [ShortChannelId]-testScidList = map mkScid [1..100]-  where-    mkScid n = case shortChannelId (BS.pack [0, 0, 0, n, 0, 0, 0, n]) of-      Just s  -> s-      Nothing -> error "mkScid: invalid"-{-# NOINLINE testScidList #-}---- | Encoded SCID list for decode benchmarks.-encodedScidList :: BS.ByteString-encodedScidList = encodeShortChannelIdList testScidList-{-# NOINLINE encodedScidList #-}---- Test messages ------------------------------------------------------------------- | Test ChannelAnnouncement message.-testChannelAnnouncement :: ChannelAnnouncement-testChannelAnnouncement = ChannelAnnouncement-  { channelAnnNodeSig1     = testSignature-  , channelAnnNodeSig2     = testSignature-  , channelAnnBitcoinSig1  = testSignature-  , channelAnnBitcoinSig2  = testSignature-  , channelAnnFeatures     = emptyFeatures-  , channelAnnChainHash    = testChainHash-  , channelAnnShortChanId  = testShortChannelId-  , channelAnnNodeId1      = testNodeId2  -- 02... (smaller)-  , channelAnnNodeId2      = testNodeId   -- 03... (larger)-  , channelAnnBitcoinKey1  = testPoint-  , channelAnnBitcoinKey2  = testPoint-  }-{-# NOINLINE testChannelAnnouncement #-}---- | Encoded ChannelAnnouncement for decode benchmarks.-encodedChannelAnnouncement :: BS.ByteString-encodedChannelAnnouncement = encodeChannelAnnouncement testChannelAnnouncement-{-# NOINLINE encodedChannelAnnouncement #-}---- | Test NodeAnnouncement message.-testNodeAnnouncement :: NodeAnnouncement-testNodeAnnouncement = NodeAnnouncement-  { nodeAnnSignature = testSignature-  , nodeAnnFeatures  = emptyFeatures-  , nodeAnnTimestamp = 1234567890-  , nodeAnnNodeId    = testNodeId-  , nodeAnnRgbColor  = testRgbColor-  , nodeAnnAlias     = testAlias-  , nodeAnnAddresses = [AddrIPv4 testIPv4 9735]-  }-{-# NOINLINE testNodeAnnouncement #-}---- | Encoded NodeAnnouncement for decode benchmarks.-encodedNodeAnnouncement :: BS.ByteString-encodedNodeAnnouncement = case encodeNodeAnnouncement testNodeAnnouncement of-  Right bs -> bs-  Left _   -> error "encodedNodeAnnouncement: encode failed"-{-# NOINLINE encodedNodeAnnouncement #-}---- | Test ChannelUpdate message.-testChannelUpdate :: ChannelUpdate-testChannelUpdate = ChannelUpdate-  { chanUpdateSignature       = testSignature-  , chanUpdateChainHash       = testChainHash-  , chanUpdateShortChanId     = testShortChannelId-  , chanUpdateTimestamp       = 1234567890-  , chanUpdateMsgFlags        = 0x01-  , chanUpdateChanFlags       = 0x00-  , chanUpdateCltvExpDelta    = 144-  , chanUpdateHtlcMinMsat     = 1000-  , chanUpdateFeeBaseMsat     = 1000-  , chanUpdateFeeProportional = 100-  , chanUpdateHtlcMaxMsat     = Just 1000000000-  }-{-# NOINLINE testChannelUpdate #-}---- | Encoded ChannelUpdate for decode benchmarks.-encodedChannelUpdate :: BS.ByteString-encodedChannelUpdate = encodeChannelUpdate testChannelUpdate-{-# NOINLINE encodedChannelUpdate #-}---- | Test AnnouncementSignatures message.-testAnnouncementSignatures :: AnnouncementSignatures-testAnnouncementSignatures = AnnouncementSignatures-  { annSigChannelId   = testChannelId-  , annSigShortChanId = testShortChannelId-  , annSigNodeSig     = testSignature-  , annSigBitcoinSig  = testSignature-  }-{-# NOINLINE testAnnouncementSignatures #-}---- | Encoded AnnouncementSignatures for decode benchmarks.-encodedAnnouncementSignatures :: BS.ByteString-encodedAnnouncementSignatures =-  encodeAnnouncementSignatures testAnnouncementSignatures-{-# NOINLINE encodedAnnouncementSignatures #-}---- | Test QueryShortChannelIds message.-testQueryShortChannelIds :: QueryShortChannelIds-testQueryShortChannelIds = QueryShortChannelIds-  { queryScidsChainHash = testChainHash-  , queryScidsData      = encodeShortChannelIdList [testShortChannelId]-  , queryScidsTlvs      = emptyTlvs-  }-{-# NOINLINE testQueryShortChannelIds #-}---- | Encoded QueryShortChannelIds for decode benchmarks.-encodedQueryShortChannelIds :: BS.ByteString-encodedQueryShortChannelIds =-  case encodeQueryShortChannelIds testQueryShortChannelIds of-    Right bs -> bs-    Left _   -> error "encodedQueryShortChannelIds: encode failed"-{-# NOINLINE encodedQueryShortChannelIds #-}---- | Test ReplyShortChannelIdsEnd message.-testReplyShortChannelIdsEnd :: ReplyShortChannelIdsEnd-testReplyShortChannelIdsEnd = ReplyShortChannelIdsEnd-  { replyScidsChainHash = testChainHash-  , replyScidsFullInfo  = 1-  }-{-# NOINLINE testReplyShortChannelIdsEnd #-}---- | Encoded ReplyShortChannelIdsEnd for decode benchmarks.-encodedReplyShortChannelIdsEnd :: BS.ByteString-encodedReplyShortChannelIdsEnd =-  encodeReplyShortChannelIdsEnd testReplyShortChannelIdsEnd-{-# NOINLINE encodedReplyShortChannelIdsEnd #-}---- | Test QueryChannelRange message.-testQueryChannelRange :: QueryChannelRange-testQueryChannelRange = QueryChannelRange-  { queryRangeChainHash  = testChainHash-  , queryRangeFirstBlock = 700000-  , queryRangeNumBlocks  = 10000-  , queryRangeTlvs       = emptyTlvs-  }-{-# NOINLINE testQueryChannelRange #-}---- | Encoded QueryChannelRange for decode benchmarks.-encodedQueryChannelRange :: BS.ByteString-encodedQueryChannelRange = encodeQueryChannelRange testQueryChannelRange-{-# NOINLINE encodedQueryChannelRange #-}---- | Test ReplyChannelRange message.-testReplyChannelRange :: ReplyChannelRange-testReplyChannelRange = ReplyChannelRange-  { replyRangeChainHash    = testChainHash-  , replyRangeFirstBlock   = 700000-  , replyRangeNumBlocks    = 10000-  , replyRangeSyncComplete = 1-  , replyRangeData         = encodeShortChannelIdList [testShortChannelId]-  , replyRangeTlvs         = emptyTlvs-  }-{-# NOINLINE testReplyChannelRange #-}---- | Encoded ReplyChannelRange for decode benchmarks.-encodedReplyChannelRange :: BS.ByteString-encodedReplyChannelRange = case encodeReplyChannelRange testReplyChannelRange of-  Right bs -> bs-  Left _   -> error "encodedReplyChannelRange: encode failed"-{-# NOINLINE encodedReplyChannelRange #-}---- | Test GossipTimestampFilter message.-testGossipTimestampFilter :: GossipTimestampFilter-testGossipTimestampFilter = GossipTimestampFilter-  { gossipFilterChainHash      = testChainHash-  , gossipFilterFirstTimestamp = 1609459200-  , gossipFilterTimestampRange = 86400-  }-{-# NOINLINE testGossipTimestampFilter #-}---- | Encoded GossipTimestampFilter for decode benchmarks.-encodedGossipTimestampFilter :: BS.ByteString-encodedGossipTimestampFilter =-  encodeGossipTimestampFilter testGossipTimestampFilter-{-# NOINLINE encodedGossipTimestampFilter #-}---- Benchmark groups ------------------------------------------------------------+import System.Exit (exitFailure)  main :: IO ()-main = defaultMain-  [ bgroup "channel_announcement"-      [ bench "encode" $ nf encodeChannelAnnouncement testChannelAnnouncement-      , bench "decode" $ nf decodeChannelAnnouncement encodedChannelAnnouncement-      ]-  , bgroup "node_announcement"-      [ bench "encode" $ nf encodeNodeAnnouncement testNodeAnnouncement-      , bench "decode" $ nf decodeNodeAnnouncement encodedNodeAnnouncement-      ]-  , bgroup "channel_update"-      [ bench "encode" $ nf encodeChannelUpdate testChannelUpdate-      , bench "decode" $ nf decodeChannelUpdate encodedChannelUpdate-      ]-  , bgroup "announcement_signatures"-      [ bench "encode" $-          nf encodeAnnouncementSignatures testAnnouncementSignatures-      , bench "decode" $-          nf decodeAnnouncementSignatures encodedAnnouncementSignatures-      ]-  , bgroup "query_short_channel_ids"-      [ bench "encode" $-          nf encodeQueryShortChannelIds testQueryShortChannelIds-      , bench "decode" $-          nf decodeQueryShortChannelIds encodedQueryShortChannelIds-      ]-  , bgroup "reply_short_channel_ids_end"-      [ bench "encode" $-          nf encodeReplyShortChannelIdsEnd testReplyShortChannelIdsEnd-      , bench "decode" $-          nf decodeReplyShortChannelIdsEnd encodedReplyShortChannelIdsEnd-      ]-  , bgroup "query_channel_range"-      [ bench "encode" $ nf encodeQueryChannelRange testQueryChannelRange-      , bench "decode" $ nf decodeQueryChannelRange encodedQueryChannelRange-      ]-  , bgroup "reply_channel_range"-      [ bench "encode" $ nf encodeReplyChannelRange testReplyChannelRange-      , bench "decode" $ nf decodeReplyChannelRange encodedReplyChannelRange+main = case fixtures of+  Nothing -> putStrLn "fixtures failed to build" >> exitFailure+  Just f  -> defaultMain [+      bgroup "decode" [+        bench "channel_announcement" $+          nf decode_channel_announcement (f_ann_bytes f)+      , bench "node_announcement" $+          nf decode_node_announcement (f_node_bytes f)+      , bench "channel_update" $ nf decode_channel_update (f_upd_bytes f)+      , bench "channel_update (decode_message)" $+          nf (decode_message 258) (f_upd_bytes f)+      , bench "query_short_channel_ids (1000 ids, flags)" $+          nf decode_query_short_channel_ids (f_qsci_bytes f)+      , bench "reply_channel_range (1000 ids, timestamps, checksums)" $+          nf decode_reply_channel_range (f_rcr_bytes f)       ]-  , bgroup "gossip_timestamp_filter"-      [ bench "encode" $-          nf encodeGossipTimestampFilter testGossipTimestampFilter-      , bench "decode" $-          nf decodeGossipTimestampFilter encodedGossipTimestampFilter+    , bgroup "encode" [+        bench "channel_announcement" $+          nf encode_channel_announcement (f_ann f)+      , bench "node_announcement" $ nf encode_node_announcement (f_node f)+      , bench "channel_update" $ nf encode_channel_update (f_upd f)+      , bench "query_short_channel_ids (1000 ids, flags)" $+          nf encode_query_short_channel_ids (f_qsci f)+      , bench "reply_channel_range (1000 ids, timestamps, checksums)" $+          nf encode_reply_channel_range (f_rcr f)       ]-  , bgroup "scid_list"-      [ bench "encode (100)" $ nf encodeShortChannelIdList testScidList-      , bench "decode (100)" $ nf decodeShortChannelIdList encodedScidList+    , bgroup "hash" [+        bench "channel_announcement_hash" $+          nf channel_announcement_hash (f_ann f)+      , bench "channel_update_hash" $ nf channel_update_hash (f_upd f)+      , bench "channel_update_checksum" $+          nf channel_update_checksum (f_upd f)       ]-  , bgroup "hash"-      [ bench "channelAnnouncementHash" $-          nf channelAnnouncementHash encodedChannelAnnouncement-      , bench "nodeAnnouncementHash" $-          nf nodeAnnouncementHash encodedNodeAnnouncement-      , bench "channelUpdateHash" $-          nf channelUpdateHash encodedChannelUpdate-      , bench "channelUpdateChecksum" $-          nf channelUpdateChecksum encodedChannelUpdate+    , bgroup "verify" [+        bench "verify_channel_announcement" $+          nf verify_channel_announcement (f_ann f)+      , bench "verify_node_announcement" $+          nf verify_node_announcement (f_node f)+      , bench "verify_channel_update" $+          nf (verify_channel_update (f_upd_key f)) (f_upd f)       ]-  , bgroup "validate"-      [ bench "channelAnnouncement" $-          nf validateChannelAnnouncement testChannelAnnouncement-      , bench "nodeAnnouncement" $-          nf validateNodeAnnouncement testNodeAnnouncement-      , bench "channelUpdate" $-          nf validateChannelUpdate testChannelUpdate-      , bench "queryChannelRange" $-          nf validateQueryChannelRange testQueryChannelRange-      , bench "replyChannelRange" $-          nf validateReplyChannelRange testReplyChannelRange+    , bgroup "validate" [+        bench "validate_reply_channel_range (1000 ids)" $+          nf validate_reply_channel_range (f_rcr f)       ]-  ]+    ]

@@ -1,359 +1,44 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}- -- | -- Module: Main -- Copyright: (c) 2025 Jared Tobin -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Weigh allocation benchmarks for BOLT #7 gossip codecs.+-- Weigh allocation benchmarks for ppad-bolt7.  module Main where -import qualified Data.ByteString as BS-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)+import Fixtures import Lightning.Protocol.BOLT7+import System.Exit (exitFailure) import Weigh --- Test data construction ---------------------------------------------------------- | 32 zero bytes for chain hashes, etc.-zeroBytes32 :: BS.ByteString-zeroBytes32 = BS.replicate 32 0x00-{-# NOINLINE zeroBytes32 #-}---- | 8 zero bytes for short channel IDs.-zeroBytes8 :: BS.ByteString-zeroBytes8 = BS.replicate 8 0x00-{-# NOINLINE zeroBytes8 #-}---- | 64-byte signature.-testSignature :: Signature-testSignature = case signature (BS.replicate 64 0x01) of-  Just s  -> s-  Nothing -> error "testSignature: invalid"-{-# NOINLINE testSignature #-}---- | 33-byte compressed public key (02 prefix + 32 zero bytes).-testPoint :: Point-testPoint = case point (BS.cons 0x02 zeroBytes32) of-  Just p  -> p-  Nothing -> error "testPoint: invalid"-{-# NOINLINE testPoint #-}---- | 32-byte chain hash.-testChainHash :: ChainHash-testChainHash = case chainHash zeroBytes32 of-  Just h  -> h-  Nothing -> error "testChainHash: invalid"-{-# NOINLINE testChainHash #-}---- | 8-byte short channel ID.-testShortChannelId :: ShortChannelId-testShortChannelId = case shortChannelId zeroBytes8 of-  Just s  -> s-  Nothing -> error "testShortChannelId: invalid"-{-# NOINLINE testShortChannelId #-}---- | 32-byte channel ID.-testChannelId :: ChannelId-testChannelId = case channelId zeroBytes32 of-  Just c  -> c-  Nothing -> error "testChannelId: invalid"-{-# NOINLINE testChannelId #-}---- | 33-byte node ID (03 prefix).-testNodeId :: NodeId-testNodeId = case nodeId (BS.cons 0x03 zeroBytes32) of-  Just n  -> n-  Nothing -> error "testNodeId: invalid"-{-# NOINLINE testNodeId #-}---- | Second node ID (02 prefix, lexicographically smaller).-testNodeId2 :: NodeId-testNodeId2 = case nodeId (BS.cons 0x02 zeroBytes32) of-  Just n  -> n-  Nothing -> error "testNodeId2: invalid"-{-# NOINLINE testNodeId2 #-}---- | RGB color.-testRgbColor :: RgbColor-testRgbColor = case rgbColor (BS.pack [0xff, 0x00, 0x00]) of-  Just c  -> c-  Nothing -> error "testRgbColor: invalid"-{-# NOINLINE testRgbColor #-}---- | 32-byte alias.-testAlias :: Alias-testAlias = case alias zeroBytes32 of-  Just a  -> a-  Nothing -> error "testAlias: invalid"-{-# NOINLINE testAlias #-}---- | IPv4 address.-testIPv4 :: IPv4Addr-testIPv4 = case ipv4Addr (BS.pack [127, 0, 0, 1]) of-  Just a  -> a-  Nothing -> error "testIPv4: invalid"-{-# NOINLINE testIPv4 #-}---- | Empty feature bits.-emptyFeatures :: FeatureBits-emptyFeatures = featureBits BS.empty-{-# NOINLINE emptyFeatures #-}---- | Empty TLV stream.-emptyTlvs :: TlvStream-emptyTlvs = unsafeTlvStream []-{-# NOINLINE emptyTlvs #-}---- | List of test SCIDs for list encoding benchmarks.-testScidList :: [ShortChannelId]-testScidList = map mkScid [1..100]-  where-    mkScid n = case shortChannelId (BS.pack [0, 0, 0, n, 0, 0, 0, n]) of-      Just s  -> s-      Nothing -> error "mkScid: invalid"-{-# NOINLINE testScidList #-}---- | Encoded SCID list for decode benchmarks.-encodedScidList :: BS.ByteString-encodedScidList = encodeShortChannelIdList testScidList-{-# NOINLINE encodedScidList #-}---- Message constructors ------------------------------------------------------------ | Construct ChannelAnnouncement message.-mkChannelAnnouncement-  :: Signature -> Signature -> ChainHash -> ShortChannelId-  -> NodeId -> NodeId -> Point -> Point -> FeatureBits-  -> ChannelAnnouncement-mkChannelAnnouncement !ns1 !ns2 !ch !scid !nid1 !nid2 !bk1 !bk2 !feat =-  ChannelAnnouncement-    { channelAnnNodeSig1     = ns1-    , channelAnnNodeSig2     = ns2-    , channelAnnBitcoinSig1  = ns1-    , channelAnnBitcoinSig2  = ns2-    , channelAnnFeatures     = feat-    , channelAnnChainHash    = ch-    , channelAnnShortChanId  = scid-    , channelAnnNodeId1      = nid1-    , channelAnnNodeId2      = nid2-    , channelAnnBitcoinKey1  = bk1-    , channelAnnBitcoinKey2  = bk2-    }---- | Construct NodeAnnouncement message.-mkNodeAnnouncement-  :: Signature -> FeatureBits -> NodeId -> RgbColor -> Alias-  -> [Address] -> NodeAnnouncement-mkNodeAnnouncement !sig !feat !nid !col !al !addrs = NodeAnnouncement-  { nodeAnnSignature = sig-  , nodeAnnFeatures  = feat-  , nodeAnnTimestamp = 1234567890-  , nodeAnnNodeId    = nid-  , nodeAnnRgbColor  = col-  , nodeAnnAlias     = al-  , nodeAnnAddresses = addrs-  }---- | Construct ChannelUpdate message.-mkChannelUpdate :: Signature -> ChainHash -> ShortChannelId -> ChannelUpdate-mkChannelUpdate !sig !ch !scid = ChannelUpdate-  { chanUpdateSignature       = sig-  , chanUpdateChainHash       = ch-  , chanUpdateShortChanId     = scid-  , chanUpdateTimestamp       = 1234567890-  , chanUpdateMsgFlags        = 0x01-  , chanUpdateChanFlags       = 0x00-  , chanUpdateCltvExpDelta    = 144-  , chanUpdateHtlcMinMsat     = 1000-  , chanUpdateFeeBaseMsat     = 1000-  , chanUpdateFeeProportional = 100-  , chanUpdateHtlcMaxMsat     = Just 1000000000-  }---- | Construct AnnouncementSignatures message.-mkAnnouncementSignatures-  :: ChannelId -> ShortChannelId -> Signature -> AnnouncementSignatures-mkAnnouncementSignatures !cid !scid !sig = AnnouncementSignatures-  { annSigChannelId   = cid-  , annSigShortChanId = scid-  , annSigNodeSig     = sig-  , annSigBitcoinSig  = sig-  }---- | Construct GossipTimestampFilter message.-mkGossipTimestampFilter :: ChainHash -> GossipTimestampFilter-mkGossipTimestampFilter !ch = GossipTimestampFilter-  { gossipFilterChainHash      = ch-  , gossipFilterFirstTimestamp = 1609459200-  , gossipFilterTimestampRange = 86400-  }---- | Construct QueryChannelRange message.-mkQueryChannelRange :: ChainHash -> TlvStream -> QueryChannelRange-mkQueryChannelRange !ch !tlvs = QueryChannelRange-  { queryRangeChainHash  = ch-  , queryRangeFirstBlock = 700000-  , queryRangeNumBlocks  = 10000-  , queryRangeTlvs       = tlvs-  }---- | Construct ReplyChannelRange message.-mkReplyChannelRange :: ChainHash -> TlvStream -> ReplyChannelRange-mkReplyChannelRange !ch !tlvs = ReplyChannelRange-  { replyRangeChainHash    = ch-  , replyRangeFirstBlock   = 700000-  , replyRangeNumBlocks    = 10000-  , replyRangeSyncComplete = 1-  , replyRangeData         = encodeShortChannelIdList [testShortChannelId]-  , replyRangeTlvs         = tlvs-  }---- Pre-constructed messages -------------------------------------------------------- | Test ChannelAnnouncement message.-testChannelAnnouncement :: ChannelAnnouncement-testChannelAnnouncement = mkChannelAnnouncement-  testSignature testSignature testChainHash testShortChannelId-  testNodeId2 testNodeId testPoint testPoint emptyFeatures-{-# NOINLINE testChannelAnnouncement #-}---- | Encoded ChannelAnnouncement for decode benchmarks.-encodedChannelAnnouncement :: BS.ByteString-encodedChannelAnnouncement = encodeChannelAnnouncement testChannelAnnouncement-{-# NOINLINE encodedChannelAnnouncement #-}---- | Test NodeAnnouncement message.-testNodeAnnouncement :: NodeAnnouncement-testNodeAnnouncement = mkNodeAnnouncement-  testSignature emptyFeatures testNodeId testRgbColor testAlias-  [AddrIPv4 testIPv4 9735]-{-# NOINLINE testNodeAnnouncement #-}---- | Encoded NodeAnnouncement for decode benchmarks.-encodedNodeAnnouncement :: BS.ByteString-encodedNodeAnnouncement = case encodeNodeAnnouncement testNodeAnnouncement of-  Right bs -> bs-  Left _   -> error "encodedNodeAnnouncement: encode failed"-{-# NOINLINE encodedNodeAnnouncement #-}---- | Test ChannelUpdate message.-testChannelUpdate :: ChannelUpdate-testChannelUpdate = mkChannelUpdate testSignature testChainHash testShortChannelId-{-# NOINLINE testChannelUpdate #-}---- | Encoded ChannelUpdate for decode benchmarks.-encodedChannelUpdate :: BS.ByteString-encodedChannelUpdate = encodeChannelUpdate testChannelUpdate-{-# NOINLINE encodedChannelUpdate #-}---- | Test AnnouncementSignatures message.-testAnnouncementSignatures :: AnnouncementSignatures-testAnnouncementSignatures =-  mkAnnouncementSignatures testChannelId testShortChannelId testSignature-{-# NOINLINE testAnnouncementSignatures #-}---- | Encoded AnnouncementSignatures for decode benchmarks.-encodedAnnouncementSignatures :: BS.ByteString-encodedAnnouncementSignatures =-  encodeAnnouncementSignatures testAnnouncementSignatures-{-# NOINLINE encodedAnnouncementSignatures #-}---- | Test GossipTimestampFilter message.-testGossipTimestampFilter :: GossipTimestampFilter-testGossipTimestampFilter = mkGossipTimestampFilter testChainHash-{-# NOINLINE testGossipTimestampFilter #-}---- | Encoded GossipTimestampFilter for decode benchmarks.-encodedGossipTimestampFilter :: BS.ByteString-encodedGossipTimestampFilter =-  encodeGossipTimestampFilter testGossipTimestampFilter-{-# NOINLINE encodedGossipTimestampFilter #-}---- | Test QueryChannelRange message.-testQueryChannelRange :: QueryChannelRange-testQueryChannelRange = mkQueryChannelRange testChainHash emptyTlvs-{-# NOINLINE testQueryChannelRange #-}---- | Encoded QueryChannelRange for decode benchmarks.-encodedQueryChannelRange :: BS.ByteString-encodedQueryChannelRange = encodeQueryChannelRange testQueryChannelRange-{-# NOINLINE encodedQueryChannelRange #-}---- | Test ReplyChannelRange message.-testReplyChannelRange :: ReplyChannelRange-testReplyChannelRange = mkReplyChannelRange testChainHash emptyTlvs-{-# NOINLINE testReplyChannelRange #-}---- | Encoded ReplyChannelRange for decode benchmarks.-encodedReplyChannelRange :: BS.ByteString-encodedReplyChannelRange = case encodeReplyChannelRange testReplyChannelRange of-  Right bs -> bs-  Left _   -> error "encodedReplyChannelRange: encode failed"-{-# NOINLINE encodedReplyChannelRange #-}---- Weigh benchmarks ------------------------------------------------------------- main :: IO ()-main = mainWith $ do-  wgroup "channel_announcement" $ do-    func "construct" (mkChannelAnnouncement-      testSignature testSignature testChainHash testShortChannelId-      testNodeId2 testNodeId testPoint testPoint) emptyFeatures-    func "encode" encodeChannelAnnouncement testChannelAnnouncement-    func "decode" decodeChannelAnnouncement encodedChannelAnnouncement--  wgroup "node_announcement" $ do-    func "construct" (mkNodeAnnouncement-      testSignature emptyFeatures testNodeId testRgbColor testAlias)-      [AddrIPv4 testIPv4 9735]-    func "encode" encodeNodeAnnouncement testNodeAnnouncement-    func "decode" decodeNodeAnnouncement encodedNodeAnnouncement--  wgroup "channel_update" $ do-    func "construct" (mkChannelUpdate testSignature testChainHash)-      testShortChannelId-    func "encode" encodeChannelUpdate testChannelUpdate-    func "decode" decodeChannelUpdate encodedChannelUpdate--  wgroup "announcement_signatures" $ do-    func "construct" (mkAnnouncementSignatures testChannelId testShortChannelId)-      testSignature-    func "encode" encodeAnnouncementSignatures testAnnouncementSignatures-    func "decode" decodeAnnouncementSignatures encodedAnnouncementSignatures--  wgroup "query_channel_range" $ do-    func "construct" (mkQueryChannelRange testChainHash) emptyTlvs-    func "encode" encodeQueryChannelRange testQueryChannelRange-    func "decode" decodeQueryChannelRange encodedQueryChannelRange--  wgroup "reply_channel_range" $ do-    func "construct" (mkReplyChannelRange testChainHash) emptyTlvs-    func "encode" encodeReplyChannelRange testReplyChannelRange-    func "decode" decodeReplyChannelRange encodedReplyChannelRange--  wgroup "gossip_timestamp_filter" $ do-    func "construct" mkGossipTimestampFilter testChainHash-    func "encode" encodeGossipTimestampFilter testGossipTimestampFilter-    func "decode" decodeGossipTimestampFilter encodedGossipTimestampFilter--  wgroup "scid_list" $ do-    func "encode (100)" encodeShortChannelIdList testScidList-    func "decode (100)" decodeShortChannelIdList encodedScidList--  wgroup "hash" $ do-    func "channelAnnouncementHash" channelAnnouncementHash-      encodedChannelAnnouncement-    func "nodeAnnouncementHash" nodeAnnouncementHash encodedNodeAnnouncement-    func "channelUpdateHash" channelUpdateHash encodedChannelUpdate-    func "channelUpdateChecksum" channelUpdateChecksum encodedChannelUpdate--  wgroup "validate" $ do-    func "channelAnnouncement" validateChannelAnnouncement testChannelAnnouncement-    func "nodeAnnouncement" validateNodeAnnouncement testNodeAnnouncement-    func "channelUpdate" validateChannelUpdate testChannelUpdate-    func "queryChannelRange" validateQueryChannelRange testQueryChannelRange-    func "replyChannelRange" validateReplyChannelRange testReplyChannelRange+main = case fixtures of+  Nothing -> putStrLn "fixtures failed to build" >> exitFailure+  Just f  -> mainWith $ do+    wgroup "decode" $ do+      func "channel_announcement" decode_channel_announcement (f_ann_bytes f)+      func "node_announcement" decode_node_announcement (f_node_bytes f)+      func "channel_update" decode_channel_update (f_upd_bytes f)+      func "query_short_channel_ids (1000 ids, flags)"+        decode_query_short_channel_ids (f_qsci_bytes f)+      func "reply_channel_range (1000 ids, timestamps, checksums)"+        decode_reply_channel_range (f_rcr_bytes f)+    wgroup "encode" $ do+      func "channel_announcement" encode_channel_announcement (f_ann f)+      func "node_announcement" encode_node_announcement (f_node f)+      func "channel_update" encode_channel_update (f_upd f)+      func "query_short_channel_ids (1000 ids, flags)"+        encode_query_short_channel_ids (f_qsci f)+      func "reply_channel_range (1000 ids, timestamps, checksums)"+        encode_reply_channel_range (f_rcr f)+    wgroup "hash" $ do+      func "channel_announcement_hash" channel_announcement_hash (f_ann f)+      func "channel_update_hash" channel_update_hash (f_upd f)+      func "channel_update_checksum" channel_update_checksum (f_upd f)+    wgroup "verify" $ do+      func "verify_channel_announcement" verify_channel_announcement (f_ann f)+      func "verify_node_announcement" verify_node_announcement (f_node f)+      func "verify_channel_update"+        (verify_channel_update (f_upd_key f)) (f_upd f)

@@ -6,102 +6,132 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Routing gossip protocol for the Lightning Network, per--- [BOLT #7](https://github.com/lightning/bolts/blob/master/07-routing-gossip.md).------ = Overview------ This module provides types, encoding\/decoding, and validation for--- BOLT #7 routing gossip messages. The protocol enables nodes to--- share channel and node information across the network.------ = Usage------ Import this module to access all BOLT #7 functionality:------ @--- import Lightning.Protocol.BOLT7--- @------ == Decoding messages------ @--- -- Decode a channel_announcement from wire format--- case decodeChannelAnnouncement wireBytes of---   Left err -> handleError err---   Right (msg, rest) -> processAnnouncement msg--- @------ == Encoding messages------ @--- -- Encode a gossip_timestamp_filter--- let msg = GossipTimestampFilter---       { gossipFilterChainHash      = mainnetChainHash---       , gossipFilterFirstTimestamp = 1609459200---       , gossipFilterTimestampRange = 86400---       }--- let wireBytes = encodeGossipTimestampFilter msg--- @------ == Validation------ @--- -- Validate a channel_announcement before processing--- case validateChannelAnnouncement announcement of---   Left ValidateNodeIdOrdering -> rejectMessage---   Right () -> processValidMessage--- @------ == Signature verification------ This library provides hash computation for signature verification:------ @--- -- Compute the hash that should be signed--- let sigHash = channelAnnouncementHash encodedMessage--- -- Verify signatures using ppad-secp256k1 (not included)--- @+-- Routing gossip for the Lightning Network, per+-- [BOLT #7](https://github.com/lightning/bolts/blob/master/07-routing-gossip.md):+-- the gossip messages and queries, their signature digests and+-- checksums, signature verification, and stateless validation. ----- = Protocol overview+-- Fundamental types (chain hashes, points, signatures, short channel+-- ids, amounts, TLV streams) come from ppad-bolt1, and feature vectors+-- from ppad-bolt9. ----- BOLT #7 defines gossip messages for routing in the Lightning Network.--- Nodes use these messages to build a view of the channel graph.+-- Decoders take a message payload, without its 2-byte type, and consume+-- all of it. Every byte is kept, including unassigned flag bits,+-- unknown address descriptors and unknown odd TLV records, so encoding+-- a decoded message reproduces its payload exactly and its signatures+-- still verify.  module Lightning.Protocol.BOLT7 (-  -- * Core types-  -- | Re-exported from "Lightning.Protocol.BOLT7.Types".-    module Lightning.Protocol.BOLT7.Types+  -- * Messages+    Message(..)+  , message_type+  , ChannelAnnouncement(..)+  , NodeAnnouncement(..)+  , ChannelUpdate(..)+  , AnnouncementSignatures(..)+  , QueryShortChannelIds(..)+  , ReplyShortChannelIdsEnd(..)+  , QueryChannelRange(..)+  , ReplyChannelRange(..)+  , GossipTimestampFilter(..) -  -- * Message types-  -- | Re-exported from "Lightning.Protocol.BOLT7.Messages".-  , module Lightning.Protocol.BOLT7.Messages+  -- * Encoding and decoding+  , encode_message+  , decode_message+  , EncodeError(..)+  , DecodeError(..) -  -- * Codec functions-  -- | Re-exported from "Lightning.Protocol.BOLT7.Codec".-  , module Lightning.Protocol.BOLT7.Codec+  -- ** Payloads+  , encode_channel_announcement+  , decode_channel_announcement+  , encode_node_announcement+  , decode_node_announcement+  , encode_channel_update+  , decode_channel_update+  , encode_announcement_signatures+  , decode_announcement_signatures+  , encode_query_short_channel_ids+  , decode_query_short_channel_ids+  , encode_reply_short_channel_ids_end+  , decode_reply_short_channel_ids_end+  , encode_query_channel_range+  , decode_query_channel_range+  , encode_reply_channel_range+  , decode_reply_channel_range+  , encode_gossip_timestamp_filter+  , decode_gossip_timestamp_filter -  -- * Hash functions-  -- | Re-exported from "Lightning.Protocol.BOLT7.Hash".-  , module Lightning.Protocol.BOLT7.Hash+  -- * Signatures and checksums+  , channel_announcement_hash+  , node_announcement_hash+  , channel_update_hash+  , verify_channel_announcement+  , verify_node_announcement+  , verify_channel_update+  , channel_update_checksum -  -- * Validation functions-  -- | Re-exported from "Lightning.Protocol.BOLT7.Validate".-  , module Lightning.Protocol.BOLT7.Validate+  -- * Validation+  , ValidationError(..)+  , validate_channel_announcement+  , validate_node_announcement+  , validate_channel_update+  , validate_query_short_channel_ids+  , validate_query_channel_range+  , validate_reply_channel_range -  -- $messagetypes+  -- * channel_update flags+  , MessageFlags(..)+  , Forwarding(..)+  , message_flags+  , message_flags_forwarding+  , has_must_be_one+  , ChannelFlags(..)+  , Direction(..)+  , ChannelStatus(..)+  , channel_flags+  , channel_flags_direction+  , channel_flags_status -  -- ** Channel announcement-  -- $announcement+  -- * node_announcement fields+  , RgbColor(..)+  , Alias+  , alias+  , un_alias -  -- ** Node announcement-  -- $nodeannouncement+  -- ** Addresses+  , Address(..)+  , usable_addresses+  , IPv4Addr+  , ipv4_addr+  , un_ipv4_addr+  , IPv6Addr+  , ipv6_addr+  , un_ipv6_addr+  , TorV2Addr+  , tor_v2_addr+  , un_tor_v2_addr+  , TorV3Addr+  , tor_v3_addr+  , un_tor_v3_addr+  , Hostname+  , hostname+  , un_hostname+  , is_ascii_hostname -  -- ** Channel updates-  -- $updates+  -- * Query fields+  , QueryFlags(..)+  , QueryFlag(..)+  , query_flags+  , has_query_flag+  , QueryOption(..)+  , QueryOptionFlag(..)+  , query_option+  , has_query_option+  , ChannelUpdateTimestamps(..)+  , ChannelUpdateChecksums(..) -  -- ** Gossip queries-  -- $queries+  -- * Short channel ids+  , format_short_channel_id   ) where  import Lightning.Protocol.BOLT7.Codec@@ -109,46 +139,3 @@ import Lightning.Protocol.BOLT7.Messages import Lightning.Protocol.BOLT7.Types import Lightning.Protocol.BOLT7.Validate---- $messagetypes------ BOLT #7 defines the following message types:------ * 256: channel_announcement--- * 257: node_announcement--- * 258: channel_update--- * 259: announcement_signatures--- * 261: query_short_channel_ids--- * 262: reply_short_channel_ids_end--- * 263: query_channel_range--- * 264: reply_channel_range--- * 265: gossip_timestamp_filter---- $announcement------ Channel announcement messages:------ * channel_announcement (256) - public channel announcement--- * announcement_signatures (259) - signatures enabling announcement---- $nodeannouncement------ Node announcement message:------ * node_announcement (257) - advertises node metadata---- $updates------ Channel update message:------ * channel_update (258) - per-direction routing parameters---- $queries------ Gossip query messages:------ * query_short_channel_ids (261) - request specific channel info--- * reply_short_channel_ids_end (262) - concludes query response--- * query_channel_range (263) - query channels in block range--- * reply_channel_range (264) - response with channel IDs--- * gossip_timestamp_filter (265) - constrain relayed gossip

@@ -1,3 +1,4 @@+{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE BangPatterns #-}  -- |@@ -6,44 +7,43 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- CRC-32C (Castagnoli) implementation for BOLT #7 checksums.------ This is an internal helper module implementing CRC-32C as specified--- in RFC 3720. CRC-32C uses the Castagnoli polynomial 0x1EDC6F41.+-- CRC-32C (Castagnoli), per RFC 3720, for @channel_update@ checksums.  module Lightning.Protocol.BOLT7.CRC32C (     crc32c   ) where -import Data.Bits (shiftR, xor, (.&.))-import Data.ByteString (ByteString)+import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.)) import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BU import Data.Word (Word8, Word32) --- | CRC-32C polynomial (Castagnoli): 0x1EDC6F41 reflected = 0x82F63B78-crc32cPoly :: Word32-crc32cPoly = 0x82F63B78-{-# INLINE crc32cPoly #-}---- | Compute CRC-32C of a bytestring.------ >>> crc32c "123456789"--- 0xe3069283-crc32c :: ByteString -> Word32-crc32c = xor 0xFFFFFFFF . BS.foldl' updateByte 0xFFFFFFFF+-- | The CRC-32C of a byte string.+crc32c :: BS.ByteString -> Word32+crc32c = complement . BS.foldl' step 0xFFFFFFFF+  where+    step !c !b = (c `shiftR` 8) `xor` entry (fromIntegral c `xor` b) {-# INLINE crc32c #-} --- | Update CRC with a single byte.-updateByte :: Word32 -> Word8 -> Word32-updateByte !crc !byte =-  let crc' = crc `xor` fromIntegral byte-  in  go 8 crc'+-- the table entry for a byte, read from 'table'+entry :: Word8 -> Word32+entry i =+  let !o = 4 * fromIntegral i  -- at most 1020, within the 1024-byte table+      byte k = fromIntegral (BU.unsafeIndex table (o + k)) :: Word32+  in  byte 0 .|. (byte 1 `shiftL` 8) .|. (byte 2 `shiftL` 16)+        .|. (byte 3 `shiftL` 24)+{-# INLINE entry #-}++-- the 256 table entries, little-endian+table :: BS.ByteString+table = fst (BS.unfoldrN 1024 byte 0)   where-    go :: Int -> Word32 -> Word32+    byte :: Int -> Maybe (Word8, Int)+    byte k = Just+      (fromIntegral (go (8 :: Int) (fromIntegral (k `shiftR` 2))+                       `shiftR` (8 * (k .&. 3))), k + 1)+    -- the Castagnoli polynomial 0x1EDC6F41, bit-reflected+    poly = 0x82F63B78 :: Word32     go 0 !c = c-    go !n !c =-      let c' = if c .&. 1 /= 0-               then (c `shiftR` 1) `xor` crc32cPoly-               else c `shiftR` 1-      in  go (n - 1) c'-{-# INLINE updateByte #-}+    go n !c = go (n - 1) ((c `shiftR` 1) `xor` (poly .&. negate (c .&. 1)))+{-# NOINLINE table #-}

@@ -1,626 +1,706 @@-{-# OPTIONS_HADDOCK prune #-}--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveGeneric #-}---- |--- Module: Lightning.Protocol.BOLT7.Codec--- Copyright: (c) 2025 Jared Tobin--- License: MIT--- Maintainer: Jared Tobin <jared@ppad.tech>------ Encoding and decoding for BOLT #7 gossip messages.--module Lightning.Protocol.BOLT7.Codec (-  -- * Error types-    EncodeError(..)-  , DecodeError(..)--  -- * Channel announcement-  , encodeChannelAnnouncement-  , decodeChannelAnnouncement--  -- * Node announcement-  , encodeNodeAnnouncement-  , decodeNodeAnnouncement--  -- * Channel update-  , encodeChannelUpdate-  , decodeChannelUpdate--  -- * Announcement signatures-  , encodeAnnouncementSignatures-  , decodeAnnouncementSignatures--  -- * Query messages-  , encodeQueryShortChannelIds-  , decodeQueryShortChannelIds-  , encodeReplyShortChannelIdsEnd-  , decodeReplyShortChannelIdsEnd-  , encodeQueryChannelRange-  , decodeQueryChannelRange-  , encodeReplyChannelRange-  , decodeReplyChannelRange-  , encodeGossipTimestampFilter-  , decodeGossipTimestampFilter--  -- * Short channel ID encoding-  , encodeShortChannelIdList-  , decodeShortChannelIdList-  ) where--import Control.DeepSeq (NFData)-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import Data.Word (Word8, Word16, Word32, Word64)-import GHC.Generics (Generic)-import Lightning.Protocol.BOLT1 (unsafeTlvStream)-import qualified Lightning.Protocol.BOLT1.Prim as Prim-import qualified Lightning.Protocol.BOLT1.TLV as TLV-import Lightning.Protocol.BOLT7.Messages-import Lightning.Protocol.BOLT7.Types---- Error types --------------------------------------------------------------------- | Encoding errors.-data EncodeError-  = EncodeLengthOverflow  -- ^ Field too large for u16 length prefix-  deriving (Eq, Show, Generic)--instance NFData EncodeError---- | Decoding errors.-data DecodeError-  = DecodeInsufficientBytes          -- ^ Not enough bytes-  | DecodeInvalidSignature           -- ^ Invalid signature field-  | DecodeInvalidChainHash           -- ^ Invalid chain hash field-  | DecodeInvalidShortChannelId      -- ^ Invalid short channel ID field-  | DecodeInvalidChannelId           -- ^ Invalid channel ID field-  | DecodeInvalidNodeId              -- ^ Invalid node ID field-  | DecodeInvalidPoint               -- ^ Invalid point field-  | DecodeInvalidRgbColor            -- ^ Invalid RGB color field-  | DecodeInvalidAlias               -- ^ Invalid alias field-  | DecodeInvalidAddress             -- ^ Invalid address encoding-  | DecodeTlvError                   -- ^ TLV decoding error-  deriving (Eq, Show, Generic)--instance NFData DecodeError---- Primitive helpers --------------------------------------------------------------- | Decode u8.-decodeU8 :: ByteString -> Either DecodeError (Word8, ByteString)-decodeU8 bs-  | BS.null bs = Left DecodeInsufficientBytes-  | otherwise = Right (BS.index bs 0, BS.drop 1 bs)-{-# INLINE decodeU8 #-}---- | Decode u16 (big-endian).-decodeU16 :: ByteString -> Either DecodeError (Word16, ByteString)-decodeU16 bs = case Prim.decodeU16 bs of-  Nothing -> Left DecodeInsufficientBytes-  Just r  -> Right r-{-# INLINE decodeU16 #-}---- | Decode u32 (big-endian).-decodeU32 :: ByteString -> Either DecodeError (Word32, ByteString)-decodeU32 bs = case Prim.decodeU32 bs of-  Nothing -> Left DecodeInsufficientBytes-  Just r  -> Right r-{-# INLINE decodeU32 #-}---- | Decode u64 (big-endian).-decodeU64 :: ByteString -> Either DecodeError (Word64, ByteString)-decodeU64 bs = case Prim.decodeU64 bs of-  Nothing -> Left DecodeInsufficientBytes-  Just r  -> Right r-{-# INLINE decodeU64 #-}---- | Decode fixed-length bytes.-decodeBytes :: Int -> ByteString -> Either DecodeError (ByteString, ByteString)-decodeBytes n bs-  | BS.length bs < n = Left DecodeInsufficientBytes-  | otherwise = Right (BS.splitAt n bs)-{-# INLINE decodeBytes #-}---- | Decode length-prefixed bytes (u16 prefix).-decodeLenPrefixed :: ByteString-                  -> Either DecodeError (ByteString, ByteString)-decodeLenPrefixed bs = do-  (len, rest) <- decodeU16 bs-  let n = fromIntegral len-  if BS.length rest < n-    then Left DecodeInsufficientBytes-    else Right (BS.splitAt n rest)-{-# INLINE decodeLenPrefixed #-}---- | Encode with u16 length prefix.-encodeLenPrefixed :: ByteString -> ByteString-encodeLenPrefixed bs = Prim.encodeU16 (fromIntegral $ BS.length bs) <> bs-{-# INLINE encodeLenPrefixed #-}---- | Decode fixed-length validated type.-decodeFixed :: Int -> DecodeError -> (ByteString -> Maybe a)-            -> ByteString -> Either DecodeError (a, ByteString)-decodeFixed len err mkVal bs = do-  (bytes, rest) <- decodeBytes len bs-  case mkVal bytes of-    Nothing -> Left err-    Just v  -> Right (v, rest)-{-# INLINE decodeFixed #-}---- Type-specific decoders ---------------------------------------------------------- | Decode Signature (64 bytes).-decodeSignature :: ByteString -> Either DecodeError (Signature, ByteString)-decodeSignature = decodeFixed signatureLen DecodeInvalidSignature signature-{-# INLINE decodeSignature #-}---- | Decode ChainHash (32 bytes).-decodeChainHash :: ByteString -> Either DecodeError (ChainHash, ByteString)-decodeChainHash = decodeFixed chainHashLen DecodeInvalidChainHash chainHash-{-# INLINE decodeChainHash #-}---- | Decode ShortChannelId (8 bytes).-decodeShortChannelId :: ByteString-                     -> Either DecodeError (ShortChannelId, ByteString)-decodeShortChannelId =-  decodeFixed shortChannelIdLen DecodeInvalidShortChannelId shortChannelId-{-# INLINE decodeShortChannelId #-}---- | Decode ChannelId (32 bytes).-decodeChannelId :: ByteString -> Either DecodeError (ChannelId, ByteString)-decodeChannelId = decodeFixed channelIdLen DecodeInvalidChannelId channelId-{-# INLINE decodeChannelId #-}---- | Decode NodeId (33 bytes).-decodeNodeId :: ByteString -> Either DecodeError (NodeId, ByteString)-decodeNodeId = decodeFixed nodeIdLen DecodeInvalidNodeId nodeId-{-# INLINE decodeNodeId #-}---- | Decode Point (33 bytes).-decodePoint :: ByteString -> Either DecodeError (Point, ByteString)-decodePoint = decodeFixed pointLen DecodeInvalidPoint point-{-# INLINE decodePoint #-}---- | Decode RgbColor (3 bytes).-decodeRgbColor :: ByteString -> Either DecodeError (RgbColor, ByteString)-decodeRgbColor = decodeFixed rgbColorLen DecodeInvalidRgbColor rgbColor-{-# INLINE decodeRgbColor #-}---- | Decode Alias (32 bytes).-decodeAlias :: ByteString -> Either DecodeError (Alias, ByteString)-decodeAlias = decodeFixed aliasLen DecodeInvalidAlias alias-{-# INLINE decodeAlias #-}---- | Decode FeatureBits (length-prefixed).-decodeFeatureBits :: ByteString -> Either DecodeError (FeatureBits, ByteString)-decodeFeatureBits bs = do-  (bytes, rest) <- decodeLenPrefixed bs-  Right (featureBits bytes, rest)-{-# INLINE decodeFeatureBits #-}---- | Decode addresses list (length-prefixed).-decodeAddresses :: ByteString -> Either DecodeError ([Address], ByteString)-decodeAddresses bs = do-  (addrData, rest) <- decodeLenPrefixed bs-  addrs <- parseAddrs addrData-  Right (addrs, rest)-  where-    parseAddrs :: ByteString -> Either DecodeError [Address]-    parseAddrs !d-      | BS.null d = Right []-      | otherwise = do-          (addr, d') <- parseOneAddr d-          addrs <- parseAddrs d'-          Right (addr : addrs)--    parseOneAddr :: ByteString -> Either DecodeError (Address, ByteString)-    parseOneAddr d = do-      (typ, d1) <- decodeU8 d-      case typ of-        1 -> do  -- IPv4-          (addrBytes, d2) <- decodeBytes ipv4AddrLen d1-          (port, d3) <- decodeU16 d2-          case ipv4Addr addrBytes of-            Nothing -> Left DecodeInvalidAddress-            Just a  -> Right (AddrIPv4 a port, d3)-        2 -> do  -- IPv6-          (addrBytes, d2) <- decodeBytes ipv6AddrLen d1-          (port, d3) <- decodeU16 d2-          case ipv6Addr addrBytes of-            Nothing -> Left DecodeInvalidAddress-            Just a  -> Right (AddrIPv6 a port, d3)-        4 -> do  -- Tor v3-          (addrBytes, d2) <- decodeBytes torV3AddrLen d1-          (port, d3) <- decodeU16 d2-          case torV3Addr addrBytes of-            Nothing -> Left DecodeInvalidAddress-            Just a  -> Right (AddrTorV3 a port, d3)-        5 -> do  -- DNS hostname-          (hostLen, d2) <- decodeU8 d1-          (hostBytes, d3) <- decodeBytes (fromIntegral hostLen) d2-          (port, d4) <- decodeU16 d3-          Right (AddrDNS hostBytes port, d4)-        _ -> Left DecodeInvalidAddress  -- Unknown address type---- Channel announcement ------------------------------------------------------------ | Encode channel_announcement message.-encodeChannelAnnouncement :: ChannelAnnouncement -> ByteString-encodeChannelAnnouncement msg = mconcat-  [ getSignature (channelAnnNodeSig1 msg)-  , getSignature (channelAnnNodeSig2 msg)-  , getSignature (channelAnnBitcoinSig1 msg)-  , getSignature (channelAnnBitcoinSig2 msg)-  , encodeLenPrefixed (getFeatureBits (channelAnnFeatures msg))-  , getChainHash (channelAnnChainHash msg)-  , getShortChannelId (channelAnnShortChanId msg)-  , getNodeId (channelAnnNodeId1 msg)-  , getNodeId (channelAnnNodeId2 msg)-  , getPoint (channelAnnBitcoinKey1 msg)-  , getPoint (channelAnnBitcoinKey2 msg)-  ]---- | Decode channel_announcement message.-decodeChannelAnnouncement :: ByteString-                          -> Either DecodeError (ChannelAnnouncement, ByteString)-decodeChannelAnnouncement bs = do-  (nodeSig1, bs1)    <- decodeSignature bs-  (nodeSig2, bs2)    <- decodeSignature bs1-  (btcSig1, bs3)     <- decodeSignature bs2-  (btcSig2, bs4)     <- decodeSignature bs3-  (features, bs5)    <- decodeFeatureBits bs4-  (chainH, bs6)      <- decodeChainHash bs5-  (scid, bs7)        <- decodeShortChannelId bs6-  (nid1, bs8)        <- decodeNodeId bs7-  (nid2, bs9)        <- decodeNodeId bs8-  (btcKey1, bs10)    <- decodePoint bs9-  (btcKey2, rest)    <- decodePoint bs10-  let msg = ChannelAnnouncement-        { channelAnnNodeSig1    = nodeSig1-        , channelAnnNodeSig2    = nodeSig2-        , channelAnnBitcoinSig1 = btcSig1-        , channelAnnBitcoinSig2 = btcSig2-        , channelAnnFeatures    = features-        , channelAnnChainHash   = chainH-        , channelAnnShortChanId = scid-        , channelAnnNodeId1     = nid1-        , channelAnnNodeId2     = nid2-        , channelAnnBitcoinKey1 = btcKey1-        , channelAnnBitcoinKey2 = btcKey2-        }-  Right (msg, rest)---- Node announcement --------------------------------------------------------------- | Encode node_announcement message.-encodeNodeAnnouncement :: NodeAnnouncement -> Either EncodeError ByteString-encodeNodeAnnouncement msg = do-  addrData <- encodeAddresses (nodeAnnAddresses msg)-  let features = getFeatureBits (nodeAnnFeatures msg)-  if BS.length features > 65535-    then Left EncodeLengthOverflow-    else Right $ mconcat-      [ getSignature (nodeAnnSignature msg)-      , encodeLenPrefixed features-      , Prim.encodeU32 (nodeAnnTimestamp msg)-      , getNodeId (nodeAnnNodeId msg)-      , getRgbColor (nodeAnnRgbColor msg)-      , getAlias (nodeAnnAlias msg)-      , encodeLenPrefixed addrData-      ]---- | Encode address list.-encodeAddresses :: [Address] -> Either EncodeError ByteString-encodeAddresses addrs = Right $ mconcat (map encodeAddress addrs)-  where-    encodeAddress :: Address -> ByteString-    encodeAddress (AddrIPv4 a port) = mconcat-      [ BS.singleton 1-      , getIPv4Addr a-      , Prim.encodeU16 port-      ]-    encodeAddress (AddrIPv6 a port) = mconcat-      [ BS.singleton 2-      , getIPv6Addr a-      , Prim.encodeU16 port-      ]-    encodeAddress (AddrTorV3 a port) = mconcat-      [ BS.singleton 4-      , getTorV3Addr a-      , Prim.encodeU16 port-      ]-    encodeAddress (AddrDNS host port) = mconcat-      [ BS.singleton 5-      , BS.singleton (fromIntegral $ BS.length host)-      , host-      , Prim.encodeU16 port-      ]---- | Decode node_announcement message.-decodeNodeAnnouncement :: ByteString-                       -> Either DecodeError (NodeAnnouncement, ByteString)-decodeNodeAnnouncement bs = do-  (sig, bs1)       <- decodeSignature bs-  (features, bs2)  <- decodeFeatureBits bs1-  (timestamp, bs3) <- decodeU32 bs2-  (nid, bs4)       <- decodeNodeId bs3-  (color, bs5)     <- decodeRgbColor bs4-  (al, bs6)        <- decodeAlias bs5-  (addrs, rest)    <- decodeAddresses bs6-  let msg = NodeAnnouncement-        { nodeAnnSignature = sig-        , nodeAnnFeatures  = features-        , nodeAnnTimestamp = timestamp-        , nodeAnnNodeId    = nid-        , nodeAnnRgbColor  = color-        , nodeAnnAlias     = al-        , nodeAnnAddresses = addrs-        }-  Right (msg, rest)---- Channel update ------------------------------------------------------------------ | Encode channel_update message.-encodeChannelUpdate :: ChannelUpdate -> ByteString-encodeChannelUpdate msg = mconcat-  [ getSignature (chanUpdateSignature msg)-  , getChainHash (chanUpdateChainHash msg)-  , getShortChannelId (chanUpdateShortChanId msg)-  , Prim.encodeU32 (chanUpdateTimestamp msg)-  , BS.singleton (encodeMessageFlags (chanUpdateMsgFlags msg))-  , BS.singleton (encodeChannelFlags (chanUpdateChanFlags msg))-  , Prim.encodeU16 (getCltvExpiryDelta (chanUpdateCltvExpDelta msg))-  , Prim.encodeU64 (getHtlcMinimumMsat (chanUpdateHtlcMinMsat msg))-  , Prim.encodeU32 (getFeeBaseMsat (chanUpdateFeeBaseMsat msg))-  , Prim.encodeU32 (getFeeProportionalMillionths (chanUpdateFeeProportional msg))-  , case chanUpdateHtlcMaxMsat msg of-      Nothing -> BS.empty-      Just m  -> Prim.encodeU64 (getHtlcMaximumMsat m)-  ]---- | Decode channel_update message.-decodeChannelUpdate :: ByteString-                    -> Either DecodeError (ChannelUpdate, ByteString)-decodeChannelUpdate bs = do-  (sig, bs1)         <- decodeSignature bs-  (chainH, bs2)      <- decodeChainHash bs1-  (scid, bs3)        <- decodeShortChannelId bs2-  (timestamp, bs4)   <- decodeU32 bs3-  (msgFlagsRaw, bs5) <- decodeU8 bs4-  (chanFlagsRaw, bs6) <- decodeU8 bs5-  (cltvDelta, bs7)   <- decodeU16 bs6-  (htlcMin, bs8)     <- decodeU64 bs7-  (feeBase, bs9)     <- decodeU32 bs8-  (feeProp, bs10)    <- decodeU32 bs9-  let msgFlags' = decodeMessageFlags msgFlagsRaw-      chanFlags' = decodeChannelFlags chanFlagsRaw-  -- htlc_maximum_msat is present if message_flags bit 0 is set-  (htlcMax, rest) <- if mfHtlcMaxPresent msgFlags'-    then do-      (m, r) <- decodeU64 bs10-      Right (Just (HtlcMaximumMsat m), r)-    else Right (Nothing, bs10)-  let msg = ChannelUpdate-        { chanUpdateSignature       = sig-        , chanUpdateChainHash       = chainH-        , chanUpdateShortChanId     = scid-        , chanUpdateTimestamp       = timestamp-        , chanUpdateMsgFlags        = msgFlags'-        , chanUpdateChanFlags       = chanFlags'-        , chanUpdateCltvExpDelta    = CltvExpiryDelta cltvDelta-        , chanUpdateHtlcMinMsat     = HtlcMinimumMsat htlcMin-        , chanUpdateFeeBaseMsat     = FeeBaseMsat feeBase-        , chanUpdateFeeProportional = FeeProportionalMillionths feeProp-        , chanUpdateHtlcMaxMsat     = htlcMax-        }-  Right (msg, rest)---- Announcement signatures --------------------------------------------------------- | Encode announcement_signatures message.-encodeAnnouncementSignatures :: AnnouncementSignatures -> ByteString-encodeAnnouncementSignatures msg = mconcat-  [ getChannelId (annSigChannelId msg)-  , getShortChannelId (annSigShortChanId msg)-  , getSignature (annSigNodeSig msg)-  , getSignature (annSigBitcoinSig msg)-  ]---- | Decode announcement_signatures message.-decodeAnnouncementSignatures :: ByteString-                             -> Either DecodeError-                                  (AnnouncementSignatures, ByteString)-decodeAnnouncementSignatures bs = do-  (cid, bs1)     <- decodeChannelId bs-  (scid, bs2)    <- decodeShortChannelId bs1-  (nodeSig, bs3) <- decodeSignature bs2-  (btcSig, rest) <- decodeSignature bs3-  let msg = AnnouncementSignatures-        { annSigChannelId   = cid-        , annSigShortChanId = scid-        , annSigNodeSig     = nodeSig-        , annSigBitcoinSig  = btcSig-        }-  Right (msg, rest)---- Query messages ------------------------------------------------------------------ | Encode query_short_channel_ids message.-encodeQueryShortChannelIds :: QueryShortChannelIds-                           -> Either EncodeError ByteString-encodeQueryShortChannelIds msg = do-  let scidData = queryScidsData msg-  if BS.length scidData > 65535-    then Left EncodeLengthOverflow-    else Right $ mconcat-      [ getChainHash (queryScidsChainHash msg)-      , encodeLenPrefixed scidData-      , TLV.encodeTlvStream (queryScidsTlvs msg)-      ]---- | Decode query_short_channel_ids message.-decodeQueryShortChannelIds :: ByteString-                           -> Either DecodeError-                                (QueryShortChannelIds, ByteString)-decodeQueryShortChannelIds bs = do-  (chainH, bs1)   <- decodeChainHash bs-  (scidData, bs2) <- decodeLenPrefixed bs1-  let tlvs = case TLV.decodeTlvStreamRaw bs2 of-        Left _  -> unsafeTlvStream []-        Right t -> t-  let msg = QueryShortChannelIds-        { queryScidsChainHash = chainH-        , queryScidsData      = scidData-        , queryScidsTlvs      = tlvs-        }-  Right (msg, BS.empty)---- | Encode reply_short_channel_ids_end message.-encodeReplyShortChannelIdsEnd :: ReplyShortChannelIdsEnd -> ByteString-encodeReplyShortChannelIdsEnd msg = mconcat-  [ getChainHash (replyScidsChainHash msg)-  , BS.singleton (replyScidsFullInfo msg)-  ]---- | Decode reply_short_channel_ids_end message.-decodeReplyShortChannelIdsEnd :: ByteString-                              -> Either DecodeError-                                   (ReplyShortChannelIdsEnd, ByteString)-decodeReplyShortChannelIdsEnd bs = do-  (chainH, bs1)    <- decodeChainHash bs-  (fullInfo, rest) <- decodeU8 bs1-  let msg = ReplyShortChannelIdsEnd-        { replyScidsChainHash = chainH-        , replyScidsFullInfo  = fullInfo-        }-  Right (msg, rest)---- | Encode query_channel_range message.-encodeQueryChannelRange :: QueryChannelRange -> ByteString-encodeQueryChannelRange msg = mconcat-  [ getChainHash (queryRangeChainHash msg)-  , Prim.encodeU32 (queryRangeFirstBlock msg)-  , Prim.encodeU32 (queryRangeNumBlocks msg)-  , TLV.encodeTlvStream (queryRangeTlvs msg)-  ]---- | Decode query_channel_range message.-decodeQueryChannelRange :: ByteString-                        -> Either DecodeError (QueryChannelRange, ByteString)-decodeQueryChannelRange bs = do-  (chainH, bs1)     <- decodeChainHash bs-  (firstBlock, bs2) <- decodeU32 bs1-  (numBlocks, bs3)  <- decodeU32 bs2-  let tlvs = case TLV.decodeTlvStreamRaw bs3 of-        Left _  -> unsafeTlvStream []-        Right t -> t-  let msg = QueryChannelRange-        { queryRangeChainHash  = chainH-        , queryRangeFirstBlock = firstBlock-        , queryRangeNumBlocks  = numBlocks-        , queryRangeTlvs       = tlvs-        }-  Right (msg, BS.empty)---- | Encode reply_channel_range message.-encodeReplyChannelRange :: ReplyChannelRange -> Either EncodeError ByteString-encodeReplyChannelRange msg = do-  let rangeData = replyRangeData msg-  if BS.length rangeData > 65535-    then Left EncodeLengthOverflow-    else Right $ mconcat-      [ getChainHash (replyRangeChainHash msg)-      , Prim.encodeU32 (replyRangeFirstBlock msg)-      , Prim.encodeU32 (replyRangeNumBlocks msg)-      , BS.singleton (replyRangeSyncComplete msg)-      , encodeLenPrefixed rangeData-      , TLV.encodeTlvStream (replyRangeTlvs msg)-      ]---- | Decode reply_channel_range message.-decodeReplyChannelRange :: ByteString-                        -> Either DecodeError (ReplyChannelRange, ByteString)-decodeReplyChannelRange bs = do-  (chainH, bs1)       <- decodeChainHash bs-  (firstBlock, bs2)   <- decodeU32 bs1-  (numBlocks, bs3)    <- decodeU32 bs2-  (syncComplete, bs4) <- decodeU8 bs3-  (rangeData, bs5)    <- decodeLenPrefixed bs4-  let tlvs = case TLV.decodeTlvStreamRaw bs5 of-        Left _  -> unsafeTlvStream []-        Right t -> t-  let msg = ReplyChannelRange-        { replyRangeChainHash    = chainH-        , replyRangeFirstBlock   = firstBlock-        , replyRangeNumBlocks    = numBlocks-        , replyRangeSyncComplete = syncComplete-        , replyRangeData         = rangeData-        , replyRangeTlvs         = tlvs-        }-  Right (msg, BS.empty)---- | Encode gossip_timestamp_filter message.-encodeGossipTimestampFilter :: GossipTimestampFilter -> ByteString-encodeGossipTimestampFilter msg = mconcat-  [ getChainHash (gossipFilterChainHash msg)-  , Prim.encodeU32 (gossipFilterFirstTimestamp msg)-  , Prim.encodeU32 (gossipFilterTimestampRange msg)-  ]---- | Decode gossip_timestamp_filter message.-decodeGossipTimestampFilter :: ByteString-                            -> Either DecodeError-                                 (GossipTimestampFilter, ByteString)-decodeGossipTimestampFilter bs = do-  (chainH, bs1)   <- decodeChainHash bs-  (firstTs, bs2)  <- decodeU32 bs1-  (tsRange, rest) <- decodeU32 bs2-  let msg = GossipTimestampFilter-        { gossipFilterChainHash      = chainH-        , gossipFilterFirstTimestamp = firstTs-        , gossipFilterTimestampRange = tsRange-        }-  Right (msg, rest)---- Short channel ID list encoding --------------------------------------------------- | Encode a list of short channel IDs as concatenated 8-byte values.------ This produces encoded_short_ids data with encoding type 0 (uncompressed).--- The first byte is the encoding type (0), followed by the concatenated SCIDs.------ Note: This does NOT sort the SCIDs. The caller should ensure they are in--- ascending order if that's required by the protocol context.-encodeShortChannelIdList :: [ShortChannelId] -> ByteString-encodeShortChannelIdList scids = BS.cons 0 $-  mconcat (map getShortChannelId scids)-{-# INLINE encodeShortChannelIdList #-}---- | Decode a list of short channel IDs from encoded_short_ids data.------ Supports encoding type 0 (uncompressed). Other encoding types will fail.-decodeShortChannelIdList :: ByteString-                         -> Either DecodeError [ShortChannelId]-decodeShortChannelIdList bs-  | BS.null bs = Left DecodeInsufficientBytes-  | otherwise = do-      let encType = BS.index bs 0-          payload = BS.drop 1 bs-      case encType of-        0 -> decodeUncompressedScids payload-        _ -> Left DecodeInvalidShortChannelId  -- Unsupported encoding type-  where-    decodeUncompressedScids :: ByteString -> Either DecodeError [ShortChannelId]-    decodeUncompressedScids !d-      | BS.null d = Right []-      | BS.length d < shortChannelIdLen = Left DecodeInsufficientBytes-      | otherwise = do-          let (scidBytes, rest) = BS.splitAt shortChannelIdLen d-          case shortChannelId scidBytes of-            Nothing -> Left DecodeInvalidShortChannelId-            Just scid -> do-              scids <- decodeUncompressedScids rest-              Right (scid : scids)-{-# INLINE decodeShortChannelIdList #-}+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}++-- |+-- Module: Lightning.Protocol.BOLT7.Codec+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Encoding and decoding of BOLT #7 messages.++module Lightning.Protocol.BOLT7.Codec (+    EncodeError(..)+  , DecodeError(..)+  , encode_message+  , decode_message+  , encode_channel_announcement+  , decode_channel_announcement+  , encode_node_announcement+  , decode_node_announcement+  , encode_channel_update+  , decode_channel_update+  , encode_announcement_signatures+  , decode_announcement_signatures+  , encode_query_short_channel_ids+  , decode_query_short_channel_ids+  , encode_reply_short_channel_ids_end+  , decode_reply_short_channel_ids_end+  , encode_query_channel_range+  , decode_query_channel_range+  , encode_reply_channel_range+  , decode_reply_channel_range+  , encode_gossip_timestamp_filter+  , decode_gossip_timestamp_filter+  ) where++import Control.DeepSeq (NFData)+import qualified Data.ByteString as BS+import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Generics (Generic)+import Lightning.Protocol.BOLT1+  ( ChainHash, MilliSatoshi, Point, ShortChannelId, Signature+  , TlvError, TlvRecord(..), TlvStream )+import qualified Lightning.Protocol.BOLT1 as BOLT1+import qualified Lightning.Protocol.BOLT9 as BOLT9+import Lightning.Protocol.BOLT7.Messages+import Lightning.Protocol.BOLT7.Types++-- errors ---------------------------------------------------------------------++-- | Why a message failed to encode.+data EncodeError+  = EncodeLengthOverflow+    -- ^ a length-prefixed field exceeds 65535 bytes+  | EncodeInvalidTlvs+    -- ^ a @_tlvs@ field holds a record of a type the message defines+  | EncodeCountMismatch+    -- ^ query flags, timestamps or checksums don't number one per+    --   short channel id+  | EncodeInvalidAddresses+    -- ^ 'na_unknown_addresses' begins with a descriptor of a known type+  deriving (Eq, Show, Generic)++instance NFData EncodeError++-- | Why a message failed to decode.+data DecodeError+  = DecodeInsufficientBytes+    -- ^ the input ended before a field did+  | DecodeInvalidPoint+    -- ^ a point lacks a compressed-encoding prefix (0x02 or 0x03)+  | DecodeInvalidAmount+    -- ^ an amount exceeds 21 million BTC+  | DecodeInvalidBool+    -- ^ a boolean byte is neither 0 nor 1+  | DecodeInvalidShortChannelIds+    -- ^ @encoded_short_ids@ lacks an encoding type, or isn't a whole+    --   number of short channel ids+  | DecodeUnknownEncoding !Word8+    -- ^ an encoded array uses an unknown encoding type (type 1, zlib,+    --   is no longer allowed)+  | DecodeCountMismatch+    -- ^ query flags, timestamps or checksums don't number one per+    --   short channel id+  | DecodeTlvError !TlvError+    -- ^ the message's TLV stream is malformed+  | DecodeInvalidTlvValue !Word64+    -- ^ a known TLV record (of the given type) has a malformed value+  | DecodeUnknownType !Word16+    -- ^ the message type is not one of BOLT #7's+  deriving (Eq, Show, Generic)++instance NFData DecodeError++-- messages -------------------------------------------------------------------++-- | Encode a 'Message' payload (excluding the 2-byte message type; see+--   'message_type'). Frame the result with+--   'Lightning.Protocol.BOLT1.encode_envelope', which enforces the+--   65535-byte message limit.+encode_message :: Message -> Either EncodeError BS.ByteString+encode_message m = case m of+  MsgChannelAnnouncement a     -> encode_channel_announcement a+  MsgNodeAnnouncement a        -> encode_node_announcement a+  MsgChannelUpdate a           -> Right (encode_channel_update a)+  MsgAnnouncementSignatures a  -> Right (encode_announcement_signatures a)+  MsgQueryShortChannelIds a    -> encode_query_short_channel_ids a+  MsgReplyShortChannelIdsEnd a -> Right (encode_reply_short_channel_ids_end a)+  MsgQueryChannelRange a       -> encode_query_channel_range a+  MsgReplyChannelRange a       -> encode_reply_channel_range a+  MsgGossipTimestampFilter a   -> Right (encode_gossip_timestamp_filter a)++-- | Decode a message payload, given its message type (as split off by+--   'Lightning.Protocol.BOLT1.decode_envelope').+--+--   >>> decode_message 260 "\NUL"+--   Left (DecodeUnknownType 260)+decode_message :: Word16 -> BS.ByteString -> Either DecodeError Message+decode_message t bs = case t of+  256 -> MsgChannelAnnouncement <$> decode_channel_announcement bs+  257 -> MsgNodeAnnouncement <$> decode_node_announcement bs+  258 -> MsgChannelUpdate <$> decode_channel_update bs+  259 -> MsgAnnouncementSignatures <$> decode_announcement_signatures bs+  261 -> MsgQueryShortChannelIds <$> decode_query_short_channel_ids bs+  262 -> MsgReplyShortChannelIdsEnd <$> decode_reply_short_channel_ids_end bs+  263 -> MsgQueryChannelRange <$> decode_query_channel_range bs+  264 -> MsgReplyChannelRange <$> decode_reply_channel_range bs+  265 -> MsgGossipTimestampFilter <$> decode_gossip_timestamp_filter bs+  _   -> Left (DecodeUnknownType t)++-- channel_announcement -------------------------------------------------------++-- | Encode a t'ChannelAnnouncement' payload. Fails if the features exceed+--   65535 bytes.+encode_channel_announcement+  :: ChannelAnnouncement -> Either EncodeError BS.ByteString+encode_channel_announcement m = do+  f <- prefixed (BOLT9.render (ca_features m))+  pure $ mconcat+    [ BOLT1.un_signature (ca_node_signature_1 m)+    , BOLT1.un_signature (ca_node_signature_2 m)+    , BOLT1.un_signature (ca_bitcoin_signature_1 m)+    , BOLT1.un_signature (ca_bitcoin_signature_2 m)+    , f+    , BOLT1.un_chain_hash (ca_chain_hash m)+    , BOLT1.encode_short_channel_id (ca_short_channel_id m)+    , BOLT1.un_point (ca_node_id_1 m)+    , BOLT1.un_point (ca_node_id_2 m)+    , BOLT1.un_point (ca_bitcoin_key_1 m)+    , BOLT1.un_point (ca_bitcoin_key_2 m)+    , BOLT1.encode_tlv_stream (ca_tlvs m)+    ]++-- | Decode a t'ChannelAnnouncement' payload.+decode_channel_announcement+  :: BS.ByteString -> Either DecodeError ChannelAnnouncement+decode_channel_announcement b0 = do+  (ns1, b1)  <- signature b0+  (ns2, b2)  <- signature b1+  (bs1, b3)  <- signature b2+  (bs2, b4)  <- signature b3+  (f, b5)    <- u16_prefixed b4+  (ch, b6)   <- chain_hash b5+  (s, b7)    <- short_channel_id b6+  (n1, b8)   <- point b7+  (n2, b9)   <- point b8+  (bk1, b10) <- point b9+  (bk2, b11) <- point b10+  ext        <- extension b11+  pure ChannelAnnouncement+    { ca_node_signature_1    = ns1+    , ca_node_signature_2    = ns2+    , ca_bitcoin_signature_1 = bs1+    , ca_bitcoin_signature_2 = bs2+    , ca_features            = BOLT9.parse f+    , ca_chain_hash          = ch+    , ca_short_channel_id    = s+    , ca_node_id_1           = n1+    , ca_node_id_2           = n2+    , ca_bitcoin_key_1       = bk1+    , ca_bitcoin_key_2       = bk2+    , ca_tlvs                = ext+    }++-- node_announcement ----------------------------------------------------------++-- | Encode a t'NodeAnnouncement' payload. Fails if the features or the+--   addresses exceed 65535 bytes, or if 'na_unknown_addresses' begins+--   with a descriptor of a known type.+encode_node_announcement+  :: NodeAnnouncement -> Either EncodeError BS.ByteString+encode_node_announcement m = do+  f <- prefixed (BOLT9.render (na_features m))+  let unknown = na_unknown_addresses m+  case BS.uncons unknown of+    Just (t, _) | t >= 1 && t <= 5 -> Left EncodeInvalidAddresses+    _ -> pure ()+  as <- prefixed (foldMap encode_address (na_addresses m) <> unknown)+  let RgbColor r g b = na_rgb_color m+      Alias al = na_alias m+  pure $ mconcat+    [ BOLT1.un_signature (na_signature m)+    , f+    , BOLT1.encode_u32 (na_timestamp m)+    , BOLT1.un_point (na_node_id m)+    , BS.pack [r, g, b]+    , al+    , as+    , BOLT1.encode_tlv_stream (na_tlvs m)+    ]++encode_address :: Address -> BS.ByteString+encode_address a = case a of+  AddrIPv4 (IPv4Addr b) p   -> BS.cons 1 (b <> BOLT1.encode_u16 p)+  AddrIPv6 (IPv6Addr b) p   -> BS.cons 2 (b <> BOLT1.encode_u16 p)+  AddrTorV2 (TorV2Addr b)   -> BS.cons 3 b+  AddrTorV3 (TorV3Addr b) p -> BS.cons 4 (b <> BOLT1.encode_u16 p)+  AddrDNS (Hostname h) p    ->+    BS.cons 5 (BS.cons (fromIntegral (BS.length h)) (h <> BOLT1.encode_u16 p))++-- | Decode a t'NodeAnnouncement' payload.+--+--   Address descriptors are parsed up to the first one of an unknown+--   type; it and the bytes after it are kept in 'na_unknown_addresses'.+--   A truncated descriptor of a known type is an error.+decode_node_announcement+  :: BS.ByteString -> Either DecodeError NodeAnnouncement+decode_node_announcement b0 = do+  (sig, b1) <- signature b0+  (f, b2)   <- u16_prefixed b1+  (ts, b3)  <- u32 b2+  (nid, b4) <- point b3+  (r, b5)   <- u8 b4+  (g, b6)   <- u8 b5+  (b, b7)   <- u8 b6+  (al, b8)  <- bytes 32 b7+  (as, b9)  <- u16_prefixed b8+  (known, unknown) <- addresses as+  ext <- extension b9+  pure NodeAnnouncement+    { na_signature         = sig+    , na_features          = BOLT9.parse f+    , na_timestamp         = ts+    , na_node_id           = nid+    , na_rgb_color         = RgbColor r g b+    , na_alias             = Alias al+    , na_addresses         = known+    , na_unknown_addresses = unknown+    , na_tlvs              = ext+    }++-- parse address descriptors, stopping at the first of an unknown type+addresses+  :: BS.ByteString -> Either DecodeError ([Address], BS.ByteString)+addresses = go []+  where+    go !acc !bs = case BS.uncons bs of+      Nothing -> Right (reverse acc, BS.empty)+      Just (t, r) -> case t of+        1 -> with_port acc 4 (AddrIPv4 . IPv4Addr) r+        2 -> with_port acc 16 (AddrIPv6 . IPv6Addr) r+        3 -> do+          (a, r1) <- bytes 12 r+          go (AddrTorV2 (TorV2Addr a) : acc) r1+        4 -> with_port acc 35 (AddrTorV3 . TorV3Addr) r+        5 -> do+          (n, r1) <- u8 r+          (h, r2) <- bytes (fromIntegral n) r1+          (p, r3) <- u16 r2+          go (AddrDNS (Hostname h) p : acc) r3+        _ -> Right (reverse acc, bs)++    with_port acc n mk r = do+      (a, r1) <- bytes n r+      (p, r2) <- u16 r1+      go (mk a p : acc) r2++-- channel_update -------------------------------------------------------------++-- | Encode a t'ChannelUpdate' payload.+encode_channel_update :: ChannelUpdate -> BS.ByteString+encode_channel_update m =+  let MessageFlags mf = cu_message_flags m+      ChannelFlags cf = cu_channel_flags m+  in  mconcat+        [ BOLT1.un_signature (cu_signature m)+        , BOLT1.un_chain_hash (cu_chain_hash m)+        , BOLT1.encode_short_channel_id (cu_short_channel_id m)+        , BOLT1.encode_u32 (cu_timestamp m)+        , BS.pack [mf, cf]+        , BOLT1.encode_u16 (cu_cltv_expiry_delta m)+        , BOLT1.encode_milli_satoshi (cu_htlc_minimum_msat m)+        , BOLT1.encode_u32 (cu_fee_base_msat m)+        , BOLT1.encode_u32 (cu_fee_proportional_millionths m)+        , BOLT1.encode_milli_satoshi (cu_htlc_maximum_msat m)+        , BOLT1.encode_tlv_stream (cu_tlvs m)+        ]++-- | Decode a t'ChannelUpdate' payload.+--+--   @htlc_maximum_msat@ is always present; the @must_be_one@ bit of+--   @message_flags@ is kept but not interpreted.+decode_channel_update :: BS.ByteString -> Either DecodeError ChannelUpdate+decode_channel_update b0 = do+  (sig, b1)   <- signature b0+  (ch, b2)    <- chain_hash b1+  (s, b3)     <- short_channel_id b2+  (ts, b4)    <- u32 b3+  (mf, b5)    <- u8 b4+  (cf, b6)    <- u8 b5+  (cltv, b7)  <- u16 b6+  (hmin, b8)  <- milli_satoshi b7+  (fb, b9)    <- u32 b8+  (fp, b10)   <- u32 b9+  (hmax, b11) <- milli_satoshi b10+  ext         <- extension b11+  pure ChannelUpdate+    { cu_signature                   = sig+    , cu_chain_hash                  = ch+    , cu_short_channel_id            = s+    , cu_timestamp                   = ts+    , cu_message_flags               = MessageFlags mf+    , cu_channel_flags               = ChannelFlags cf+    , cu_cltv_expiry_delta           = cltv+    , cu_htlc_minimum_msat           = hmin+    , cu_fee_base_msat               = fb+    , cu_fee_proportional_millionths = fp+    , cu_htlc_maximum_msat           = hmax+    , cu_tlvs                        = ext+    }++-- announcement_signatures ----------------------------------------------------++-- | Encode an t'AnnouncementSignatures' payload.+encode_announcement_signatures :: AnnouncementSignatures -> BS.ByteString+encode_announcement_signatures m = mconcat+  [ BOLT1.un_channel_id (as_channel_id m)+  , BOLT1.encode_short_channel_id (as_short_channel_id m)+  , BOLT1.un_signature (as_node_signature m)+  , BOLT1.un_signature (as_bitcoin_signature m)+  , BOLT1.encode_tlv_stream (as_tlvs m)+  ]++-- | Decode an t'AnnouncementSignatures' payload.+decode_announcement_signatures+  :: BS.ByteString -> Either DecodeError AnnouncementSignatures+decode_announcement_signatures b0 = do+  (cid, b1) <- need (BOLT1.decode_channel_id b0)+  (s, b2)   <- short_channel_id b1+  (ns, b3)  <- signature b2+  (bs, b4)  <- signature b3+  ext       <- extension b4+  pure (AnnouncementSignatures cid s ns bs ext)++-- query_short_channel_ids ----------------------------------------------------++-- | Encode a t'QueryShortChannelIds' payload. Fails if the short channel+--   ids exceed the u16 length limit (8191 of them), if the query flags+--   don't number one per short channel id, or if 'qsci_tlvs' holds a+--   record of type 1.+encode_query_short_channel_ids+  :: QueryShortChannelIds -> Either EncodeError BS.ByteString+encode_query_short_channel_ids m = do+  let scids = qsci_short_channel_ids m+  ids <- prefixed (encode_short_ids scids)+  flags <- case qsci_query_flags m of+    Nothing -> pure []+    Just fs+      | length fs /= length scids -> Left EncodeCountMismatch+      | otherwise -> pure+          [TlvRecord 1 (BS.cons 0 (foldMap (\(QueryFlags w) ->+                                       BOLT1.encode_bigsize w) fs))]+  t <- merge [1] flags (qsci_tlvs m)+  pure (BOLT1.un_chain_hash (qsci_chain_hash m) <> ids <> t)++-- | Decode a t'QueryShortChannelIds' payload.+--+--   Fails on an unknown encoding type (including the deprecated zlib+--   encoding), on @encoded_short_ids@ that isn't a whole number of short+--   channel ids, and on query flags that don't number one per short+--   channel id.+--+--   >>> let zlib = BS.replicate 32 0 <> "\NUL\STX\SOHx"+--   >>> decode_query_short_channel_ids zlib+--   Left (DecodeUnknownEncoding 1)+decode_query_short_channel_ids+  :: BS.ByteString -> Either DecodeError QueryShortChannelIds+decode_query_short_channel_ids b0 = do+  (ch, b1)  <- chain_hash b0+  (ids, b2) <- u16_prefixed b1+  scids     <- short_ids ids+  s         <- tlvs [1] b2+  flags     <- traverse (query_flags_value (length scids))+                 (BOLT1.lookup_tlv 1 s)+  pure QueryShortChannelIds+    { qsci_chain_hash        = ch+    , qsci_short_channel_ids = scids+    , qsci_query_flags       = flags+    , qsci_tlvs              = BOLT1.filter_tlv_stream (/= 1) s+    }++query_flags_value :: Int -> BS.ByteString -> Either DecodeError [QueryFlags]+query_flags_value n v = case BS.uncons v of+  Nothing -> Left (DecodeInvalidTlvValue 1)+  Just (0, r) -> do+    fs <- bigsizes r+    if length fs /= n+      then Left DecodeCountMismatch+      else Right (map QueryFlags fs)+  Just (e, _) -> Left (DecodeUnknownEncoding e)+  where+    bigsizes !r+      | BS.null r = Right []+      | otherwise = case BOLT1.decode_bigsize r of+          Nothing      -> Left (DecodeInvalidTlvValue 1)+          Just (w, r1) -> (w :) <$> bigsizes r1++-- reply_short_channel_ids_end ------------------------------------------------++-- | Encode a t'ReplyShortChannelIdsEnd' payload.+encode_reply_short_channel_ids_end+  :: ReplyShortChannelIdsEnd -> BS.ByteString+encode_reply_short_channel_ids_end m = mconcat+  [ BOLT1.un_chain_hash (rsce_chain_hash m)+  , encode_bool (rsce_full_information m)+  , BOLT1.encode_tlv_stream (rsce_tlvs m)+  ]++-- | Decode a t'ReplyShortChannelIdsEnd' payload.+--+--   >>> decode_reply_short_channel_ids_end (BS.replicate 32 0 <> "\STX")+--   Left DecodeInvalidBool+decode_reply_short_channel_ids_end+  :: BS.ByteString -> Either DecodeError ReplyShortChannelIdsEnd+decode_reply_short_channel_ids_end b0 = do+  (ch, b1)   <- chain_hash b0+  (full, b2) <- bool b1+  ext        <- extension b2+  pure (ReplyShortChannelIdsEnd ch full ext)++-- query_channel_range --------------------------------------------------------++-- | Encode a t'QueryChannelRange' payload. Fails if 'qcr_tlvs' holds a+--   record of type 1.+encode_query_channel_range+  :: QueryChannelRange -> Either EncodeError BS.ByteString+encode_query_channel_range m = do+  let opt = case qcr_query_option m of+        Nothing              -> []+        Just (QueryOption w) -> [TlvRecord 1 (BOLT1.encode_bigsize w)]+  t <- merge [1] opt (qcr_tlvs m)+  pure $ mconcat+    [ BOLT1.un_chain_hash (qcr_chain_hash m)+    , BOLT1.encode_u32 (qcr_first_blocknum m)+    , BOLT1.encode_u32 (qcr_number_of_blocks m)+    , t+    ]++-- | Decode a t'QueryChannelRange' payload.+decode_query_channel_range+  :: BS.ByteString -> Either DecodeError QueryChannelRange+decode_query_channel_range b0 = do+  (ch, b1)    <- chain_hash b0+  (first, b2) <- u32 b1+  (num, b3)   <- u32 b2+  s           <- tlvs [1] b3+  opt         <- traverse option (BOLT1.lookup_tlv 1 s)+  pure QueryChannelRange+    { qcr_chain_hash       = ch+    , qcr_first_blocknum   = first+    , qcr_number_of_blocks = num+    , qcr_query_option     = opt+    , qcr_tlvs             = BOLT1.filter_tlv_stream (/= 1) s+    }+  where+    option v = case BOLT1.decode_bigsize v of+      Just (w, r) | BS.null r -> Right (QueryOption w)+      _ -> Left (DecodeInvalidTlvValue 1)++-- reply_channel_range --------------------------------------------------------++-- | Encode a t'ReplyChannelRange' payload. Fails if the short channel ids+--   exceed the u16 length limit (8191 of them), if the timestamps or+--   checksums don't number one per short channel id, or if 'rcr_tlvs'+--   holds a record of type 1 or 3.+encode_reply_channel_range+  :: ReplyChannelRange -> Either EncodeError BS.ByteString+encode_reply_channel_range m = do+  let scids = rcr_short_channel_ids m+      n = length scids+      count xs+        | length xs /= n = Left EncodeCountMismatch+        | otherwise      = Right ()+  ids <- prefixed (encode_short_ids scids)+  ts <- case rcr_timestamps m of+    Nothing -> pure []+    Just xs -> do+      count xs+      pure [TlvRecord 1 (BS.cons 0 (foldMap+        (\(ChannelUpdateTimestamps a b) -> pair a b) xs))]+  cs <- case rcr_checksums m of+    Nothing -> pure []+    Just xs -> do+      count xs+      pure [TlvRecord 3 (foldMap+        (\(ChannelUpdateChecksums a b) -> pair a b) xs)]+  t <- merge [1, 3] (ts <> cs) (rcr_tlvs m)+  pure $ mconcat+    [ BOLT1.un_chain_hash (rcr_chain_hash m)+    , BOLT1.encode_u32 (rcr_first_blocknum m)+    , BOLT1.encode_u32 (rcr_number_of_blocks m)+    , encode_bool (rcr_sync_complete m)+    , ids+    , t+    ]+  where+    pair a b = BOLT1.encode_u32 a <> BOLT1.encode_u32 b++-- | Decode a t'ReplyChannelRange' payload.+--+--   Fails on an unknown encoding type (including the deprecated zlib+--   encoding), on @encoded_short_ids@ that isn't a whole number of short+--   channel ids, and on timestamps or checksums that don't number one+--   per short channel id.+decode_reply_channel_range+  :: BS.ByteString -> Either DecodeError ReplyChannelRange+decode_reply_channel_range b0 = do+  (ch, b1)    <- chain_hash b0+  (first, b2) <- u32 b1+  (num, b3)   <- u32 b2+  (sync, b4)  <- bool b3+  (ids, b5)   <- u16_prefixed b4+  scids       <- short_ids ids+  s           <- tlvs [1, 3] b5+  let n = length scids+  ts <- traverse (timestamps n) (BOLT1.lookup_tlv 1 s)+  cs <- traverse (pairs 3 ChannelUpdateChecksums n) (BOLT1.lookup_tlv 3 s)+  pure ReplyChannelRange+    { rcr_chain_hash        = ch+    , rcr_first_blocknum    = first+    , rcr_number_of_blocks  = num+    , rcr_sync_complete     = sync+    , rcr_short_channel_ids = scids+    , rcr_timestamps        = ts+    , rcr_checksums         = cs+    , rcr_tlvs              =+        BOLT1.filter_tlv_stream (\t -> t /= 1 && t /= 3) s+    }+  where+    timestamps n v = case BS.uncons v of+      Nothing     -> Left (DecodeInvalidTlvValue 1)+      Just (0, r) -> pairs 1 ChannelUpdateTimestamps n r+      Just (e, _) -> Left (DecodeUnknownEncoding e)++-- decode an array of u32 pairs holding n elements+pairs+  :: Word64 -> (Word32 -> Word32 -> a) -> Int -> BS.ByteString+  -> Either DecodeError [a]+pairs t mk n r+  | BS.length r `rem` 8 /= 0  = Left (DecodeInvalidTlvValue t)+  | BS.length r `quot` 8 /= n = Left DecodeCountMismatch+  | otherwise                 = Right (go r)+  where+    go !bs = case BOLT1.decode_u32 bs of+      Nothing -> []+      Just (a, r1) -> case BOLT1.decode_u32 r1 of+        Nothing      -> []+        Just (b, r2) -> mk a b : go r2++-- gossip_timestamp_filter ----------------------------------------------------++-- | Encode a t'GossipTimestampFilter' payload.+encode_gossip_timestamp_filter :: GossipTimestampFilter -> BS.ByteString+encode_gossip_timestamp_filter m = mconcat+  [ BOLT1.un_chain_hash (gtf_chain_hash m)+  , BOLT1.encode_u32 (gtf_first_timestamp m)+  , BOLT1.encode_u32 (gtf_timestamp_range m)+  , BOLT1.encode_tlv_stream (gtf_tlvs m)+  ]++-- | Decode a t'GossipTimestampFilter' payload.+decode_gossip_timestamp_filter+  :: BS.ByteString -> Either DecodeError GossipTimestampFilter+decode_gossip_timestamp_filter b0 = do+  (ch, b1)    <- chain_hash b0+  (first, b2) <- u32 b1+  (range, b3) <- u32 b2+  ext         <- extension b3+  pure (GossipTimestampFilter ch first range ext)++-- encoded short channel ids --------------------------------------------------++-- encoding type 0 (uncompressed), the only one allowed+encode_short_ids :: [ShortChannelId] -> BS.ByteString+encode_short_ids = BS.cons 0 . foldMap BOLT1.encode_short_channel_id++short_ids :: BS.ByteString -> Either DecodeError [ShortChannelId]+short_ids bs = case BS.uncons bs of+  Nothing -> Left DecodeInvalidShortChannelIds+  Just (0, r)+    | BS.length r `rem` 8 == 0 -> Right (go r)+    | otherwise                -> Left DecodeInvalidShortChannelIds+  Just (e, _) -> Left (DecodeUnknownEncoding e)+  where+    go !r = case BOLT1.decode_short_channel_id r of+      Nothing      -> []+      Just (s, r1) -> s : go r1++-- helpers --------------------------------------------------------------------++need :: Maybe a -> Either DecodeError a+need = maybe (Left DecodeInsufficientBytes) Right+{-# INLINE need #-}++u8 :: BS.ByteString -> Either DecodeError (Word8, BS.ByteString)+u8 = need . BS.uncons+{-# INLINE u8 #-}++u16 :: BS.ByteString -> Either DecodeError (Word16, BS.ByteString)+u16 = need . BOLT1.decode_u16+{-# INLINE u16 #-}++u32 :: BS.ByteString -> Either DecodeError (Word32, BS.ByteString)+u32 = need . BOLT1.decode_u32+{-# INLINE u32 #-}++bytes+  :: Int -> BS.ByteString+  -> Either DecodeError (BS.ByteString, BS.ByteString)+bytes n bs+  | BS.length bs < n = Left DecodeInsufficientBytes+  | otherwise        = Right (BS.splitAt n bs)+{-# INLINE bytes #-}++u16_prefixed+  :: BS.ByteString -> Either DecodeError (BS.ByteString, BS.ByteString)+u16_prefixed = need . BOLT1.decode_u16_prefixed+{-# INLINE u16_prefixed #-}++bool :: BS.ByteString -> Either DecodeError (Bool, BS.ByteString)+bool bs = do+  (b, r) <- u8 bs+  case b of+    0 -> Right (False, r)+    1 -> Right (True, r)+    _ -> Left DecodeInvalidBool++signature :: BS.ByteString -> Either DecodeError (Signature, BS.ByteString)+signature = need . BOLT1.decode_signature+{-# INLINE signature #-}++chain_hash :: BS.ByteString -> Either DecodeError (ChainHash, BS.ByteString)+chain_hash = need . BOLT1.decode_chain_hash+{-# INLINE chain_hash #-}++short_channel_id+  :: BS.ByteString -> Either DecodeError (ShortChannelId, BS.ByteString)+short_channel_id = need . BOLT1.decode_short_channel_id+{-# INLINE short_channel_id #-}++point :: BS.ByteString -> Either DecodeError (Point, BS.ByteString)+point bs = do+  (b, r) <- bytes 33 bs+  case BOLT1.point b of+    Nothing -> Left DecodeInvalidPoint+    Just p  -> Right (p, r)++milli_satoshi+  :: BS.ByteString -> Either DecodeError (MilliSatoshi, BS.ByteString)+milli_satoshi bs = do+  (w, r) <- need (BOLT1.decode_u64 bs)+  case BOLT1.milli_satoshi w of+    Nothing -> Left DecodeInvalidAmount+    Just a  -> Right (a, r)++-- a TLV stream with the given known types+tlvs :: [Word64] -> BS.ByteString -> Either DecodeError TlvStream+tlvs known bs = either (Left . DecodeTlvError) Right+  (BOLT1.decode_tlv_stream (`elem` known) bs)++-- an extension stream, in which no types are known+extension :: BS.ByteString -> Either DecodeError TlvStream+extension = tlvs []+{-# INLINE extension #-}++prefixed :: BS.ByteString -> Either EncodeError BS.ByteString+prefixed bs =+  maybe (Left EncodeLengthOverflow) Right (BOLT1.encode_u16_prefixed bs)+{-# INLINE prefixed #-}++encode_bool :: Bool -> BS.ByteString+encode_bool b = BS.singleton (if b then 1 else 0)+{-# INLINE encode_bool #-}++-- encode typed records together with the extra records of a @_tlvs@+-- field, which mustn't use any of the message's known types+merge+  :: [Word64] -> [TlvRecord] -> TlvStream -> Either EncodeError BS.ByteString+merge known typed extra+  | any ((`elem` known) . tlv_type) rs = Left EncodeInvalidTlvs+  | otherwise =+      maybe (Left EncodeInvalidTlvs) (Right . BOLT1.encode_tlv_stream)+      (BOLT1.tlv_stream (typed <> rs))+  where+    rs = BOLT1.un_tlv_stream extra

@@ -1,5 +1,4 @@-{-# OPTIONS_HADDOCK prune #-}-+{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE BangPatterns #-}  -- |@@ -8,99 +7,117 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Signature hash computation for BOLT #7 messages.+-- Signature digests, signature verification and checksums for BOLT #7+-- messages. ----- These functions compute the double-SHA256 hash that is signed in each--- message type. The hash covers the message content excluding the--- signature field(s).+-- Signatures cover the encoded message after its signature fields,+-- extension included. Since decoding keeps every byte, the digest of a+-- decoded message is the digest of the bytes received.  module Lightning.Protocol.BOLT7.Hash (-  -- * Signature hashes-    channelAnnouncementHash-  , nodeAnnouncementHash-  , channelUpdateHash--  -- * Checksums-  , channelUpdateChecksum+    channel_announcement_hash+  , node_announcement_hash+  , channel_update_hash+  , verify_channel_announcement+  , verify_node_announcement+  , verify_channel_update+  , channel_update_checksum   ) where -import Data.ByteString (ByteString)+import qualified Crypto.Curve.Secp256k1 as Secp256k1+import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString as BS import Data.Word (Word32)-import qualified Crypto.Hash.SHA256 as SHA256+import Lightning.Protocol.BOLT1 (Point, Signature)+import qualified Lightning.Protocol.BOLT1 as BOLT1 import Lightning.Protocol.BOLT7.CRC32C (crc32c)-import Lightning.Protocol.BOLT7.Types (signatureLen, chainHashLen)+import Lightning.Protocol.BOLT7.Codec+import Lightning.Protocol.BOLT7.Messages --- | Double SHA-256 hash (used for Lightning message signing).-doubleSha256 :: ByteString -> ByteString-doubleSha256 = SHA256.hash . SHA256.hash-{-# INLINE doubleSha256 #-}+-- the signed bytes of each message+announcement_signed :: ChannelAnnouncement -> Either EncodeError BS.ByteString+announcement_signed = fmap (BS.drop 256) . encode_channel_announcement+{-# INLINE announcement_signed #-} --- | Compute signature hash for channel_announcement.------ The hash covers the message starting at byte offset 256, which is after--- the four 64-byte signatures (node_sig_1, node_sig_2, bitcoin_sig_1,--- bitcoin_sig_2).------ Returns the double-SHA256 hash (32 bytes).-channelAnnouncementHash :: ByteString -> ByteString-channelAnnouncementHash !msg =-  let offset = 4 * signatureLen-      payload = BS.drop offset msg-  in  doubleSha256 payload-{-# INLINE channelAnnouncementHash #-}+node_signed :: NodeAnnouncement -> Either EncodeError BS.ByteString+node_signed = fmap (BS.drop 64) . encode_node_announcement+{-# INLINE node_signed #-} --- | Compute signature hash for node_announcement.------ The hash covers the message starting after the signature field (64 bytes).------ Returns the double-SHA256 hash (32 bytes).-nodeAnnouncementHash :: ByteString -> ByteString-nodeAnnouncementHash !msg =-  let payload = BS.drop signatureLen msg-  in  doubleSha256 payload-{-# INLINE nodeAnnouncementHash #-}+update_signed :: ChannelUpdate -> BS.ByteString+update_signed = BS.drop 64 . encode_channel_update+{-# INLINE update_signed #-} --- | Compute signature hash for channel_update.------ The hash covers the message starting after the signature field (64 bytes).------ Returns the double-SHA256 hash (32 bytes).-channelUpdateHash :: ByteString -> ByteString-channelUpdateHash !msg =-  let payload = BS.drop signatureLen msg-  in  doubleSha256 payload-{-# INLINE channelUpdateHash #-}+double_sha256 :: BS.ByteString -> BS.ByteString+double_sha256 = SHA256.hash . SHA256.hash+{-# INLINE double_sha256 #-} --- | Compute checksum for channel_update.+-- | The digest the four signatures of a t'ChannelAnnouncement' sign: the+--   double SHA-256 of its encoding from offset 256 (after the+--   signatures) to the end. Fails as 'encode_channel_announcement' does.+channel_announcement_hash+  :: ChannelAnnouncement -> Either EncodeError BS.ByteString+channel_announcement_hash = fmap double_sha256 . announcement_signed++-- | The digest the signature of a t'NodeAnnouncement' signs: the double+--   SHA-256 of its encoding after the signature. Fails as+--   'encode_node_announcement' does.+node_announcement_hash+  :: NodeAnnouncement -> Either EncodeError BS.ByteString+node_announcement_hash = fmap double_sha256 . node_signed++-- | The digest the signature of a t'ChannelUpdate' signs: the double+--   SHA-256 of its encoding after the signature.+channel_update_hash :: ChannelUpdate -> BS.ByteString+channel_update_hash = double_sha256 . update_signed++-- | Verify the four signatures of a t'ChannelAnnouncement': both node+--   signatures and both bitcoin signatures, each over+--   'channel_announcement_hash' under the corresponding key. ----- This is the CRC-32C of the channel_update message excluding the--- signature field (bytes 0-63) and timestamp field (bytes 96-99).+--   As with libsecp256k1, signatures must be in low-s form. A key that+--   isn't a point on the curve fails verification.+verify_channel_announcement :: ChannelAnnouncement -> Bool+verify_channel_announcement m = case announcement_signed m of+  Left _ -> False+  Right signed ->+    let !d = SHA256.hash signed+    in  verify d (ca_node_id_1 m) (ca_node_signature_1 m)+          && verify d (ca_node_id_2 m) (ca_node_signature_2 m)+          && verify d (ca_bitcoin_key_1 m) (ca_bitcoin_signature_1 m)+          && verify d (ca_bitcoin_key_2 m) (ca_bitcoin_signature_2 m)++-- | Verify the signature of a t'NodeAnnouncement' under its node id. ----- The checksum is used in the checksums_tlv of reply_channel_range.+--   As with libsecp256k1, the signature must be in low-s form.+verify_node_announcement :: NodeAnnouncement -> Bool+verify_node_announcement m = case node_signed m of+  Left _       -> False+  Right signed -> verify (SHA256.hash signed) (na_node_id m) (na_signature m)++-- | Verify the signature of a t'ChannelUpdate' under the given node id. ----- Message layout after signature:---   - chain_hash: 32 bytes (offset 64-95)---   - short_channel_id: 8 bytes (offset 96-103)---   - timestamp: 4 bytes (offset 104-107) -- EXCLUDED---   - message_flags: 1 byte (offset 108)---   - channel_flags: 1 byte (offset 109)---   - cltv_expiry_delta: 2 bytes (offset 110-111)---   - htlc_minimum_msat: 8 bytes (offset 112-119)---   - fee_base_msat: 4 bytes (offset 120-123)---   - fee_proportional_millionths: 4 bytes (offset 124-127)---   - htlc_maximum_msat: 8 bytes (offset 128-135, if present)-channelUpdateChecksum :: ByteString -> Word32-channelUpdateChecksum !msg =-  let -- Offset 64: chain_hash (32 bytes)-      chainHash = BS.take chainHashLen (BS.drop signatureLen msg)-      -- Offset 96: short_channel_id (8 bytes)-      scid = BS.take 8 (BS.drop (signatureLen + chainHashLen) msg)-      -- Skip timestamp (4 bytes at offset 104)-      -- Offset 108 to end: rest of message-      restOffset = signatureLen + chainHashLen + 8 + 4  -- 64 + 32 + 8 + 4 = 108-      rest = BS.drop restOffset msg-      -- Concatenate: chain_hash + scid + (message without sig and timestamp)-      checksumData = BS.concat [chainHash, scid, rest]-  in  crc32c checksumData-{-# INLINE channelUpdateChecksum #-}+--   The key is that of the channel's t'ChannelAnnouncement' selected by+--   the update's direction: 'ca_node_id_1' for+--   'Lightning.Protocol.BOLT7.NodeOne', 'ca_node_id_2' for+--   'Lightning.Protocol.BOLT7.NodeTwo'. As with libsecp256k1, the+--   signature must be in low-s form.+verify_channel_update :: Point -> ChannelUpdate -> Bool+verify_channel_update k m =+  verify (SHA256.hash (update_signed m)) k (cu_signature m)++-- verify a signature over the double SHA-256 of some bytes, given their+-- single SHA-256 (secp256k1's verify_ecdsa hashes once more)+verify :: BS.ByteString -> Point -> Signature -> Bool+verify d k s =+  case ( Secp256k1.parse_point (BOLT1.un_point k)+       , Secp256k1.parse_sig (BOLT1.un_signature s) ) of+    (Just p, Just sig) -> Secp256k1.verify_ecdsa' Secp256k1.precompute d p sig+    _                  -> False++-- | The checksum of a t'ChannelUpdate', as used in the @checksums_tlv@ of+--   @reply_channel_range@: the CRC-32C (RFC 3720) of the update without+--   its signature and timestamp. Extension records are included.+channel_update_checksum :: ChannelUpdate -> Word32+channel_update_checksum m =+  let !bs = encode_channel_update m+  in  crc32c (BS.take 40 (BS.drop 64 bs) <> BS.drop 108 bs)

@@ -1,6 +1,4 @@-{-# OPTIONS_HADDOCK prune #-}--{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveGeneric #-}  -- |@@ -9,228 +7,189 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- BOLT #7 gossip message type definitions.+-- The messages defined by BOLT #7.  module Lightning.Protocol.BOLT7.Messages (-  -- * Message types-    MsgType(..)-  , msgTypeCode--  -- * Channel announcement+    Message(..)+  , message_type   , ChannelAnnouncement(..)--  -- * Node announcement   , NodeAnnouncement(..)--  -- * Channel update   , ChannelUpdate(..)--  -- * Announcement signatures   , AnnouncementSignatures(..)--  -- * Query messages   , QueryShortChannelIds(..)   , ReplyShortChannelIdsEnd(..)   , QueryChannelRange(..)   , ReplyChannelRange(..)   , GossipTimestampFilter(..)--  -- * Union type-  , Message(..)   ) where  import Control.DeepSeq (NFData)-import Data.ByteString (ByteString)-import Data.Word (Word8, Word16, Word32)  -- Word8 still used by other messages+import qualified Data.ByteString as BS+import Data.Word (Word16, Word32) import GHC.Generics (Generic)-import Lightning.Protocol.BOLT1 (TlvStream)+import Lightning.Protocol.BOLT1+  ( ChainHash, ChannelId, MilliSatoshi, Point, ShortChannelId+  , Signature, TlvStream )+import qualified Lightning.Protocol.BOLT9 as BOLT9 import Lightning.Protocol.BOLT7.Types --- Message type codes -------------------------------------------------------------- | BOLT #7 message type codes.-data MsgType-  = MsgChannelAnnouncement       -- ^ 256-  | MsgNodeAnnouncement          -- ^ 257-  | MsgChannelUpdate             -- ^ 258-  | MsgAnnouncementSignatures    -- ^ 259-  | MsgQueryShortChannelIds      -- ^ 261-  | MsgReplyShortChannelIdsEnd   -- ^ 262-  | MsgQueryChannelRange         -- ^ 263-  | MsgReplyChannelRange         -- ^ 264-  | MsgGossipTimestampFilter     -- ^ 265-  deriving (Eq, Show, Generic)--instance NFData MsgType---- | Get numeric code for message type.-msgTypeCode :: MsgType -> Word16-msgTypeCode MsgChannelAnnouncement     = 256-msgTypeCode MsgNodeAnnouncement        = 257-msgTypeCode MsgChannelUpdate           = 258-msgTypeCode MsgAnnouncementSignatures  = 259-msgTypeCode MsgQueryShortChannelIds    = 261-msgTypeCode MsgReplyShortChannelIdsEnd = 262-msgTypeCode MsgQueryChannelRange       = 263-msgTypeCode MsgReplyChannelRange       = 264-msgTypeCode MsgGossipTimestampFilter   = 265-{-# INLINE msgTypeCode #-}---- Channel announcement ------------------------------------------------------------ | channel_announcement message (type 256).------ Announces a public channel to the network.+-- | The @channel_announcement@ message (type 256). data ChannelAnnouncement = ChannelAnnouncement-  { channelAnnNodeSig1     :: !Signature     -- ^ Signature from node_id_1-  , channelAnnNodeSig2     :: !Signature     -- ^ Signature from node_id_2-  , channelAnnBitcoinSig1  :: !Signature     -- ^ Signature from bitcoin_key_1-  , channelAnnBitcoinSig2  :: !Signature     -- ^ Signature from bitcoin_key_2-  , channelAnnFeatures     :: !FeatureBits   -- ^ Feature bits-  , channelAnnChainHash    :: !ChainHash     -- ^ Chain identifier-  , channelAnnShortChanId  :: !ShortChannelId -- ^ Short channel ID-  , channelAnnNodeId1      :: !NodeId        -- ^ First node (lexicographically)-  , channelAnnNodeId2      :: !NodeId        -- ^ Second node-  , channelAnnBitcoinKey1  :: !Point         -- ^ Bitcoin key for node_id_1-  , channelAnnBitcoinKey2  :: !Point         -- ^ Bitcoin key for node_id_2-  }-  deriving (Eq, Show, Generic)+  { ca_node_signature_1    :: !Signature+  , ca_node_signature_2    :: !Signature+  , ca_bitcoin_signature_1 :: !Signature+  , ca_bitcoin_signature_2 :: !Signature+  , ca_features            :: !BOLT9.FeatureVector+  , ca_chain_hash          :: !ChainHash+  , ca_short_channel_id    :: {-# UNPACK #-} !ShortChannelId+  , ca_node_id_1           :: !Point+    -- ^ the lexicographically lesser node id+  , ca_node_id_2           :: !Point+  , ca_bitcoin_key_1       :: !Point+  , ca_bitcoin_key_2       :: !Point+  , ca_tlvs                :: !TlvStream+    -- ^ extension TLV records (all unknown odd)+  } deriving (Eq, Show, Generic)  instance NFData ChannelAnnouncement --- Node announcement --------------------------------------------------------------- | node_announcement message (type 257).------ Advertises node metadata to the network.+-- | The @node_announcement@ message (type 257). data NodeAnnouncement = NodeAnnouncement-  { nodeAnnSignature  :: !Signature      -- ^ Signature of message-  , nodeAnnFeatures   :: !FeatureBits    -- ^ Feature bits-  , nodeAnnTimestamp  :: !Timestamp      -- ^ Unix timestamp-  , nodeAnnNodeId     :: !NodeId         -- ^ Node public key-  , nodeAnnRgbColor   :: !RgbColor       -- ^ RGB color-  , nodeAnnAlias      :: !Alias          -- ^ Node alias (32 bytes UTF-8)-  , nodeAnnAddresses  :: ![Address]      -- ^ List of addresses-  }-  deriving (Eq, Show, Generic)+  { na_signature         :: !Signature+  , na_features          :: !BOLT9.FeatureVector+  , na_timestamp         :: {-# UNPACK #-} !Word32+  , na_node_id           :: !Point+  , na_rgb_color         :: !RgbColor+  , na_alias             :: !Alias+  , na_addresses         :: ![Address]+    -- ^ address descriptors of known types, in order+  , na_unknown_addresses :: !BS.ByteString+    -- ^ the address bytes from the first descriptor of an unknown type+    --   on (empty if there is none), kept as received+  , na_tlvs              :: !TlvStream+    -- ^ extension TLV records (all unknown odd)+  } deriving (Eq, Show, Generic)  instance NFData NodeAnnouncement --- Channel update ------------------------------------------------------------------ | channel_update message (type 258).------ Communicates per-direction routing parameters.+-- | The @channel_update@ message (type 258). data ChannelUpdate = ChannelUpdate-  { chanUpdateSignature      :: !Signature       -- ^ Signature of message-  , chanUpdateChainHash      :: !ChainHash       -- ^ Chain identifier-  , chanUpdateShortChanId    :: !ShortChannelId  -- ^ Short channel ID-  , chanUpdateTimestamp      :: !Timestamp       -- ^ Unix timestamp-  , chanUpdateMsgFlags       :: !MessageFlags    -- ^ Message flags-  , chanUpdateChanFlags      :: !ChannelFlags    -- ^ Channel flags-  , chanUpdateCltvExpDelta   :: !CltvExpiryDelta -- ^ CLTV expiry delta-  , chanUpdateHtlcMinMsat    :: !HtlcMinimumMsat -- ^ Minimum HTLC msat-  , chanUpdateFeeBaseMsat    :: !FeeBaseMsat     -- ^ Base fee msat-  , chanUpdateFeeProportional :: !FeeProportionalMillionths -- ^ Prop fee-  , chanUpdateHtlcMaxMsat    :: !(Maybe HtlcMaximumMsat) -- ^ Max HTLC (optional)-  }-  deriving (Eq, Show, Generic)+  { cu_signature                   :: !Signature+  , cu_chain_hash                  :: !ChainHash+  , cu_short_channel_id            :: {-# UNPACK #-} !ShortChannelId+  , cu_timestamp                   :: {-# UNPACK #-} !Word32+  , cu_message_flags               :: {-# UNPACK #-} !MessageFlags+  , cu_channel_flags               :: {-# UNPACK #-} !ChannelFlags+  , cu_cltv_expiry_delta           :: {-# UNPACK #-} !Word16+  , cu_htlc_minimum_msat           :: {-# UNPACK #-} !MilliSatoshi+  , cu_fee_base_msat               :: {-# UNPACK #-} !Word32+  , cu_fee_proportional_millionths :: {-# UNPACK #-} !Word32+  , cu_htlc_maximum_msat           :: {-# UNPACK #-} !MilliSatoshi+  , cu_tlvs                        :: !TlvStream+    -- ^ extension TLV records (all unknown odd)+  } deriving (Eq, Show, Generic)  instance NFData ChannelUpdate --- Announcement signatures --------------------------------------------------------- | announcement_signatures message (type 259).------ Sent between channel peers to enable channel announcement.+-- | The @announcement_signatures@ message (type 259). data AnnouncementSignatures = AnnouncementSignatures-  { annSigChannelId     :: !ChannelId       -- ^ Channel ID-  , annSigShortChanId   :: !ShortChannelId  -- ^ Short channel ID-  , annSigNodeSig       :: !Signature       -- ^ Node signature-  , annSigBitcoinSig    :: !Signature       -- ^ Bitcoin signature-  }-  deriving (Eq, Show, Generic)+  { as_channel_id        :: !ChannelId+  , as_short_channel_id  :: {-# UNPACK #-} !ShortChannelId+  , as_node_signature    :: !Signature+  , as_bitcoin_signature :: !Signature+  , as_tlvs              :: !TlvStream+    -- ^ extension TLV records (all unknown odd)+  } deriving (Eq, Show, Generic)  instance NFData AnnouncementSignatures --- Query messages ------------------------------------------------------------------ | query_short_channel_ids message (type 261).------ Requests information about specific channels.+-- | The @query_short_channel_ids@ message (type 261). data QueryShortChannelIds = QueryShortChannelIds-  { queryScidsChainHash :: !ChainHash    -- ^ Chain identifier-  , queryScidsData      :: !ByteString   -- ^ Encoded short_channel_ids-  , queryScidsTlvs      :: !TlvStream    -- ^ Optional TLV (query_flags)-  }-  deriving (Eq, Show, Generic)+  { qsci_chain_hash        :: !ChainHash+  , qsci_short_channel_ids :: ![ShortChannelId]+  , qsci_query_flags       :: !(Maybe [QueryFlags])+    -- ^ @query_flags@ (TLV type 1): one per short channel id+  , qsci_tlvs              :: !TlvStream+    -- ^ unknown odd TLV records+  } deriving (Eq, Show, Generic)  instance NFData QueryShortChannelIds --- | reply_short_channel_ids_end message (type 262).------ Concludes response to query_short_channel_ids.+-- | The @reply_short_channel_ids_end@ message (type 262). data ReplyShortChannelIdsEnd = ReplyShortChannelIdsEnd-  { replyScidsChainHash    :: !ChainHash  -- ^ Chain identifier-  , replyScidsFullInfo     :: !Word8      -- ^ 1 if complete, 0 otherwise-  }-  deriving (Eq, Show, Generic)+  { rsce_chain_hash       :: !ChainHash+  , rsce_full_information :: !Bool+  , rsce_tlvs             :: !TlvStream+    -- ^ extension TLV records (all unknown odd)+  } deriving (Eq, Show, Generic)  instance NFData ReplyShortChannelIdsEnd --- | query_channel_range message (type 263).------ Queries channels within a block range.+-- | The @query_channel_range@ message (type 263). data QueryChannelRange = QueryChannelRange-  { queryRangeChainHash     :: !ChainHash  -- ^ Chain identifier-  , queryRangeFirstBlock    :: !Word32     -- ^ First block number-  , queryRangeNumBlocks     :: !Word32     -- ^ Number of blocks-  , queryRangeTlvs          :: !TlvStream  -- ^ Optional TLV (query_option)-  }-  deriving (Eq, Show, Generic)+  { qcr_chain_hash       :: !ChainHash+  , qcr_first_blocknum   :: {-# UNPACK #-} !Word32+  , qcr_number_of_blocks :: {-# UNPACK #-} !Word32+  , qcr_query_option     :: !(Maybe QueryOption)+    -- ^ @query_option@ (TLV type 1)+  , qcr_tlvs             :: !TlvStream+    -- ^ unknown odd TLV records+  } deriving (Eq, Show, Generic)  instance NFData QueryChannelRange --- | reply_channel_range message (type 264).------ Responds to query_channel_range with channel IDs.+-- | The @reply_channel_range@ message (type 264). data ReplyChannelRange = ReplyChannelRange-  { replyRangeChainHash   :: !ChainHash    -- ^ Chain identifier-  , replyRangeFirstBlock  :: !Word32       -- ^ First block number-  , replyRangeNumBlocks   :: !Word32       -- ^ Number of blocks-  , replyRangeSyncComplete :: !Word8       -- ^ 1 if sync complete-  , replyRangeData        :: !ByteString   -- ^ Encoded short_channel_ids-  , replyRangeTlvs        :: !TlvStream    -- ^ Optional TLVs-  }-  deriving (Eq, Show, Generic)+  { rcr_chain_hash        :: !ChainHash+  , rcr_first_blocknum    :: {-# UNPACK #-} !Word32+  , rcr_number_of_blocks  :: {-# UNPACK #-} !Word32+  , rcr_sync_complete     :: !Bool+  , rcr_short_channel_ids :: ![ShortChannelId]+  , rcr_timestamps        :: !(Maybe [ChannelUpdateTimestamps])+    -- ^ @timestamps_tlv@ (TLV type 1): one per short channel id+  , rcr_checksums         :: !(Maybe [ChannelUpdateChecksums])+    -- ^ @checksums_tlv@ (TLV type 3): one per short channel id+  , rcr_tlvs              :: !TlvStream+    -- ^ unknown odd TLV records+  } deriving (Eq, Show, Generic)  instance NFData ReplyChannelRange --- | gossip_timestamp_filter message (type 265).------ Constrains which gossip messages are relayed.+-- | The @gossip_timestamp_filter@ message (type 265). data GossipTimestampFilter = GossipTimestampFilter-  { gossipFilterChainHash     :: !ChainHash  -- ^ Chain identifier-  , gossipFilterFirstTimestamp :: !Word32    -- ^ First timestamp-  , gossipFilterTimestampRange :: !Word32    -- ^ Timestamp range-  }-  deriving (Eq, Show, Generic)+  { gtf_chain_hash      :: !ChainHash+  , gtf_first_timestamp :: {-# UNPACK #-} !Word32+  , gtf_timestamp_range :: {-# UNPACK #-} !Word32+  , gtf_tlvs            :: !TlvStream+    -- ^ extension TLV records (all unknown odd)+  } deriving (Eq, Show, Generic)  instance NFData GossipTimestampFilter --- Union type ---------------------------------------------------------------------- | Union of all BOLT #7 message types.+-- | A BOLT #7 message. data Message-  = MsgChanAnn !ChannelAnnouncement-  | MsgNodeAnn !NodeAnnouncement-  | MsgChanUpd !ChannelUpdate-  | MsgAnnSig  !AnnouncementSignatures-  | MsgQueryScids !QueryShortChannelIds-  | MsgReplyScids !ReplyShortChannelIdsEnd-  | MsgQueryRange !QueryChannelRange-  | MsgReplyRange !ReplyChannelRange-  | MsgGossipFilter !GossipTimestampFilter+  = MsgChannelAnnouncement !ChannelAnnouncement+  | MsgNodeAnnouncement !NodeAnnouncement+  | MsgChannelUpdate !ChannelUpdate+  | MsgAnnouncementSignatures !AnnouncementSignatures+  | MsgQueryShortChannelIds !QueryShortChannelIds+  | MsgReplyShortChannelIdsEnd !ReplyShortChannelIdsEnd+  | MsgQueryChannelRange !QueryChannelRange+  | MsgReplyChannelRange !ReplyChannelRange+  | MsgGossipTimestampFilter !GossipTimestampFilter   deriving (Eq, Show, Generic)  instance NFData Message++-- | The message type of a 'Message'.+message_type :: Message -> Word16+message_type m = case m of+  MsgChannelAnnouncement _     -> 256+  MsgNodeAnnouncement _        -> 257+  MsgChannelUpdate _           -> 258+  MsgAnnouncementSignatures _  -> 259+  MsgQueryShortChannelIds _    -> 261+  MsgReplyShortChannelIdsEnd _ -> 262+  MsgQueryChannelRange _       -> 263+  MsgReplyChannelRange _       -> 264+  MsgGossipTimestampFilter _   -> 265

@@ -1,5 +1,4 @@-{-# OPTIONS_HADDOCK prune #-}-+{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} @@ -9,484 +8,453 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Core types for BOLT #7 routing gossip.+-- Field types for BOLT #7 gossip messages.  module Lightning.Protocol.BOLT7.Types (-  -- * Identifiers-    ChainHash-  , chainHash-  , getChainHash-  , mainnetChainHash-  , ShortChannelId-  , shortChannelId-  , mkShortChannelId-  , getShortChannelId-  , scidBlockHeight-  , scidTxIndex-  , scidOutputIndex-  , formatScid-  , ChannelId-  , channelId-  , getChannelId--  -- * Cryptographic types-  , Signature-  , signature-  , getSignature-  , Point-  , point-  , getPoint-  , NodeId-  , nodeId-  , getNodeId--  -- * Node metadata-  , RgbColor-  , rgbColor-  , getRgbColor-  , Alias-  , alias-  , getAlias-  , Timestamp-  , FeatureBits-  , featureBits-  , getFeatureBits--  -- * Address types-  , Address(..)-  , IPv4Addr-  , ipv4Addr-  , getIPv4Addr-  , IPv6Addr-  , ipv6Addr-  , getIPv6Addr-  , TorV3Addr-  , torV3Addr-  , getTorV3Addr+  -- * Short channel ids+    format_short_channel_id -  -- * Channel update flags+  -- * channel_update flags   , MessageFlags(..)-  , encodeMessageFlags-  , decodeMessageFlags+  , Forwarding(..)+  , message_flags+  , message_flags_forwarding+  , has_must_be_one   , ChannelFlags(..)-  , encodeChannelFlags-  , decodeChannelFlags+  , Direction(..)+  , ChannelStatus(..)+  , channel_flags+  , channel_flags_direction+  , channel_flags_status -  -- * Routing parameters-  , CltvExpiryDelta(..)-  , FeeBaseMsat(..)-  , FeeProportionalMillionths(..)-  , HtlcMinimumMsat(..)-  , HtlcMaximumMsat(..)+  -- * node_announcement fields+  , RgbColor(..)+  , Alias(..)+  , alias+  , un_alias+  , Address(..)+  , IPv4Addr(..)+  , ipv4_addr+  , un_ipv4_addr+  , IPv6Addr(..)+  , ipv6_addr+  , un_ipv6_addr+  , TorV2Addr(..)+  , tor_v2_addr+  , un_tor_v2_addr+  , TorV3Addr(..)+  , tor_v3_addr+  , un_tor_v3_addr+  , Hostname(..)+  , hostname+  , un_hostname+  , is_ascii_hostname+  , usable_addresses -  -- * Constants-  , chainHashLen-  , shortChannelIdLen-  , channelIdLen-  , signatureLen-  , pointLen-  , nodeIdLen-  , rgbColorLen-  , aliasLen-  , ipv4AddrLen-  , ipv6AddrLen-  , torV3AddrLen+  -- * Query fields+  , QueryFlags(..)+  , QueryFlag(..)+  , query_flags+  , has_query_flag+  , QueryOption(..)+  , QueryOptionFlag(..)+  , query_option+  , has_query_option+  , ChannelUpdateTimestamps(..)+  , ChannelUpdateChecksums(..)   ) where  import Control.DeepSeq (NFData)-import Data.Bits (shiftL, shiftR, (.&.), (.|.))-import Data.ByteString (ByteString)+import Data.Bits ((.|.), bit, testBit) import qualified Data.ByteString as BS import Data.Word (Word8, Word16, Word32, Word64) import GHC.Generics (Generic)---- Constants ----------------------------------------------------------------------- | Length of a chain hash (32 bytes).-chainHashLen :: Int-chainHashLen = 32-{-# INLINE chainHashLen #-}---- | Length of a short channel ID (8 bytes).-shortChannelIdLen :: Int-shortChannelIdLen = 8-{-# INLINE shortChannelIdLen #-}---- | Length of a channel ID (32 bytes).-channelIdLen :: Int-channelIdLen = 32-{-# INLINE channelIdLen #-}---- | Length of a signature (64 bytes).-signatureLen :: Int-signatureLen = 64-{-# INLINE signatureLen #-}---- | Length of a compressed public key (33 bytes).-pointLen :: Int-pointLen = 33-{-# INLINE pointLen #-}---- | Length of a node ID (33 bytes, same as compressed public key).-nodeIdLen :: Int-nodeIdLen = 33-{-# INLINE nodeIdLen #-}---- | Length of RGB color (3 bytes).-rgbColorLen :: Int-rgbColorLen = 3-{-# INLINE rgbColorLen #-}---- | Length of node alias (32 bytes).-aliasLen :: Int-aliasLen = 32-{-# INLINE aliasLen #-}---- | Length of IPv4 address (4 bytes).-ipv4AddrLen :: Int-ipv4AddrLen = 4-{-# INLINE ipv4AddrLen #-}+import Lightning.Protocol.BOLT1+  (ShortChannelId, scid_block_height, scid_tx_index, scid_output_index) --- | Length of IPv6 address (16 bytes).-ipv6AddrLen :: Int-ipv6AddrLen = 16-{-# INLINE ipv6AddrLen #-}+-- short channel ids ---------------------------------------------------------- --- | Length of Tor v3 address (35 bytes).-torV3AddrLen :: Int-torV3AddrLen = 35-{-# INLINE torV3AddrLen #-}+-- | Render a short channel id in the human-readable format of BOLT #7:+--   block height, transaction index and output index, in decimal,+--   separated by @x@.+--+--   >>> fmap format_short_channel_id (short_channel_id 539268 845 1)+--   Just "539268x845x1"+format_short_channel_id :: ShortChannelId -> String+format_short_channel_id s =+  show (scid_block_height s) ++ "x" ++ show (scid_tx_index s) ++ "x"+    ++ show (scid_output_index s) --- Identifiers -----------------------------------------------------------------+-- channel_update flags ------------------------------------------------------- --- | Chain hash identifying the blockchain (32 bytes).-newtype ChainHash = ChainHash { getChainHash :: ByteString }+-- | The @message_flags@ byte of a @channel_update@: bit 0 is+--   @must_be_one@, bit 1 is @dont_forward@, and the other bits are+--   unassigned. Every byte is a valid value; unassigned bits are kept so+--   that re-encoding reproduces the signed bytes.+newtype MessageFlags = MessageFlags Word8   deriving (Eq, Show, Generic) -instance NFData ChainHash---- | Smart constructor for ChainHash. Returns Nothing if not 32 bytes.-chainHash :: ByteString -> Maybe ChainHash-chainHash !bs-  | BS.length bs == chainHashLen = Just (ChainHash bs)-  | otherwise = Nothing-{-# INLINE chainHash #-}---- | Bitcoin mainnet chain hash (genesis block hash, little-endian).------ This is the double-SHA256 of the mainnet genesis block header, reversed--- to little-endian byte order as used in the protocol.-mainnetChainHash :: ChainHash-mainnetChainHash = ChainHash $ BS.pack-  [ 0x6f, 0xe2, 0x8c, 0x0a, 0xb6, 0xf1, 0xb3, 0x72-  , 0xc1, 0xa6, 0xa2, 0x46, 0xae, 0x63, 0xf7, 0x4f-  , 0x93, 0x1e, 0x83, 0x65, 0xe1, 0x5a, 0x08, 0x9c-  , 0x68, 0xd6, 0x19, 0x00, 0x00, 0x00, 0x00, 0x00-  ]---- | Short channel ID (8 bytes): block height (3) + tx index (3) + output (2).-newtype ShortChannelId = ShortChannelId { getShortChannelId :: ByteString }-  deriving (Eq, Show, Generic)+instance NFData MessageFlags -instance NFData ShortChannelId+-- | Whether a @channel_update@ may be relayed to other peers (the+--   @dont_forward@ bit).+data Forwarding+  = Forward      -- ^ @dont_forward@ is 0+  | DontForward  -- ^ @dont_forward@ is 1, as for unannounced channels+  deriving (Eq, Ord, Show, Generic) --- | Smart constructor for ShortChannelId. Returns Nothing if not 8 bytes.-shortChannelId :: ByteString -> Maybe ShortChannelId-shortChannelId !bs-  | BS.length bs == shortChannelIdLen = Just (ShortChannelId bs)-  | otherwise = Nothing-{-# INLINE shortChannelId #-}+instance NFData Forwarding --- | Construct ShortChannelId from components.------ Block height and tx index are truncated to 24 bits.+-- | The t'MessageFlags' an origin node sets: @must_be_one@ set, the given+--   @dont_forward@ bit, and no unassigned bits. ----- >>> mkShortChannelId 539268 845 1--- ShortChannelId {getShortChannelId = "\NUL\131\132\NUL\ETX-\NUL\SOH"}-mkShortChannelId-  :: Word32  -- ^ Block height (24 bits)-  -> Word32  -- ^ Transaction index (24 bits)-  -> Word16  -- ^ Output index-  -> ShortChannelId-mkShortChannelId !block !txIdx !outIdx = ShortChannelId $ BS.pack-  [ fromIntegral ((block `shiftR` 16) .&. 0xff) :: Word8-  , fromIntegral ((block `shiftR` 8) .&. 0xff)-  , fromIntegral (block .&. 0xff)-  , fromIntegral ((txIdx `shiftR` 16) .&. 0xff)-  , fromIntegral ((txIdx `shiftR` 8) .&. 0xff)-  , fromIntegral (txIdx .&. 0xff)-  , fromIntegral ((outIdx `shiftR` 8) .&. 0xff)-  , fromIntegral (outIdx .&. 0xff)-  ]-{-# INLINE mkShortChannelId #-}---- | Extract block height from short channel ID (first 3 bytes, big-endian).-scidBlockHeight :: ShortChannelId -> Word32-scidBlockHeight (ShortChannelId bs) =-  let b0 = fromIntegral (BS.index bs 0)-      b1 = fromIntegral (BS.index bs 1)-      b2 = fromIntegral (BS.index bs 2)-  in  (b0 `shiftL` 16) .|. (b1 `shiftL` 8) .|. b2-{-# INLINE scidBlockHeight #-}---- | Extract transaction index from short channel ID (bytes 3-5, big-endian).-scidTxIndex :: ShortChannelId -> Word32-scidTxIndex (ShortChannelId bs) =-  let b3 = fromIntegral (BS.index bs 3)-      b4 = fromIntegral (BS.index bs 4)-      b5 = fromIntegral (BS.index bs 5)-  in  (b3 `shiftL` 16) .|. (b4 `shiftL` 8) .|. b5-{-# INLINE scidTxIndex #-}---- | Extract output index from short channel ID (last 2 bytes, big-endian).-scidOutputIndex :: ShortChannelId -> Word16-scidOutputIndex (ShortChannelId bs) =-  let b6 = fromIntegral (BS.index bs 6)-      b7 = fromIntegral (BS.index bs 7)-  in  (b6 `shiftL` 8) .|. b7-{-# INLINE scidOutputIndex #-}+--   >>> message_flags DontForward+--   MessageFlags 3+message_flags :: Forwarding -> MessageFlags+message_flags Forward     = MessageFlags 0x01+message_flags DontForward = MessageFlags 0x03+{-# INLINE message_flags #-} --- | Format short channel ID as human-readable string.------ Uses the standard "block x tx x output" notation.+-- | The @dont_forward@ bit of t'MessageFlags'. ----- >>> formatScid (mkShortChannelId 539268 845 1)--- "539268x845x1"-formatScid :: ShortChannelId -> String-formatScid scid =-  show (scidBlockHeight scid) ++ "x" ++-  show (scidTxIndex scid) ++ "x" ++-  show (scidOutputIndex scid)-{-# INLINE formatScid #-}---- | Channel ID (32 bytes).-newtype ChannelId = ChannelId { getChannelId :: ByteString }-  deriving (Eq, Show, Generic)--instance NFData ChannelId---- | Smart constructor for ChannelId. Returns Nothing if not 32 bytes.-channelId :: ByteString -> Maybe ChannelId-channelId !bs-  | BS.length bs == channelIdLen = Just (ChannelId bs)-  | otherwise = Nothing-{-# INLINE channelId #-}+--   >>> message_flags_forwarding (MessageFlags 0x01)+--   Forward+message_flags_forwarding :: MessageFlags -> Forwarding+message_flags_forwarding (MessageFlags w)+  | testBit w 1 = DontForward+  | otherwise   = Forward+{-# INLINE message_flags_forwarding #-} --- Cryptographic types ---------------------------------------------------------+-- | Whether the @must_be_one@ bit is set. Senders must set it; receivers+--   ignore it.+--+--   >>> has_must_be_one (MessageFlags 0x00)+--   False+has_must_be_one :: MessageFlags -> Bool+has_must_be_one (MessageFlags w) = testBit w 0+{-# INLINE has_must_be_one #-} --- | Signature (64 bytes).-newtype Signature = Signature { getSignature :: ByteString }+-- | The @channel_flags@ byte of a @channel_update@: bit 0 is+--   @direction@, bit 1 is @disable@, and the other bits are unassigned.+--   Every byte is a valid value; unassigned bits are kept so that+--   re-encoding reproduces the signed bytes.+newtype ChannelFlags = ChannelFlags Word8   deriving (Eq, Show, Generic) -instance NFData Signature+instance NFData ChannelFlags --- | Smart constructor for Signature. Returns Nothing if not 64 bytes.-signature :: ByteString -> Maybe Signature-signature !bs-  | BS.length bs == signatureLen = Just (Signature bs)-  | otherwise = Nothing-{-# INLINE signature #-}+-- | The node a @channel_update@ originates from.+data Direction+  = NodeOne  -- ^ @node_id_1@ (@direction@ is 0)+  | NodeTwo  -- ^ @node_id_2@ (@direction@ is 1)+  deriving (Eq, Ord, Show, Generic) --- | Compressed public key (33 bytes).-newtype Point = Point { getPoint :: ByteString }-  deriving (Eq, Show, Generic)+instance NFData Direction -instance NFData Point+-- | Whether a channel direction is usable.+data ChannelStatus+  = Enabled   -- ^ @disable@ is 0+  | Disabled  -- ^ @disable@ is 1+  deriving (Eq, Ord, Show, Generic) --- | Smart constructor for Point. Returns Nothing if not 33 bytes.-point :: ByteString -> Maybe Point-point !bs-  | BS.length bs == pointLen = Just (Point bs)-  | otherwise = Nothing-{-# INLINE point #-}+instance NFData ChannelStatus --- | Node ID (33 bytes, same as compressed public key).+-- | The t'ChannelFlags' for the given direction and status, with no+--   unassigned bits set. ----- Has Ord instance for lexicographic comparison (required by spec for--- channel announcements where node_id_1 < node_id_2).-newtype NodeId = NodeId { getNodeId :: ByteString }-  deriving (Eq, Ord, Show, Generic)+--   >>> channel_flags NodeTwo Disabled+--   ChannelFlags 3+channel_flags :: Direction -> ChannelStatus -> ChannelFlags+channel_flags d s = ChannelFlags (dir .|. sta)+  where+    dir = case d of+      NodeOne -> 0x00+      NodeTwo -> 0x01+    sta = case s of+      Enabled  -> 0x00+      Disabled -> 0x02+{-# INLINE channel_flags #-} -instance NFData NodeId+-- | The @direction@ bit of t'ChannelFlags'.+--+--   >>> channel_flags_direction (ChannelFlags 0x05)+--   NodeTwo+channel_flags_direction :: ChannelFlags -> Direction+channel_flags_direction (ChannelFlags w)+  | testBit w 0 = NodeTwo+  | otherwise   = NodeOne+{-# INLINE channel_flags_direction #-} --- | Smart constructor for NodeId. Returns Nothing if not 33 bytes.-nodeId :: ByteString -> Maybe NodeId-nodeId !bs-  | BS.length bs == nodeIdLen = Just (NodeId bs)-  | otherwise = Nothing-{-# INLINE nodeId #-}+-- | The @disable@ bit of t'ChannelFlags'.+--+--   >>> channel_flags_status (ChannelFlags 0x02)+--   Disabled+channel_flags_status :: ChannelFlags -> ChannelStatus+channel_flags_status (ChannelFlags w)+  | testBit w 1 = Disabled+  | otherwise   = Enabled+{-# INLINE channel_flags_status #-} --- Node metadata ---------------------------------------------------------------+-- node_announcement fields --------------------------------------------------- --- | RGB color (3 bytes).-newtype RgbColor = RgbColor { getRgbColor :: ByteString }+-- | A node's colour: red, green and blue.+data RgbColor = RgbColor+  {-# UNPACK #-} !Word8+  {-# UNPACK #-} !Word8+  {-# UNPACK #-} !Word8   deriving (Eq, Show, Generic)  instance NFData RgbColor --- | Smart constructor for RgbColor. Returns Nothing if not 3 bytes.-rgbColor :: ByteString -> Maybe RgbColor-rgbColor !bs-  | BS.length bs == rgbColorLen = Just (RgbColor bs)-  | otherwise = Nothing-{-# INLINE rgbColor #-}---- | Node alias (32 bytes, UTF-8 padded with zero bytes).-newtype Alias = Alias { getAlias :: ByteString }+-- | A 32-byte node alias. Origin nodes should use UTF-8 padded with zero+--   bytes, but receivers must accept any bytes.+newtype Alias = Alias BS.ByteString   deriving (Eq, Show, Generic)  instance NFData Alias --- | Smart constructor for Alias. Returns Nothing if not 32 bytes.-alias :: ByteString -> Maybe Alias-alias !bs-  | BS.length bs == aliasLen = Just (Alias bs)-  | otherwise = Nothing+-- | Construct an t'Alias' from exactly 32 bytes.+--+--   >>> alias "too short"+--   Nothing+alias :: BS.ByteString -> Maybe Alias+alias bs+  | BS.length bs == 32 = Just (Alias bs)+  | otherwise          = Nothing {-# INLINE alias #-} --- | Timestamp (Unix epoch seconds).-type Timestamp = Word32+-- | The bytes of an t'Alias'.+un_alias :: Alias -> BS.ByteString+un_alias (Alias bs) = bs+{-# INLINE un_alias #-} --- | Feature bits (variable length).-newtype FeatureBits = FeatureBits { getFeatureBits :: ByteString }+-- | A 4-byte IPv4 address.+newtype IPv4Addr = IPv4Addr BS.ByteString   deriving (Eq, Show, Generic) -instance NFData FeatureBits+instance NFData IPv4Addr --- | Smart constructor for FeatureBits (any length).-featureBits :: ByteString -> FeatureBits-featureBits = FeatureBits-{-# INLINE featureBits #-}+-- | Construct an t'IPv4Addr' from exactly 4 bytes.+--+--   >>> ipv4_addr "\127\NUL\NUL\SOH"+--   Just (IPv4Addr "\DEL\NUL\NUL\SOH")+ipv4_addr :: BS.ByteString -> Maybe IPv4Addr+ipv4_addr bs+  | BS.length bs == 4 = Just (IPv4Addr bs)+  | otherwise         = Nothing+{-# INLINE ipv4_addr #-} --- Address types ---------------------------------------------------------------+-- | The bytes of an t'IPv4Addr'.+un_ipv4_addr :: IPv4Addr -> BS.ByteString+un_ipv4_addr (IPv4Addr bs) = bs+{-# INLINE un_ipv4_addr #-} --- | IPv4 address (4 bytes).-newtype IPv4Addr = IPv4Addr { getIPv4Addr :: ByteString }+-- | A 16-byte IPv6 address.+newtype IPv6Addr = IPv6Addr BS.ByteString   deriving (Eq, Show, Generic) -instance NFData IPv4Addr+instance NFData IPv6Addr --- | Smart constructor for IPv4Addr. Returns Nothing if not 4 bytes.-ipv4Addr :: ByteString -> Maybe IPv4Addr-ipv4Addr !bs-  | BS.length bs == ipv4AddrLen = Just (IPv4Addr bs)-  | otherwise = Nothing-{-# INLINE ipv4Addr #-}+-- | Construct an t'IPv6Addr' from exactly 16 bytes.+ipv6_addr :: BS.ByteString -> Maybe IPv6Addr+ipv6_addr bs+  | BS.length bs == 16 = Just (IPv6Addr bs)+  | otherwise          = Nothing+{-# INLINE ipv6_addr #-} --- | IPv6 address (16 bytes).-newtype IPv6Addr = IPv6Addr { getIPv6Addr :: ByteString }+-- | The bytes of an t'IPv6Addr'.+un_ipv6_addr :: IPv6Addr -> BS.ByteString+un_ipv6_addr (IPv6Addr bs) = bs+{-# INLINE un_ipv6_addr #-}++-- | The 12 data bytes of a deprecated Tor v2 address descriptor (type+--   3). They are kept, uninterpreted, so that re-encoding reproduces+--   the signed bytes.+newtype TorV2Addr = TorV2Addr BS.ByteString   deriving (Eq, Show, Generic) -instance NFData IPv6Addr+instance NFData TorV2Addr --- | Smart constructor for IPv6Addr. Returns Nothing if not 16 bytes.-ipv6Addr :: ByteString -> Maybe IPv6Addr-ipv6Addr !bs-  | BS.length bs == ipv6AddrLen = Just (IPv6Addr bs)-  | otherwise = Nothing-{-# INLINE ipv6Addr #-}+-- | Construct a t'TorV2Addr' from exactly 12 bytes.+tor_v2_addr :: BS.ByteString -> Maybe TorV2Addr+tor_v2_addr bs+  | BS.length bs == 12 = Just (TorV2Addr bs)+  | otherwise          = Nothing+{-# INLINE tor_v2_addr #-} --- | Tor v3 onion address (35 bytes: 32 pubkey + 2 checksum + 1 version).-newtype TorV3Addr = TorV3Addr { getTorV3Addr :: ByteString }+-- | The bytes of a t'TorV2Addr'.+un_tor_v2_addr :: TorV2Addr -> BS.ByteString+un_tor_v2_addr (TorV2Addr bs) = bs+{-# INLINE un_tor_v2_addr #-}++-- | A 35-byte Tor v3 onion service address: a 32-byte ed25519 public+--   key, a 2-byte checksum and a 1-byte version.+newtype TorV3Addr = TorV3Addr BS.ByteString   deriving (Eq, Show, Generic)  instance NFData TorV3Addr --- | Smart constructor for TorV3Addr. Returns Nothing if not 35 bytes.-torV3Addr :: ByteString -> Maybe TorV3Addr-torV3Addr !bs-  | BS.length bs == torV3AddrLen = Just (TorV3Addr bs)-  | otherwise = Nothing-{-# INLINE torV3Addr #-}+-- | Construct a t'TorV3Addr' from exactly 35 bytes.+tor_v3_addr :: BS.ByteString -> Maybe TorV3Addr+tor_v3_addr bs+  | BS.length bs == 35 = Just (TorV3Addr bs)+  | otherwise          = Nothing+{-# INLINE tor_v3_addr #-} --- | Network address with port.-data Address-  = AddrIPv4 !IPv4Addr !Word16    -- ^ IPv4 address + port-  | AddrIPv6 !IPv6Addr !Word16    -- ^ IPv6 address + port-  | AddrTorV3 !TorV3Addr !Word16  -- ^ Tor v3 address + port-  | AddrDNS !ByteString !Word16   -- ^ DNS hostname + port+-- | The bytes of a t'TorV3Addr'.+un_tor_v3_addr :: TorV3Addr -> BS.ByteString+un_tor_v3_addr (TorV3Addr bs) = bs+{-# INLINE un_tor_v3_addr #-}++-- | A DNS hostname of at most 255 bytes (the limit of its length byte).+--+--   BOLT #7 requires hostnames to be ASCII, with other characters+--   Punycode-encoded, but receivers keep whatever bytes they are given;+--   see 'is_ascii_hostname'.+newtype Hostname = Hostname BS.ByteString   deriving (Eq, Show, Generic) -instance NFData Address+instance NFData Hostname --- Channel update flags --------------------------------------------------------+-- | Construct a t'Hostname' from at most 255 bytes.+--+--   >>> hostname "ln.example.com"+--   Just (Hostname "ln.example.com")+--   >>> hostname (BS.replicate 256 0x61)+--   Nothing+hostname :: BS.ByteString -> Maybe Hostname+hostname bs+  | BS.length bs <= 255 = Just (Hostname bs)+  | otherwise           = Nothing+{-# INLINE hostname #-} --- | Message flags for channel_update.+-- | The bytes of a t'Hostname'.+un_hostname :: Hostname -> BS.ByteString+un_hostname (Hostname bs) = bs+{-# INLINE un_hostname #-}++-- | Whether a t'Hostname' is non-empty and ASCII, as BOLT #7 requires. ----- Bit 0: htlc_maximum_msat field is present.-data MessageFlags = MessageFlags-  { mfHtlcMaxPresent :: !Bool  -- ^ htlc_maximum_msat is present-  }+--   >>> fmap is_ascii_hostname (hostname "caf\233")+--   Just False+is_ascii_hostname :: Hostname -> Bool+is_ascii_hostname (Hostname bs) = not (BS.null bs) && BS.all (< 0x80) bs+{-# INLINE is_ascii_hostname #-}++-- | An address descriptor of a known type, with its port where it has+--   one.+data Address+  = AddrIPv4  !IPv4Addr  {-# UNPACK #-} !Word16  -- ^ type 1+  | AddrIPv6  !IPv6Addr  {-# UNPACK #-} !Word16  -- ^ type 2+  | AddrTorV2 !TorV2Addr                         -- ^ type 3 (deprecated)+  | AddrTorV3 !TorV3Addr {-# UNPACK #-} !Word16  -- ^ type 4+  | AddrDNS   !Hostname  {-# UNPACK #-} !Word16  -- ^ type 5   deriving (Eq, Show, Generic) -instance NFData MessageFlags+instance NFData Address --- | Encode MessageFlags to Word8.-encodeMessageFlags :: MessageFlags -> Word8-encodeMessageFlags mf = if mfHtlcMaxPresent mf then 0x01 else 0x00-{-# INLINE encodeMessageFlags #-}+-- | The addresses a receiver should connect to, per the BOLT #7 receiver+--   rules: drops Tor v2 descriptors, descriptors with port 0, DNS+--   hostnames that are empty or not ASCII, and every DNS descriptor+--   after the first.+usable_addresses :: [Address] -> [Address]+usable_addresses = go False+  where+    go _ [] = []+    go !dns (a : as) = case a of+      AddrIPv4 _ p  -> port p+      AddrIPv6 _ p  -> port p+      AddrTorV2 _   -> go dns as+      AddrTorV3 _ p -> port p+      AddrDNS h p+        | dns                            -> go dns as+        | p /= 0 && is_ascii_hostname h  -> a : go True as+        | otherwise                      -> go True as+      where+        port p+          | p == 0    = go dns as+          | otherwise = a : go dns as --- | Decode Word8 to MessageFlags.-decodeMessageFlags :: Word8 -> MessageFlags-decodeMessageFlags w = MessageFlags { mfHtlcMaxPresent = w .&. 0x01 /= 0 }-{-# INLINE decodeMessageFlags #-}+-- query fields --------------------------------------------------------------- --- | Channel flags for channel_update.------ Bit 0: direction (0 = node_id_1 is origin, 1 = node_id_2 is origin).--- Bit 1: disabled (1 = channel disabled).-data ChannelFlags = ChannelFlags-  { cfDirection :: !Bool  -- ^ True = node_id_2 is origin-  , cfDisabled  :: !Bool  -- ^ True = channel is disabled-  }+-- | A @query_flags@ bitfield, sent for each short channel id in a+--   @query_short_channel_ids@. Every value is valid; unassigned bits are+--   kept.+newtype QueryFlags = QueryFlags Word64   deriving (Eq, Show, Generic) -instance NFData ChannelFlags+instance NFData QueryFlags --- | Encode ChannelFlags to Word8.-encodeChannelFlags :: ChannelFlags -> Word8-encodeChannelFlags cf =-  (if cfDirection cf then 0x01 else 0x00) .|.-  (if cfDisabled cf then 0x02 else 0x00)-{-# INLINE encodeChannelFlags #-}+-- | The assigned bits of t'QueryFlags'.+data QueryFlag+  = WantChannelAnnouncement  -- ^ bit 0+  | WantChannelUpdate1       -- ^ bit 1: the @channel_update@ of node 1+  | WantChannelUpdate2       -- ^ bit 2: the @channel_update@ of node 2+  | WantNodeAnnouncement1    -- ^ bit 3: the @node_announcement@ of node 1+  | WantNodeAnnouncement2    -- ^ bit 4: the @node_announcement@ of node 2+  deriving (Eq, Ord, Show, Enum, Bounded, Generic) --- | Decode Word8 to ChannelFlags.-decodeChannelFlags :: Word8 -> ChannelFlags-decodeChannelFlags w = ChannelFlags-  { cfDirection = w .&. 0x01 /= 0-  , cfDisabled  = w .&. 0x02 /= 0-  }-{-# INLINE decodeChannelFlags #-}+instance NFData QueryFlag --- Routing parameters ----------------------------------------------------------+-- | The t'QueryFlags' with exactly the given bits set.+--+--   >>> query_flags [WantChannelAnnouncement, WantChannelUpdate2]+--   QueryFlags 5+query_flags :: [QueryFlag] -> QueryFlags+query_flags = QueryFlags . foldr (\f acc -> acc .|. bit (fromEnum f)) 0 --- | CLTV expiry delta.-newtype CltvExpiryDelta = CltvExpiryDelta { getCltvExpiryDelta :: Word16 }-  deriving (Eq, Ord, Show, Generic)+-- | Whether the given bit is set.+--+--   >>> has_query_flag WantChannelUpdate1 (QueryFlags 2)+--   True+has_query_flag :: QueryFlag -> QueryFlags -> Bool+has_query_flag f (QueryFlags w) = testBit w (fromEnum f)+{-# INLINE has_query_flag #-} -instance NFData CltvExpiryDelta+-- | The @query_option_flags@ bitfield of a @query_channel_range@. Every+--   value is valid; unassigned bits are kept.+newtype QueryOption = QueryOption Word64+  deriving (Eq, Show, Generic) --- | Base fee in millisatoshis.-newtype FeeBaseMsat = FeeBaseMsat { getFeeBaseMsat :: Word32 }-  deriving (Eq, Ord, Show, Generic)+instance NFData QueryOption -instance NFData FeeBaseMsat+-- | The assigned bits of t'QueryOption'.+data QueryOptionFlag+  = WantTimestamps  -- ^ bit 0+  | WantChecksums   -- ^ bit 1+  deriving (Eq, Ord, Show, Enum, Bounded, Generic) --- | Proportional fee in millionths.-newtype FeeProportionalMillionths = FeeProportionalMillionths-  { getFeeProportionalMillionths :: Word32 }-  deriving (Eq, Ord, Show, Generic)+instance NFData QueryOptionFlag -instance NFData FeeProportionalMillionths+-- | The t'QueryOption' with exactly the given bits set.+--+--   >>> query_option [WantTimestamps, WantChecksums]+--   QueryOption 3+query_option :: [QueryOptionFlag] -> QueryOption+query_option = QueryOption . foldr (\f acc -> acc .|. bit (fromEnum f)) 0 --- | Minimum HTLC value in millisatoshis.-newtype HtlcMinimumMsat = HtlcMinimumMsat { getHtlcMinimumMsat :: Word64 }-  deriving (Eq, Ord, Show, Generic)+-- | Whether the given bit is set.+--+--   >>> has_query_option WantChecksums (QueryOption 1)+--   False+has_query_option :: QueryOptionFlag -> QueryOption -> Bool+has_query_option f (QueryOption w) = testBit w (fromEnum f)+{-# INLINE has_query_option #-} -instance NFData HtlcMinimumMsat+-- | The timestamps of a channel's latest @channel_update@s, from+--   @node_id_1@ and @node_id_2@ (0 where there is none).+data ChannelUpdateTimestamps = ChannelUpdateTimestamps+  {-# UNPACK #-} !Word32+  {-# UNPACK #-} !Word32+  deriving (Eq, Show, Generic) --- | Maximum HTLC value in millisatoshis.-newtype HtlcMaximumMsat = HtlcMaximumMsat { getHtlcMaximumMsat :: Word64 }-  deriving (Eq, Ord, Show, Generic)+instance NFData ChannelUpdateTimestamps -instance NFData HtlcMaximumMsat+-- | The checksums of a channel's latest @channel_update@s, from+--   @node_id_1@ and @node_id_2@ (0 where there is none).+data ChannelUpdateChecksums = ChannelUpdateChecksums+  {-# UNPACK #-} !Word32+  {-# UNPACK #-} !Word32+  deriving (Eq, Show, Generic)++instance NFData ChannelUpdateChecksums

@@ -1,6 +1,4 @@-{-# OPTIONS_HADDOCK prune #-}--{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveGeneric #-}  -- |@@ -9,133 +7,101 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Validation functions for BOLT #7 gossip messages.------ These functions check message invariants as specified in BOLT #7.--- They do NOT verify cryptographic signatures; that requires the--- actual public keys and is left to the caller.+-- Stateless checks of BOLT #7 messages.  module Lightning.Protocol.BOLT7.Validate (-  -- * Error types     ValidationError(..)--  -- * Validation functions-  , validateChannelAnnouncement-  , validateNodeAnnouncement-  , validateChannelUpdate-  , validateQueryChannelRange-  , validateReplyChannelRange+  , validate_channel_announcement+  , validate_node_announcement+  , validate_channel_update+  , validate_query_short_channel_ids+  , validate_query_channel_range+  , validate_reply_channel_range   ) where  import Control.DeepSeq (NFData)-import Data.Word (Word32, Word64)+import Data.Word (Word64) import GHC.Generics (Generic)-import Lightning.Protocol.BOLT7.Codec (decodeShortChannelIdList)+import Lightning.Protocol.BOLT1 (ShortChannelId) import Lightning.Protocol.BOLT7.Messages import Lightning.Protocol.BOLT7.Types --- | Validation errors.+-- | A rule a message breaks. data ValidationError-  = ValidateNodeIdOrdering        -- ^ node_id_1 must be < node_id_2-  | ValidateUnknownEvenFeature    -- ^ Unknown even feature bit set-  | ValidateHtlcAmounts           -- ^ htlc_minimum_msat > htlc_maximum_msat-  | ValidateBlockOverflow         -- ^ first_blocknum + number_of_blocks overflow-  | ValidateScidNotAscending      -- ^ short_channel_ids not in ascending order+  = ValidateNodeIdOrdering+    -- ^ @node_id_1@ is not lexicographically less than @node_id_2@+  | ValidateMultipleDns+    -- ^ more than one DNS hostname descriptor+  | ValidateHtlcAmounts+    -- ^ @htlc_minimum_msat@ exceeds @htlc_maximum_msat@+  | ValidateZeroBlocks+    -- ^ @number_of_blocks@ is 0+  | ValidateBlockOverflow+    -- ^ the block range extends past block 2^32 - 1+  | ValidateScidNotAscending+    -- ^ short channel ids are not in strictly ascending order   deriving (Eq, Show, Generic)  instance NFData ValidationError --- | Validate channel_announcement message.------ Checks:+-- | Check that @node_id_1@ is lexicographically less than @node_id_2@;+--   a receiver must ignore the message otherwise. ----- * node_id_1 < node_id_2 (lexicographic ordering)--- * Feature bits do not contain unknown even bits-validateChannelAnnouncement :: ChannelAnnouncement-                            -> Either ValidationError ()-validateChannelAnnouncement msg = do-  -- Check node_id ordering-  let nid1 = channelAnnNodeId1 msg-      nid2 = channelAnnNodeId2 msg-  if nid1 >= nid2-    then Left ValidateNodeIdOrdering-    else Right ()-  -- Check feature bits-  validateFeatureBits (channelAnnFeatures msg)+--   Signatures and feature bits are not checked here; see+--   'Lightning.Protocol.BOLT7.verify_channel_announcement' and+--   ppad-bolt9's @validate_remote@.+validate_channel_announcement+  :: ChannelAnnouncement -> Either ValidationError ()+validate_channel_announcement m+  | ca_node_id_1 m < ca_node_id_2 m = Right ()+  | otherwise                       = Left ValidateNodeIdOrdering --- | Validate node_announcement message.------ Checks:------ * Feature bits do not contain unknown even bits+-- | Check that at most one DNS hostname is announced; a receiver must+--   not forward the message otherwise. ----- Note: Address list validation (duplicate DNS entries) and alias--- UTF-8 validation are not enforced; the spec allows non-UTF-8 aliases.-validateNodeAnnouncement :: NodeAnnouncement -> Either ValidationError ()-validateNodeAnnouncement msg = do-  validateFeatureBits (nodeAnnFeatures msg)+--   Descriptors a receiver should merely ignore (Tor v2, port 0, a+--   hostname that isn't ASCII) are left to+--   'Lightning.Protocol.BOLT7.usable_addresses'.+validate_node_announcement :: NodeAnnouncement -> Either ValidationError ()+validate_node_announcement m+  | length [ () | AddrDNS _ _ <- na_addresses m ] > 1 =+      Left ValidateMultipleDns+  | otherwise = Right () --- | Validate channel_update message.------ Checks:------ * htlc_minimum_msat <= htlc_maximum_msat (if htlc_maximum_msat present)------ Note: The spec says message_flags bit 0 MUST be set if htlc_maximum_msat--- is advertised. We don't enforce this at validation time since the codec--- already handles the conditional field based on the flag.-validateChannelUpdate :: ChannelUpdate -> Either ValidationError ()-validateChannelUpdate msg = do-  case chanUpdateHtlcMaxMsat msg of-    Nothing -> Right ()-    Just htlcMax ->-      let htlcMin = chanUpdateHtlcMinMsat msg-      in  if getHtlcMinimumMsat htlcMin > getHtlcMaximumMsat htlcMax-          then Left ValidateHtlcAmounts-          else Right ()+-- | Check that @htlc_minimum_msat@ does not exceed @htlc_maximum_msat@;+--   a receiver should not route through the channel otherwise.+validate_channel_update :: ChannelUpdate -> Either ValidationError ()+validate_channel_update m+  | cu_htlc_minimum_msat m > cu_htlc_maximum_msat m = Left ValidateHtlcAmounts+  | otherwise = Right () --- | Validate query_channel_range message.------ Checks:------ * first_blocknum + number_of_blocks does not overflow-validateQueryChannelRange :: QueryChannelRange -> Either ValidationError ()-validateQueryChannelRange msg = do-  let first = fromIntegral (queryRangeFirstBlock msg) :: Word64-      num   = fromIntegral (queryRangeNumBlocks msg) :: Word64-  if first + num > fromIntegral (maxBound :: Word32)-    then Left ValidateBlockOverflow-    else Right ()+-- | Check that the short channel ids are in strictly ascending order, as+--   their encoding requires.+validate_query_short_channel_ids+  :: QueryShortChannelIds -> Either ValidationError ()+validate_query_short_channel_ids = ascending . qsci_short_channel_ids --- | Validate reply_channel_range message.------ Checks:------ * Encoded short_channel_ids are in ascending order-validateReplyChannelRange :: ReplyChannelRange -> Either ValidationError ()-validateReplyChannelRange msg =-  case decodeShortChannelIdList (replyRangeData msg) of-    Left _ -> Right ()  -- Can't decode, skip validation-    Right scids -> checkAscending scids+-- | Check that @number_of_blocks@ is at least 1, as the sender must+--   ensure, and that the range ends at or before block 2^32 - 1 (a+--   library rule: such a range can't be represented).+validate_query_channel_range+  :: QueryChannelRange -> Either ValidationError ()+validate_query_channel_range m+  | num == 0                  = Left ValidateZeroBlocks+  | first + num > 0x100000000 = Left ValidateBlockOverflow+  | otherwise                 = Right ()   where-    checkAscending [] = Right ()-    checkAscending [_] = Right ()-    checkAscending (a:b:rest)-      | getShortChannelId a < getShortChannelId b = checkAscending (b:rest)-      | otherwise = Left ValidateScidNotAscending+    first = fromIntegral (qcr_first_blocknum m) :: Word64+    num   = fromIntegral (qcr_number_of_blocks m) :: Word64 --- Internal helpers -----------------------------------------------------------+-- | Check that the short channel ids are in strictly ascending order, as+--   their encoding requires.+validate_reply_channel_range+  :: ReplyChannelRange -> Either ValidationError ()+validate_reply_channel_range = ascending . rcr_short_channel_ids --- | Validate feature bits - reject unknown even bits.------ Per BOLT #9, even feature bits are "required" and odd bits are--- "optional". A node MUST fail if an unknown even bit is set.------ For this library, we consider all feature bits as "known" (since we--- don't implement feature negotiation). The caller should validate--- against their own set of supported features.-validateFeatureBits :: FeatureBits -> Either ValidationError ()-validateFeatureBits _features = Right ()--- Note: Full feature validation requires knowing which features are--- supported by the implementation. For now we accept all features.--- The caller should implement their own feature bit validation.+ascending :: [ShortChannelId] -> Either ValidationError ()+ascending (a : rest@(b : _))+  | a < b     = ascending rest+  | otherwise = Left ValidateScidNotAscending+ascending _ = Right ()

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-bolt7-version:            0.0.1+version:            0.1.0 synopsis:           Routing gossip per BOLT #7 license:            MIT license-file:       LICENSE@@ -8,10 +8,10 @@ maintainer:         jared@ppad.tech category:           Cryptography build-type:         Simple-tested-with:        GHC == 9.10.3+tested-with:        GHC == { 9.10.3 } extra-doc-files:    CHANGELOG description:-  Routing gossip protocol, per+  Routing gossip, per   [BOLT #7](https://github.com/lightning/bolts/blob/master/07-routing-gossip.md).  source-repository head@@ -25,6 +25,7 @@       -Wall   exposed-modules:       Lightning.Protocol.BOLT7+  other-modules:       Lightning.Protocol.BOLT7.Codec       Lightning.Protocol.BOLT7.CRC32C       Lightning.Protocol.BOLT7.Hash@@ -35,24 +36,31 @@       base >= 4.9 && < 5     , bytestring >= 0.9 && < 0.13     , deepseq >= 1.4 && < 1.6-    , ppad-bolt1 >= 0.0.1 && < 0.1-    , ppad-sha256 >= 0.3 && < 0.4+    , ppad-bolt1 >= 0.1 && < 0.2+    , ppad-bolt9 >= 0.1 && < 0.2+    , ppad-secp256k1 >= 0.5.8 && < 0.6+    , ppad-sha256 >= 0.3.2 && < 0.4  test-suite bolt7-tests   type:                exitcode-stdio-1.0   default-language:    Haskell2010   hs-source-dirs:      test   main-is:             Main.hs+  other-modules:+      Vectors    ghc-options:-    -rtsopts -Wall -O2+    -rtsopts -Wall    build-depends:       base     , bytestring     , ppad-base16-    , ppad-bolt1 >= 0.0.1 && < 0.1+    , ppad-bolt1     , ppad-bolt7+    , ppad-bolt9+    , ppad-secp256k1+    , ppad-sha256     , tasty     , tasty-hunit     , tasty-quickcheck@@ -62,16 +70,18 @@   default-language:    Haskell2010   hs-source-dirs:      bench   main-is:             Main.hs+  other-modules:+      Fixtures    ghc-options:-    -rtsopts -O2 -Wall -fno-warn-orphans+    -rtsopts -O2 -Wall    build-depends:       base     , bytestring     , criterion-    , deepseq-    , ppad-bolt1 >= 0.0.1 && < 0.1+    , ppad-base16+    , ppad-bolt1     , ppad-bolt7  benchmark bolt7-weigh@@ -79,14 +89,16 @@   default-language:    Haskell2010   hs-source-dirs:      bench   main-is:             Weight.hs+  other-modules:+      Fixtures    ghc-options:-    -rtsopts -O2 -Wall -fno-warn-orphans+    -rtsopts -O2 -Wall    build-depends:       base     , bytestring-    , deepseq-    , ppad-bolt1 >= 0.0.1 && < 0.1+    , ppad-base16+    , ppad-bolt1     , ppad-bolt7     , weigh

@@ -2,683 +2,1226 @@  module Main where -import qualified Data.ByteString as BS-import Data.Maybe (fromJust)-import Data.Word (Word16, Word32)-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)-import Lightning.Protocol.BOLT7-import Lightning.Protocol.BOLT7.CRC32C (crc32c)-import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck--main :: IO ()-main = defaultMain $ testGroup "ppad-bolt7" [-    type_tests-  , channel_announcement_tests-  , node_announcement_tests-  , channel_update_tests-  , announcement_signatures_tests-  , query_tests-  , scid_list_tests-  , hash_tests-  , validation_tests-  , error_tests-  , property_tests-  ]---- Test data helpers --------------------------------------------------------------- | Create a valid ChainHash (32 bytes).-testChainHash :: ChainHash-testChainHash = fromJust $ chainHash (BS.replicate 32 0x01)---- | Create a valid ShortChannelId (8 bytes).-testShortChannelId :: ShortChannelId-testShortChannelId = fromJust $ shortChannelId (BS.replicate 8 0xab)---- | Create a valid ChannelId (32 bytes).-testChannelId :: ChannelId-testChannelId = fromJust $ channelId (BS.replicate 32 0xcd)---- | Create a valid Signature (64 bytes).-testSignature :: Signature-testSignature = fromJust $ signature (BS.replicate 64 0xee)---- | Create a valid Point (33 bytes).-testPoint :: Point-testPoint = fromJust $ point (BS.pack $ 0x02 : replicate 32 0xff)---- | Create a valid NodeId (33 bytes).-testNodeId :: NodeId-testNodeId = fromJust $ nodeId (BS.pack $ 0x03 : replicate 32 0xaa)---- | Create a second valid NodeId (33 bytes).-testNodeId2 :: NodeId-testNodeId2 = fromJust $ nodeId (BS.pack $ 0x02 : replicate 32 0xbb)---- | Create a valid RgbColor (3 bytes).-testRgbColor :: RgbColor-testRgbColor = fromJust $ rgbColor (BS.pack [0xff, 0x00, 0x00])---- | Create a valid Alias (32 bytes).-testAlias :: Alias-testAlias = fromJust $ alias (BS.pack $ replicate 32 0x00)---- | Empty TLV stream for messages.-emptyTlvs :: TlvStream-emptyTlvs = unsafeTlvStream []---- | Empty feature bits.-emptyFeatures :: FeatureBits-emptyFeatures = featureBits BS.empty---- Type Tests --------------------------------------------------------------------type_tests :: TestTree-type_tests = testGroup "Types" [-    testGroup "ShortChannelId" [-      testCase "scidBlockHeight" $ do-        -- 8 bytes: block=0x123456, tx=0x789abc, output=0xdef0-        let scid = fromJust $ shortChannelId (BS.pack-              [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0])-        scidBlockHeight scid @?= 0x123456-    , testCase "scidTxIndex" $ do-        let scid = fromJust $ shortChannelId (BS.pack-              [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0])-        scidTxIndex scid @?= 0x789abc-    , testCase "scidOutputIndex" $ do-        let scid = fromJust $ shortChannelId (BS.pack-              [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0])-        scidOutputIndex scid @?= 0xdef0-    , testCase "mkShortChannelId roundtrip" $ do-        let scid = mkShortChannelId 539268 845 1-        scidBlockHeight scid @?= 539268-        scidTxIndex scid @?= 845-        scidOutputIndex scid @?= 1-    , testCase "formatScid" $ do-        let scid = mkShortChannelId 539268 845 1-        formatScid scid @?= "539268x845x1"-    , testCase "formatScid zero values" $ do-        let scid = mkShortChannelId 0 0 0-        formatScid scid @?= "0x0x0"-    ]-  , testGroup "Smart constructors" [-      testCase "chainHash rejects wrong length" $ do-        chainHash (BS.replicate 31 0x00) @?= Nothing-        chainHash (BS.replicate 33 0x00) @?= Nothing-    , testCase "shortChannelId rejects wrong length" $ do-        shortChannelId (BS.replicate 7 0x00) @?= Nothing-        shortChannelId (BS.replicate 9 0x00) @?= Nothing-    , testCase "signature rejects wrong length" $ do-        signature (BS.replicate 63 0x00) @?= Nothing-        signature (BS.replicate 65 0x00) @?= Nothing-    , testCase "point rejects wrong length" $ do-        point (BS.replicate 32 0x00) @?= Nothing-        point (BS.replicate 34 0x00) @?= Nothing-    ]-  , testGroup "Constants" [-      testCase "mainnetChainHash has correct length" $ do-        BS.length (getChainHash mainnetChainHash) @?= 32-    ]-  , testGroup "NodeId ordering" [-      testCase "NodeId Ord is lexicographic" $ do-        let n1 = fromJust $ nodeId (BS.pack $ 0x02 : replicate 32 0x00)-            n2 = fromJust $ nodeId (BS.pack $ 0x03 : replicate 32 0x00)-        n1 < n2 @?= True-        n2 < n1 @?= False-    ]-  ]---- Channel Announcement Tests ----------------------------------------------------channel_announcement_tests :: TestTree-channel_announcement_tests = testGroup "ChannelAnnouncement" [-    testCase "encode/decode roundtrip" $ do-      let msg = ChannelAnnouncement-            { channelAnnNodeSig1     = testSignature-            , channelAnnNodeSig2     = testSignature-            , channelAnnBitcoinSig1  = testSignature-            , channelAnnBitcoinSig2  = testSignature-            , channelAnnFeatures     = emptyFeatures-            , channelAnnChainHash    = testChainHash-            , channelAnnShortChanId  = testShortChannelId-            , channelAnnNodeId1      = testNodeId-            , channelAnnNodeId2      = testNodeId2-            , channelAnnBitcoinKey1  = testPoint-            , channelAnnBitcoinKey2  = testPoint-            }-          encoded = encodeChannelAnnouncement msg-      case decodeChannelAnnouncement encoded of-        Right (decoded, _) -> decoded @?= msg-        Left e -> assertFailure $ "decode failed: " ++ show e-  ]---- Node Announcement Tests -------------------------------------------------------node_announcement_tests :: TestTree-node_announcement_tests = testGroup "NodeAnnouncement" [-    testCase "encode/decode roundtrip with no addresses" $ do-      let msg = NodeAnnouncement-            { nodeAnnSignature = testSignature-            , nodeAnnFeatures  = emptyFeatures-            , nodeAnnTimestamp = 1234567890-            , nodeAnnNodeId    = testNodeId-            , nodeAnnRgbColor  = testRgbColor-            , nodeAnnAlias     = testAlias-            , nodeAnnAddresses = []-            }-      case encodeNodeAnnouncement msg of-        Left e -> assertFailure $ "encode failed: " ++ show e-        Right encoded -> case decodeNodeAnnouncement encoded of-          Right (decoded, _) -> decoded @?= msg-          Left e -> assertFailure $ "decode failed: " ++ show e-  , testCase "encode/decode roundtrip with IPv4 address" $ do-      let ipv4 = fromJust $ ipv4Addr (BS.pack [127, 0, 0, 1])-          msg = NodeAnnouncement-            { nodeAnnSignature = testSignature-            , nodeAnnFeatures  = emptyFeatures-            , nodeAnnTimestamp = 1234567890-            , nodeAnnNodeId    = testNodeId-            , nodeAnnRgbColor  = testRgbColor-            , nodeAnnAlias     = testAlias-            , nodeAnnAddresses = [AddrIPv4 ipv4 9735]-            }-      case encodeNodeAnnouncement msg of-        Left e -> assertFailure $ "encode failed: " ++ show e-        Right encoded -> case decodeNodeAnnouncement encoded of-          Right (decoded, _) -> decoded @?= msg-          Left e -> assertFailure $ "decode failed: " ++ show e-  ]---- Channel Update Tests ----------------------------------------------------------channel_update_tests :: TestTree-channel_update_tests = testGroup "ChannelUpdate" [-    testCase "encode/decode roundtrip without htlc_maximum_msat" $ do-      let msg = ChannelUpdate-            { chanUpdateSignature      = testSignature-            , chanUpdateChainHash      = testChainHash-            , chanUpdateShortChanId    = testShortChannelId-            , chanUpdateTimestamp      = 1234567890-            , chanUpdateMsgFlags       = MessageFlags { mfHtlcMaxPresent = False }-            , chanUpdateChanFlags      = ChannelFlags-                { cfDirection = True, cfDisabled = False }-            , chanUpdateCltvExpDelta   = CltvExpiryDelta 144-            , chanUpdateHtlcMinMsat    = HtlcMinimumMsat 1000-            , chanUpdateFeeBaseMsat    = FeeBaseMsat 1000-            , chanUpdateFeeProportional = FeeProportionalMillionths 100-            , chanUpdateHtlcMaxMsat    = Nothing-            }-          encoded = encodeChannelUpdate msg-      case decodeChannelUpdate encoded of-        Right (decoded, _) -> decoded @?= msg-        Left e -> assertFailure $ "decode failed: " ++ show e-  , testCase "encode/decode roundtrip with htlc_maximum_msat" $ do-      let msg = ChannelUpdate-            { chanUpdateSignature      = testSignature-            , chanUpdateChainHash      = testChainHash-            , chanUpdateShortChanId    = testShortChannelId-            , chanUpdateTimestamp      = 1234567890-            , chanUpdateMsgFlags       = MessageFlags { mfHtlcMaxPresent = True }-            , chanUpdateChanFlags      = ChannelFlags-                { cfDirection = False, cfDisabled = False }-            , chanUpdateCltvExpDelta   = CltvExpiryDelta 40-            , chanUpdateHtlcMinMsat    = HtlcMinimumMsat 1000-            , chanUpdateFeeBaseMsat    = FeeBaseMsat 500-            , chanUpdateFeeProportional = FeeProportionalMillionths 50-            , chanUpdateHtlcMaxMsat    = Just (HtlcMaximumMsat 1000000000)-            }-          encoded = encodeChannelUpdate msg-      case decodeChannelUpdate encoded of-        Right (decoded, _) -> decoded @?= msg-        Left e -> assertFailure $ "decode failed: " ++ show e-  ]---- Announcement Signatures Tests -------------------------------------------------announcement_signatures_tests :: TestTree-announcement_signatures_tests = testGroup "AnnouncementSignatures" [-    testCase "encode/decode roundtrip" $ do-      let msg = AnnouncementSignatures-            { annSigChannelId   = testChannelId-            , annSigShortChanId = testShortChannelId-            , annSigNodeSig     = testSignature-            , annSigBitcoinSig  = testSignature-            }-          encoded = encodeAnnouncementSignatures msg-      case decodeAnnouncementSignatures encoded of-        Right (decoded, _) -> decoded @?= msg-        Left e -> assertFailure $ "decode failed: " ++ show e-  ]---- Query Tests -------------------------------------------------------------------query_tests :: TestTree-query_tests = testGroup "Query Messages" [-    testGroup "QueryShortChannelIds" [-      testCase "encode/decode roundtrip" $ do-        let msg = QueryShortChannelIds-              { queryScidsChainHash = testChainHash-              , queryScidsData      = BS.replicate 24 0xab  -- 3 SCIDs-              , queryScidsTlvs      = emptyTlvs-              }-        case encodeQueryShortChannelIds msg of-          Left e -> assertFailure $ "encode failed: " ++ show e-          Right encoded -> case decodeQueryShortChannelIds encoded of-            Right (decoded, _) -> do-              queryScidsChainHash decoded @?= queryScidsChainHash msg-              queryScidsData decoded @?= queryScidsData msg-            Left e -> assertFailure $ "decode failed: " ++ show e-    ]-  , testGroup "ReplyShortChannelIdsEnd" [-      testCase "encode/decode roundtrip" $ do-        let msg = ReplyShortChannelIdsEnd-              { replyScidsChainHash = testChainHash-              , replyScidsFullInfo  = 1-              }-            encoded = encodeReplyShortChannelIdsEnd msg-        case decodeReplyShortChannelIdsEnd encoded of-          Right (decoded, _) -> decoded @?= msg-          Left e -> assertFailure $ "decode failed: " ++ show e-    ]-  , testGroup "QueryChannelRange" [-      testCase "encode/decode roundtrip" $ do-        let msg = QueryChannelRange-              { queryRangeChainHash  = testChainHash-              , queryRangeFirstBlock = 600000-              , queryRangeNumBlocks  = 10000-              , queryRangeTlvs       = emptyTlvs-              }-            encoded = encodeQueryChannelRange msg-        case decodeQueryChannelRange encoded of-          Right (decoded, _) -> do-            queryRangeChainHash decoded @?= queryRangeChainHash msg-            queryRangeFirstBlock decoded @?= queryRangeFirstBlock msg-            queryRangeNumBlocks decoded @?= queryRangeNumBlocks msg-          Left e -> assertFailure $ "decode failed: " ++ show e-    ]-  , testGroup "ReplyChannelRange" [-      testCase "encode/decode roundtrip" $ do-        let msg = ReplyChannelRange-              { replyRangeChainHash    = testChainHash-              , replyRangeFirstBlock   = 600000-              , replyRangeNumBlocks    = 10000-              , replyRangeSyncComplete = 1-              , replyRangeData         = BS.replicate 16 0xcd-              , replyRangeTlvs         = emptyTlvs-              }-        case encodeReplyChannelRange msg of-          Left e -> assertFailure $ "encode failed: " ++ show e-          Right encoded -> case decodeReplyChannelRange encoded of-            Right (decoded, _) -> do-              replyRangeChainHash decoded @?= replyRangeChainHash msg-              replyRangeFirstBlock decoded @?= replyRangeFirstBlock msg-              replyRangeNumBlocks decoded @?= replyRangeNumBlocks msg-              replyRangeSyncComplete decoded @?= replyRangeSyncComplete msg-              replyRangeData decoded @?= replyRangeData msg-            Left e -> assertFailure $ "decode failed: " ++ show e-    ]-  , testGroup "GossipTimestampFilter" [-      testCase "encode/decode roundtrip" $ do-        let msg = GossipTimestampFilter-              { gossipFilterChainHash      = testChainHash-              , gossipFilterFirstTimestamp = 1609459200-              , gossipFilterTimestampRange = 86400-              }-            encoded = encodeGossipTimestampFilter msg-        case decodeGossipTimestampFilter encoded of-          Right (decoded, _) -> decoded @?= msg-          Left e -> assertFailure $ "decode failed: " ++ show e-    ]-  ]---- SCID List Tests --------------------------------------------------------------scid_list_tests :: TestTree-scid_list_tests = testGroup "SCID List Encoding" [-    testCase "encode/decode roundtrip empty list" $ do-      let encoded = encodeShortChannelIdList []-      case decodeShortChannelIdList encoded of-        Right decoded -> decoded @?= []-        Left e -> assertFailure $ "decode failed: " ++ show e-  , testCase "encode/decode roundtrip single SCID" $ do-      let scids = [mkShortChannelId 539268 845 1]-          encoded = encodeShortChannelIdList scids-      case decodeShortChannelIdList encoded of-        Right decoded -> decoded @?= scids-        Left e -> assertFailure $ "decode failed: " ++ show e-  , testCase "encode/decode roundtrip multiple SCIDs" $ do-      let scids = [ mkShortChannelId 100000 1 0-                  , mkShortChannelId 200000 2 1-                  , mkShortChannelId 300000 3 2-                  ]-          encoded = encodeShortChannelIdList scids-      case decodeShortChannelIdList encoded of-        Right decoded -> decoded @?= scids-        Left e -> assertFailure $ "decode failed: " ++ show e-  , testCase "encoding has correct format" $ do-      let scids = [mkShortChannelId 1 2 3]-          encoded = encodeShortChannelIdList scids-      -- First byte should be 0 (encoding type)-      BS.index encoded 0 @?= 0-      -- Total length: 1 (type) + 8 (SCID) = 9-      BS.length encoded @?= 9-  , testCase "decode rejects unknown encoding type" $ do-      -- Encoding type 1 (zlib compressed) is not supported-      let badEncoded = BS.cons 1 (getShortChannelId testShortChannelId)-      case decodeShortChannelIdList badEncoded of-        Left _ -> pure ()-        Right _ -> assertFailure "should reject encoding type 1"-  ]---- Hash Tests -------------------------------------------------------------------hash_tests :: TestTree-hash_tests = testGroup "Hash Functions" [-    testGroup "CRC32C" [-      testCase "known test vector '123456789'" $ do-        -- Standard CRC-32C test vector-        crc32c "123456789" @?= 0xe3069283-    , testCase "empty string" $ do-        crc32c "" @?= 0x00000000-    ]-  , testGroup "Signature Hashes" [-      testCase "channelAnnouncementHash produces 32 bytes" $ do-        -- Create a minimal valid encoded message-        let msg = encodeChannelAnnouncement ChannelAnnouncement-              { channelAnnNodeSig1    = testSignature-              , channelAnnNodeSig2    = testSignature-              , channelAnnBitcoinSig1 = testSignature-              , channelAnnBitcoinSig2 = testSignature-              , channelAnnFeatures    = emptyFeatures-              , channelAnnChainHash   = testChainHash-              , channelAnnShortChanId = testShortChannelId-              , channelAnnNodeId1     = testNodeId-              , channelAnnNodeId2     = testNodeId2-              , channelAnnBitcoinKey1 = testPoint-              , channelAnnBitcoinKey2 = testPoint-              }-            hashVal = channelAnnouncementHash msg-        BS.length hashVal @?= 32-    , testCase "nodeAnnouncementHash produces 32 bytes" $ do-        case encodeNodeAnnouncement NodeAnnouncement-              { nodeAnnSignature = testSignature-              , nodeAnnFeatures  = emptyFeatures-              , nodeAnnTimestamp = 1234567890-              , nodeAnnNodeId    = testNodeId-              , nodeAnnRgbColor  = testRgbColor-              , nodeAnnAlias     = testAlias-              , nodeAnnAddresses = []-              } of-          Left e -> assertFailure $ "encode failed: " ++ show e-          Right msg -> do-            let hashVal = nodeAnnouncementHash msg-            BS.length hashVal @?= 32-    , testCase "channelUpdateHash produces 32 bytes" $ do-        let msg = encodeChannelUpdate ChannelUpdate-              { chanUpdateSignature       = testSignature-              , chanUpdateChainHash       = testChainHash-              , chanUpdateShortChanId     = testShortChannelId-              , chanUpdateTimestamp       = 1234567890-              , chanUpdateMsgFlags        = MessageFlags { mfHtlcMaxPresent = False }-              , chanUpdateChanFlags       = ChannelFlags-                  { cfDirection = False, cfDisabled = False }-              , chanUpdateCltvExpDelta    = CltvExpiryDelta 144-              , chanUpdateHtlcMinMsat     = HtlcMinimumMsat 1000-              , chanUpdateFeeBaseMsat     = FeeBaseMsat 1000-              , chanUpdateFeeProportional = FeeProportionalMillionths 100-              , chanUpdateHtlcMaxMsat     = Nothing-              }-            hashVal = channelUpdateHash msg-        BS.length hashVal @?= 32-    ]-  , testGroup "Checksum" [-      testCase "channelUpdateChecksum produces consistent result" $ do-        -- The checksum should be deterministic-        let msg = encodeChannelUpdate ChannelUpdate-              { chanUpdateSignature       = testSignature-              , chanUpdateChainHash       = testChainHash-              , chanUpdateShortChanId     = testShortChannelId-              , chanUpdateTimestamp       = 1234567890-              , chanUpdateMsgFlags        = MessageFlags { mfHtlcMaxPresent = False }-              , chanUpdateChanFlags       = ChannelFlags-                  { cfDirection = False, cfDisabled = False }-              , chanUpdateCltvExpDelta    = CltvExpiryDelta 144-              , chanUpdateHtlcMinMsat     = HtlcMinimumMsat 1000-              , chanUpdateFeeBaseMsat     = FeeBaseMsat 1000-              , chanUpdateFeeProportional = FeeProportionalMillionths 100-              , chanUpdateHtlcMaxMsat     = Nothing-              }-            cs1 = channelUpdateChecksum msg-            cs2 = channelUpdateChecksum msg-        cs1 @?= cs2-    , testCase "different timestamps produce same checksum" $ do-        -- Checksum excludes timestamp field-        let msg1 = encodeChannelUpdate ChannelUpdate-              { chanUpdateSignature       = testSignature-              , chanUpdateChainHash       = testChainHash-              , chanUpdateShortChanId     = testShortChannelId-              , chanUpdateTimestamp       = 1000000000-              , chanUpdateMsgFlags        = MessageFlags { mfHtlcMaxPresent = False }-              , chanUpdateChanFlags       = ChannelFlags-                  { cfDirection = False, cfDisabled = False }-              , chanUpdateCltvExpDelta    = CltvExpiryDelta 144-              , chanUpdateHtlcMinMsat     = HtlcMinimumMsat 1000-              , chanUpdateFeeBaseMsat     = FeeBaseMsat 1000-              , chanUpdateFeeProportional = FeeProportionalMillionths 100-              , chanUpdateHtlcMaxMsat     = Nothing-              }-            msg2 = encodeChannelUpdate ChannelUpdate-              { chanUpdateSignature       = testSignature-              , chanUpdateChainHash       = testChainHash-              , chanUpdateShortChanId     = testShortChannelId-              , chanUpdateTimestamp       = 2000000000-              , chanUpdateMsgFlags        = MessageFlags { mfHtlcMaxPresent = False }-              , chanUpdateChanFlags       = ChannelFlags-                  { cfDirection = False, cfDisabled = False }-              , chanUpdateCltvExpDelta    = CltvExpiryDelta 144-              , chanUpdateHtlcMinMsat     = HtlcMinimumMsat 1000-              , chanUpdateFeeBaseMsat     = FeeBaseMsat 1000-              , chanUpdateFeeProportional = FeeProportionalMillionths 100-              , chanUpdateHtlcMaxMsat     = Nothing-              }-        channelUpdateChecksum msg1 @?= channelUpdateChecksum msg2-    ]-  ]---- Validation Tests -------------------------------------------------------------validation_tests :: TestTree-validation_tests = testGroup "Validation" [-    testGroup "ChannelAnnouncement" [-      testCase "valid announcement passes" $ do-        let msg = ChannelAnnouncement-              { channelAnnNodeSig1    = testSignature-              , channelAnnNodeSig2    = testSignature-              , channelAnnBitcoinSig1 = testSignature-              , channelAnnBitcoinSig2 = testSignature-              , channelAnnFeatures    = emptyFeatures-              , channelAnnChainHash   = testChainHash-              , channelAnnShortChanId = testShortChannelId-              , channelAnnNodeId1     = testNodeId2  -- 0x02... < 0x03...-              , channelAnnNodeId2     = testNodeId   -- 0x03...-              , channelAnnBitcoinKey1 = testPoint-              , channelAnnBitcoinKey2 = testPoint-              }-        validateChannelAnnouncement msg @?= Right ()-    , testCase "rejects wrong node_id order" $ do-        let msg = ChannelAnnouncement-              { channelAnnNodeSig1    = testSignature-              , channelAnnNodeSig2    = testSignature-              , channelAnnBitcoinSig1 = testSignature-              , channelAnnBitcoinSig2 = testSignature-              , channelAnnFeatures    = emptyFeatures-              , channelAnnChainHash   = testChainHash-              , channelAnnShortChanId = testShortChannelId-              , channelAnnNodeId1     = testNodeId   -- 0x03... > 0x02...-              , channelAnnNodeId2     = testNodeId2  -- 0x02...-              , channelAnnBitcoinKey1 = testPoint-              , channelAnnBitcoinKey2 = testPoint-              }-        validateChannelAnnouncement msg @?= Left ValidateNodeIdOrdering-    ]-  , testGroup "ChannelUpdate" [-      testCase "valid update passes" $ do-        let msg = ChannelUpdate-              { chanUpdateSignature       = testSignature-              , chanUpdateChainHash       = testChainHash-              , chanUpdateShortChanId     = testShortChannelId-              , chanUpdateTimestamp       = 1234567890-              , chanUpdateMsgFlags        = MessageFlags { mfHtlcMaxPresent = True }-              , chanUpdateChanFlags       = ChannelFlags-                  { cfDirection = False, cfDisabled = False }-              , chanUpdateCltvExpDelta    = CltvExpiryDelta 144-              , chanUpdateHtlcMinMsat     = HtlcMinimumMsat 1000-              , chanUpdateFeeBaseMsat     = FeeBaseMsat 1000-              , chanUpdateFeeProportional = FeeProportionalMillionths 100-              , chanUpdateHtlcMaxMsat     = Just (HtlcMaximumMsat 1000000000)-              }-        validateChannelUpdate msg @?= Right ()-    , testCase "rejects htlc_min > htlc_max" $ do-        let msg = ChannelUpdate-              { chanUpdateSignature       = testSignature-              , chanUpdateChainHash       = testChainHash-              , chanUpdateShortChanId     = testShortChannelId-              , chanUpdateTimestamp       = 1234567890-              , chanUpdateMsgFlags        = MessageFlags { mfHtlcMaxPresent = True }-              , chanUpdateChanFlags       = ChannelFlags-                  { cfDirection = False, cfDisabled = False }-              , chanUpdateCltvExpDelta    = CltvExpiryDelta 144-              , chanUpdateHtlcMinMsat     = HtlcMinimumMsat 2000000000  -- > htlcMax-              , chanUpdateFeeBaseMsat     = FeeBaseMsat 1000-              , chanUpdateFeeProportional = FeeProportionalMillionths 100-              , chanUpdateHtlcMaxMsat     = Just (HtlcMaximumMsat 1000000000)-              }-        validateChannelUpdate msg @?= Left ValidateHtlcAmounts-    ]-  , testGroup "QueryChannelRange" [-      testCase "valid range passes" $ do-        let msg = QueryChannelRange-              { queryRangeChainHash  = testChainHash-              , queryRangeFirstBlock = 600000-              , queryRangeNumBlocks  = 10000-              , queryRangeTlvs       = emptyTlvs-              }-        validateQueryChannelRange msg @?= Right ()-    , testCase "rejects overflow" $ do-        let msg = QueryChannelRange-              { queryRangeChainHash  = testChainHash-              , queryRangeFirstBlock = maxBound  -- 0xFFFFFFFF-              , queryRangeNumBlocks  = 10-              , queryRangeTlvs       = emptyTlvs-              }-        validateQueryChannelRange msg @?= Left ValidateBlockOverflow-    ]-  ]---- Error Tests -------------------------------------------------------------------error_tests :: TestTree-error_tests = testGroup "Error Conditions" [-    testGroup "Insufficient Bytes" [-      testCase "decodeChannelAnnouncement empty" $ do-        case decodeChannelAnnouncement BS.empty of-          Left DecodeInsufficientBytes -> pure ()-          other -> assertFailure $ "expected insufficient: " ++ show other-    , testCase "decodeChannelUpdate too short" $ do-        case decodeChannelUpdate (BS.replicate 50 0x00) of-          Left DecodeInsufficientBytes -> pure ()-          other -> assertFailure $ "expected insufficient: " ++ show other-    , testCase "decodeAnnouncementSignatures too short" $ do-        case decodeAnnouncementSignatures (BS.replicate 50 0x00) of-          Left DecodeInsufficientBytes -> pure ()-          other -> assertFailure $ "expected insufficient: " ++ show other-    , testCase "decodeGossipTimestampFilter too short" $ do-        case decodeGossipTimestampFilter (BS.replicate 30 0x00) of-          Left DecodeInsufficientBytes -> pure ()-          other -> assertFailure $ "expected insufficient: " ++ show other-    ]-  ]---- Property Tests ----------------------------------------------------------------property_tests :: TestTree-property_tests = testGroup "Properties" [-    testProperty "ChannelAnnouncement roundtrip" propChannelAnnouncementRoundtrip-  , testProperty "ChannelUpdate roundtrip" propChannelUpdateRoundtrip-  , testProperty "AnnouncementSignatures roundtrip"-      propAnnouncementSignaturesRoundtrip-  , testProperty "GossipTimestampFilter roundtrip"-      propGossipTimestampFilterRoundtrip-  ]---- Property: ChannelAnnouncement roundtrip-propChannelAnnouncementRoundtrip :: Property-propChannelAnnouncementRoundtrip = property $ do-  let msg = ChannelAnnouncement-        { channelAnnNodeSig1     = testSignature-        , channelAnnNodeSig2     = testSignature-        , channelAnnBitcoinSig1  = testSignature-        , channelAnnBitcoinSig2  = testSignature-        , channelAnnFeatures     = emptyFeatures-        , channelAnnChainHash    = testChainHash-        , channelAnnShortChanId  = testShortChannelId-        , channelAnnNodeId1      = testNodeId-        , channelAnnNodeId2      = testNodeId2-        , channelAnnBitcoinKey1  = testPoint-        , channelAnnBitcoinKey2  = testPoint-        }-      encoded = encodeChannelAnnouncement msg-  case decodeChannelAnnouncement encoded of-    Right (decoded, _) -> decoded == msg-    Left _ -> False---- Property: ChannelUpdate roundtrip-propChannelUpdateRoundtrip :: Word32 -> Word16 -> Property-propChannelUpdateRoundtrip timestamp cltvDelta = property $ do-  let msg = ChannelUpdate-        { chanUpdateSignature      = testSignature-        , chanUpdateChainHash      = testChainHash-        , chanUpdateShortChanId    = testShortChannelId-        , chanUpdateTimestamp      = timestamp-        , chanUpdateMsgFlags       = MessageFlags { mfHtlcMaxPresent = False }-        , chanUpdateChanFlags      = ChannelFlags-            { cfDirection = False, cfDisabled = False }-        , chanUpdateCltvExpDelta   = CltvExpiryDelta cltvDelta-        , chanUpdateHtlcMinMsat    = HtlcMinimumMsat 1000-        , chanUpdateFeeBaseMsat    = FeeBaseMsat 1000-        , chanUpdateFeeProportional = FeeProportionalMillionths 100-        , chanUpdateHtlcMaxMsat    = Nothing-        }-      encoded = encodeChannelUpdate msg-  case decodeChannelUpdate encoded of-    Right (decoded, _) -> decoded == msg-    Left _ -> False---- Property: AnnouncementSignatures roundtrip-propAnnouncementSignaturesRoundtrip :: Property-propAnnouncementSignaturesRoundtrip = property $ do-  let msg = AnnouncementSignatures-        { annSigChannelId   = testChannelId-        , annSigShortChanId = testShortChannelId-        , annSigNodeSig     = testSignature-        , annSigBitcoinSig  = testSignature-        }-      encoded = encodeAnnouncementSignatures msg-  case decodeAnnouncementSignatures encoded of-    Right (decoded, _) -> decoded == msg-    Left _ -> False---- Property: GossipTimestampFilter roundtrip-propGossipTimestampFilterRoundtrip :: Word32 -> Word32 -> Property-propGossipTimestampFilterRoundtrip firstTs tsRange = property $ do-  let msg = GossipTimestampFilter-        { gossipFilterChainHash      = testChainHash-        , gossipFilterFirstTimestamp = firstTs-        , gossipFilterTimestampRange = tsRange-        }-      encoded = encodeGossipTimestampFilter msg-  case decodeGossipTimestampFilter encoded of-    Right (decoded, _) -> decoded == msg-    Left _ -> False+import Data.Bits ((.&.), (.|.), shiftR, xor)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import Data.Word (Word8, Word16, Word32, Word64)+import Lightning.Protocol.BOLT1+  ( ChainHash, Point, ShortChannelId(..), Signature, TlvError(..)+  , TlvRecord(..), TlvStream )+import qualified Lightning.Protocol.BOLT1 as BOLT1+import Lightning.Protocol.BOLT7+import qualified Lightning.Protocol.BOLT9 as BOLT9+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck hiding ((.&.))+import Vectors++main :: IO ()+main = defaultMain $ testGroup "ppad-bolt7" [+    field_tests+  , spec_vector_tests+  , mainnet_tests+  , node_announcement_tests+  , channel_update_tests+  , query_tests+  , other_message_tests+  , encode_error_tests+  , dispatch_tests+  , validation_tests+  , checksum_tests+  , property_tests+  ]++-- helpers --------------------------------------------------------------------++must :: String -> Maybe a -> IO a+must what = maybe (assertFailure ("unexpected Nothing: " ++ what)) pure++expectRight :: Show e => String -> Either e a -> IO a+expectRight what =+  either (\e -> assertFailure (what ++ " failed: " ++ show e)) pure++hex :: BS.ByteString -> IO BS.ByteString+hex h = must ("hex " ++ show h) (B16.decode h)++-- total helpers for pure contexts (properties)+chain_hash_of :: Word8 -> Maybe ChainHash+chain_hash_of w = BOLT1.chain_hash (BS.replicate 32 w)++big_endian :: Int -> Word64 -> BS.ByteString+big_endian n w =+  BS.pack [ fromIntegral (w `shiftR` (8 * i)) | i <- [n - 1, n - 2 .. 0] ]++u16be :: Int -> BS.ByteString+u16be = big_endian 2 . fromIntegral++-- replace the byte at an offset (no-op past the end)+set_byte :: Int -> Word8 -> BS.ByteString -> BS.ByteString+set_byte i w bs+  | i < 0 || i >= BS.length bs = bs+  | otherwise = BS.take i bs <> BS.singleton w <> BS.drop (i + 1) bs++-- | Fixture values, built with the smart constructors.+data Fx = Fx+  { fx_chain  :: ChainHash+  , fx_sig    :: Signature+  , fx_node_1 :: Point+  , fx_node_2 :: Point+  , fx_cid    :: BOLT1.ChannelId+  , fx_scid   :: ShortChannelId+  , fx_alias  :: Alias+  , fx_scids  :: [ShortChannelId]+  }++fixtures :: IO Fx+fixtures = do+  ch <- must "chain_hash" (chain_hash_of 0x01)+  sg <- must "signature" (BOLT1.signature (BS.replicate 64 0xee))+  n1 <- must "point" (BOLT1.point (BS.cons 0x02 (BS.replicate 32 0xbb)))+  n2 <- must "point" (BOLT1.point (BS.cons 0x03 (BS.replicate 32 0xaa)))+  ci <- must "channel_id" (BOLT1.channel_id (BS.replicate 32 0xcd))+  sc <- must "short_channel_id" (BOLT1.short_channel_id 539268 845 1)+  al <- must "alias" (alias (BS.replicate 32 0))+  ss <- must "short_channel_ids" $ traverse+          (\(b, t, o) -> BOLT1.short_channel_id b t o)+          [(100000, 1, 0), (200000, 2, 1), (300000, 3, 2)]+  pure Fx+    { fx_chain  = ch+    , fx_sig    = sg+    , fx_node_1 = n1+    , fx_node_2 = n2+    , fx_cid    = ci+    , fx_scid   = sc+    , fx_alias  = al+    , fx_scids  = ss+    }++msat :: Word64 -> IO BOLT1.MilliSatoshi+msat = must "milli_satoshi" . BOLT1.milli_satoshi++update_fixture :: Fx -> IO ChannelUpdate+update_fixture fx = do+  hmin <- msat 1000+  hmax <- msat 1000000000+  pure ChannelUpdate+    { cu_signature                   = fx_sig fx+    , cu_chain_hash                  = fx_chain fx+    , cu_short_channel_id            = fx_scid fx+    , cu_timestamp                   = 1234567890+    , cu_message_flags               = message_flags Forward+    , cu_channel_flags               = channel_flags NodeOne Enabled+    , cu_cltv_expiry_delta           = 144+    , cu_htlc_minimum_msat           = hmin+    , cu_fee_base_msat               = 1000+    , cu_fee_proportional_millionths = 100+    , cu_htlc_maximum_msat           = hmax+    , cu_tlvs                        = BOLT1.empty_tlv_stream+    }++announcement_fixture :: Fx -> ChannelAnnouncement+announcement_fixture fx = ChannelAnnouncement+  { ca_node_signature_1    = fx_sig fx+  , ca_node_signature_2    = fx_sig fx+  , ca_bitcoin_signature_1 = fx_sig fx+  , ca_bitcoin_signature_2 = fx_sig fx+  , ca_features            = BOLT9.empty+  , ca_chain_hash          = fx_chain fx+  , ca_short_channel_id    = fx_scid fx+  , ca_node_id_1           = fx_node_1 fx+  , ca_node_id_2           = fx_node_2 fx+  , ca_bitcoin_key_1       = fx_node_1 fx+  , ca_bitcoin_key_2       = fx_node_2 fx+  , ca_tlvs                = BOLT1.empty_tlv_stream+  }++node_fixture :: Fx -> [Address] -> NodeAnnouncement+node_fixture fx addrs = NodeAnnouncement+  { na_signature         = fx_sig fx+  , na_features          = BOLT9.empty+  , na_timestamp         = 1234567890+  , na_node_id           = fx_node_2 fx+  , na_rgb_color         = RgbColor 0xff 0x00 0x00+  , na_alias             = fx_alias fx+  , na_addresses         = addrs+  , na_unknown_addresses = BS.empty+  , na_tlvs              = BOLT1.empty_tlv_stream+  }++tlvs_of :: [TlvRecord] -> IO TlvStream+tlvs_of = must "tlv_stream" . BOLT1.tlv_stream++-- field types ----------------------------------------------------------------++field_tests :: TestTree+field_tests = testGroup "field types" [+    testCase "format_short_channel_id" $ do+      let fmt b t o =+            fmap format_short_channel_id (BOLT1.short_channel_id b t o)+      fmt 539268 845 1 @?= Just "539268x845x1"+      fmt 0 0 0 @?= Just "0x0x0"+      fmt 0xffffff 0xffffff 0xffff @?= Just "16777215x16777215x65535"+  , testCase "message_flags" $ do+      message_flags Forward @?= MessageFlags 0x01+      message_flags DontForward @?= MessageFlags 0x03+      map (message_flags_forwarding . MessageFlags) [0, 1, 2, 3, 0xfd]+        @?= [Forward, Forward, DontForward, DontForward, Forward]+      map (has_must_be_one . MessageFlags) [0, 1, 2, 0xfe]+        @?= [False, True, False, False]+  , testCase "channel_flags" $ do+      [ channel_flags d s | d <- [NodeOne, NodeTwo], s <- [Enabled, Disabled] ]+        @?= map ChannelFlags [0, 2, 1, 3]+      map (channel_flags_direction . ChannelFlags) [0x04, 0x05, 0xfe]+        @?= [NodeOne, NodeTwo, NodeOne]+      map (channel_flags_status . ChannelFlags) [0x04, 0x06, 0xfd]+        @?= [Enabled, Disabled, Enabled]+  , testCase "query_flags" $ do+      query_flags [] @?= QueryFlags 0+      query_flags [minBound .. maxBound] @?= QueryFlags 31+      query_flags [WantNodeAnnouncement2, WantChannelUpdate1] @?= QueryFlags 18+      map (`has_query_flag` QueryFlags 0x25) [minBound .. maxBound]+        @?= [True, False, True, False, False]+  , testCase "query_option" $ do+      query_option [WantChecksums] @?= QueryOption 2+      map (`has_query_option` QueryOption 0x05) [minBound .. maxBound]+        @?= [True, False]+  , testCase "fixed-size constructors check lengths" $ do+      let lens mk = [ mk (BS.replicate n 0) /= Nothing | n <- [0 .. 40] ]+          only n = [ k == n | k <- [0 .. 40 :: Int] ]+      lens alias @?= only 32+      lens ipv4_addr @?= only 4+      lens ipv6_addr @?= only 16+      lens tor_v2_addr @?= only 12+      lens tor_v3_addr @?= only 35+  , testCase "hostname" $ do+      fmap un_hostname (hostname "ln.example.com") @?= Just "ln.example.com"+      fmap un_hostname (hostname "") @?= Just ""+      fmap (BS.length . un_hostname) (hostname (BS.replicate 255 0x61))+        @?= Just 255+      hostname (BS.replicate 256 0x61) @?= Nothing+      let ascii h = fmap is_ascii_hostname (hostname h)+      ascii "xn--caf-dma" @?= Just True+      ascii "caf\233" @?= Just False+      ascii "\0\255" @?= Just False+      ascii "" @?= Just False+  , testCase "usable_addresses" $ do+      v4 <- must "ipv4" (ipv4_addr "\127\0\0\1")+      v6 <- must "ipv6" (ipv6_addr (BS.replicate 16 1))+      t2 <- must "tor v2" (tor_v2_addr (BS.replicate 12 0xaa))+      t3 <- must "tor v3" (tor_v3_addr (BS.replicate 35 0xbb))+      h1 <- must "hostname" (hostname "a.example.com")+      h2 <- must "hostname" (hostname "b.example.com")+      bad <- must "hostname" (hostname "caf\233")+      usable_addresses+        [ AddrIPv4 v4 9735, AddrTorV2 t2, AddrIPv6 v6 0, AddrTorV3 t3 9735+        , AddrDNS h1 9735, AddrDNS h2 9735, AddrIPv6 v6 9735 ]+        @?= [ AddrIPv4 v4 9735, AddrTorV3 t3 9735, AddrDNS h1 9735+            , AddrIPv6 v6 9735 ]+      -- a hostname that is ignored still counts as the first+      usable_addresses [AddrDNS bad 9735, AddrDNS h1 9735] @?= []+      usable_addresses [AddrDNS h1 0, AddrDNS h2 9735] @?= []+  ]++-- extended-queries.json ------------------------------------------------------++-- the vectors' chain hash (regtest)+regtest :: IO ChainHash+regtest = hex+  "0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206"+  >>= must "chain_hash" . BOLT1.chain_hash++scids :: [(Word32, Word32, Word16)] -> IO [ShortChannelId]+scids = must "short_channel_id"+  . traverse (\(b, t, o) -> BOLT1.short_channel_id b t o)++-- decode a vector, compare with the expected message, and re-encode the+-- expected message+known_answer :: BS.ByteString -> Message -> Assertion+known_answer h expected = do+  wire <- hex h+  (t, payload) <- expectRight "decode_envelope" (BOLT1.decode_envelope wire)+  decode_message t payload @?= Right expected+  message_type expected @?= t+  encode_message expected @?= Right payload++rejected :: BS.ByteString -> DecodeError -> Assertion+rejected h err = do+  wire <- hex h+  (t, payload) <- expectRight "decode_envelope" (BOLT1.decode_envelope wire)+  decode_message t payload @?= Left err++spec_vector_tests :: TestTree+spec_vector_tests = testGroup "bolt07/extended-queries.json" $+  case query_vectors of+    [v0, v1, v2, v3, v4, v5, v6, v7, v8, v9] -> [+        testCase "0: query_channel_range" $ do+          ch <- regtest+          known_answer v0 $ MsgQueryChannelRange+            (QueryChannelRange ch 100000 1500 Nothing BOLT1.empty_tlv_stream)+      , testCase "1: query_channel_range with query_option" $ do+          ch <- regtest+          known_answer v1 $ MsgQueryChannelRange $ QueryChannelRange ch+            35000 100 (Just (query_option [WantTimestamps, WantChecksums]))+            BOLT1.empty_tlv_stream+      , testCase "2: reply_channel_range" $ do+          ch <- regtest+          ss <- scids [(0, 0, 142), (0, 0, 15465), (0, 69, 42692)]+          known_answer v2 $ MsgReplyChannelRange+            (ReplyChannelRange ch 756230 1500 True ss Nothing Nothing+              BOLT1.empty_tlv_stream)+      , testCase "3: reply_channel_range, zlib (rejected)" $+          rejected v3 (DecodeUnknownEncoding 1)+      , testCase "4: reply_channel_range with timestamps and checksums" $ do+          ch <- regtest+          ss <- scids [(0, 0, 12355), (0, 7, 30934), (0, 70, 57793)]+          known_answer v4 $ MsgReplyChannelRange $+            ReplyChannelRange ch 122334 1500 True ss+              (Just [ ChannelUpdateTimestamps 164545 948165+                    , ChannelUpdateTimestamps 489645 4786864+                    , ChannelUpdateTimestamps 46456 9788415 ])+              (Just [ ChannelUpdateChecksums 1111 2222+                    , ChannelUpdateChecksums 3333 4444+                    , ChannelUpdateChecksums 5555 6666 ])+              BOLT1.empty_tlv_stream+      , testCase "5: reply_channel_range, zlib (rejected)" $+          rejected v5 (DecodeUnknownEncoding 1)+      , testCase "6: query_short_channel_ids" $ do+          ch <- regtest+          ss <- scids [(0, 0, 142), (0, 0, 15465), (0, 69, 42692)]+          known_answer v6 $ MsgQueryShortChannelIds+            (QueryShortChannelIds ch ss Nothing BOLT1.empty_tlv_stream)+      , testCase "7: query_short_channel_ids, zlib (rejected)" $+          rejected v7 (DecodeUnknownEncoding 1)+      , testCase "8: query_short_channel_ids, zlib query_flags (rejected)" $+          rejected v8 (DecodeUnknownEncoding 1)+      , testCase "9: query_short_channel_ids, zlib (rejected)" $+          rejected v9 (DecodeUnknownEncoding 1)+      ]+    _ -> [testCase "vector count" (assertFailure "expected 10 vectors")]++-- mainnet gossip -------------------------------------------------------------++decoded_announcements :: IO [(BS.ByteString, ChannelAnnouncement)]+decoded_announcements = traverse go mainnet_announcements+  where+    go v = do+      p <- hex (av_payload v)+      a <- expectRight "decode_channel_announcement"+             (decode_channel_announcement p)+      pure (p, a)++-- the key of the node that signed an update+signer :: ChannelAnnouncement -> ChannelUpdate -> Point+signer a u = case channel_flags_direction (cu_channel_flags u) of+  NodeOne -> ca_node_id_1 a+  NodeTwo -> ca_node_id_2 a++other :: ChannelAnnouncement -> ChannelUpdate -> Point+other a u = case channel_flags_direction (cu_channel_flags u) of+  NodeOne -> ca_node_id_2 a+  NodeTwo -> ca_node_id_1 a++mainnet_tests :: TestTree+mainnet_tests = testGroup "mainnet gossip" [+    testCase "channel_announcements: decode, re-encode, hash, verify" $ do+      anns <- decoded_announcements+      length anns @?= 6+      mapM_ (\(v, (p, a)) -> do+          encode_channel_announcement a @?= Right p+          d <- hex (av_digest v)+          channel_announcement_hash a @?= Right d+          assertBool "signatures verify" (verify_channel_announcement a)+          validate_channel_announcement a @?= Right ())+        (zip mainnet_announcements anns)+  , testCase "channel_announcement fields" $ do+      anns <- decoded_announcements+      (_, a) <- must "first announcement" (safe_head anns)+      mainnet <- hex+        "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+      n1 <- hex+        "02bb5e47ee26aca1654ce092d9d06eac15d953210c737f2220e2d7e54c4f108677"+      n2 <- hex+        "030b828fd1e42549fbc2f1d0960ec3663362c41777d3d87fe1b8e1d4bf063abcaa"+      format_short_channel_id (ca_short_channel_id a) @?= "850052x2992x1"+      BOLT1.un_chain_hash (ca_chain_hash a) @?= mainnet+      BOLT9.render (ca_features a) @?= BS.empty+      BOLT1.un_point (ca_node_id_1 a) @?= n1+      BOLT1.un_point (ca_node_id_2 a) @?= n2+      BOLT1.un_tlv_stream (ca_tlvs a) @?= []+  , testCase "channel_announcement: tampering breaks verification" $ do+      anns <- decoded_announcements+      (p, a) <- must "first announcement" (safe_head anns)+      -- change the short channel id (signed)+      let p' = set_byte 295 0xff p+      a' <- expectRight "decode" (decode_channel_announcement p')+      assertBool "tampered" (not (verify_channel_announcement a'))+      let swapped = a { ca_node_signature_1 = ca_node_signature_2 a+                      , ca_node_signature_2 = ca_node_signature_1 a }+      assertBool "swapped" (not (verify_channel_announcement swapped))+  , testCase "channel_updates: decode, re-encode, hash, checksum, verify" $ do+      anns <- decoded_announcements+      length mainnet_updates @?= 13+      mapM_ (\v -> do+          p <- hex (uv_payload v)+          u <- expectRight "decode_channel_update" (decode_channel_update p)+          (_, a) <- must "announcement" (safe_index anns (uv_ann v))+          cu_short_channel_id u @?= ca_short_channel_id a+          encode_channel_update u @?= p+          d <- hex (uv_digest v)+          channel_update_hash u @?= d+          channel_update_checksum u @?= uv_checksum v+          assertBool "verifies under its signer"+            (verify_channel_update (signer a u) u)+          assertBool "fails under the other node"+            (not (verify_channel_update (other a u) u)))+        mainnet_updates+  , testCase "channel_update fields (136 bytes)" $ do+      u <- update_vector 1+      BS.length (encode_channel_update u) @?= 136+      format_short_channel_id (cu_short_channel_id u) @?= "850052x2992x1"+      cu_timestamp u @?= 1776493010+      cu_message_flags u @?= MessageFlags 0x01+      cu_channel_flags u @?= channel_flags NodeTwo Disabled+      cu_cltv_expiry_delta u @?= 80+      BOLT1.un_milli_satoshi (cu_htlc_minimum_msat u) @?= 1000+      cu_fee_base_msat u @?= 1000+      cu_fee_proportional_millionths u @?= 800+      BOLT1.un_milli_satoshi (cu_htlc_maximum_msat u) @?= 2970000000+      BOLT1.un_tlv_stream (cu_tlvs u) @?= []+  , testCase "channel_update fields (148 bytes, inbound-fee extension)" $ do+      u <- update_vector 0+      ext <- hex "00000000ffffffed"+      cu_timestamp u @?= 1779047542+      cu_channel_flags u @?= channel_flags NodeOne Enabled+      cu_cltv_expiry_delta u @?= 100+      cu_fee_base_msat u @?= 0+      cu_fee_proportional_millionths u @?= 5000+      BOLT1.un_milli_satoshi (cu_htlc_maximum_msat u) @?= 2970000000+      BOLT1.un_tlv_stream (cu_tlvs u) @?= [TlvRecord 55555 ext]+  , testCase "a real update with htlc_minimum_msat > htlc_maximum_msat" $ do+      u <- update_vector 8+      validate_channel_update u @?= Left ValidateHtlcAmounts+  , testCase "dropping the extension breaks verification" $ do+      anns <- decoded_announcements+      (_, a) <- must "announcement" (safe_head anns)+      u <- update_vector 0+      let u' = u { cu_tlvs = BOLT1.empty_tlv_stream }+      assertBool "with" (verify_channel_update (signer a u) u)+      assertBool "without" (not (verify_channel_update (signer a u) u'))+  ]+  where+    update_vector i = do+      v <- must "update vector" (safe_index mainnet_updates i)+      p <- hex (uv_payload v)+      expectRight "decode_channel_update" (decode_channel_update p)++safe_head :: [a] -> Maybe a+safe_head (x : _) = Just x+safe_head []      = Nothing++safe_index :: [a] -> Int -> Maybe a+safe_index xs i+  | i < 0     = Nothing+  | otherwise = safe_head (drop i xs)++-- node_announcement ----------------------------------------------------------++-- a node_announcement payload carrying the given address bytes+node_wire :: Fx -> BS.ByteString -> BS.ByteString+node_wire fx addrs = mconcat+  [ BS.replicate 64 0xee              -- signature+  , u16be 0                           -- flen+  , BS.pack [0x49, 0x96, 0x02, 0xd2]  -- timestamp+  , BOLT1.un_point (fx_node_2 fx)+  , BS.pack [0xff, 0x00, 0x00]+  , BS.replicate 32 0+  , u16be (BS.length addrs)+  , addrs+  ]++-- address descriptors (port 9735)+desc_v4, desc_v6, desc_tor_v2, desc_tor_v3 :: BS.ByteString+desc_v4 = BS.pack [1, 127, 0, 0, 1, 0x26, 0x07]+desc_v6 = BS.pack (2 : replicate 15 0 ++ [1, 0x26, 0x07])+desc_tor_v2 = BS.cons 3 (BS.replicate 12 0xaa)+desc_tor_v3 = BS.cons 4 (BS.replicate 35 0xbb) <> u16be 9735++desc_dns :: BS.ByteString -> BS.ByteString+desc_dns h = BS.pack [5, fromIntegral (BS.length h)] <> h <> u16be 9735++-- decode the addresses of a node_announcement built by node_wire, and+-- check that it re-encodes exactly+addrs_of+  :: Fx -> BS.ByteString -> IO (Either DecodeError ([Address], BS.ByteString))+addrs_of fx bytes = do+  let wire = node_wire fx bytes+  case decode_node_announcement wire of+    Left e -> pure (Left e)+    Right n -> do+      encode_node_announcement n @?= Right wire+      pure (Right (na_addresses n, na_unknown_addresses n))++node_announcement_tests :: TestTree+node_announcement_tests = testGroup "node_announcement" [+    testCase "signed vector: fields, re-encoding, hash, verification" $ do+      let (h, dh) = node_announcement_vector+      p <- hex h+      d <- hex dh+      n <- expectRight "decode" (decode_node_announcement p)+      fs <- hex "08000000000002aaa2"+      nid <- hex+        "0324653eac434488002cc06bbfb7f10fe18991e35f9fe4302dbea6d2353dc0ab1c"+      v4 <- must "ipv4" (ipv4_addr "\127\0\0\1")+      v6 <- must "ipv6" (ipv6_addr (BS.replicate 15 0 <> "\1"))+      t2 <- must "tor v2" (tor_v2_addr (BS.replicate 12 0xaa))+      t3 <- must "tor v3" (tor_v3_addr (BS.replicate 35 0xbb))+      dns <- must "hostname" (hostname "ln.example.com")+      BOLT9.render (na_features n) @?= fs+      na_timestamp n @?= 1700000000+      BOLT1.un_point (na_node_id n) @?= nid+      na_rgb_color n @?= RgbColor 0x31 0x41 0x59+      BS.takeWhile (/= 0) (un_alias (na_alias n)) @?= "ppad-bolt7"+      na_addresses n @?=+        [ AddrIPv4 v4 9735, AddrIPv6 v6 9735, AddrTorV2 t2+        , AddrTorV3 t3 9735, AddrDNS dns 9735 ]+      na_unknown_addresses n @?= "\x06\x01\x02\x03"+      BOLT1.un_tlv_stream (na_tlvs n) @?= [TlvRecord 101 "ext"]+      encode_node_announcement n @?= Right p+      node_announcement_hash n @?= Right d+      assertBool "verifies" (verify_node_announcement n)+      assertBool "tampered"+        (not (verify_node_announcement n { na_timestamp = 1700000001 }))+      usable_addresses (na_addresses n) @?=+        [ AddrIPv4 v4 9735, AddrIPv6 v6 9735, AddrTorV3 t3 9735+        , AddrDNS dns 9735 ]+      validate_node_announcement n @?= Right ()+  , testCase "keeps deprecated Tor v2 descriptors" $ do+      fx <- fixtures+      r <- addrs_of fx (desc_v4 <> desc_tor_v2 <> desc_v6 <> desc_tor_v3)+      fmap (map kind . fst) r @?= Right [1, 3, 2, 4]+  , testCase "stops at the first unknown type, keeping the rest" $ do+      fx <- fixtures+      let rest = BS.pack [6, 1, 2, 3] <> desc_v6+      r <- addrs_of fx (desc_v4 <> rest)+      fmap (\(as, u) -> (map kind as, u)) r @?= Right ([1], rest)+  , testCase "stops at a type-0 descriptor" $ do+      fx <- fixtures+      let bytes = BS.singleton 0 <> desc_v4+      r <- addrs_of fx bytes+      fmap (\(as, u) -> (map kind as, u)) r @?= Right ([], bytes)+  , testCase "keeps descriptors with port 0" $ do+      fx <- fixtures+      v4 <- must "ipv4" (ipv4_addr "\127\0\0\1")+      r <- addrs_of fx (BS.pack [1, 127, 0, 0, 1, 0, 0])+      r @?= Right ([AddrIPv4 v4 0], BS.empty)+  , testCase "keeps empty and non-ASCII hostnames" $ do+      fx <- fixtures+      r <- addrs_of fx (desc_dns "" <> desc_dns "\xff\&ab")+      fmap (map (\a -> case a of+                    AddrDNS h _ -> un_hostname h+                    _           -> "?") . fst) r+        @?= Right ["", "\xff\&ab"]+  , testCase "rejects a truncated descriptor of a known type" $ do+      fx <- fixtures+      let truncated bytes = decode_node_announcement (node_wire fx bytes)+            @?= Left DecodeInsufficientBytes+      truncated (BS.pack [1, 127, 0, 0])+      truncated (BS.pack [2, 0, 0])+      truncated (BS.pack [3, 1, 2, 3])+      truncated (BS.cons 4 (BS.replicate 36 0))+      truncated (BS.pack [5, 4, 0x61])+  , testCase "rejects a node_id without a compressed prefix" $ do+      fx <- fixtures+      let wire = set_byte 70 0x04 (node_wire fx BS.empty)+      decode_node_announcement wire @?= Left DecodeInvalidPoint+  , testCase "na_unknown_addresses must not begin with a known type" $ do+      fx <- fixtures+      let with u = encode_node_announcement+            (node_fixture fx []) { na_unknown_addresses = u }+      mapM_ (\t -> with (BS.pack [t, 0]) @?= Left EncodeInvalidAddresses)+        [1 .. 5]+      assertBool "type 0" (either (const False) (const True)+        (with (BS.pack [0, 1])))+      assertBool "type 6" (either (const False) (const True)+        (with (BS.pack [6, 1])))+  , testCase "extension with an unknown even type is rejected" $ do+      fx <- fixtures+      decode_node_announcement (node_wire fx BS.empty <> "\x02\x00")+        @?= Left (DecodeTlvError (TlvUnknownEvenType 2))+  ]+  where+    kind :: Address -> Int+    kind a = case a of+      AddrIPv4 _ _  -> 1+      AddrIPv6 _ _  -> 2+      AddrTorV2 _   -> 3+      AddrTorV3 _ _ -> 4+      AddrDNS _ _   -> 5++-- channel_update -------------------------------------------------------------++channel_update_tests :: TestTree+channel_update_tests = testGroup "channel_update" [+    testCase "encoder writes the flags and htlc_maximum_msat" $ do+      u <- fixtures >>= update_fixture+      let wire = encode_channel_update u+      BS.length wire @?= 136+      BS.indexMaybe wire 108 @?= Just 0x01+      BS.indexMaybe wire 109 @?= Just 0x00+      BS.drop 128 wire @?= BS.pack [0, 0, 0, 0, 0x3b, 0x9a, 0xca, 0]+  , testCase "dont_forward" $ do+      u <- fixtures >>= update_fixture+      let wire = encode_channel_update+            u { cu_message_flags = message_flags DontForward }+      BS.indexMaybe wire 108 @?= Just 0x03+      d <- expectRight "decode" (decode_channel_update wire)+      message_flags_forwarding (cu_message_flags d) @?= DontForward+  , testCase "keeps a clear must_be_one bit" $ do+      u <- fixtures >>= update_fixture+      let wire = set_byte 108 0x00 (encode_channel_update u)+      d <- expectRight "decode" (decode_channel_update wire)+      d @?= u { cu_message_flags = MessageFlags 0 }+      encode_channel_update d @?= wire+  , testCase "keeps unassigned flag bits" $ do+      u <- fixtures >>= update_fixture+      let wire = set_byte 109 0xfd+                   (set_byte 108 0xfc (encode_channel_update u))+      d <- expectRight "decode" (decode_channel_update wire)+      cu_message_flags d @?= MessageFlags 0xfc+      cu_channel_flags d @?= ChannelFlags 0xfd+      channel_flags_direction (cu_channel_flags d) @?= NodeTwo+      channel_flags_status (cu_channel_flags d) @?= Enabled+      encode_channel_update d @?= wire+  , testCase "keeps extension records" $ do+      u <- fixtures >>= update_fixture+      ext <- tlvs_of [TlvRecord 55555 "\0\0\0\0\xff\xff\xff\xed"]+      let wire = encode_channel_update u { cu_tlvs = ext }+      BS.length wire @?= 148+      decode_channel_update wire @?= Right u { cu_tlvs = ext }+  , testCase "rejects a missing htlc_maximum_msat" $ do+      u <- fixtures >>= update_fixture+      decode_channel_update (BS.take 128 (encode_channel_update u))+        @?= Left DecodeInsufficientBytes+  , testCase "rejects amounts above 21M BTC" $ do+      u <- fixtures >>= update_fixture+      let wire = encode_channel_update u+          over = big_endian 8 0x1d24b2dfac520001+          at off = BS.take off wire <> over <> BS.drop (off + 8) wire+      decode_channel_update (at 112) @?= Left DecodeInvalidAmount+      decode_channel_update (at 128) @?= Left DecodeInvalidAmount+      max_msat <- msat 0x1d24b2dfac520000+      fmap cu_htlc_maximum_msat (decode_channel_update+        (BS.take 128 wire <> big_endian 8 0x1d24b2dfac520000))+        @?= Right max_msat+  , testCase "rejects a malformed extension" $ do+      u <- fixtures >>= update_fixture+      let wire = encode_channel_update u+      decode_channel_update (wire <> "\x02\x00")+        @?= Left (DecodeTlvError (TlvUnknownEvenType 2))+      decode_channel_update (wire <> "\x01\x05\xaa")+        @?= Left (DecodeTlvError TlvTruncated)+      decode_channel_update (wire <> "\xfd\x00\x01\x00")+        @?= Left (DecodeTlvError TlvNonMinimalBigSize)+  , testCase "rejects truncated input" $+      decode_channel_update (BS.replicate 50 0)+        @?= Left DecodeInsufficientBytes+  ]++-- queries --------------------------------------------------------------------++-- payload builders+qsci_wire :: Fx -> BS.ByteString -> BS.ByteString -> BS.ByteString+qsci_wire fx ids tlvs =+  BOLT1.un_chain_hash (fx_chain fx) <> u16be (BS.length ids) <> ids <> tlvs++qcr_wire :: Fx -> BS.ByteString -> BS.ByteString+qcr_wire fx tlvs = mconcat+  [ BOLT1.un_chain_hash (fx_chain fx)+  , big_endian 4 600000+  , big_endian 4 10000+  , tlvs+  ]++rcr_wire :: Fx -> Word8 -> BS.ByteString -> BS.ByteString -> BS.ByteString+rcr_wire fx sync ids tlvs = mconcat+  [ BOLT1.un_chain_hash (fx_chain fx)+  , big_endian 4 600000+  , big_endian 4 10000+  , BS.singleton sync+  , u16be (BS.length ids)+  , ids+  , tlvs+  ]++-- encoded_short_ids for some short channel ids+encoded_ids :: [ShortChannelId] -> BS.ByteString+encoded_ids ss = BS.cons 0 (foldMap BOLT1.encode_short_channel_id ss)++-- TLV stream rules for a query decoder, given its known types and the+-- unknown records it keeps+tlv_stream_tests+  :: String+  -> BS.ByteString+  -> (Fx -> BS.ByteString -> Either DecodeError [TlvRecord])+  -> TestTree+tlv_stream_tests name known dec = testGroup name [+    testCase "empty stream" $ do+      fx <- fixtures+      dec fx BS.empty @?= Right []+  , testCase "keeps unknown odd types" $ do+      fx <- fixtures+      dec fx (BS.pack [5, 1, 0x2a, 7, 0]) @?=+        Right [TlvRecord 5 "\x2a", TlvRecord 7 ""]+  , testCase "rejects unknown even types" $ do+      fx <- fixtures+      dec fx (BS.pack [2, 0]) @?= Left (DecodeTlvError (TlvUnknownEvenType 2))+  , testCase "rejects a length past the end" $ do+      fx <- fixtures+      dec fx (BS.pack [5, 5, 0xaa]) @?= Left (DecodeTlvError TlvTruncated)+  , testCase "rejects repeated types" $ do+      fx <- fixtures+      dec fx (BS.pack [5, 0, 5, 0])+        @?= Left (DecodeTlvError TlvNotStrictlyIncreasing)+  , testCase "rejects a non-minimal BigSize" $ do+      fx <- fixtures+      dec fx (BS.pack [0xfd, 0x00, 0x05, 0x00])+        @?= Left (DecodeTlvError TlvNonMinimalBigSize)+  , testCase "known records are typed, not kept as unknown" $ do+      fx <- fixtures+      dec fx known @?= Right []+      dec fx (known <> BS.pack [5, 0]) @?= Right [TlvRecord 5 ""]+  ]++query_tests :: TestTree+query_tests = testGroup "queries" [+    tlv_stream_tests "query_short_channel_ids TLVs" (BS.pack [1, 2, 0, 0])+      $ \fx tlvs ->+      fmap (BOLT1.un_tlv_stream . qsci_tlvs)+        (decode_query_short_channel_ids+          (qsci_wire fx (encoded_ids [fx_scid fx]) tlvs))+  , tlv_stream_tests "query_channel_range TLVs" (BS.pack [1, 1, 3])+      $ \fx tlvs ->+      fmap (BOLT1.un_tlv_stream . qcr_tlvs)+        (decode_query_channel_range (qcr_wire fx tlvs))+  , tlv_stream_tests "reply_channel_range TLVs"+      (BS.pack ([1, 9] ++ replicate 9 0 ++ [3, 8] ++ replicate 8 0))+      $ \fx tlvs ->+      fmap (BOLT1.un_tlv_stream . rcr_tlvs)+        (decode_reply_channel_range+          (rcr_wire fx 1 (encoded_ids [fx_scid fx]) tlvs))+  , testGroup "query_short_channel_ids" [+      testCase "query_flags" $ do+        fx <- fixtures+        let ss = take 2 (fx_scids fx)+            wire = qsci_wire fx (encoded_ids ss)+              (BS.pack [1, 3, 0, 0x01, 0x1f])+            m = QueryShortChannelIds (fx_chain fx) ss+                  (Just [QueryFlags 1, QueryFlags 31]) BOLT1.empty_tlv_stream+        decode_query_short_channel_ids wire @?= Right m+        encode_query_short_channel_ids m @?= Right wire+    , testCase "query_flags beyond one byte" $ do+        fx <- fixtures+        let ss = take 1 (fx_scids fx)+            wire = qsci_wire fx (encoded_ids ss)+                     (BS.pack [1, 4, 0, 0xfd, 0x01, 0x00])+        fmap qsci_query_flags (decode_query_short_channel_ids wire)+          @?= Right (Just [QueryFlags 256])+    , testCase "rejects a query flag count mismatch" $ do+        fx <- fixtures+        let ss = take 2 (fx_scids fx)+            wire = qsci_wire fx (encoded_ids ss) (BS.pack [1, 2, 0, 0x01])+        decode_query_short_channel_ids wire @?= Left DecodeCountMismatch+    , testCase "rejects malformed query_flags" $ do+        fx <- fixtures+        let with tlv = decode_query_short_channel_ids+              (qsci_wire fx (encoded_ids [fx_scid fx]) tlv)+        with (BS.pack [1, 0]) @?= Left (DecodeInvalidTlvValue 1)+        with (BS.pack [1, 4, 0, 0xfd, 0x00, 0x01])+          @?= Left (DecodeInvalidTlvValue 1)+        with (BS.pack [1, 2, 0, 0xfd]) @?= Left (DecodeInvalidTlvValue 1)+        with (BS.pack [1, 2, 1, 0x01]) @?= Left (DecodeUnknownEncoding 1)+    , testCase "rejects malformed encoded_short_ids" $ do+        fx <- fixtures+        let with ids = decode_query_short_channel_ids (qsci_wire fx ids "")+        with BS.empty @?= Left DecodeInvalidShortChannelIds+        with (BS.cons 0 (BS.replicate 7 0))+          @?= Left DecodeInvalidShortChannelIds+        with (BS.cons 0 (BS.replicate 9 0))+          @?= Left DecodeInvalidShortChannelIds+        with (BS.cons 1 (BS.replicate 8 0)) @?= Left (DecodeUnknownEncoding 1)+        with (BS.cons 2 (BS.replicate 8 0)) @?= Left (DecodeUnknownEncoding 2)+    , testCase "an empty list still carries its encoding type" $ do+        fx <- fixtures+        let m = QueryShortChannelIds (fx_chain fx) [] Nothing+                  BOLT1.empty_tlv_stream+            wire = qsci_wire fx (BS.singleton 0) ""+        encode_query_short_channel_ids m @?= Right wire+        decode_query_short_channel_ids wire @?= Right m+    ]+  , testGroup "query_channel_range" [+      testCase "query_option" $ do+        fx <- fixtures+        let wire = qcr_wire fx (BS.pack [1, 3, 0xfd, 0x01, 0x00])+        fmap qcr_query_option (decode_query_channel_range wire)+          @?= Right (Just (QueryOption 256))+    , testCase "rejects malformed query_option" $ do+        fx <- fixtures+        let with tlv = decode_query_channel_range (qcr_wire fx tlv)+        with (BS.pack [1, 0]) @?= Left (DecodeInvalidTlvValue 1)+        with (BS.pack [1, 2, 3, 0]) @?= Left (DecodeInvalidTlvValue 1)+        with (BS.pack [1, 3, 0xfd, 0x00, 0x03])+          @?= Left (DecodeInvalidTlvValue 1)+    , testCase "rejects truncated input" $ do+        fx <- fixtures+        decode_query_channel_range (BS.take 39 (qcr_wire fx ""))+          @?= Left DecodeInsufficientBytes+    ]+  , testGroup "reply_channel_range" [+      testCase "rejects malformed timestamps" $ do+        fx <- fixtures+        let ss = take 2 (fx_scids fx)+            with tlv = decode_reply_channel_range+              (rcr_wire fx 1 (encoded_ids ss) tlv)+        with (BS.pack [1, 0]) @?= Left (DecodeInvalidTlvValue 1)+        with (BS.pack [1, 9, 1] <> BS.replicate 8 0)+          @?= Left (DecodeUnknownEncoding 1)+        with (BS.pack [1, 9, 0] <> BS.replicate 8 0)+          @?= Left DecodeCountMismatch+        with (BS.pack [1, 13, 0] <> BS.replicate 12 0)+          @?= Left (DecodeInvalidTlvValue 1)+    , testCase "rejects malformed checksums" $ do+        fx <- fixtures+        let ss = take 2 (fx_scids fx)+            with tlv = decode_reply_channel_range+              (rcr_wire fx 1 (encoded_ids ss) tlv)+        with (BS.pack [3, 8] <> BS.replicate 8 0) @?= Left DecodeCountMismatch+        with (BS.pack [3, 12] <> BS.replicate 12 0)+          @?= Left (DecodeInvalidTlvValue 3)+        fmap rcr_checksums (with (BS.pack [3, 16] <> BS.replicate 16 0))+          @?= Right (Just (replicate 2 (ChannelUpdateChecksums 0 0)))+    , testCase "rejects a sync_complete other than 0 or 1" $ do+        fx <- fixtures+        let with s = fmap rcr_sync_complete (decode_reply_channel_range+              (rcr_wire fx s (encoded_ids []) ""))+        with 0 @?= Right False+        with 1 @?= Right True+        with 2 @?= Left DecodeInvalidBool+    , testCase "rejects malformed encoded_short_ids" $ do+        fx <- fixtures+        let with ids = decode_reply_channel_range (rcr_wire fx 1 ids "")+        with BS.empty @?= Left DecodeInvalidShortChannelIds+        with (BS.cons 0 (BS.replicate 12 0))+          @?= Left DecodeInvalidShortChannelIds+        with (BS.cons 1 (BS.replicate 8 0)) @?= Left (DecodeUnknownEncoding 1)+    ]+  ]++-- other messages -------------------------------------------------------------++other_message_tests :: TestTree+other_message_tests = testGroup "other messages" [+    testCase "reply_short_channel_ids_end" $ do+      fx <- fixtures+      let ch = BOLT1.un_chain_hash (fx_chain fx)+      ext <- tlvs_of [TlvRecord 9 "x"]+      decode_reply_short_channel_ids_end (ch <> "\x01")+        @?= Right (ReplyShortChannelIdsEnd (fx_chain fx) True+                     BOLT1.empty_tlv_stream)+      decode_reply_short_channel_ids_end (ch <> "\x00\x09\x01x")+        @?= Right (ReplyShortChannelIdsEnd (fx_chain fx) False ext)+      decode_reply_short_channel_ids_end (ch <> "\x02")+        @?= Left DecodeInvalidBool+      decode_reply_short_channel_ids_end ch @?= Left DecodeInsufficientBytes+  , testCase "announcement_signatures" $ do+      fx <- fixtures+      ext <- tlvs_of [TlvRecord 1 "a"]+      let m = AnnouncementSignatures (fx_cid fx) (fx_scid fx) (fx_sig fx)+                (fx_sig fx) ext+          wire = encode_announcement_signatures m+      BS.length wire @?= 32 + 8 + 64 + 64 + 3+      decode_announcement_signatures wire @?= Right m+      decode_announcement_signatures (BS.take 167 wire)+        @?= Left DecodeInsufficientBytes+      -- type 1 is odd, so it may appear in an extension; 2 may not+      decode_announcement_signatures (BS.take 168 wire <> "\x02\x00")+        @?= Left (DecodeTlvError (TlvUnknownEvenType 2))+  , testCase "gossip_timestamp_filter" $ do+      fx <- fixtures+      let m = GossipTimestampFilter (fx_chain fx) 1609459200 86400+                BOLT1.empty_tlv_stream+          wire = encode_gossip_timestamp_filter m+      BS.drop 32 wire @?= BS.pack [0x5f, 0xee, 0x66, 0x00, 0, 1, 0x51, 0x80]+      decode_gossip_timestamp_filter wire @?= Right m+      decode_gossip_timestamp_filter (BS.take 39 wire)+        @?= Left DecodeInsufficientBytes+  , testCase "channel_announcement rejects bad points" $ do+      fx <- fixtures+      wire <- expectRight "encode"+        (encode_channel_announcement (announcement_fixture fx))+      -- node_id_1 starts after the signatures, features, chain hash+      -- and short channel id+      decode_channel_announcement (set_byte 298 0x04 wire)+        @?= Left DecodeInvalidPoint+      decode_channel_announcement (BS.take 429 wire)+        @?= Left DecodeInsufficientBytes+  ]++-- encoding errors ------------------------------------------------------------++encode_error_tests :: TestTree+encode_error_tests = testGroup "encoding errors" [+    testCase "channel_announcement features" $ do+      fx <- fixtures+      let feats n = (announcement_fixture fx)+            { ca_features = BOLT9.parse (BS.replicate n 1) }+      encode_channel_announcement (feats 65536) @?= Left EncodeLengthOverflow+      wire <- expectRight "encode" (encode_channel_announcement (feats 65535))+      decode_channel_announcement wire @?= Right (feats 65535)+  , testCase "node_announcement features and addresses" $ do+      fx <- fixtures+      v4 <- must "ipv4" (ipv4_addr "\127\0\0\1")+      let base = node_fixture fx []+      encode_node_announcement base+        { na_features = BOLT9.parse (BS.replicate 65536 1) }+        @?= Left EncodeLengthOverflow+      -- 10923 IPv4 descriptors take 65538 bytes+      let v4s n = node_fixture fx (replicate n (AddrIPv4 v4 1))+      encode_node_announcement (v4s 10923) @?= Left EncodeLengthOverflow+      wire <- expectRight "encode" (encode_node_announcement (v4s 9362))+      fmap (length . na_addresses) (decode_node_announcement wire)+        @?= Right 9362+  , testCase "short channel id lists" $ do+      fx <- fixtures+      let ids n = map ShortChannelId [1 .. n]+          q n = QueryShortChannelIds (fx_chain fx) (ids n) Nothing+                  BOLT1.empty_tlv_stream+          r n = ReplyChannelRange (fx_chain fx) 0 1 True (ids n) Nothing+                  Nothing BOLT1.empty_tlv_stream+      encode_query_short_channel_ids (q 8192) @?= Left EncodeLengthOverflow+      encode_reply_channel_range (r 8192) @?= Left EncodeLengthOverflow+      wire <- expectRight "encode" (encode_query_short_channel_ids (q 8191))+      decode_query_short_channel_ids wire @?= Right (q 8191)+  , testCase "count mismatches" $ do+      fx <- fixtures+      let ss = fx_scids fx+          q = QueryShortChannelIds (fx_chain fx) ss (Just [QueryFlags 1])+                BOLT1.empty_tlv_stream+          r = ReplyChannelRange (fx_chain fx) 0 1 True ss Nothing Nothing+                BOLT1.empty_tlv_stream+      encode_query_short_channel_ids q @?= Left EncodeCountMismatch+      encode_reply_channel_range r+        { rcr_timestamps = Just [ChannelUpdateTimestamps 1 2] }+        @?= Left EncodeCountMismatch+      encode_reply_channel_range r+        { rcr_checksums = Just (replicate 4 (ChannelUpdateChecksums 1 2)) }+        @?= Left EncodeCountMismatch+  , testCase "extra records must not use known types" $ do+      fx <- fixtures+      t1 <- tlvs_of [TlvRecord 1 "\0"]+      t3 <- tlvs_of [TlvRecord 3 ""]+      t5 <- tlvs_of [TlvRecord 5 ""]+      let q = QueryShortChannelIds (fx_chain fx) [] Nothing+          c = QueryChannelRange (fx_chain fx) 0 1 Nothing+          r = ReplyChannelRange (fx_chain fx) 0 1 True [] Nothing Nothing+      encode_query_short_channel_ids (q t1) @?= Left EncodeInvalidTlvs+      encode_query_channel_range (c t1) @?= Left EncodeInvalidTlvs+      encode_reply_channel_range (r t1) @?= Left EncodeInvalidTlvs+      encode_reply_channel_range (r t3) @?= Left EncodeInvalidTlvs+      wire <- expectRight "encode" (encode_reply_channel_range (r t5))+      decode_reply_channel_range wire @?= Right (r t5)+  ]++-- dispatch -------------------------------------------------------------------++dispatch_tests :: TestTree+dispatch_tests = testGroup "dispatch" [+    testCase "unknown message types" $+      mapM_ (\t -> decode_message t "" @?= Left (DecodeUnknownType t))+        [0, 16, 255, 260, 266, 32768]+  , testCase "message types" $ do+      fx <- fixtures+      u <- update_fixture fx+      let e = BOLT1.empty_tlv_stream+          ms = [ MsgChannelAnnouncement (announcement_fixture fx)+               , MsgNodeAnnouncement (node_fixture fx [])+               , MsgChannelUpdate u+               , MsgAnnouncementSignatures (AnnouncementSignatures+                   (fx_cid fx) (fx_scid fx) (fx_sig fx) (fx_sig fx) e)+               , MsgQueryShortChannelIds+                   (QueryShortChannelIds (fx_chain fx) [] Nothing e)+               , MsgReplyShortChannelIdsEnd+                   (ReplyShortChannelIdsEnd (fx_chain fx) True e)+               , MsgQueryChannelRange+                   (QueryChannelRange (fx_chain fx) 0 1 Nothing e)+               , MsgReplyChannelRange (ReplyChannelRange+                   (fx_chain fx) 0 1 True [] Nothing Nothing e)+               , MsgGossipTimestampFilter+                   (GossipTimestampFilter (fx_chain fx) 0 1 e)+               ]+      map message_type ms @?= [256, 257, 258, 259, 261, 262, 263, 264, 265]+      mapM_ (\m -> do+          p <- expectRight "encode" (encode_message m)+          decode_message (message_type m) p @?= Right m)+        ms+  ]++-- validation -----------------------------------------------------------------++validation_tests :: TestTree+validation_tests = testGroup "validation" [+    testCase "channel_announcement node id order" $ do+      fx <- fixtures+      let a = announcement_fixture fx+      validate_channel_announcement a @?= Right ()+      validate_channel_announcement+        a { ca_node_id_1 = fx_node_2 fx, ca_node_id_2 = fx_node_1 fx }+        @?= Left ValidateNodeIdOrdering+      validate_channel_announcement a { ca_node_id_2 = fx_node_1 fx }+        @?= Left ValidateNodeIdOrdering+  , testCase "node_announcement DNS hostnames" $ do+      fx <- fixtures+      v4 <- must "ipv4" (ipv4_addr "\127\0\0\1")+      h1 <- must "hostname" (hostname "a.example.com")+      h2 <- must "hostname" (hostname "b.example.com")+      validate_node_announcement+        (node_fixture fx [AddrIPv4 v4 1, AddrDNS h1 1])+        @?= Right ()+      validate_node_announcement (node_fixture fx [AddrDNS h1 1, AddrDNS h2 1])+        @?= Left ValidateMultipleDns+  , testCase "channel_update htlc amounts" $ do+      fx <- fixtures+      u <- update_fixture fx+      big <- msat 2000000000+      validate_channel_update u @?= Right ()+      validate_channel_update+        u { cu_htlc_minimum_msat = cu_htlc_maximum_msat u } @?= Right ()+      validate_channel_update u { cu_htlc_minimum_msat = big }+        @?= Left ValidateHtlcAmounts+  , testCase "query_channel_range block range" $ do+      fx <- fixtures+      let q f n = validate_query_channel_range+            (QueryChannelRange (fx_chain fx) f n Nothing+              BOLT1.empty_tlv_stream)+      q 600000 10000 @?= Right ()+      q 600000 0 @?= Left ValidateZeroBlocks+      q maxBound 1 @?= Right ()+      q maxBound 2 @?= Left ValidateBlockOverflow+      q 0 maxBound @?= Right ()+      q 1 maxBound @?= Right ()+      q 2 maxBound @?= Left ValidateBlockOverflow+  , testCase "short channel ids ascend" $ do+      fx <- fixtures+      let ss = fx_scids fx+          e = BOLT1.empty_tlv_stream+          r xs = validate_reply_channel_range+            (ReplyChannelRange (fx_chain fx) 0 1 True xs Nothing Nothing e)+          q xs = validate_query_short_channel_ids+            (QueryShortChannelIds (fx_chain fx) xs Nothing e)+      r ss @?= Right ()+      r [] @?= Right ()+      r (reverse ss) @?= Left ValidateScidNotAscending+      r (take 1 ss <> take 1 ss) @?= Left ValidateScidNotAscending+      q ss @?= Right ()+      q (reverse ss) @?= Left ValidateScidNotAscending+  ]++-- checksums ------------------------------------------------------------------++-- an independent, table-driven CRC-32C+crc32c_ref :: BS.ByteString -> Word32+crc32c_ref = xor 0xffffffff . BS.foldl' step 0xffffffff+  where+    step c b = (c `shiftR` 8)+      `xor` table (fromIntegral ((c `xor` fromIntegral b) .&. 0xff))+    table :: Word32 -> Word32+    table n = go (8 :: Int) n+      where+        go 0 x = x+        go k x+          | x .&. 1 == 1 = go (k - 1) ((x `shiftR` 1) `xor` 0x82f63b78)+          | otherwise    = go (k - 1) (x `shiftR` 1)++-- the checksum per BOLT #7: the update without signature and timestamp+checksum_ref :: BS.ByteString -> Word32+checksum_ref wire =+  crc32c_ref (BS.take 40 (BS.drop 64 wire) <> BS.drop 108 wire)++checksum_tests :: TestTree+checksum_tests = testGroup "checksums" [+    testCase "reference CRC-32C matches RFC 3720 vectors" $ do+      crc32c_ref "123456789" @?= 0xe3069283+      crc32c_ref (BS.replicate 32 0x00) @?= 0x8a9136aa+      crc32c_ref (BS.replicate 32 0xff) @?= 0x62a8ab43+      crc32c_ref (BS.pack [0 .. 31]) @?= 0x46dd794e+      crc32c_ref (BS.pack [31, 30 .. 0]) @?= 0x113fdb5c+  , testCase "checksum ignores signature and timestamp" $ do+      fx <- fixtures+      u <- update_fixture fx+      sig <- must "signature" (BOLT1.signature (BS.replicate 64 0x11))+      channel_update_checksum u { cu_signature = sig, cu_timestamp = 1 }+        @?= channel_update_checksum u+      assertBool "covers the fees"+        (channel_update_checksum u { cu_fee_base_msat = 1001 }+          /= channel_update_checksum u)+  , testProperty "checksum matches the reference" $+      forAll gen_channel_update $ \u ->+        channel_update_checksum u === checksum_ref (encode_channel_update u)+  ]++-- properties -----------------------------------------------------------------++property_tests :: TestTree+property_tests = testGroup "properties" [+    testProperty "real gossip re-encodes exactly" $+      forAll (elements samples) $ \(t, h) ->+        case B16.decode h of+          Nothing -> counterexample "bad hex" False+          Just p  -> fmap encode_message (decode_message t p)+                       === Right (Right p)+  , testProperty "mutated real gossip re-encodes exactly, if it decodes" $+      forAll (elements samples) $ \(t, h) ->+      forAll arbitrary $ \(NonNegative i, w) ->+        case B16.decode h of+          Nothing -> counterexample "bad hex" False+          Just p  ->+            let p' = set_byte (i `mod` BS.length p) w p+            in  case decode_message t p' of+                  Left _  -> property True+                  Right m -> encode_message m === Right p'+  , testProperty "messages round-trip" $+      forAll gen_message $ \m -> case encode_message m of+        Left e  -> counterexample (show e) False+        Right p -> decode_message (message_type m) p === Right m+  , testProperty "channel_flags accessors" $ \w ->+      let f = ChannelFlags w+      in  channel_flags (channel_flags_direction f) (channel_flags_status f)+            === ChannelFlags (w .&. 0x03)+  , testProperty "message_flags accessors" $ \w ->+      let f = MessageFlags w+      in  message_flags (message_flags_forwarding f)+            === MessageFlags (w .&. 0x02 .|. 0x01)+  , testProperty "query_flags sets exactly its bits" $+      forAll (sublistOf [minBound .. maxBound]) $ \fs ->+        map (`has_query_flag` query_flags fs) [minBound .. maxBound]+          === map (`elem` fs) [minBound .. maxBound]+  , testProperty "query_option sets exactly its bits" $+      forAll (sublistOf [minBound .. maxBound]) $ \fs ->+        map (`has_query_option` query_option fs) [minBound .. maxBound]+          === map (`elem` fs) [minBound .. maxBound]+  ]++-- (type, hex payload) of every embedded real or signed message+samples :: [(Word16, BS.ByteString)]+samples =+     [ (256, av_payload v) | v <- mainnet_announcements ]+  <> [ (258, uv_payload v) | v <- mainnet_updates ]+  <> [ (257, fst node_announcement_vector) ]++-- generators -----------------------------------------------------------------++gen_bytes :: Int -> Gen BS.ByteString+gen_bytes n = BS.pack <$> vectorOf n arbitrary++gen_var_bytes :: Int -> Gen BS.ByteString+gen_var_bytes m = choose (0, m) >>= gen_bytes++gen_chain_hash :: Gen ChainHash+gen_chain_hash = gen_bytes 32 `suchThatMap` BOLT1.chain_hash++gen_signature :: Gen Signature+gen_signature = gen_bytes 64 `suchThatMap` BOLT1.signature++gen_point :: Gen Point+gen_point = do+  h <- elements [0x02, 0x03]+  b <- gen_bytes 32+  pure (BS.cons h b) `suchThatMap` BOLT1.point++gen_scid :: Gen ShortChannelId+gen_scid = ShortChannelId <$> arbitrary++gen_msat :: Gen BOLT1.MilliSatoshi+gen_msat = choose (0, 0x1d24b2dfac520000) `suchThatMap` BOLT1.milli_satoshi++gen_features :: Gen BOLT9.FeatureVector+gen_features = BOLT9.parse <$> gen_var_bytes 8++-- TLV records of distinct odd types at or above the given minimum+gen_tlvs :: Word64 -> Gen TlvStream+gen_tlvs lo = do+  n <- choose (0, 3)+  ts <- vectorOf n (choose (lo `div` 2, 40000))+  rs <- traverse (\t -> TlvRecord (2 * t + 1) <$> gen_var_bytes 10) ts+  pure rs `suchThatMap` BOLT1.tlv_stream++gen_address :: Gen Address+gen_address = oneof+  [ AddrIPv4 <$> (gen_bytes 4 `suchThatMap` ipv4_addr) <*> arbitrary+  , AddrIPv6 <$> (gen_bytes 16 `suchThatMap` ipv6_addr) <*> arbitrary+  , AddrTorV2 <$> (gen_bytes 12 `suchThatMap` tor_v2_addr)+  , AddrTorV3 <$> (gen_bytes 35 `suchThatMap` tor_v3_addr) <*> arbitrary+  , AddrDNS <$> (gen_var_bytes 40 `suchThatMap` hostname) <*> arbitrary+  ]++gen_unknown_addresses :: Gen BS.ByteString+gen_unknown_addresses = oneof+  [ pure BS.empty+  , BS.cons <$> elements (0 : [6 .. 255]) <*> gen_var_bytes 10+  ]++gen_channel_announcement :: Gen ChannelAnnouncement+gen_channel_announcement = ChannelAnnouncement+  <$> gen_signature <*> gen_signature <*> gen_signature <*> gen_signature+  <*> gen_features <*> gen_chain_hash <*> gen_scid+  <*> gen_point <*> gen_point <*> gen_point <*> gen_point+  <*> gen_tlvs 0++gen_node_announcement :: Gen NodeAnnouncement+gen_node_announcement = NodeAnnouncement+  <$> gen_signature <*> gen_features <*> arbitrary <*> gen_point+  <*> (RgbColor <$> arbitrary <*> arbitrary <*> arbitrary)+  <*> (gen_bytes 32 `suchThatMap` alias)+  <*> listOf gen_address <*> gen_unknown_addresses <*> gen_tlvs 0++gen_channel_update :: Gen ChannelUpdate+gen_channel_update = ChannelUpdate+  <$> gen_signature <*> gen_chain_hash <*> gen_scid <*> arbitrary+  <*> (MessageFlags <$> arbitrary) <*> (ChannelFlags <$> arbitrary)+  <*> arbitrary <*> gen_msat <*> arbitrary <*> arbitrary <*> gen_msat+  <*> gen_tlvs 0++-- a list of short channel ids and, maybe, one entry for each+gen_scids_with :: Gen a -> Gen ([ShortChannelId], Maybe [a])+gen_scids_with g = do+  ss <- listOf gen_scid+  xs <- oneof [pure Nothing, Just <$> vectorOf (length ss) g]+  pure (ss, xs)++gen_message :: Gen Message+gen_message = oneof+  [ MsgChannelAnnouncement <$> gen_channel_announcement+  , MsgNodeAnnouncement <$> gen_node_announcement+  , MsgChannelUpdate <$> gen_channel_update+  , MsgAnnouncementSignatures <$> (AnnouncementSignatures+      <$> (gen_bytes 32 `suchThatMap` BOLT1.channel_id) <*> gen_scid+      <*> gen_signature <*> gen_signature <*> gen_tlvs 0)+  , MsgQueryShortChannelIds <$> do+      (ss, fs) <- gen_scids_with (QueryFlags <$> arbitrary)+      QueryShortChannelIds <$> gen_chain_hash <*> pure ss <*> pure fs+        <*> gen_tlvs 3+  , MsgReplyShortChannelIdsEnd <$> (ReplyShortChannelIdsEnd+      <$> gen_chain_hash <*> arbitrary <*> gen_tlvs 0)+  , MsgQueryChannelRange <$> (QueryChannelRange+      <$> gen_chain_hash <*> arbitrary <*> arbitrary+      <*> oneof [pure Nothing, Just . QueryOption <$> arbitrary]+      <*> gen_tlvs 3)+  , MsgReplyChannelRange <$> do+      (ss, ts) <- gen_scids_with+        (ChannelUpdateTimestamps <$> arbitrary <*> arbitrary)+      cs <- oneof [pure Nothing, Just <$> vectorOf (length ss)+        (ChannelUpdateChecksums <$> arbitrary <*> arbitrary)]+      ReplyChannelRange <$> gen_chain_hash <*> arbitrary <*> arbitrary+        <*> arbitrary <*> pure ss <*> pure ts <*> pure cs <*> gen_tlvs 5+  , MsgGossipTimestampFilter <$> (GossipTimestampFilter+      <$> gen_chain_hash <*> arbitrary <*> arbitrary <*> gen_tlvs 0)+  ]

@@ -0,0 +1,376 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module: Vectors+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Test vectors: real mainnet gossip, and the extended gossip query+-- vectors of BOLT #7 (bolt07/extended-queries.json). Hex strings.++module Vectors (+    AnnVector(..)+  , UpdateVector(..)+  , mainnet_announcements+  , mainnet_updates+  , node_announcement_vector+  , query_vectors+  ) where++import qualified Data.ByteString as BS+import Data.Word (Word32)++-- mainnet gossip -------------------------------------------------------------++-- Real mainnet channel_announcements and channel_updates, as captured+-- from a peer. Payloads exclude the 2-byte message type. The digests+-- (double SHA-256 of the signed bytes) and CRC-32C checksums were+-- computed independently of this library.++-- | A channel_announcement payload and its signature digest.+data AnnVector = AnnVector+  { av_payload :: !BS.ByteString  -- ^ hex+  , av_digest  :: !BS.ByteString  -- ^ hex+  }++-- | A channel_update payload, its signature digest and checksum, and+--   the index of its channel's announcement in 'mainnet_announcements'.+data UpdateVector = UpdateVector+  { uv_payload  :: !BS.ByteString  -- ^ hex+  , uv_digest   :: !BS.ByteString  -- ^ hex+  , uv_checksum :: !Word32+  , uv_ann      :: !Int+  }++mainnet_announcements :: [AnnVector]+mainnet_announcements = [+    -- 850052x2992x1+    AnnVector (mconcat+        [ "3c256c270126d2c52ab5464fa959d627e9baec8c76bd2b81d34b47c4efb03290"+        , "40126ea7a0f8d31420976dc28ff684dc63f62620fa10dbac4fe3d417ca5690c1"+        , "b7fe1de61f5dd2b8368886d6c98f625c9110198e57c14fac93d4eff34e19ce5f"+        , "5dc6fef4501e8105c8f9b82d6d0b348f5840864445b071ae7a741b5eb92d2ec0"+        , "ab85681e4e1e85144bbbd8757c14cee92468d2c5ac84345cb28931b6fed5e339"+        , "00ed9dd363db630f31248cfa933a3667cbf87bb78a48a442e81c652686355365"+        , "ff33164c7588f0a753d50c4d52dd4a81c611fa47b4e950dfc9e3379a12ef7834"+        , "781c0900b90f56a5a49893446d03c8d283c3c093e3c8c682ff6cb40d70d9eebc"+        , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"+        , "00000cf884000bb0000102bb5e47ee26aca1654ce092d9d06eac15d953210c73"+        , "7f2220e2d7e54c4f108677030b828fd1e42549fbc2f1d0960ec3663362c41777"+        , "d3d87fe1b8e1d4bf063abcaa02bc3f260955062a4f427704edef1864c76d6777"+        , "fe81bed43a5f6297dda1c7ca9203523e164f4f9fbdea978c6570d56b13ca8338"+        , "430e6794ff74cf6aa0dbda71dd2d"+        ])+      "3dc0e5a431551c44f2afd49cda2d3bf2a5f1b9cc86ef93db8953c17dd1ef4ded"+    -- 850013x1067x1+  , AnnVector (mconcat+        [ "f37bf5c2f2c11c79541fe16c2a5d63b8795d583ba72f8f1ec9160bbe02a7101d"+        , "519aa61c125737f82a67be9a586da3e04f941907d9a9c59dd77dd2ae965df2cd"+        , "f3e247f3f0227ef24baa2ede50f1844e12db674ac4ea53644d701521951ab3c5"+        , "49eb93a75d6984cb5ca7a5872f0a27f6aa3608a5dfe4468e3f941af8c86425d3"+        , "4c1ac5663d72b2934d74b20a2f364f3cd09c6528d47e09f9be99be54b1338b0e"+        , "6bf9ee1bad5bf92cc95de7b0d268d92e9c671f2cfe51a0f5edbf93bf7ee9232e"+        , "20e7d157eefa4b3615e176f61cad5543584188c9d890209f192c0118f162c77f"+        , "4259dc4c6aec293913bd59211a9a876cad93d7f7961e027de731e48171688ddb"+        , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"+        , "00000cf85d00042b00010322d0e43b3d92d30ed187f4e101a9a9605c3ee5fc97"+        , "21e6dac3ce3d7732fbb13e037f990e61acee8a7697966afd29dd88f3b1f8a7b1"+        , "4d625c4f8742bd952003a59003359448149bdca64024ab6c2243ab555f9313aa"+        , "49ee1da0b1dd0ce1c575b2cca202dfb90cceb72720dd3d3ea168e53ed64d506e"+        , "4c277fde46946843ee8eab54ab3b"+        ])+      "f753e841682abc578fd12650fe47dac6094ab7882d47026bd3b6055e9060e993"+    -- 850043x3419x1+  , AnnVector (mconcat+        [ "0269559b5385e499d1ec6283c2ec0a0a5b93d45f6cce2d5f69709a9fd3382722"+        , "063a230e7c0fca1b198ed81fc36658c259f70475074f336c7d146d7cb4042de2"+        , "74162681acf44507e98656d6311fc2a8a85ef7bebd34fde195c244623704b8bf"+        , "77d8e2965bdbc7ae483d8d2e2ef41cee147ada06440c1501af0a502f54f8d060"+        , "3ed003cb101583b0986c54994f985e88b730f80a600706b6ac1de2b8030e3961"+        , "388ad7d4a6d7b0d2718374f52ef4b4ab7f7523ba839d922f362613a283615328"+        , "54b9165b22d4f86be8f7503f0149b36db4bbba3496bcb6fb989c558bea04c2d0"+        , "1e6fbddfbec938a1c9fdd841339b7f5ecc40e33cc1df7da7b76da52f72078e7d"+        , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"+        , "00000cf87b000d5b0001020b831768ded7615eef25b34639c14b912496137ff5"+        , "218ad3277d0efd57a32e0902bb5e47ee26aca1654ce092d9d06eac15d953210c"+        , "737f2220e2d7e54c4f10867703a9be624c84cde9e7452b108942cb7c3c642a1c"+        , "37ab6468b031c605bb103cb5ab038ace825c070bc5af8d326b534ef6ab38ec04"+        , "adbbfa859b00369cc86fbacc3e38"+        ])+      "473c18a52a826efc39367a38a98d9226511289f7e33c38906faeecf890ecdf0f"+    -- 850292x3675x0+  , AnnVector (mconcat+        [ "76d849642499e76439884821fe95628a274e059a77a5cad5039836d40a63cc52"+        , "04aa8748f7a284eaf0e22450d37b51feb293391ae2460ce328826af35ab9da8e"+        , "e052bd9578c74e5a0180294141d66f8f78ec2928456db4eab4062f31c1666bd9"+        , "30a220d211b8a438f9ad9c9169e3bd197ab1452b784f91f22529d4144fc19c28"+        , "c0a83de0ec63b53e71f119b37983f687ee947521b8c9d044917fbb8a0e9a8c2a"+        , "26ac05a821fdf1bac3a764ab9f08c293ed0b01e6dad17ad4da991b403cdfe576"+        , "d49813544db805ae2afbe85572915e4145df0dc55cfd15396bd6f4abbbc9a052"+        , "4e8577ed60f5d058706ca9e3fb970d54b707c598e258727b8da2df2a168f4f42"+        , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"+        , "00000cf974000e5b0000020cd843f3128386ac5551647496d57aeb0b5259611d"+        , "7ebb9314cae7711565354803bd743abf0f94b6d208d1c3c47aa8e958d6ddd8aa"+        , "4e8c910c6e1d6b8dd7413a93024c95a299224252655af8a9a8d07da1313b8efc"+        , "1dda8964d652ccb81ac5253e0d039404ec864e4efc233af1c781c872048493bc"+        , "df6d284746293cf5f2b2790af0de"+        ])+      "d0f087817bde3d17c5c6f9eb5a9d7c0d14f2498d0c58ebfbd4e8bccfa536ff05"+    -- 853240x888x2+  , AnnVector (mconcat+        [ "f4e2a166440900d15e319812df9c5ffeab61e15f417febb18c1fc07dcc701700"+        , "3fecf1c075d39f4e134e5061a00de59161378f6855cefa71687f710678cc4c27"+        , "e010bc600453f7ac4b84c5f5243dc2b6447af512110c1ef11173a1498a71bc6f"+        , "535607ccf9f64e87ea9641413bd3ad2ec7d96d711f5de0106bf23fd172215f18"+        , "fd12d34bffebe0d64900e944b4fd7ad81f26adb5ed4ea0099ef3c53e09034178"+        , "693af5a55308d341e8af0dddd19eed46438174cdc2e9c65f9ff14844c4d991c4"+        , "37f97805f017d56205f387b24f22d620ea474ba6f837ae114cef015022d55841"+        , "2eca08400137adc856e80254b61783a77941f9550a0d008ef567c0acfa8e9155"+        , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"+        , "00000d04f8000378000202ad898fce14604311ebe871e1053fa248a25e683803"+        , "a8e599f168fba79bad5f5202c2ecfd7e7646f7a249491c565737b5c9f83863c2"+        , "3b88e752f2d624e026f5fde702519af7e8fa7c6c47858108d1ab7eb9b531a594"+        , "34314c804174ccb0bb658d0f5e03562b849da8a6e3f17d1585f53011eabeb53d"+        , "b6eb23066af87bb81e8adbd0eb1a"+        ])+      "cd04212b8a16a7367adb8314e37698b50ad54a9c901d21586fdd1420fba78431"+    -- 855691x1739x0+  , AnnVector (mconcat+        [ "2bd9078e1b73e459703af26014f26f43426961f70e0f289545559bcc5f75cd74"+        , "5dc4beba17a15301df594267c92fd9e563d75982cc406e095162bdd931107d84"+        , "e98528d5322f18e203805b372049a2eb32aadd3a26ad2fa733a06279635e8dca"+        , "4d778a9c4a1ae260ae581562bd5e57298db70e48308ee2ba8c8bdb91db062e21"+        , "41e5a4396bdc112449c9d2f572f88c1fa610620825ac3fa6bb04a1bfd6cc34a4"+        , "5fb5a00ec08371146305eb845d2ea98b4f60c8bff4e5e589315c34c6af95863e"+        , "6c01bdbd7c589bc448b4f0805e9756b2dcfcd5812df8b507cbf2ae488d6519a3"+        , "12841bcf0f3707f1934b00f845cbe05b67d085d1a4367c8820659285e8760952"+        , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"+        , "00000d0e8b0006cb000002439112f98b6f4828e1a7426bfbece166bd36837d7d"+        , "ea4225a75ebd1d96864a070324ba2392e25bff76abd0b1f7e4b53b5f82aa53fd"+        , "dc3419b051b6c801db9e2247039adc288b1728f289ca4ac30e4b258a19f776c2"+        , "0e3190f259d759cd672c5f943803e45a0234b0649ba3d599e10df0339a36c140"+        , "652b5efa18b7c17fadfd5b754888"+        ])+      "0092fb593a97482cd7a0dc9ed4954e90eb1ca0700ca55f7a0183674a5faf27ea"+  ]++mainnet_updates :: [UpdateVector]+mainnet_updates = [+    -- 850052x2992x1, 148 bytes, channel_flags 0+    UpdateVector (mconcat+        [ "1c3f0859cb3f4494919c3dcc80d22bbf1e25e378bd95f071530833c2371c33d7"+        , "0766012ebef1cd79b299a54d0d29bea2ef6feca1d6cfa188864c95d7eea7e9a4"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0cf884000bb000016a0a1c760100006400000000000003e80000000000001388"+        , "00000000b1069a80fdd9030800000000ffffffed"+        ])+      "b1989933c26561ab2cdcc49b471aee5f6e0403a5eb7b88a908cb19cfee0556b9"+      0xf0a89fda 0+    -- 850052x2992x1, 136 bytes, channel_flags 3+  , UpdateVector (mconcat+        [ "261e3d1f1b77b4a606c20dbe5b395e35703adc82fd9320b88e892f51547b93e9"+        , "060f793d8cfd93d2063060a692c31749d0eb3dd351f3e4bbc562d00f89472a42"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0cf884000bb0000169e321d20103005000000000000003e8000003e800000320"+        , "00000000b1069a80"+        ])+      "5c9960b6fef9fa0d53073895420159e856c7c5f33fdeb694b163a832efe6b8e3"+      0x1da953bd 0+    -- 850013x1067x1, 136 bytes, channel_flags 1+  , UpdateVector (mconcat+        [ "7619128817aadc3c4da18103c468f8c0869f03394e815a7386a81bf74eabb76f"+        , "357c67e0353b25b173bb67a57185db0d39b8bc3736538e58376ccd184cadf539"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0cf85d00042b000169e334b80101005000000000000003e8000003e800000001"+        , "00000022ce4c6080"+        ])+      "b3d7e24cfbf4d578e3d8ded39d2885fec322c57355e7a513879c72665014e094"+      0xb28659fc 1+    -- 850043x3419x1, 136 bytes, channel_flags 0+  , UpdateVector (mconcat+        [ "f0b2facf82a20cb2c33b12337fd54f4553decff2abc86c20fb7059b890d2f16f"+        , "11d604798b3829ba0367c1898ea21fbb0d50570e70812119ecc069ecde21785a"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0cf87b000d5b000169e3810f0100006400000000000f424000000000000000c3"+        , "000000001d8119c0"+        ])+      "1b2702991ef2d85cc3dffdc390a3a597f3651d00803e6e08581fd8140694ddf4"+      0x036645d4 2+    -- 850043x3419x1, 148 bytes, channel_flags 1+  , UpdateVector (mconcat+        [ "c93858ef07309fe98c1690521634ad3a55c715500cdf4d31eef8d6f412613c0a"+        , "491df28ec2e7c4a5288a5bf2848d18486d9cf4eeb3f41befeaedf1e121416438"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0cf87b000d5b000169e3810f0101006400000000000003e80000000000001388"+        , "000000009ae5c730fdd9030800000000fffffa95"+        ])+      "6deeb53e1859601e9b2b859dccace2dd9f85dc6d0605d6d7a966329d2633df1c"+      0x878e5ea4 2+    -- 850052x2992x1, 148 bytes, channel_flags 2+  , UpdateVector (mconcat+        [ "3bf18f613f864d7b9907c98915cf4cbec8d4ac5245f5c66ca3d93571074d8c4f"+        , "3cbc7963377020145f9645ead56f462537384e43cba27ac4b73d9e734275fe6a"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0cf884000bb0000169e3478f0102006400000000000003e80000000000001066"+        , "00000000b1069a80fdd9030800000000fffffab8"+        ])+      "3af8a43926c24d2707cecf621fb7906cc1feb4c6880b0fde3de19bb5da7e5649"+      0x5ba7913c 0+    -- 850292x3675x0, 136 bytes, channel_flags 2+  , UpdateVector (mconcat+        [ "ee28b4d0ce3abded3c43d5d990a40020b255df072cc76a9fdfd8482aed0c81c1"+        , "02e7e124dcd74acaaf5cf0773cbd10a828b721925cb54f7569cca335f6a9237c"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0cf974000e5b000069e37c460102002800000000000003e8000003e800000001"+        , "0000000076046700"+        ])+      "43949a9fa1993b3375b7fc2e3a35e35ceb28766907f3d738fa8f46b9ba02474f"+      0x9d4f0032 3+    -- 853240x888x2, 148 bytes, channel_flags 3+  , UpdateVector (mconcat+        [ "c5cfd6f873caf8ad9207f10db0b618bbf4db86e31b64ad6d0d2aca0a14de8899"+        , "261b3b94e7eff8317f77c3fee62941e660361dd3ed4213a94a7bb13fee71dcc8"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0d04f8000378000269e32992010300900000000000005208000000000000017a"+        , "000000001dcd6500fdd903080000000000000000"+        ])+      "a6d2ea4523ee28ad1f117ac2cffbb6bf29aa5cc6f7f58d2dc058a999563c9560"+      0x172a10e7 4+    -- 855691x1739x0, 136 bytes, channel_flags 0+  , UpdateVector (mconcat+        [ "0f325a044bff29a14636b22023d2a44abf939e34b776020907627b4c72488ed9"+        , "70b357c059e7a110611bb2093d9fffdd00028a84fc08aea155a57d4b79434410"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0d0e8b0006cb000069e046c70100004800000000000003e80000000000000147"+        , "0000000000000000"+        ])+      "d00785fd5793d86401fb54de019d4094fbff37416d9f611a55fc8fe9a5f536c4"+      0x368d3c11 5+    -- 850013x1067x1, 148 bytes, channel_flags 0+  , UpdateVector (mconcat+        [ "2faeaef5708bde4ce33a2145bca38544d9d3c4431c6e10210f6fab36c37306f2"+        , "53ab90c2d5ec3710c6f481dab4735e398fa83eec94b2d5a9bd41df26a92bce7b"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0cf85d00042b000169e33b320100009000000000000003e8000000000000109a"+        , "00000022ce4c6080fdd903080000000000000000"+        ])+      "1acb192f08b4dfb70359cebc337e6ed2cc985b74e70dacc9ecdc1bd957a56923"+      0xf4948aaf 1+    -- 850292x3675x0, 136 bytes, channel_flags 1+  , UpdateVector (mconcat+        [ "6bbb96e7af06e5a35815d7bfc1777ee680cb7d2f728855cc8373baf469e1d375"+        , "3aa3f7023a796ead27e8fc37e9509358c6e8c2e9ee6a71db5c8dc9c044a3395c"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0cf974000e5b000069e37c840101005000000000000003e80000000000000064"+        , "0000000076046700"+        ])+      "cf3744188962bb9ab7a9847f9b21624c488ec250e780c728c1f9d0032d2ff3a2"+      0xe7e9397e 3+    -- 853240x888x2, 136 bytes, channel_flags 0+  , UpdateVector (mconcat+        [ "49ac69d15fbdb35e1022bbe10d4c319fcc981c488e8120a6c6630caa81d96326"+        , "335ac4948bbaa6bd24811550700c98fcb6af26f00f173d94fa1f060962e8d829"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0d04f8000378000269dea9690100005000000000000003e8000003e8000003e7"+        , "00000000ec08ce00"+        ])+      "14e2befbe15ea11b5094628ce2ceb1e22a325ed7a7fc03300641e0d7785e32f1"+      0xe265c205 4+    -- 855691x1739x0, 136 bytes, channel_flags 1+  , UpdateVector (mconcat+        [ "337910ec557c3c04ad42130175e9c783179bb6e0627b36e96b5c635795e4f500"+        , "2f11d94319a52c930fd166643709f1b97c096c64cbf412f620f53158c45054eb"+        , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"+        , "0d0e8b0006cb000069e2cb460101005000000000000003e8000000000000000a"+        , "000000012a05f200"+        ])+      "bc08450188a2eb2f1e4fa964a5f11d458a06ce4a00010f86980fbb68c7d8f033"+      0x822c67ea 5+  ]++-- node_announcement ----------------------------------------------------------++-- | A node_announcement payload signed with the secret key 0x4242..42,+--   and its signature digest (computed independently of this library).+--   It carries one descriptor of each known type, a descriptor of the+--   unknown type 6, and an extension record of type 101.+node_announcement_vector :: (BS.ByteString, BS.ByteString)+node_announcement_vector = (mconcat+    [ "edbd2df19aee2f072d9665e2d9a2807fbcd4be6876f6863955ea11870e411e66"+    , "063a31dcef14f1983524f87e108ee556b3a6646c873cd4bbcc07512c8f5e8f6a"+    , "000908000000000002aaa26553f1000324653eac434488002cc06bbfb7f10fe1"+    , "8991e35f9fe4302dbea6d2353dc0ab1c314159707061642d626f6c7437000000"+    , "000000000000000000000000000000000000000063017f000001260702000000"+    , "00000000000000000000000001260703aaaaaaaaaaaaaaaaaaaaaaaa04bbbbbb"+    , "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"+    , "2607050e6c6e2e6578616d706c652e636f6d2607060102036503657874"+    ]+  , "c81748f1075dce2da919ce8a52fe59fec409aa10208b8ffc227f5292af5f0abf")++-- extended gossip queries ----------------------------------------------------++-- | The vectors of bolt07/extended-queries.json, in order: messages with+--   their 2-byte type, in hex.+query_vectors :: [BS.ByteString]+query_vectors = [+    -- 0: QueryChannelRange+    mconcat+      [ "01070f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"+      , "2206000186a0000005dc"+      ]+    -- 1: QueryChannelRange+  , mconcat+      [ "01070f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"+      , "2206000088b800000064010103"+      ]+    -- 2: ReplyChannelRange, UNCOMPRESSED+  , mconcat+      [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"+      , "2206000b8a06000005dc01001900000000000000008e0000000000003c690000"+      , "00000045a6c4"+      ]+    -- 3: ReplyChannelRange, COMPRESSED_ZLIB+  , mconcat+      [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"+      , "2206000006400000006e01001601789c636000833e08659309a65878be010010"+      , "a9023a"+      ]+    -- 4: ReplyChannelRange, UNCOMPRESSED+  , mconcat+      [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"+      , "22060001ddde000005dc01001900000000000000304300000000000778d60000"+      , "00000046e1c1011900000282c1000e77c5000778ad00490ab00000b57800955b"+      , "ff031800000457000008ae00000d050000115c000015b300001a0a"+      ]+    -- 5: ReplyChannelRange, COMPRESSED_ZLIB+  , mconcat+      [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"+      , "22060001ddde000005dc01001801789c63600001036730c55e710d4cbb3d3c08"+      , "0017c303b1012201789c63606a3ac8c0577e9481bd622d8327d7060686ad150c"+      , "53a3ff0300554707db031800000457000008ae00000d050000115c000015b300"+      , "001a0a"+      ]+    -- 6: QueryShortChannelIds, UNCOMPRESSED+  , mconcat+      [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"+      , "2206001900000000000000008e0000000000003c69000000000045a6c4"+      ]+    -- 7: QueryShortChannelIds, COMPRESSED_ZLIB+  , mconcat+      [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"+      , "2206001801789c63600001c12b608a69e73e30edbaec0800203b040e"+      ]+    -- 8: QueryShortChannelIds, UNCOMPRESSED+  , mconcat+      [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"+      , "22060019000000000000002fc80000000000003cc4000000000045a6c4010c01"+      , "789c6364620100000e0008"+      ]+    -- 9: QueryShortChannelIds, COMPRESSED_ZLIB+  , mconcat+      [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"+      , "2206001801789c63600001f30a30c5b0cd144cb92e3b020017c6034a010c0178"+      , "9c6364620100000e0008"+      ]+  ]