packages feed

ppad-bolt7 (empty) → 0.0.1

raw patch · 13 files changed

+3320/−0 lines, 13 filesdep +basedep +bytestringdep +criterion

Dependencies added: base, bytestring, criterion, deepseq, ppad-base16, ppad-bolt1, ppad-bolt7, ppad-sha256, tasty, tasty-hunit, tasty-quickcheck, weigh

Files

+ CHANGELOG view
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2025 Jared Tobin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ bench/Main.hs view
@@ -0,0 +1,361 @@+{-# 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.++module Main where++import Criterion.Main+import qualified Data.ByteString as BS+import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)+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 ------------------------------------------------------------++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+      ]+  , bgroup "gossip_timestamp_filter"+      [ bench "encode" $+          nf encodeGossipTimestampFilter testGossipTimestampFilter+      , bench "decode" $+          nf decodeGossipTimestampFilter encodedGossipTimestampFilter+      ]+  , bgroup "scid_list"+      [ bench "encode (100)" $ nf encodeShortChannelIdList testScidList+      , bench "decode (100)" $ nf decodeShortChannelIdList encodedScidList+      ]+  , bgroup "hash"+      [ bench "channelAnnouncementHash" $+          nf channelAnnouncementHash encodedChannelAnnouncement+      , bench "nodeAnnouncementHash" $+          nf nodeAnnouncementHash encodedNodeAnnouncement+      , bench "channelUpdateHash" $+          nf channelUpdateHash encodedChannelUpdate+      , bench "channelUpdateChecksum" $+          nf channelUpdateChecksum encodedChannelUpdate+      ]+  , 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+      ]+  ]
+ bench/Weight.hs view
@@ -0,0 +1,359 @@+{-# 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.++module Main where++import qualified Data.ByteString as BS+import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)+import Lightning.Protocol.BOLT7+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
+ lib/Lightning/Protocol/BOLT7.hs view
@@ -0,0 +1,154 @@+{-# OPTIONS_HADDOCK prune #-}++-- |+-- Module: Lightning.Protocol.BOLT7+-- Copyright: (c) 2025 Jared Tobin+-- 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)+-- @+--+-- = Protocol overview+--+-- BOLT #7 defines gossip messages for routing in the Lightning Network.+-- Nodes use these messages to build a view of the channel graph.++module Lightning.Protocol.BOLT7 (+  -- * Core types+  -- | Re-exported from "Lightning.Protocol.BOLT7.Types".+    module Lightning.Protocol.BOLT7.Types++  -- * Message types+  -- | Re-exported from "Lightning.Protocol.BOLT7.Messages".+  , module Lightning.Protocol.BOLT7.Messages++  -- * Codec functions+  -- | Re-exported from "Lightning.Protocol.BOLT7.Codec".+  , module Lightning.Protocol.BOLT7.Codec++  -- * Hash functions+  -- | Re-exported from "Lightning.Protocol.BOLT7.Hash".+  , module Lightning.Protocol.BOLT7.Hash++  -- * Validation functions+  -- | Re-exported from "Lightning.Protocol.BOLT7.Validate".+  , module Lightning.Protocol.BOLT7.Validate++  -- $messagetypes++  -- ** Channel announcement+  -- $announcement++  -- ** Node announcement+  -- $nodeannouncement++  -- ** Channel updates+  -- $updates++  -- ** Gossip queries+  -- $queries+  ) where++import Lightning.Protocol.BOLT7.Codec+import Lightning.Protocol.BOLT7.Hash+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
+ lib/Lightning/Protocol/BOLT7/CRC32C.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE BangPatterns #-}++-- |+-- Module: Lightning.Protocol.BOLT7.CRC32C+-- Copyright: (c) 2025 Jared Tobin+-- 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.++module Lightning.Protocol.BOLT7.CRC32C (+    crc32c+  ) where++import Data.Bits (shiftR, xor, (.&.))+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+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+{-# 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'+  where+    go :: Int -> Word32 -> 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 #-}
+ lib/Lightning/Protocol/BOLT7/Codec.hs view
@@ -0,0 +1,626 @@+{-# 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 #-}
+ lib/Lightning/Protocol/BOLT7/Hash.hs view
@@ -0,0 +1,106 @@+{-# OPTIONS_HADDOCK prune #-}++{-# LANGUAGE BangPatterns #-}++-- |+-- Module: Lightning.Protocol.BOLT7.Hash+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Signature hash computation 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).++module Lightning.Protocol.BOLT7.Hash (+  -- * Signature hashes+    channelAnnouncementHash+  , nodeAnnouncementHash+  , channelUpdateHash++  -- * Checksums+  , channelUpdateChecksum+  ) where++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Word (Word32)+import qualified Crypto.Hash.SHA256 as SHA256+import Lightning.Protocol.BOLT7.CRC32C (crc32c)+import Lightning.Protocol.BOLT7.Types (signatureLen, chainHashLen)++-- | Double SHA-256 hash (used for Lightning message signing).+doubleSha256 :: ByteString -> ByteString+doubleSha256 = SHA256.hash . SHA256.hash+{-# INLINE doubleSha256 #-}++-- | 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 #-}++-- | 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 #-}++-- | 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 #-}++-- | Compute checksum for channel_update.+--+-- This is the CRC-32C of the channel_update message excluding the+-- signature field (bytes 0-63) and timestamp field (bytes 96-99).+--+-- The checksum is used in the checksums_tlv of reply_channel_range.+--+-- 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 #-}
+ lib/Lightning/Protocol/BOLT7/Messages.hs view
@@ -0,0 +1,236 @@+{-# OPTIONS_HADDOCK prune #-}++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}++-- |+-- Module: Lightning.Protocol.BOLT7.Messages+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- BOLT #7 gossip message type definitions.++module Lightning.Protocol.BOLT7.Messages (+  -- * Message types+    MsgType(..)+  , msgTypeCode++  -- * Channel announcement+  , 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 GHC.Generics (Generic)+import Lightning.Protocol.BOLT1 (TlvStream)+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.+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)++instance NFData ChannelAnnouncement++-- Node announcement -----------------------------------------------------------++-- | node_announcement message (type 257).+--+-- Advertises node metadata to the network.+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)++instance NFData NodeAnnouncement++-- Channel update --------------------------------------------------------------++-- | channel_update message (type 258).+--+-- Communicates per-direction routing parameters.+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)++instance NFData ChannelUpdate++-- Announcement signatures -----------------------------------------------------++-- | announcement_signatures message (type 259).+--+-- Sent between channel peers to enable channel announcement.+data AnnouncementSignatures = AnnouncementSignatures+  { annSigChannelId     :: !ChannelId       -- ^ Channel ID+  , annSigShortChanId   :: !ShortChannelId  -- ^ Short channel ID+  , annSigNodeSig       :: !Signature       -- ^ Node signature+  , annSigBitcoinSig    :: !Signature       -- ^ Bitcoin signature+  }+  deriving (Eq, Show, Generic)++instance NFData AnnouncementSignatures++-- Query messages --------------------------------------------------------------++-- | query_short_channel_ids message (type 261).+--+-- Requests information about specific channels.+data QueryShortChannelIds = QueryShortChannelIds+  { queryScidsChainHash :: !ChainHash    -- ^ Chain identifier+  , queryScidsData      :: !ByteString   -- ^ Encoded short_channel_ids+  , queryScidsTlvs      :: !TlvStream    -- ^ Optional TLV (query_flags)+  }+  deriving (Eq, Show, Generic)++instance NFData QueryShortChannelIds++-- | reply_short_channel_ids_end message (type 262).+--+-- Concludes response to query_short_channel_ids.+data ReplyShortChannelIdsEnd = ReplyShortChannelIdsEnd+  { replyScidsChainHash    :: !ChainHash  -- ^ Chain identifier+  , replyScidsFullInfo     :: !Word8      -- ^ 1 if complete, 0 otherwise+  }+  deriving (Eq, Show, Generic)++instance NFData ReplyShortChannelIdsEnd++-- | query_channel_range message (type 263).+--+-- Queries channels within a block range.+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)++instance NFData QueryChannelRange++-- | reply_channel_range message (type 264).+--+-- Responds to query_channel_range with channel IDs.+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)++instance NFData ReplyChannelRange++-- | gossip_timestamp_filter message (type 265).+--+-- Constrains which gossip messages are relayed.+data GossipTimestampFilter = GossipTimestampFilter+  { gossipFilterChainHash     :: !ChainHash  -- ^ Chain identifier+  , gossipFilterFirstTimestamp :: !Word32    -- ^ First timestamp+  , gossipFilterTimestampRange :: !Word32    -- ^ Timestamp range+  }+  deriving (Eq, Show, Generic)++instance NFData GossipTimestampFilter++-- Union type ------------------------------------------------------------------++-- | Union of all BOLT #7 message types.+data Message+  = MsgChanAnn !ChannelAnnouncement+  | MsgNodeAnn !NodeAnnouncement+  | MsgChanUpd !ChannelUpdate+  | MsgAnnSig  !AnnouncementSignatures+  | MsgQueryScids !QueryShortChannelIds+  | MsgReplyScids !ReplyShortChannelIdsEnd+  | MsgQueryRange !QueryChannelRange+  | MsgReplyRange !ReplyChannelRange+  | MsgGossipFilter !GossipTimestampFilter+  deriving (Eq, Show, Generic)++instance NFData Message
+ lib/Lightning/Protocol/BOLT7/Types.hs view
@@ -0,0 +1,492 @@+{-# OPTIONS_HADDOCK prune #-}++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}++-- |+-- Module: Lightning.Protocol.BOLT7.Types+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Core types for BOLT #7 routing gossip.++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++  -- * Channel update flags+  , MessageFlags(..)+  , encodeMessageFlags+  , decodeMessageFlags+  , ChannelFlags(..)+  , encodeChannelFlags+  , decodeChannelFlags++  -- * Routing parameters+  , CltvExpiryDelta(..)+  , FeeBaseMsat(..)+  , FeeProportionalMillionths(..)+  , HtlcMinimumMsat(..)+  , HtlcMaximumMsat(..)++  -- * Constants+  , chainHashLen+  , shortChannelIdLen+  , channelIdLen+  , signatureLen+  , pointLen+  , nodeIdLen+  , rgbColorLen+  , aliasLen+  , ipv4AddrLen+  , ipv6AddrLen+  , torV3AddrLen+  ) where++import Control.DeepSeq (NFData)+import Data.Bits (shiftL, shiftR, (.&.), (.|.))+import Data.ByteString (ByteString)+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 #-}++-- | Length of IPv6 address (16 bytes).+ipv6AddrLen :: Int+ipv6AddrLen = 16+{-# INLINE ipv6AddrLen #-}++-- | Length of Tor v3 address (35 bytes).+torV3AddrLen :: Int+torV3AddrLen = 35+{-# INLINE torV3AddrLen #-}++-- Identifiers -----------------------------------------------------------------++-- | Chain hash identifying the blockchain (32 bytes).+newtype ChainHash = ChainHash { getChainHash :: ByteString }+  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 ShortChannelId++-- | 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 #-}++-- | Construct ShortChannelId from components.+--+-- Block height and tx index are truncated to 24 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 #-}++-- | Format short channel ID as human-readable string.+--+-- Uses the standard "block x tx x output" notation.+--+-- >>> 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 #-}++-- Cryptographic types ---------------------------------------------------------++-- | Signature (64 bytes).+newtype Signature = Signature { getSignature :: ByteString }+  deriving (Eq, Show, Generic)++instance NFData Signature++-- | 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 #-}++-- | Compressed public key (33 bytes).+newtype Point = Point { getPoint :: ByteString }+  deriving (Eq, Show, Generic)++instance NFData Point++-- | 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 #-}++-- | Node ID (33 bytes, same as compressed public key).+--+-- 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)++instance NFData NodeId++-- | 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 #-}++-- Node metadata ---------------------------------------------------------------++-- | RGB color (3 bytes).+newtype RgbColor = RgbColor { getRgbColor :: ByteString }+  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 }+  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+{-# INLINE alias #-}++-- | Timestamp (Unix epoch seconds).+type Timestamp = Word32++-- | Feature bits (variable length).+newtype FeatureBits = FeatureBits { getFeatureBits :: ByteString }+  deriving (Eq, Show, Generic)++instance NFData FeatureBits++-- | Smart constructor for FeatureBits (any length).+featureBits :: ByteString -> FeatureBits+featureBits = FeatureBits+{-# INLINE featureBits #-}++-- Address types ---------------------------------------------------------------++-- | IPv4 address (4 bytes).+newtype IPv4Addr = IPv4Addr { getIPv4Addr :: ByteString }+  deriving (Eq, Show, Generic)++instance NFData IPv4Addr++-- | 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 #-}++-- | IPv6 address (16 bytes).+newtype IPv6Addr = IPv6Addr { getIPv6Addr :: ByteString }+  deriving (Eq, Show, Generic)++instance NFData IPv6Addr++-- | 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 #-}++-- | Tor v3 onion address (35 bytes: 32 pubkey + 2 checksum + 1 version).+newtype TorV3Addr = TorV3Addr { getTorV3Addr :: 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 #-}++-- | 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+  deriving (Eq, Show, Generic)++instance NFData Address++-- Channel update flags --------------------------------------------------------++-- | Message flags for channel_update.+--+-- Bit 0: htlc_maximum_msat field is present.+data MessageFlags = MessageFlags+  { mfHtlcMaxPresent :: !Bool  -- ^ htlc_maximum_msat is present+  }+  deriving (Eq, Show, Generic)++instance NFData MessageFlags++-- | Encode MessageFlags to Word8.+encodeMessageFlags :: MessageFlags -> Word8+encodeMessageFlags mf = if mfHtlcMaxPresent mf then 0x01 else 0x00+{-# INLINE encodeMessageFlags #-}++-- | Decode Word8 to MessageFlags.+decodeMessageFlags :: Word8 -> MessageFlags+decodeMessageFlags w = MessageFlags { mfHtlcMaxPresent = w .&. 0x01 /= 0 }+{-# INLINE decodeMessageFlags #-}++-- | 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+  }+  deriving (Eq, Show, Generic)++instance NFData ChannelFlags++-- | 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 #-}++-- | Decode Word8 to ChannelFlags.+decodeChannelFlags :: Word8 -> ChannelFlags+decodeChannelFlags w = ChannelFlags+  { cfDirection = w .&. 0x01 /= 0+  , cfDisabled  = w .&. 0x02 /= 0+  }+{-# INLINE decodeChannelFlags #-}++-- Routing parameters ----------------------------------------------------------++-- | CLTV expiry delta.+newtype CltvExpiryDelta = CltvExpiryDelta { getCltvExpiryDelta :: Word16 }+  deriving (Eq, Ord, Show, Generic)++instance NFData CltvExpiryDelta++-- | Base fee in millisatoshis.+newtype FeeBaseMsat = FeeBaseMsat { getFeeBaseMsat :: Word32 }+  deriving (Eq, Ord, Show, Generic)++instance NFData FeeBaseMsat++-- | Proportional fee in millionths.+newtype FeeProportionalMillionths = FeeProportionalMillionths+  { getFeeProportionalMillionths :: Word32 }+  deriving (Eq, Ord, Show, Generic)++instance NFData FeeProportionalMillionths++-- | Minimum HTLC value in millisatoshis.+newtype HtlcMinimumMsat = HtlcMinimumMsat { getHtlcMinimumMsat :: Word64 }+  deriving (Eq, Ord, Show, Generic)++instance NFData HtlcMinimumMsat++-- | Maximum HTLC value in millisatoshis.+newtype HtlcMaximumMsat = HtlcMaximumMsat { getHtlcMaximumMsat :: Word64 }+  deriving (Eq, Ord, Show, Generic)++instance NFData HtlcMaximumMsat
+ lib/Lightning/Protocol/BOLT7/Validate.hs view
@@ -0,0 +1,141 @@+{-# OPTIONS_HADDOCK prune #-}++{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}++-- |+-- Module: Lightning.Protocol.BOLT7.Validate+-- Copyright: (c) 2025 Jared Tobin+-- 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.++module Lightning.Protocol.BOLT7.Validate (+  -- * Error types+    ValidationError(..)++  -- * Validation functions+  , validateChannelAnnouncement+  , validateNodeAnnouncement+  , validateChannelUpdate+  , validateQueryChannelRange+  , validateReplyChannelRange+  ) where++import Control.DeepSeq (NFData)+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)+import Lightning.Protocol.BOLT7.Codec (decodeShortChannelIdList)+import Lightning.Protocol.BOLT7.Messages+import Lightning.Protocol.BOLT7.Types++-- | Validation errors.+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+  deriving (Eq, Show, Generic)++instance NFData ValidationError++-- | Validate channel_announcement message.+--+-- Checks:+--+-- * 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)++-- | Validate node_announcement message.+--+-- Checks:+--+-- * Feature bits do not contain unknown even bits+--+-- 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)++-- | 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 ()++-- | 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 ()++-- | 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+  where+    checkAscending [] = Right ()+    checkAscending [_] = Right ()+    checkAscending (a:b:rest)+      | getShortChannelId a < getShortChannelId b = checkAscending (b:rest)+      | otherwise = Left ValidateScidNotAscending++-- Internal helpers -----------------------------------------------------------++-- | 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.
+ ppad-bolt7.cabal view
@@ -0,0 +1,92 @@+cabal-version:      3.0+name:               ppad-bolt7+version:            0.0.1+synopsis:           Routing gossip per BOLT #7+license:            MIT+license-file:       LICENSE+author:             Jared Tobin+maintainer:         jared@ppad.tech+category:           Cryptography+build-type:         Simple+tested-with:        GHC == 9.10.3+extra-doc-files:    CHANGELOG+description:+  Routing gossip protocol, per+  [BOLT #7](https://github.com/lightning/bolts/blob/master/07-routing-gossip.md).++source-repository head+  type:     git+  location: git.ppad.tech/bolt7.git++library+  default-language: Haskell2010+  hs-source-dirs:   lib+  ghc-options:+      -Wall+  exposed-modules:+      Lightning.Protocol.BOLT7+      Lightning.Protocol.BOLT7.Codec+      Lightning.Protocol.BOLT7.CRC32C+      Lightning.Protocol.BOLT7.Hash+      Lightning.Protocol.BOLT7.Messages+      Lightning.Protocol.BOLT7.Types+      Lightning.Protocol.BOLT7.Validate+  build-depends:+      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++test-suite bolt7-tests+  type:                exitcode-stdio-1.0+  default-language:    Haskell2010+  hs-source-dirs:      test+  main-is:             Main.hs++  ghc-options:+    -rtsopts -Wall -O2++  build-depends:+      base+    , bytestring+    , ppad-base16+    , ppad-bolt1 >= 0.0.1 && < 0.1+    , ppad-bolt7+    , tasty+    , tasty-hunit+    , tasty-quickcheck++benchmark bolt7-bench+  type:                exitcode-stdio-1.0+  default-language:    Haskell2010+  hs-source-dirs:      bench+  main-is:             Main.hs++  ghc-options:+    -rtsopts -O2 -Wall -fno-warn-orphans++  build-depends:+      base+    , bytestring+    , criterion+    , deepseq+    , ppad-bolt1 >= 0.0.1 && < 0.1+    , ppad-bolt7++benchmark bolt7-weigh+  type:                exitcode-stdio-1.0+  default-language:    Haskell2010+  hs-source-dirs:      bench+  main-is:             Weight.hs++  ghc-options:+    -rtsopts -O2 -Wall -fno-warn-orphans++  build-depends:+      base+    , bytestring+    , deepseq+    , ppad-bolt1 >= 0.0.1 && < 0.1+    , ppad-bolt7+    , weigh
+ test/Main.hs view
@@ -0,0 +1,684 @@+{-# LANGUAGE OverloadedStrings #-}++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