diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,361 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Main +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- 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 + ] + ] diff --git a/bench/Weight.hs b/bench/Weight.hs new file mode 100644 --- /dev/null +++ b/bench/Weight.hs @@ -0,0 +1,359 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Main +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- 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 diff --git a/lib/Lightning/Protocol/BOLT7.hs b/lib/Lightning/Protocol/BOLT7.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT7.hs @@ -0,0 +1,154 @@ +{-# OPTIONS_HADDOCK prune #-} + +-- | +-- Module: Lightning.Protocol.BOLT7 +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- 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 diff --git a/lib/Lightning/Protocol/BOLT7/CRC32C.hs b/lib/Lightning/Protocol/BOLT7/CRC32C.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT7/CRC32C.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE BangPatterns #-} + +-- | +-- Module: Lightning.Protocol.BOLT7.CRC32C +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- 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 #-} diff --git a/lib/Lightning/Protocol/BOLT7/Codec.hs b/lib/Lightning/Protocol/BOLT7/Codec.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT7/Codec.hs @@ -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 +-- +-- 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 #-} diff --git a/lib/Lightning/Protocol/BOLT7/Hash.hs b/lib/Lightning/Protocol/BOLT7/Hash.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT7/Hash.hs @@ -0,0 +1,106 @@ +{-# OPTIONS_HADDOCK prune #-} + +{-# LANGUAGE BangPatterns #-} + +-- | +-- Module: Lightning.Protocol.BOLT7.Hash +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- 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 #-} diff --git a/lib/Lightning/Protocol/BOLT7/Messages.hs b/lib/Lightning/Protocol/BOLT7/Messages.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT7/Messages.hs @@ -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 +-- +-- 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 diff --git a/lib/Lightning/Protocol/BOLT7/Types.hs b/lib/Lightning/Protocol/BOLT7/Types.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT7/Types.hs @@ -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 +-- +-- 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 diff --git a/lib/Lightning/Protocol/BOLT7/Validate.hs b/lib/Lightning/Protocol/BOLT7/Validate.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT7/Validate.hs @@ -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 +-- +-- 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. diff --git a/ppad-bolt7.cabal b/ppad-bolt7.cabal new file mode 100644 --- /dev/null +++ b/ppad-bolt7.cabal @@ -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 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -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