diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -0,0 +1,38 @@ +# Changelog + +- 0.1.0 (2026-10-10) + * A substantial rewrite, with breaking changes throughout: + + * The API is exported from Lightning.Protocol.BOLT7 alone, and uses + snake_case names (e.g. decode_channel_update, cu_timestamp). + + * Fundamental types come from ppad-bolt1 0.1 (Point, ShortChannelId, + MilliSatoshi, TLV streams) and feature vectors from ppad-bolt9. + The local NodeId, FeatureBits, routing-parameter newtypes, + mainnetChainHash and length constants are gone. + + * Decoders take a whole payload and keep every byte: unassigned + flag bits, unknown address descriptors and extension TLV records. + Encoding a decoded message reproduces it, so its signatures still + verify. channel_update models message_flags (must_be_one, + dont_forward) and channel_flags (direction, disable). + + * Query messages have typed short channel id lists, query_flags, + query_option, timestamps and checksums. + + * Signature digests and checksums take typed messages. Adds + signature verification (via ppad-secp256k1), a message + dispatcher, and usable_addresses for the receiver's address + rules. + + * Fixes: htlc_maximum_msat is mandatory; node_announcement accepts + unknown and deprecated address descriptors; malformed query TLV + streams, unknown even TLV types and the deprecated zlib encoding are + rejected; u16 length prefixes no longer wrap; validation no longer + accepts undecodable data or claims to check feature bits. + + * Tests cover the BOLT #7 extended-queries vectors and real mainnet + gossip, with signature checks. + +- 0.0.1 (2026-04-18) + * Initial release. diff --git a/bench/Fixtures.hs b/bench/Fixtures.hs new file mode 100644 --- /dev/null +++ b/bench/Fixtures.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Fixtures +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- Benchmark inputs: real mainnet gossip, a signed node_announcement, and +-- large gossip query replies. + +module Fixtures ( + Fixtures(..) + , fixtures + ) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import qualified Lightning.Protocol.BOLT1 as BOLT1 +import Lightning.Protocol.BOLT7 + +data Fixtures = Fixtures + { f_ann_bytes :: !BS.ByteString + , f_ann :: !ChannelAnnouncement + , f_upd_bytes :: !BS.ByteString + , f_upd :: !ChannelUpdate + , f_upd_key :: !BOLT1.Point + , f_node_bytes :: !BS.ByteString + , f_node :: !NodeAnnouncement + , f_qsci_bytes :: !BS.ByteString + , f_qsci :: !QueryShortChannelIds + , f_rcr_bytes :: !BS.ByteString + , f_rcr :: !ReplyChannelRange + } + +-- | The fixtures, or 'Nothing' if one fails to build. +fixtures :: Maybe Fixtures +fixtures = do + ann_bytes <- B16.decode ann_hex + ann <- right (decode_channel_announcement ann_bytes) + upd_bytes <- B16.decode upd_hex + upd <- right (decode_channel_update upd_bytes) + node_bytes <- B16.decode node_hex + node <- right (decode_node_announcement node_bytes) + ch <- BOLT1.chain_hash (BS.replicate 32 0x6f) + let ids = [ BOLT1.ShortChannelId (0x0cf88400000000 + 0x10000 * i) + | i <- [1 .. 1000] ] + qsci = QueryShortChannelIds ch ids + (Just (map (\i -> QueryFlags (i `mod` 32)) [1 .. 1000])) + BOLT1.empty_tlv_stream + rcr = ReplyChannelRange ch 850000 10000 True ids + (Just [ ChannelUpdateTimestamps (1776493010 + i) (1776493020 + i) + | i <- [1 .. 1000] ]) + (Just [ ChannelUpdateChecksums (0x1da953bd + i) (0xf0a89fda + i) + | i <- [1 .. 1000] ]) + BOLT1.empty_tlv_stream + qsci_bytes <- right (encode_query_short_channel_ids qsci) + rcr_bytes <- right (encode_reply_channel_range rcr) + pure Fixtures + { f_ann_bytes = ann_bytes + , f_ann = ann + , f_upd_bytes = upd_bytes + , f_upd = upd + , f_upd_key = ca_node_id_1 ann + , f_node_bytes = node_bytes + , f_node = node + , f_qsci_bytes = qsci_bytes + , f_qsci = qsci + , f_rcr_bytes = rcr_bytes + , f_rcr = rcr + } + where + right :: Either e a -> Maybe a + right = either (const Nothing) Just + +-- channel_announcement for 850052x2992x1 +ann_hex :: BS.ByteString +ann_hex = mconcat + [ "3c256c270126d2c52ab5464fa959d627e9baec8c76bd2b81d34b47c4efb03290" + , "40126ea7a0f8d31420976dc28ff684dc63f62620fa10dbac4fe3d417ca5690c1" + , "b7fe1de61f5dd2b8368886d6c98f625c9110198e57c14fac93d4eff34e19ce5f" + , "5dc6fef4501e8105c8f9b82d6d0b348f5840864445b071ae7a741b5eb92d2ec0" + , "ab85681e4e1e85144bbbd8757c14cee92468d2c5ac84345cb28931b6fed5e339" + , "00ed9dd363db630f31248cfa933a3667cbf87bb78a48a442e81c652686355365" + , "ff33164c7588f0a753d50c4d52dd4a81c611fa47b4e950dfc9e3379a12ef7834" + , "781c0900b90f56a5a49893446d03c8d283c3c093e3c8c682ff6cb40d70d9eebc" + , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000" + , "00000cf884000bb0000102bb5e47ee26aca1654ce092d9d06eac15d953210c73" + , "7f2220e2d7e54c4f108677030b828fd1e42549fbc2f1d0960ec3663362c41777" + , "d3d87fe1b8e1d4bf063abcaa02bc3f260955062a4f427704edef1864c76d6777" + , "fe81bed43a5f6297dda1c7ca9203523e164f4f9fbdea978c6570d56b13ca8338" + , "430e6794ff74cf6aa0dbda71dd2d" + ] + +-- a channel_update for it from node_id_1, with an inbound-fee extension +upd_hex :: BS.ByteString +upd_hex = mconcat + [ "1c3f0859cb3f4494919c3dcc80d22bbf1e25e378bd95f071530833c2371c33d7" + , "0766012ebef1cd79b299a54d0d29bea2ef6feca1d6cfa188864c95d7eea7e9a4" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0cf884000bb000016a0a1c760100006400000000000003e80000000000001388" + , "00000000b1069a80fdd9030800000000ffffffed" + ] + +-- a node_announcement with one address descriptor of each type +node_hex :: BS.ByteString +node_hex = mconcat + [ "edbd2df19aee2f072d9665e2d9a2807fbcd4be6876f6863955ea11870e411e66" + , "063a31dcef14f1983524f87e108ee556b3a6646c873cd4bbcc07512c8f5e8f6a" + , "000908000000000002aaa26553f1000324653eac434488002cc06bbfb7f10fe1" + , "8991e35f9fe4302dbea6d2353dc0ab1c314159707061642d626f6c7437000000" + , "000000000000000000000000000000000000000063017f000001260702000000" + , "00000000000000000000000001260703aaaaaaaaaaaaaaaaaaaaaaaa04bbbbbb" + , "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" + , "2607050e6c6e2e6578616d706c652e636f6d2607060102036503657874" + ] diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,361 +1,62 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} - -- | -- Module: Main -- Copyright: (c) 2025 Jared Tobin -- License: MIT -- Maintainer: Jared Tobin -- --- Criterion timing benchmarks for BOLT #7 gossip codecs. +-- Criterion timing benchmarks for ppad-bolt7. module Main where import Criterion.Main -import qualified Data.ByteString as BS -import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream) +import Fixtures import Lightning.Protocol.BOLT7 - --- Test data construction ------------------------------------------------------ - --- | 32 zero bytes for chain hashes, etc. -zeroBytes32 :: BS.ByteString -zeroBytes32 = BS.replicate 32 0x00 -{-# NOINLINE zeroBytes32 #-} - --- | 8 zero bytes for short channel IDs. -zeroBytes8 :: BS.ByteString -zeroBytes8 = BS.replicate 8 0x00 -{-# NOINLINE zeroBytes8 #-} - --- | 64-byte signature. -testSignature :: Signature -testSignature = case signature (BS.replicate 64 0x01) of - Just s -> s - Nothing -> error "testSignature: invalid" -{-# NOINLINE testSignature #-} - --- | 33-byte compressed public key (02 prefix + 32 zero bytes). -testPoint :: Point -testPoint = case point (BS.cons 0x02 zeroBytes32) of - Just p -> p - Nothing -> error "testPoint: invalid" -{-# NOINLINE testPoint #-} - --- | 32-byte chain hash. -testChainHash :: ChainHash -testChainHash = case chainHash zeroBytes32 of - Just h -> h - Nothing -> error "testChainHash: invalid" -{-# NOINLINE testChainHash #-} - --- | 8-byte short channel ID. -testShortChannelId :: ShortChannelId -testShortChannelId = case shortChannelId zeroBytes8 of - Just s -> s - Nothing -> error "testShortChannelId: invalid" -{-# NOINLINE testShortChannelId #-} - --- | 32-byte channel ID. -testChannelId :: ChannelId -testChannelId = case channelId zeroBytes32 of - Just c -> c - Nothing -> error "testChannelId: invalid" -{-# NOINLINE testChannelId #-} - --- | 33-byte node ID (03 prefix). -testNodeId :: NodeId -testNodeId = case nodeId (BS.cons 0x03 zeroBytes32) of - Just n -> n - Nothing -> error "testNodeId: invalid" -{-# NOINLINE testNodeId #-} - --- | Second node ID (02 prefix, lexicographically smaller). -testNodeId2 :: NodeId -testNodeId2 = case nodeId (BS.cons 0x02 zeroBytes32) of - Just n -> n - Nothing -> error "testNodeId2: invalid" -{-# NOINLINE testNodeId2 #-} - --- | RGB color. -testRgbColor :: RgbColor -testRgbColor = case rgbColor (BS.pack [0xff, 0x00, 0x00]) of - Just c -> c - Nothing -> error "testRgbColor: invalid" -{-# NOINLINE testRgbColor #-} - --- | 32-byte alias. -testAlias :: Alias -testAlias = case alias zeroBytes32 of - Just a -> a - Nothing -> error "testAlias: invalid" -{-# NOINLINE testAlias #-} - --- | IPv4 address. -testIPv4 :: IPv4Addr -testIPv4 = case ipv4Addr (BS.pack [127, 0, 0, 1]) of - Just a -> a - Nothing -> error "testIPv4: invalid" -{-# NOINLINE testIPv4 #-} - --- | Empty TLV stream. -emptyTlvs :: TlvStream -emptyTlvs = unsafeTlvStream [] -{-# NOINLINE emptyTlvs #-} - --- | Empty feature bits. -emptyFeatures :: FeatureBits -emptyFeatures = featureBits BS.empty -{-# NOINLINE emptyFeatures #-} - --- | List of test SCIDs for list encoding benchmarks. -testScidList :: [ShortChannelId] -testScidList = map mkScid [1..100] - where - mkScid n = case shortChannelId (BS.pack [0, 0, 0, n, 0, 0, 0, n]) of - Just s -> s - Nothing -> error "mkScid: invalid" -{-# NOINLINE testScidList #-} - --- | Encoded SCID list for decode benchmarks. -encodedScidList :: BS.ByteString -encodedScidList = encodeShortChannelIdList testScidList -{-# NOINLINE encodedScidList #-} - --- Test messages --------------------------------------------------------------- - --- | Test ChannelAnnouncement message. -testChannelAnnouncement :: ChannelAnnouncement -testChannelAnnouncement = ChannelAnnouncement - { channelAnnNodeSig1 = testSignature - , channelAnnNodeSig2 = testSignature - , channelAnnBitcoinSig1 = testSignature - , channelAnnBitcoinSig2 = testSignature - , channelAnnFeatures = emptyFeatures - , channelAnnChainHash = testChainHash - , channelAnnShortChanId = testShortChannelId - , channelAnnNodeId1 = testNodeId2 -- 02... (smaller) - , channelAnnNodeId2 = testNodeId -- 03... (larger) - , channelAnnBitcoinKey1 = testPoint - , channelAnnBitcoinKey2 = testPoint - } -{-# NOINLINE testChannelAnnouncement #-} - --- | Encoded ChannelAnnouncement for decode benchmarks. -encodedChannelAnnouncement :: BS.ByteString -encodedChannelAnnouncement = encodeChannelAnnouncement testChannelAnnouncement -{-# NOINLINE encodedChannelAnnouncement #-} - --- | Test NodeAnnouncement message. -testNodeAnnouncement :: NodeAnnouncement -testNodeAnnouncement = NodeAnnouncement - { nodeAnnSignature = testSignature - , nodeAnnFeatures = emptyFeatures - , nodeAnnTimestamp = 1234567890 - , nodeAnnNodeId = testNodeId - , nodeAnnRgbColor = testRgbColor - , nodeAnnAlias = testAlias - , nodeAnnAddresses = [AddrIPv4 testIPv4 9735] - } -{-# NOINLINE testNodeAnnouncement #-} - --- | Encoded NodeAnnouncement for decode benchmarks. -encodedNodeAnnouncement :: BS.ByteString -encodedNodeAnnouncement = case encodeNodeAnnouncement testNodeAnnouncement of - Right bs -> bs - Left _ -> error "encodedNodeAnnouncement: encode failed" -{-# NOINLINE encodedNodeAnnouncement #-} - --- | Test ChannelUpdate message. -testChannelUpdate :: ChannelUpdate -testChannelUpdate = ChannelUpdate - { chanUpdateSignature = testSignature - , chanUpdateChainHash = testChainHash - , chanUpdateShortChanId = testShortChannelId - , chanUpdateTimestamp = 1234567890 - , chanUpdateMsgFlags = 0x01 - , chanUpdateChanFlags = 0x00 - , chanUpdateCltvExpDelta = 144 - , chanUpdateHtlcMinMsat = 1000 - , chanUpdateFeeBaseMsat = 1000 - , chanUpdateFeeProportional = 100 - , chanUpdateHtlcMaxMsat = Just 1000000000 - } -{-# NOINLINE testChannelUpdate #-} - --- | Encoded ChannelUpdate for decode benchmarks. -encodedChannelUpdate :: BS.ByteString -encodedChannelUpdate = encodeChannelUpdate testChannelUpdate -{-# NOINLINE encodedChannelUpdate #-} - --- | Test AnnouncementSignatures message. -testAnnouncementSignatures :: AnnouncementSignatures -testAnnouncementSignatures = AnnouncementSignatures - { annSigChannelId = testChannelId - , annSigShortChanId = testShortChannelId - , annSigNodeSig = testSignature - , annSigBitcoinSig = testSignature - } -{-# NOINLINE testAnnouncementSignatures #-} - --- | Encoded AnnouncementSignatures for decode benchmarks. -encodedAnnouncementSignatures :: BS.ByteString -encodedAnnouncementSignatures = - encodeAnnouncementSignatures testAnnouncementSignatures -{-# NOINLINE encodedAnnouncementSignatures #-} - --- | Test QueryShortChannelIds message. -testQueryShortChannelIds :: QueryShortChannelIds -testQueryShortChannelIds = QueryShortChannelIds - { queryScidsChainHash = testChainHash - , queryScidsData = encodeShortChannelIdList [testShortChannelId] - , queryScidsTlvs = emptyTlvs - } -{-# NOINLINE testQueryShortChannelIds #-} - --- | Encoded QueryShortChannelIds for decode benchmarks. -encodedQueryShortChannelIds :: BS.ByteString -encodedQueryShortChannelIds = - case encodeQueryShortChannelIds testQueryShortChannelIds of - Right bs -> bs - Left _ -> error "encodedQueryShortChannelIds: encode failed" -{-# NOINLINE encodedQueryShortChannelIds #-} - --- | Test ReplyShortChannelIdsEnd message. -testReplyShortChannelIdsEnd :: ReplyShortChannelIdsEnd -testReplyShortChannelIdsEnd = ReplyShortChannelIdsEnd - { replyScidsChainHash = testChainHash - , replyScidsFullInfo = 1 - } -{-# NOINLINE testReplyShortChannelIdsEnd #-} - --- | Encoded ReplyShortChannelIdsEnd for decode benchmarks. -encodedReplyShortChannelIdsEnd :: BS.ByteString -encodedReplyShortChannelIdsEnd = - encodeReplyShortChannelIdsEnd testReplyShortChannelIdsEnd -{-# NOINLINE encodedReplyShortChannelIdsEnd #-} - --- | Test QueryChannelRange message. -testQueryChannelRange :: QueryChannelRange -testQueryChannelRange = QueryChannelRange - { queryRangeChainHash = testChainHash - , queryRangeFirstBlock = 700000 - , queryRangeNumBlocks = 10000 - , queryRangeTlvs = emptyTlvs - } -{-# NOINLINE testQueryChannelRange #-} - --- | Encoded QueryChannelRange for decode benchmarks. -encodedQueryChannelRange :: BS.ByteString -encodedQueryChannelRange = encodeQueryChannelRange testQueryChannelRange -{-# NOINLINE encodedQueryChannelRange #-} - --- | Test ReplyChannelRange message. -testReplyChannelRange :: ReplyChannelRange -testReplyChannelRange = ReplyChannelRange - { replyRangeChainHash = testChainHash - , replyRangeFirstBlock = 700000 - , replyRangeNumBlocks = 10000 - , replyRangeSyncComplete = 1 - , replyRangeData = encodeShortChannelIdList [testShortChannelId] - , replyRangeTlvs = emptyTlvs - } -{-# NOINLINE testReplyChannelRange #-} - --- | Encoded ReplyChannelRange for decode benchmarks. -encodedReplyChannelRange :: BS.ByteString -encodedReplyChannelRange = case encodeReplyChannelRange testReplyChannelRange of - Right bs -> bs - Left _ -> error "encodedReplyChannelRange: encode failed" -{-# NOINLINE encodedReplyChannelRange #-} - --- | Test GossipTimestampFilter message. -testGossipTimestampFilter :: GossipTimestampFilter -testGossipTimestampFilter = GossipTimestampFilter - { gossipFilterChainHash = testChainHash - , gossipFilterFirstTimestamp = 1609459200 - , gossipFilterTimestampRange = 86400 - } -{-# NOINLINE testGossipTimestampFilter #-} - --- | Encoded GossipTimestampFilter for decode benchmarks. -encodedGossipTimestampFilter :: BS.ByteString -encodedGossipTimestampFilter = - encodeGossipTimestampFilter testGossipTimestampFilter -{-# NOINLINE encodedGossipTimestampFilter #-} - --- Benchmark groups ------------------------------------------------------------ +import System.Exit (exitFailure) main :: IO () -main = defaultMain - [ bgroup "channel_announcement" - [ bench "encode" $ nf encodeChannelAnnouncement testChannelAnnouncement - , bench "decode" $ nf decodeChannelAnnouncement encodedChannelAnnouncement - ] - , bgroup "node_announcement" - [ bench "encode" $ nf encodeNodeAnnouncement testNodeAnnouncement - , bench "decode" $ nf decodeNodeAnnouncement encodedNodeAnnouncement - ] - , bgroup "channel_update" - [ bench "encode" $ nf encodeChannelUpdate testChannelUpdate - , bench "decode" $ nf decodeChannelUpdate encodedChannelUpdate - ] - , bgroup "announcement_signatures" - [ bench "encode" $ - nf encodeAnnouncementSignatures testAnnouncementSignatures - , bench "decode" $ - nf decodeAnnouncementSignatures encodedAnnouncementSignatures - ] - , bgroup "query_short_channel_ids" - [ bench "encode" $ - nf encodeQueryShortChannelIds testQueryShortChannelIds - , bench "decode" $ - nf decodeQueryShortChannelIds encodedQueryShortChannelIds - ] - , bgroup "reply_short_channel_ids_end" - [ bench "encode" $ - nf encodeReplyShortChannelIdsEnd testReplyShortChannelIdsEnd - , bench "decode" $ - nf decodeReplyShortChannelIdsEnd encodedReplyShortChannelIdsEnd - ] - , bgroup "query_channel_range" - [ bench "encode" $ nf encodeQueryChannelRange testQueryChannelRange - , bench "decode" $ nf decodeQueryChannelRange encodedQueryChannelRange - ] - , bgroup "reply_channel_range" - [ bench "encode" $ nf encodeReplyChannelRange testReplyChannelRange - , bench "decode" $ nf decodeReplyChannelRange encodedReplyChannelRange +main = case fixtures of + Nothing -> putStrLn "fixtures failed to build" >> exitFailure + Just f -> defaultMain [ + bgroup "decode" [ + bench "channel_announcement" $ + nf decode_channel_announcement (f_ann_bytes f) + , bench "node_announcement" $ + nf decode_node_announcement (f_node_bytes f) + , bench "channel_update" $ nf decode_channel_update (f_upd_bytes f) + , bench "channel_update (decode_message)" $ + nf (decode_message 258) (f_upd_bytes f) + , bench "query_short_channel_ids (1000 ids, flags)" $ + nf decode_query_short_channel_ids (f_qsci_bytes f) + , bench "reply_channel_range (1000 ids, timestamps, checksums)" $ + nf decode_reply_channel_range (f_rcr_bytes f) ] - , bgroup "gossip_timestamp_filter" - [ bench "encode" $ - nf encodeGossipTimestampFilter testGossipTimestampFilter - , bench "decode" $ - nf decodeGossipTimestampFilter encodedGossipTimestampFilter + , bgroup "encode" [ + bench "channel_announcement" $ + nf encode_channel_announcement (f_ann f) + , bench "node_announcement" $ nf encode_node_announcement (f_node f) + , bench "channel_update" $ nf encode_channel_update (f_upd f) + , bench "query_short_channel_ids (1000 ids, flags)" $ + nf encode_query_short_channel_ids (f_qsci f) + , bench "reply_channel_range (1000 ids, timestamps, checksums)" $ + nf encode_reply_channel_range (f_rcr f) ] - , bgroup "scid_list" - [ bench "encode (100)" $ nf encodeShortChannelIdList testScidList - , bench "decode (100)" $ nf decodeShortChannelIdList encodedScidList + , bgroup "hash" [ + bench "channel_announcement_hash" $ + nf channel_announcement_hash (f_ann f) + , bench "channel_update_hash" $ nf channel_update_hash (f_upd f) + , bench "channel_update_checksum" $ + nf channel_update_checksum (f_upd f) ] - , bgroup "hash" - [ bench "channelAnnouncementHash" $ - nf channelAnnouncementHash encodedChannelAnnouncement - , bench "nodeAnnouncementHash" $ - nf nodeAnnouncementHash encodedNodeAnnouncement - , bench "channelUpdateHash" $ - nf channelUpdateHash encodedChannelUpdate - , bench "channelUpdateChecksum" $ - nf channelUpdateChecksum encodedChannelUpdate + , bgroup "verify" [ + bench "verify_channel_announcement" $ + nf verify_channel_announcement (f_ann f) + , bench "verify_node_announcement" $ + nf verify_node_announcement (f_node f) + , bench "verify_channel_update" $ + nf (verify_channel_update (f_upd_key f)) (f_upd f) ] - , bgroup "validate" - [ bench "channelAnnouncement" $ - nf validateChannelAnnouncement testChannelAnnouncement - , bench "nodeAnnouncement" $ - nf validateNodeAnnouncement testNodeAnnouncement - , bench "channelUpdate" $ - nf validateChannelUpdate testChannelUpdate - , bench "queryChannelRange" $ - nf validateQueryChannelRange testQueryChannelRange - , bench "replyChannelRange" $ - nf validateReplyChannelRange testReplyChannelRange + , bgroup "validate" [ + bench "validate_reply_channel_range (1000 ids)" $ + nf validate_reply_channel_range (f_rcr f) ] - ] + ] diff --git a/bench/Weight.hs b/bench/Weight.hs --- a/bench/Weight.hs +++ b/bench/Weight.hs @@ -1,359 +1,44 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} - -- | -- Module: Main -- Copyright: (c) 2025 Jared Tobin -- License: MIT -- Maintainer: Jared Tobin -- --- Weigh allocation benchmarks for BOLT #7 gossip codecs. +-- Weigh allocation benchmarks for ppad-bolt7. module Main where -import qualified Data.ByteString as BS -import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream) +import Fixtures import Lightning.Protocol.BOLT7 +import System.Exit (exitFailure) import Weigh --- Test data construction ------------------------------------------------------ - --- | 32 zero bytes for chain hashes, etc. -zeroBytes32 :: BS.ByteString -zeroBytes32 = BS.replicate 32 0x00 -{-# NOINLINE zeroBytes32 #-} - --- | 8 zero bytes for short channel IDs. -zeroBytes8 :: BS.ByteString -zeroBytes8 = BS.replicate 8 0x00 -{-# NOINLINE zeroBytes8 #-} - --- | 64-byte signature. -testSignature :: Signature -testSignature = case signature (BS.replicate 64 0x01) of - Just s -> s - Nothing -> error "testSignature: invalid" -{-# NOINLINE testSignature #-} - --- | 33-byte compressed public key (02 prefix + 32 zero bytes). -testPoint :: Point -testPoint = case point (BS.cons 0x02 zeroBytes32) of - Just p -> p - Nothing -> error "testPoint: invalid" -{-# NOINLINE testPoint #-} - --- | 32-byte chain hash. -testChainHash :: ChainHash -testChainHash = case chainHash zeroBytes32 of - Just h -> h - Nothing -> error "testChainHash: invalid" -{-# NOINLINE testChainHash #-} - --- | 8-byte short channel ID. -testShortChannelId :: ShortChannelId -testShortChannelId = case shortChannelId zeroBytes8 of - Just s -> s - Nothing -> error "testShortChannelId: invalid" -{-# NOINLINE testShortChannelId #-} - --- | 32-byte channel ID. -testChannelId :: ChannelId -testChannelId = case channelId zeroBytes32 of - Just c -> c - Nothing -> error "testChannelId: invalid" -{-# NOINLINE testChannelId #-} - --- | 33-byte node ID (03 prefix). -testNodeId :: NodeId -testNodeId = case nodeId (BS.cons 0x03 zeroBytes32) of - Just n -> n - Nothing -> error "testNodeId: invalid" -{-# NOINLINE testNodeId #-} - --- | Second node ID (02 prefix, lexicographically smaller). -testNodeId2 :: NodeId -testNodeId2 = case nodeId (BS.cons 0x02 zeroBytes32) of - Just n -> n - Nothing -> error "testNodeId2: invalid" -{-# NOINLINE testNodeId2 #-} - --- | RGB color. -testRgbColor :: RgbColor -testRgbColor = case rgbColor (BS.pack [0xff, 0x00, 0x00]) of - Just c -> c - Nothing -> error "testRgbColor: invalid" -{-# NOINLINE testRgbColor #-} - --- | 32-byte alias. -testAlias :: Alias -testAlias = case alias zeroBytes32 of - Just a -> a - Nothing -> error "testAlias: invalid" -{-# NOINLINE testAlias #-} - --- | IPv4 address. -testIPv4 :: IPv4Addr -testIPv4 = case ipv4Addr (BS.pack [127, 0, 0, 1]) of - Just a -> a - Nothing -> error "testIPv4: invalid" -{-# NOINLINE testIPv4 #-} - --- | Empty feature bits. -emptyFeatures :: FeatureBits -emptyFeatures = featureBits BS.empty -{-# NOINLINE emptyFeatures #-} - --- | Empty TLV stream. -emptyTlvs :: TlvStream -emptyTlvs = unsafeTlvStream [] -{-# NOINLINE emptyTlvs #-} - --- | List of test SCIDs for list encoding benchmarks. -testScidList :: [ShortChannelId] -testScidList = map mkScid [1..100] - where - mkScid n = case shortChannelId (BS.pack [0, 0, 0, n, 0, 0, 0, n]) of - Just s -> s - Nothing -> error "mkScid: invalid" -{-# NOINLINE testScidList #-} - --- | Encoded SCID list for decode benchmarks. -encodedScidList :: BS.ByteString -encodedScidList = encodeShortChannelIdList testScidList -{-# NOINLINE encodedScidList #-} - --- Message constructors -------------------------------------------------------- - --- | Construct ChannelAnnouncement message. -mkChannelAnnouncement - :: Signature -> Signature -> ChainHash -> ShortChannelId - -> NodeId -> NodeId -> Point -> Point -> FeatureBits - -> ChannelAnnouncement -mkChannelAnnouncement !ns1 !ns2 !ch !scid !nid1 !nid2 !bk1 !bk2 !feat = - ChannelAnnouncement - { channelAnnNodeSig1 = ns1 - , channelAnnNodeSig2 = ns2 - , channelAnnBitcoinSig1 = ns1 - , channelAnnBitcoinSig2 = ns2 - , channelAnnFeatures = feat - , channelAnnChainHash = ch - , channelAnnShortChanId = scid - , channelAnnNodeId1 = nid1 - , channelAnnNodeId2 = nid2 - , channelAnnBitcoinKey1 = bk1 - , channelAnnBitcoinKey2 = bk2 - } - --- | Construct NodeAnnouncement message. -mkNodeAnnouncement - :: Signature -> FeatureBits -> NodeId -> RgbColor -> Alias - -> [Address] -> NodeAnnouncement -mkNodeAnnouncement !sig !feat !nid !col !al !addrs = NodeAnnouncement - { nodeAnnSignature = sig - , nodeAnnFeatures = feat - , nodeAnnTimestamp = 1234567890 - , nodeAnnNodeId = nid - , nodeAnnRgbColor = col - , nodeAnnAlias = al - , nodeAnnAddresses = addrs - } - --- | Construct ChannelUpdate message. -mkChannelUpdate :: Signature -> ChainHash -> ShortChannelId -> ChannelUpdate -mkChannelUpdate !sig !ch !scid = ChannelUpdate - { chanUpdateSignature = sig - , chanUpdateChainHash = ch - , chanUpdateShortChanId = scid - , chanUpdateTimestamp = 1234567890 - , chanUpdateMsgFlags = 0x01 - , chanUpdateChanFlags = 0x00 - , chanUpdateCltvExpDelta = 144 - , chanUpdateHtlcMinMsat = 1000 - , chanUpdateFeeBaseMsat = 1000 - , chanUpdateFeeProportional = 100 - , chanUpdateHtlcMaxMsat = Just 1000000000 - } - --- | Construct AnnouncementSignatures message. -mkAnnouncementSignatures - :: ChannelId -> ShortChannelId -> Signature -> AnnouncementSignatures -mkAnnouncementSignatures !cid !scid !sig = AnnouncementSignatures - { annSigChannelId = cid - , annSigShortChanId = scid - , annSigNodeSig = sig - , annSigBitcoinSig = sig - } - --- | Construct GossipTimestampFilter message. -mkGossipTimestampFilter :: ChainHash -> GossipTimestampFilter -mkGossipTimestampFilter !ch = GossipTimestampFilter - { gossipFilterChainHash = ch - , gossipFilterFirstTimestamp = 1609459200 - , gossipFilterTimestampRange = 86400 - } - --- | Construct QueryChannelRange message. -mkQueryChannelRange :: ChainHash -> TlvStream -> QueryChannelRange -mkQueryChannelRange !ch !tlvs = QueryChannelRange - { queryRangeChainHash = ch - , queryRangeFirstBlock = 700000 - , queryRangeNumBlocks = 10000 - , queryRangeTlvs = tlvs - } - --- | Construct ReplyChannelRange message. -mkReplyChannelRange :: ChainHash -> TlvStream -> ReplyChannelRange -mkReplyChannelRange !ch !tlvs = ReplyChannelRange - { replyRangeChainHash = ch - , replyRangeFirstBlock = 700000 - , replyRangeNumBlocks = 10000 - , replyRangeSyncComplete = 1 - , replyRangeData = encodeShortChannelIdList [testShortChannelId] - , replyRangeTlvs = tlvs - } - --- Pre-constructed messages ---------------------------------------------------- - --- | Test ChannelAnnouncement message. -testChannelAnnouncement :: ChannelAnnouncement -testChannelAnnouncement = mkChannelAnnouncement - testSignature testSignature testChainHash testShortChannelId - testNodeId2 testNodeId testPoint testPoint emptyFeatures -{-# NOINLINE testChannelAnnouncement #-} - --- | Encoded ChannelAnnouncement for decode benchmarks. -encodedChannelAnnouncement :: BS.ByteString -encodedChannelAnnouncement = encodeChannelAnnouncement testChannelAnnouncement -{-# NOINLINE encodedChannelAnnouncement #-} - --- | Test NodeAnnouncement message. -testNodeAnnouncement :: NodeAnnouncement -testNodeAnnouncement = mkNodeAnnouncement - testSignature emptyFeatures testNodeId testRgbColor testAlias - [AddrIPv4 testIPv4 9735] -{-# NOINLINE testNodeAnnouncement #-} - --- | Encoded NodeAnnouncement for decode benchmarks. -encodedNodeAnnouncement :: BS.ByteString -encodedNodeAnnouncement = case encodeNodeAnnouncement testNodeAnnouncement of - Right bs -> bs - Left _ -> error "encodedNodeAnnouncement: encode failed" -{-# NOINLINE encodedNodeAnnouncement #-} - --- | Test ChannelUpdate message. -testChannelUpdate :: ChannelUpdate -testChannelUpdate = mkChannelUpdate testSignature testChainHash testShortChannelId -{-# NOINLINE testChannelUpdate #-} - --- | Encoded ChannelUpdate for decode benchmarks. -encodedChannelUpdate :: BS.ByteString -encodedChannelUpdate = encodeChannelUpdate testChannelUpdate -{-# NOINLINE encodedChannelUpdate #-} - --- | Test AnnouncementSignatures message. -testAnnouncementSignatures :: AnnouncementSignatures -testAnnouncementSignatures = - mkAnnouncementSignatures testChannelId testShortChannelId testSignature -{-# NOINLINE testAnnouncementSignatures #-} - --- | Encoded AnnouncementSignatures for decode benchmarks. -encodedAnnouncementSignatures :: BS.ByteString -encodedAnnouncementSignatures = - encodeAnnouncementSignatures testAnnouncementSignatures -{-# NOINLINE encodedAnnouncementSignatures #-} - --- | Test GossipTimestampFilter message. -testGossipTimestampFilter :: GossipTimestampFilter -testGossipTimestampFilter = mkGossipTimestampFilter testChainHash -{-# NOINLINE testGossipTimestampFilter #-} - --- | Encoded GossipTimestampFilter for decode benchmarks. -encodedGossipTimestampFilter :: BS.ByteString -encodedGossipTimestampFilter = - encodeGossipTimestampFilter testGossipTimestampFilter -{-# NOINLINE encodedGossipTimestampFilter #-} - --- | Test QueryChannelRange message. -testQueryChannelRange :: QueryChannelRange -testQueryChannelRange = mkQueryChannelRange testChainHash emptyTlvs -{-# NOINLINE testQueryChannelRange #-} - --- | Encoded QueryChannelRange for decode benchmarks. -encodedQueryChannelRange :: BS.ByteString -encodedQueryChannelRange = encodeQueryChannelRange testQueryChannelRange -{-# NOINLINE encodedQueryChannelRange #-} - --- | Test ReplyChannelRange message. -testReplyChannelRange :: ReplyChannelRange -testReplyChannelRange = mkReplyChannelRange testChainHash emptyTlvs -{-# NOINLINE testReplyChannelRange #-} - --- | Encoded ReplyChannelRange for decode benchmarks. -encodedReplyChannelRange :: BS.ByteString -encodedReplyChannelRange = case encodeReplyChannelRange testReplyChannelRange of - Right bs -> bs - Left _ -> error "encodedReplyChannelRange: encode failed" -{-# NOINLINE encodedReplyChannelRange #-} - --- Weigh benchmarks ------------------------------------------------------------ - main :: IO () -main = mainWith $ do - wgroup "channel_announcement" $ do - func "construct" (mkChannelAnnouncement - testSignature testSignature testChainHash testShortChannelId - testNodeId2 testNodeId testPoint testPoint) emptyFeatures - func "encode" encodeChannelAnnouncement testChannelAnnouncement - func "decode" decodeChannelAnnouncement encodedChannelAnnouncement - - wgroup "node_announcement" $ do - func "construct" (mkNodeAnnouncement - testSignature emptyFeatures testNodeId testRgbColor testAlias) - [AddrIPv4 testIPv4 9735] - func "encode" encodeNodeAnnouncement testNodeAnnouncement - func "decode" decodeNodeAnnouncement encodedNodeAnnouncement - - wgroup "channel_update" $ do - func "construct" (mkChannelUpdate testSignature testChainHash) - testShortChannelId - func "encode" encodeChannelUpdate testChannelUpdate - func "decode" decodeChannelUpdate encodedChannelUpdate - - wgroup "announcement_signatures" $ do - func "construct" (mkAnnouncementSignatures testChannelId testShortChannelId) - testSignature - func "encode" encodeAnnouncementSignatures testAnnouncementSignatures - func "decode" decodeAnnouncementSignatures encodedAnnouncementSignatures - - wgroup "query_channel_range" $ do - func "construct" (mkQueryChannelRange testChainHash) emptyTlvs - func "encode" encodeQueryChannelRange testQueryChannelRange - func "decode" decodeQueryChannelRange encodedQueryChannelRange - - wgroup "reply_channel_range" $ do - func "construct" (mkReplyChannelRange testChainHash) emptyTlvs - func "encode" encodeReplyChannelRange testReplyChannelRange - func "decode" decodeReplyChannelRange encodedReplyChannelRange - - wgroup "gossip_timestamp_filter" $ do - func "construct" mkGossipTimestampFilter testChainHash - func "encode" encodeGossipTimestampFilter testGossipTimestampFilter - func "decode" decodeGossipTimestampFilter encodedGossipTimestampFilter - - wgroup "scid_list" $ do - func "encode (100)" encodeShortChannelIdList testScidList - func "decode (100)" decodeShortChannelIdList encodedScidList - - wgroup "hash" $ do - func "channelAnnouncementHash" channelAnnouncementHash - encodedChannelAnnouncement - func "nodeAnnouncementHash" nodeAnnouncementHash encodedNodeAnnouncement - func "channelUpdateHash" channelUpdateHash encodedChannelUpdate - func "channelUpdateChecksum" channelUpdateChecksum encodedChannelUpdate - - wgroup "validate" $ do - func "channelAnnouncement" validateChannelAnnouncement testChannelAnnouncement - func "nodeAnnouncement" validateNodeAnnouncement testNodeAnnouncement - func "channelUpdate" validateChannelUpdate testChannelUpdate - func "queryChannelRange" validateQueryChannelRange testQueryChannelRange - func "replyChannelRange" validateReplyChannelRange testReplyChannelRange +main = case fixtures of + Nothing -> putStrLn "fixtures failed to build" >> exitFailure + Just f -> mainWith $ do + wgroup "decode" $ do + func "channel_announcement" decode_channel_announcement (f_ann_bytes f) + func "node_announcement" decode_node_announcement (f_node_bytes f) + func "channel_update" decode_channel_update (f_upd_bytes f) + func "query_short_channel_ids (1000 ids, flags)" + decode_query_short_channel_ids (f_qsci_bytes f) + func "reply_channel_range (1000 ids, timestamps, checksums)" + decode_reply_channel_range (f_rcr_bytes f) + wgroup "encode" $ do + func "channel_announcement" encode_channel_announcement (f_ann f) + func "node_announcement" encode_node_announcement (f_node f) + func "channel_update" encode_channel_update (f_upd f) + func "query_short_channel_ids (1000 ids, flags)" + encode_query_short_channel_ids (f_qsci f) + func "reply_channel_range (1000 ids, timestamps, checksums)" + encode_reply_channel_range (f_rcr f) + wgroup "hash" $ do + func "channel_announcement_hash" channel_announcement_hash (f_ann f) + func "channel_update_hash" channel_update_hash (f_upd f) + func "channel_update_checksum" channel_update_checksum (f_upd f) + wgroup "verify" $ do + func "verify_channel_announcement" verify_channel_announcement (f_ann f) + func "verify_node_announcement" verify_node_announcement (f_node f) + func "verify_channel_update" + (verify_channel_update (f_upd_key f)) (f_upd f) diff --git a/lib/Lightning/Protocol/BOLT7.hs b/lib/Lightning/Protocol/BOLT7.hs --- a/lib/Lightning/Protocol/BOLT7.hs +++ b/lib/Lightning/Protocol/BOLT7.hs @@ -6,102 +6,132 @@ -- 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) --- @ +-- Routing gossip for the Lightning Network, per +-- [BOLT #7](https://github.com/lightning/bolts/blob/master/07-routing-gossip.md): +-- the gossip messages and queries, their signature digests and +-- checksums, signature verification, and stateless validation. -- --- = Protocol overview +-- Fundamental types (chain hashes, points, signatures, short channel +-- ids, amounts, TLV streams) come from ppad-bolt1, and feature vectors +-- from ppad-bolt9. -- --- BOLT #7 defines gossip messages for routing in the Lightning Network. --- Nodes use these messages to build a view of the channel graph. +-- Decoders take a message payload, without its 2-byte type, and consume +-- all of it. Every byte is kept, including unassigned flag bits, +-- unknown address descriptors and unknown odd TLV records, so encoding +-- a decoded message reproduces its payload exactly and its signatures +-- still verify. module Lightning.Protocol.BOLT7 ( - -- * Core types - -- | Re-exported from "Lightning.Protocol.BOLT7.Types". - module Lightning.Protocol.BOLT7.Types + -- * Messages + Message(..) + , message_type + , ChannelAnnouncement(..) + , NodeAnnouncement(..) + , ChannelUpdate(..) + , AnnouncementSignatures(..) + , QueryShortChannelIds(..) + , ReplyShortChannelIdsEnd(..) + , QueryChannelRange(..) + , ReplyChannelRange(..) + , GossipTimestampFilter(..) - -- * Message types - -- | Re-exported from "Lightning.Protocol.BOLT7.Messages". - , module Lightning.Protocol.BOLT7.Messages + -- * Encoding and decoding + , encode_message + , decode_message + , EncodeError(..) + , DecodeError(..) - -- * Codec functions - -- | Re-exported from "Lightning.Protocol.BOLT7.Codec". - , module Lightning.Protocol.BOLT7.Codec + -- ** Payloads + , encode_channel_announcement + , decode_channel_announcement + , encode_node_announcement + , decode_node_announcement + , encode_channel_update + , decode_channel_update + , encode_announcement_signatures + , decode_announcement_signatures + , encode_query_short_channel_ids + , decode_query_short_channel_ids + , encode_reply_short_channel_ids_end + , decode_reply_short_channel_ids_end + , encode_query_channel_range + , decode_query_channel_range + , encode_reply_channel_range + , decode_reply_channel_range + , encode_gossip_timestamp_filter + , decode_gossip_timestamp_filter - -- * Hash functions - -- | Re-exported from "Lightning.Protocol.BOLT7.Hash". - , module Lightning.Protocol.BOLT7.Hash + -- * Signatures and checksums + , channel_announcement_hash + , node_announcement_hash + , channel_update_hash + , verify_channel_announcement + , verify_node_announcement + , verify_channel_update + , channel_update_checksum - -- * Validation functions - -- | Re-exported from "Lightning.Protocol.BOLT7.Validate". - , module Lightning.Protocol.BOLT7.Validate + -- * Validation + , ValidationError(..) + , validate_channel_announcement + , validate_node_announcement + , validate_channel_update + , validate_query_short_channel_ids + , validate_query_channel_range + , validate_reply_channel_range - -- $messagetypes + -- * channel_update flags + , MessageFlags(..) + , Forwarding(..) + , message_flags + , message_flags_forwarding + , has_must_be_one + , ChannelFlags(..) + , Direction(..) + , ChannelStatus(..) + , channel_flags + , channel_flags_direction + , channel_flags_status - -- ** Channel announcement - -- $announcement + -- * node_announcement fields + , RgbColor(..) + , Alias + , alias + , un_alias - -- ** Node announcement - -- $nodeannouncement + -- ** Addresses + , Address(..) + , usable_addresses + , IPv4Addr + , ipv4_addr + , un_ipv4_addr + , IPv6Addr + , ipv6_addr + , un_ipv6_addr + , TorV2Addr + , tor_v2_addr + , un_tor_v2_addr + , TorV3Addr + , tor_v3_addr + , un_tor_v3_addr + , Hostname + , hostname + , un_hostname + , is_ascii_hostname - -- ** Channel updates - -- $updates + -- * Query fields + , QueryFlags(..) + , QueryFlag(..) + , query_flags + , has_query_flag + , QueryOption(..) + , QueryOptionFlag(..) + , query_option + , has_query_option + , ChannelUpdateTimestamps(..) + , ChannelUpdateChecksums(..) - -- ** Gossip queries - -- $queries + -- * Short channel ids + , format_short_channel_id ) where import Lightning.Protocol.BOLT7.Codec @@ -109,46 +139,3 @@ import Lightning.Protocol.BOLT7.Messages import Lightning.Protocol.BOLT7.Types import Lightning.Protocol.BOLT7.Validate - --- $messagetypes --- --- BOLT #7 defines the following message types: --- --- * 256: channel_announcement --- * 257: node_announcement --- * 258: channel_update --- * 259: announcement_signatures --- * 261: query_short_channel_ids --- * 262: reply_short_channel_ids_end --- * 263: query_channel_range --- * 264: reply_channel_range --- * 265: gossip_timestamp_filter - --- $announcement --- --- Channel announcement messages: --- --- * channel_announcement (256) - public channel announcement --- * announcement_signatures (259) - signatures enabling announcement - --- $nodeannouncement --- --- Node announcement message: --- --- * node_announcement (257) - advertises node metadata - --- $updates --- --- Channel update message: --- --- * channel_update (258) - per-direction routing parameters - --- $queries --- --- Gossip query messages: --- --- * query_short_channel_ids (261) - request specific channel info --- * reply_short_channel_ids_end (262) - concludes query response --- * query_channel_range (263) - query channels in block range --- * reply_channel_range (264) - response with channel IDs --- * gossip_timestamp_filter (265) - constrain relayed gossip diff --git a/lib/Lightning/Protocol/BOLT7/CRC32C.hs b/lib/Lightning/Protocol/BOLT7/CRC32C.hs --- a/lib/Lightning/Protocol/BOLT7/CRC32C.hs +++ b/lib/Lightning/Protocol/BOLT7/CRC32C.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE BangPatterns #-} -- | @@ -6,44 +7,43 @@ -- 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. +-- CRC-32C (Castagnoli), per RFC 3720, for @channel_update@ checksums. module Lightning.Protocol.BOLT7.CRC32C ( crc32c ) where -import Data.Bits (shiftR, xor, (.&.)) -import Data.ByteString (ByteString) +import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.)) import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BU import Data.Word (Word8, Word32) --- | CRC-32C polynomial (Castagnoli): 0x1EDC6F41 reflected = 0x82F63B78 -crc32cPoly :: Word32 -crc32cPoly = 0x82F63B78 -{-# INLINE crc32cPoly #-} - --- | Compute CRC-32C of a bytestring. --- --- >>> crc32c "123456789" --- 0xe3069283 -crc32c :: ByteString -> Word32 -crc32c = xor 0xFFFFFFFF . BS.foldl' updateByte 0xFFFFFFFF +-- | The CRC-32C of a byte string. +crc32c :: BS.ByteString -> Word32 +crc32c = complement . BS.foldl' step 0xFFFFFFFF + where + step !c !b = (c `shiftR` 8) `xor` entry (fromIntegral c `xor` b) {-# INLINE crc32c #-} --- | Update CRC with a single byte. -updateByte :: Word32 -> Word8 -> Word32 -updateByte !crc !byte = - let crc' = crc `xor` fromIntegral byte - in go 8 crc' +-- the table entry for a byte, read from 'table' +entry :: Word8 -> Word32 +entry i = + let !o = 4 * fromIntegral i -- at most 1020, within the 1024-byte table + byte k = fromIntegral (BU.unsafeIndex table (o + k)) :: Word32 + in byte 0 .|. (byte 1 `shiftL` 8) .|. (byte 2 `shiftL` 16) + .|. (byte 3 `shiftL` 24) +{-# INLINE entry #-} + +-- the 256 table entries, little-endian +table :: BS.ByteString +table = fst (BS.unfoldrN 1024 byte 0) where - go :: Int -> Word32 -> Word32 + byte :: Int -> Maybe (Word8, Int) + byte k = Just + (fromIntegral (go (8 :: Int) (fromIntegral (k `shiftR` 2)) + `shiftR` (8 * (k .&. 3))), k + 1) + -- the Castagnoli polynomial 0x1EDC6F41, bit-reflected + poly = 0x82F63B78 :: Word32 go 0 !c = c - go !n !c = - let c' = if c .&. 1 /= 0 - then (c `shiftR` 1) `xor` crc32cPoly - else c `shiftR` 1 - in go (n - 1) c' -{-# INLINE updateByte #-} + go n !c = go (n - 1) ((c `shiftR` 1) `xor` (poly .&. negate (c .&. 1))) +{-# NOINLINE table #-} diff --git a/lib/Lightning/Protocol/BOLT7/Codec.hs b/lib/Lightning/Protocol/BOLT7/Codec.hs --- a/lib/Lightning/Protocol/BOLT7/Codec.hs +++ b/lib/Lightning/Protocol/BOLT7/Codec.hs @@ -1,626 +1,706 @@ -{-# OPTIONS_HADDOCK prune #-} - -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE DeriveGeneric #-} - --- | --- Module: Lightning.Protocol.BOLT7.Codec --- Copyright: (c) 2025 Jared Tobin --- License: MIT --- Maintainer: Jared Tobin --- --- Encoding and decoding for BOLT #7 gossip messages. - -module Lightning.Protocol.BOLT7.Codec ( - -- * Error types - EncodeError(..) - , DecodeError(..) - - -- * Channel announcement - , encodeChannelAnnouncement - , decodeChannelAnnouncement - - -- * Node announcement - , encodeNodeAnnouncement - , decodeNodeAnnouncement - - -- * Channel update - , encodeChannelUpdate - , decodeChannelUpdate - - -- * Announcement signatures - , encodeAnnouncementSignatures - , decodeAnnouncementSignatures - - -- * Query messages - , encodeQueryShortChannelIds - , decodeQueryShortChannelIds - , encodeReplyShortChannelIdsEnd - , decodeReplyShortChannelIdsEnd - , encodeQueryChannelRange - , decodeQueryChannelRange - , encodeReplyChannelRange - , decodeReplyChannelRange - , encodeGossipTimestampFilter - , decodeGossipTimestampFilter - - -- * Short channel ID encoding - , encodeShortChannelIdList - , decodeShortChannelIdList - ) where - -import Control.DeepSeq (NFData) -import Data.ByteString (ByteString) -import qualified Data.ByteString as BS -import Data.Word (Word8, Word16, Word32, Word64) -import GHC.Generics (Generic) -import Lightning.Protocol.BOLT1 (unsafeTlvStream) -import qualified Lightning.Protocol.BOLT1.Prim as Prim -import qualified Lightning.Protocol.BOLT1.TLV as TLV -import Lightning.Protocol.BOLT7.Messages -import Lightning.Protocol.BOLT7.Types - --- Error types ----------------------------------------------------------------- - --- | Encoding errors. -data EncodeError - = EncodeLengthOverflow -- ^ Field too large for u16 length prefix - deriving (Eq, Show, Generic) - -instance NFData EncodeError - --- | Decoding errors. -data DecodeError - = DecodeInsufficientBytes -- ^ Not enough bytes - | DecodeInvalidSignature -- ^ Invalid signature field - | DecodeInvalidChainHash -- ^ Invalid chain hash field - | DecodeInvalidShortChannelId -- ^ Invalid short channel ID field - | DecodeInvalidChannelId -- ^ Invalid channel ID field - | DecodeInvalidNodeId -- ^ Invalid node ID field - | DecodeInvalidPoint -- ^ Invalid point field - | DecodeInvalidRgbColor -- ^ Invalid RGB color field - | DecodeInvalidAlias -- ^ Invalid alias field - | DecodeInvalidAddress -- ^ Invalid address encoding - | DecodeTlvError -- ^ TLV decoding error - deriving (Eq, Show, Generic) - -instance NFData DecodeError - --- Primitive helpers ----------------------------------------------------------- - --- | Decode u8. -decodeU8 :: ByteString -> Either DecodeError (Word8, ByteString) -decodeU8 bs - | BS.null bs = Left DecodeInsufficientBytes - | otherwise = Right (BS.index bs 0, BS.drop 1 bs) -{-# INLINE decodeU8 #-} - --- | Decode u16 (big-endian). -decodeU16 :: ByteString -> Either DecodeError (Word16, ByteString) -decodeU16 bs = case Prim.decodeU16 bs of - Nothing -> Left DecodeInsufficientBytes - Just r -> Right r -{-# INLINE decodeU16 #-} - --- | Decode u32 (big-endian). -decodeU32 :: ByteString -> Either DecodeError (Word32, ByteString) -decodeU32 bs = case Prim.decodeU32 bs of - Nothing -> Left DecodeInsufficientBytes - Just r -> Right r -{-# INLINE decodeU32 #-} - --- | Decode u64 (big-endian). -decodeU64 :: ByteString -> Either DecodeError (Word64, ByteString) -decodeU64 bs = case Prim.decodeU64 bs of - Nothing -> Left DecodeInsufficientBytes - Just r -> Right r -{-# INLINE decodeU64 #-} - --- | Decode fixed-length bytes. -decodeBytes :: Int -> ByteString -> Either DecodeError (ByteString, ByteString) -decodeBytes n bs - | BS.length bs < n = Left DecodeInsufficientBytes - | otherwise = Right (BS.splitAt n bs) -{-# INLINE decodeBytes #-} - --- | Decode length-prefixed bytes (u16 prefix). -decodeLenPrefixed :: ByteString - -> Either DecodeError (ByteString, ByteString) -decodeLenPrefixed bs = do - (len, rest) <- decodeU16 bs - let n = fromIntegral len - if BS.length rest < n - then Left DecodeInsufficientBytes - else Right (BS.splitAt n rest) -{-# INLINE decodeLenPrefixed #-} - --- | Encode with u16 length prefix. -encodeLenPrefixed :: ByteString -> ByteString -encodeLenPrefixed bs = Prim.encodeU16 (fromIntegral $ BS.length bs) <> bs -{-# INLINE encodeLenPrefixed #-} - --- | Decode fixed-length validated type. -decodeFixed :: Int -> DecodeError -> (ByteString -> Maybe a) - -> ByteString -> Either DecodeError (a, ByteString) -decodeFixed len err mkVal bs = do - (bytes, rest) <- decodeBytes len bs - case mkVal bytes of - Nothing -> Left err - Just v -> Right (v, rest) -{-# INLINE decodeFixed #-} - --- Type-specific decoders ------------------------------------------------------ - --- | Decode Signature (64 bytes). -decodeSignature :: ByteString -> Either DecodeError (Signature, ByteString) -decodeSignature = decodeFixed signatureLen DecodeInvalidSignature signature -{-# INLINE decodeSignature #-} - --- | Decode ChainHash (32 bytes). -decodeChainHash :: ByteString -> Either DecodeError (ChainHash, ByteString) -decodeChainHash = decodeFixed chainHashLen DecodeInvalidChainHash chainHash -{-# INLINE decodeChainHash #-} - --- | Decode ShortChannelId (8 bytes). -decodeShortChannelId :: ByteString - -> Either DecodeError (ShortChannelId, ByteString) -decodeShortChannelId = - decodeFixed shortChannelIdLen DecodeInvalidShortChannelId shortChannelId -{-# INLINE decodeShortChannelId #-} - --- | Decode ChannelId (32 bytes). -decodeChannelId :: ByteString -> Either DecodeError (ChannelId, ByteString) -decodeChannelId = decodeFixed channelIdLen DecodeInvalidChannelId channelId -{-# INLINE decodeChannelId #-} - --- | Decode NodeId (33 bytes). -decodeNodeId :: ByteString -> Either DecodeError (NodeId, ByteString) -decodeNodeId = decodeFixed nodeIdLen DecodeInvalidNodeId nodeId -{-# INLINE decodeNodeId #-} - --- | Decode Point (33 bytes). -decodePoint :: ByteString -> Either DecodeError (Point, ByteString) -decodePoint = decodeFixed pointLen DecodeInvalidPoint point -{-# INLINE decodePoint #-} - --- | Decode RgbColor (3 bytes). -decodeRgbColor :: ByteString -> Either DecodeError (RgbColor, ByteString) -decodeRgbColor = decodeFixed rgbColorLen DecodeInvalidRgbColor rgbColor -{-# INLINE decodeRgbColor #-} - --- | Decode Alias (32 bytes). -decodeAlias :: ByteString -> Either DecodeError (Alias, ByteString) -decodeAlias = decodeFixed aliasLen DecodeInvalidAlias alias -{-# INLINE decodeAlias #-} - --- | Decode FeatureBits (length-prefixed). -decodeFeatureBits :: ByteString -> Either DecodeError (FeatureBits, ByteString) -decodeFeatureBits bs = do - (bytes, rest) <- decodeLenPrefixed bs - Right (featureBits bytes, rest) -{-# INLINE decodeFeatureBits #-} - --- | Decode addresses list (length-prefixed). -decodeAddresses :: ByteString -> Either DecodeError ([Address], ByteString) -decodeAddresses bs = do - (addrData, rest) <- decodeLenPrefixed bs - addrs <- parseAddrs addrData - Right (addrs, rest) - where - parseAddrs :: ByteString -> Either DecodeError [Address] - parseAddrs !d - | BS.null d = Right [] - | otherwise = do - (addr, d') <- parseOneAddr d - addrs <- parseAddrs d' - Right (addr : addrs) - - parseOneAddr :: ByteString -> Either DecodeError (Address, ByteString) - parseOneAddr d = do - (typ, d1) <- decodeU8 d - case typ of - 1 -> do -- IPv4 - (addrBytes, d2) <- decodeBytes ipv4AddrLen d1 - (port, d3) <- decodeU16 d2 - case ipv4Addr addrBytes of - Nothing -> Left DecodeInvalidAddress - Just a -> Right (AddrIPv4 a port, d3) - 2 -> do -- IPv6 - (addrBytes, d2) <- decodeBytes ipv6AddrLen d1 - (port, d3) <- decodeU16 d2 - case ipv6Addr addrBytes of - Nothing -> Left DecodeInvalidAddress - Just a -> Right (AddrIPv6 a port, d3) - 4 -> do -- Tor v3 - (addrBytes, d2) <- decodeBytes torV3AddrLen d1 - (port, d3) <- decodeU16 d2 - case torV3Addr addrBytes of - Nothing -> Left DecodeInvalidAddress - Just a -> Right (AddrTorV3 a port, d3) - 5 -> do -- DNS hostname - (hostLen, d2) <- decodeU8 d1 - (hostBytes, d3) <- decodeBytes (fromIntegral hostLen) d2 - (port, d4) <- decodeU16 d3 - Right (AddrDNS hostBytes port, d4) - _ -> Left DecodeInvalidAddress -- Unknown address type - --- Channel announcement -------------------------------------------------------- - --- | Encode channel_announcement message. -encodeChannelAnnouncement :: ChannelAnnouncement -> ByteString -encodeChannelAnnouncement msg = mconcat - [ getSignature (channelAnnNodeSig1 msg) - , getSignature (channelAnnNodeSig2 msg) - , getSignature (channelAnnBitcoinSig1 msg) - , getSignature (channelAnnBitcoinSig2 msg) - , encodeLenPrefixed (getFeatureBits (channelAnnFeatures msg)) - , getChainHash (channelAnnChainHash msg) - , getShortChannelId (channelAnnShortChanId msg) - , getNodeId (channelAnnNodeId1 msg) - , getNodeId (channelAnnNodeId2 msg) - , getPoint (channelAnnBitcoinKey1 msg) - , getPoint (channelAnnBitcoinKey2 msg) - ] - --- | Decode channel_announcement message. -decodeChannelAnnouncement :: ByteString - -> Either DecodeError (ChannelAnnouncement, ByteString) -decodeChannelAnnouncement bs = do - (nodeSig1, bs1) <- decodeSignature bs - (nodeSig2, bs2) <- decodeSignature bs1 - (btcSig1, bs3) <- decodeSignature bs2 - (btcSig2, bs4) <- decodeSignature bs3 - (features, bs5) <- decodeFeatureBits bs4 - (chainH, bs6) <- decodeChainHash bs5 - (scid, bs7) <- decodeShortChannelId bs6 - (nid1, bs8) <- decodeNodeId bs7 - (nid2, bs9) <- decodeNodeId bs8 - (btcKey1, bs10) <- decodePoint bs9 - (btcKey2, rest) <- decodePoint bs10 - let msg = ChannelAnnouncement - { channelAnnNodeSig1 = nodeSig1 - , channelAnnNodeSig2 = nodeSig2 - , channelAnnBitcoinSig1 = btcSig1 - , channelAnnBitcoinSig2 = btcSig2 - , channelAnnFeatures = features - , channelAnnChainHash = chainH - , channelAnnShortChanId = scid - , channelAnnNodeId1 = nid1 - , channelAnnNodeId2 = nid2 - , channelAnnBitcoinKey1 = btcKey1 - , channelAnnBitcoinKey2 = btcKey2 - } - Right (msg, rest) - --- Node announcement ----------------------------------------------------------- - --- | Encode node_announcement message. -encodeNodeAnnouncement :: NodeAnnouncement -> Either EncodeError ByteString -encodeNodeAnnouncement msg = do - addrData <- encodeAddresses (nodeAnnAddresses msg) - let features = getFeatureBits (nodeAnnFeatures msg) - if BS.length features > 65535 - then Left EncodeLengthOverflow - else Right $ mconcat - [ getSignature (nodeAnnSignature msg) - , encodeLenPrefixed features - , Prim.encodeU32 (nodeAnnTimestamp msg) - , getNodeId (nodeAnnNodeId msg) - , getRgbColor (nodeAnnRgbColor msg) - , getAlias (nodeAnnAlias msg) - , encodeLenPrefixed addrData - ] - --- | Encode address list. -encodeAddresses :: [Address] -> Either EncodeError ByteString -encodeAddresses addrs = Right $ mconcat (map encodeAddress addrs) - where - encodeAddress :: Address -> ByteString - encodeAddress (AddrIPv4 a port) = mconcat - [ BS.singleton 1 - , getIPv4Addr a - , Prim.encodeU16 port - ] - encodeAddress (AddrIPv6 a port) = mconcat - [ BS.singleton 2 - , getIPv6Addr a - , Prim.encodeU16 port - ] - encodeAddress (AddrTorV3 a port) = mconcat - [ BS.singleton 4 - , getTorV3Addr a - , Prim.encodeU16 port - ] - encodeAddress (AddrDNS host port) = mconcat - [ BS.singleton 5 - , BS.singleton (fromIntegral $ BS.length host) - , host - , Prim.encodeU16 port - ] - --- | Decode node_announcement message. -decodeNodeAnnouncement :: ByteString - -> Either DecodeError (NodeAnnouncement, ByteString) -decodeNodeAnnouncement bs = do - (sig, bs1) <- decodeSignature bs - (features, bs2) <- decodeFeatureBits bs1 - (timestamp, bs3) <- decodeU32 bs2 - (nid, bs4) <- decodeNodeId bs3 - (color, bs5) <- decodeRgbColor bs4 - (al, bs6) <- decodeAlias bs5 - (addrs, rest) <- decodeAddresses bs6 - let msg = NodeAnnouncement - { nodeAnnSignature = sig - , nodeAnnFeatures = features - , nodeAnnTimestamp = timestamp - , nodeAnnNodeId = nid - , nodeAnnRgbColor = color - , nodeAnnAlias = al - , nodeAnnAddresses = addrs - } - Right (msg, rest) - --- Channel update -------------------------------------------------------------- - --- | Encode channel_update message. -encodeChannelUpdate :: ChannelUpdate -> ByteString -encodeChannelUpdate msg = mconcat - [ getSignature (chanUpdateSignature msg) - , getChainHash (chanUpdateChainHash msg) - , getShortChannelId (chanUpdateShortChanId msg) - , Prim.encodeU32 (chanUpdateTimestamp msg) - , BS.singleton (encodeMessageFlags (chanUpdateMsgFlags msg)) - , BS.singleton (encodeChannelFlags (chanUpdateChanFlags msg)) - , Prim.encodeU16 (getCltvExpiryDelta (chanUpdateCltvExpDelta msg)) - , Prim.encodeU64 (getHtlcMinimumMsat (chanUpdateHtlcMinMsat msg)) - , Prim.encodeU32 (getFeeBaseMsat (chanUpdateFeeBaseMsat msg)) - , Prim.encodeU32 (getFeeProportionalMillionths (chanUpdateFeeProportional msg)) - , case chanUpdateHtlcMaxMsat msg of - Nothing -> BS.empty - Just m -> Prim.encodeU64 (getHtlcMaximumMsat m) - ] - --- | Decode channel_update message. -decodeChannelUpdate :: ByteString - -> Either DecodeError (ChannelUpdate, ByteString) -decodeChannelUpdate bs = do - (sig, bs1) <- decodeSignature bs - (chainH, bs2) <- decodeChainHash bs1 - (scid, bs3) <- decodeShortChannelId bs2 - (timestamp, bs4) <- decodeU32 bs3 - (msgFlagsRaw, bs5) <- decodeU8 bs4 - (chanFlagsRaw, bs6) <- decodeU8 bs5 - (cltvDelta, bs7) <- decodeU16 bs6 - (htlcMin, bs8) <- decodeU64 bs7 - (feeBase, bs9) <- decodeU32 bs8 - (feeProp, bs10) <- decodeU32 bs9 - let msgFlags' = decodeMessageFlags msgFlagsRaw - chanFlags' = decodeChannelFlags chanFlagsRaw - -- htlc_maximum_msat is present if message_flags bit 0 is set - (htlcMax, rest) <- if mfHtlcMaxPresent msgFlags' - then do - (m, r) <- decodeU64 bs10 - Right (Just (HtlcMaximumMsat m), r) - else Right (Nothing, bs10) - let msg = ChannelUpdate - { chanUpdateSignature = sig - , chanUpdateChainHash = chainH - , chanUpdateShortChanId = scid - , chanUpdateTimestamp = timestamp - , chanUpdateMsgFlags = msgFlags' - , chanUpdateChanFlags = chanFlags' - , chanUpdateCltvExpDelta = CltvExpiryDelta cltvDelta - , chanUpdateHtlcMinMsat = HtlcMinimumMsat htlcMin - , chanUpdateFeeBaseMsat = FeeBaseMsat feeBase - , chanUpdateFeeProportional = FeeProportionalMillionths feeProp - , chanUpdateHtlcMaxMsat = htlcMax - } - Right (msg, rest) - --- Announcement signatures ----------------------------------------------------- - --- | Encode announcement_signatures message. -encodeAnnouncementSignatures :: AnnouncementSignatures -> ByteString -encodeAnnouncementSignatures msg = mconcat - [ getChannelId (annSigChannelId msg) - , getShortChannelId (annSigShortChanId msg) - , getSignature (annSigNodeSig msg) - , getSignature (annSigBitcoinSig msg) - ] - --- | Decode announcement_signatures message. -decodeAnnouncementSignatures :: ByteString - -> Either DecodeError - (AnnouncementSignatures, ByteString) -decodeAnnouncementSignatures bs = do - (cid, bs1) <- decodeChannelId bs - (scid, bs2) <- decodeShortChannelId bs1 - (nodeSig, bs3) <- decodeSignature bs2 - (btcSig, rest) <- decodeSignature bs3 - let msg = AnnouncementSignatures - { annSigChannelId = cid - , annSigShortChanId = scid - , annSigNodeSig = nodeSig - , annSigBitcoinSig = btcSig - } - Right (msg, rest) - --- Query messages -------------------------------------------------------------- - --- | Encode query_short_channel_ids message. -encodeQueryShortChannelIds :: QueryShortChannelIds - -> Either EncodeError ByteString -encodeQueryShortChannelIds msg = do - let scidData = queryScidsData msg - if BS.length scidData > 65535 - then Left EncodeLengthOverflow - else Right $ mconcat - [ getChainHash (queryScidsChainHash msg) - , encodeLenPrefixed scidData - , TLV.encodeTlvStream (queryScidsTlvs msg) - ] - --- | Decode query_short_channel_ids message. -decodeQueryShortChannelIds :: ByteString - -> Either DecodeError - (QueryShortChannelIds, ByteString) -decodeQueryShortChannelIds bs = do - (chainH, bs1) <- decodeChainHash bs - (scidData, bs2) <- decodeLenPrefixed bs1 - let tlvs = case TLV.decodeTlvStreamRaw bs2 of - Left _ -> unsafeTlvStream [] - Right t -> t - let msg = QueryShortChannelIds - { queryScidsChainHash = chainH - , queryScidsData = scidData - , queryScidsTlvs = tlvs - } - Right (msg, BS.empty) - --- | Encode reply_short_channel_ids_end message. -encodeReplyShortChannelIdsEnd :: ReplyShortChannelIdsEnd -> ByteString -encodeReplyShortChannelIdsEnd msg = mconcat - [ getChainHash (replyScidsChainHash msg) - , BS.singleton (replyScidsFullInfo msg) - ] - --- | Decode reply_short_channel_ids_end message. -decodeReplyShortChannelIdsEnd :: ByteString - -> Either DecodeError - (ReplyShortChannelIdsEnd, ByteString) -decodeReplyShortChannelIdsEnd bs = do - (chainH, bs1) <- decodeChainHash bs - (fullInfo, rest) <- decodeU8 bs1 - let msg = ReplyShortChannelIdsEnd - { replyScidsChainHash = chainH - , replyScidsFullInfo = fullInfo - } - Right (msg, rest) - --- | Encode query_channel_range message. -encodeQueryChannelRange :: QueryChannelRange -> ByteString -encodeQueryChannelRange msg = mconcat - [ getChainHash (queryRangeChainHash msg) - , Prim.encodeU32 (queryRangeFirstBlock msg) - , Prim.encodeU32 (queryRangeNumBlocks msg) - , TLV.encodeTlvStream (queryRangeTlvs msg) - ] - --- | Decode query_channel_range message. -decodeQueryChannelRange :: ByteString - -> Either DecodeError (QueryChannelRange, ByteString) -decodeQueryChannelRange bs = do - (chainH, bs1) <- decodeChainHash bs - (firstBlock, bs2) <- decodeU32 bs1 - (numBlocks, bs3) <- decodeU32 bs2 - let tlvs = case TLV.decodeTlvStreamRaw bs3 of - Left _ -> unsafeTlvStream [] - Right t -> t - let msg = QueryChannelRange - { queryRangeChainHash = chainH - , queryRangeFirstBlock = firstBlock - , queryRangeNumBlocks = numBlocks - , queryRangeTlvs = tlvs - } - Right (msg, BS.empty) - --- | Encode reply_channel_range message. -encodeReplyChannelRange :: ReplyChannelRange -> Either EncodeError ByteString -encodeReplyChannelRange msg = do - let rangeData = replyRangeData msg - if BS.length rangeData > 65535 - then Left EncodeLengthOverflow - else Right $ mconcat - [ getChainHash (replyRangeChainHash msg) - , Prim.encodeU32 (replyRangeFirstBlock msg) - , Prim.encodeU32 (replyRangeNumBlocks msg) - , BS.singleton (replyRangeSyncComplete msg) - , encodeLenPrefixed rangeData - , TLV.encodeTlvStream (replyRangeTlvs msg) - ] - --- | Decode reply_channel_range message. -decodeReplyChannelRange :: ByteString - -> Either DecodeError (ReplyChannelRange, ByteString) -decodeReplyChannelRange bs = do - (chainH, bs1) <- decodeChainHash bs - (firstBlock, bs2) <- decodeU32 bs1 - (numBlocks, bs3) <- decodeU32 bs2 - (syncComplete, bs4) <- decodeU8 bs3 - (rangeData, bs5) <- decodeLenPrefixed bs4 - let tlvs = case TLV.decodeTlvStreamRaw bs5 of - Left _ -> unsafeTlvStream [] - Right t -> t - let msg = ReplyChannelRange - { replyRangeChainHash = chainH - , replyRangeFirstBlock = firstBlock - , replyRangeNumBlocks = numBlocks - , replyRangeSyncComplete = syncComplete - , replyRangeData = rangeData - , replyRangeTlvs = tlvs - } - Right (msg, BS.empty) - --- | Encode gossip_timestamp_filter message. -encodeGossipTimestampFilter :: GossipTimestampFilter -> ByteString -encodeGossipTimestampFilter msg = mconcat - [ getChainHash (gossipFilterChainHash msg) - , Prim.encodeU32 (gossipFilterFirstTimestamp msg) - , Prim.encodeU32 (gossipFilterTimestampRange msg) - ] - --- | Decode gossip_timestamp_filter message. -decodeGossipTimestampFilter :: ByteString - -> Either DecodeError - (GossipTimestampFilter, ByteString) -decodeGossipTimestampFilter bs = do - (chainH, bs1) <- decodeChainHash bs - (firstTs, bs2) <- decodeU32 bs1 - (tsRange, rest) <- decodeU32 bs2 - let msg = GossipTimestampFilter - { gossipFilterChainHash = chainH - , gossipFilterFirstTimestamp = firstTs - , gossipFilterTimestampRange = tsRange - } - Right (msg, rest) - --- Short channel ID list encoding ----------------------------------------------- - --- | Encode a list of short channel IDs as concatenated 8-byte values. --- --- This produces encoded_short_ids data with encoding type 0 (uncompressed). --- The first byte is the encoding type (0), followed by the concatenated SCIDs. --- --- Note: This does NOT sort the SCIDs. The caller should ensure they are in --- ascending order if that's required by the protocol context. -encodeShortChannelIdList :: [ShortChannelId] -> ByteString -encodeShortChannelIdList scids = BS.cons 0 $ - mconcat (map getShortChannelId scids) -{-# INLINE encodeShortChannelIdList #-} - --- | Decode a list of short channel IDs from encoded_short_ids data. --- --- Supports encoding type 0 (uncompressed). Other encoding types will fail. -decodeShortChannelIdList :: ByteString - -> Either DecodeError [ShortChannelId] -decodeShortChannelIdList bs - | BS.null bs = Left DecodeInsufficientBytes - | otherwise = do - let encType = BS.index bs 0 - payload = BS.drop 1 bs - case encType of - 0 -> decodeUncompressedScids payload - _ -> Left DecodeInvalidShortChannelId -- Unsupported encoding type - where - decodeUncompressedScids :: ByteString -> Either DecodeError [ShortChannelId] - decodeUncompressedScids !d - | BS.null d = Right [] - | BS.length d < shortChannelIdLen = Left DecodeInsufficientBytes - | otherwise = do - let (scidBytes, rest) = BS.splitAt shortChannelIdLen d - case shortChannelId scidBytes of - Nothing -> Left DecodeInvalidShortChannelId - Just scid -> do - scids <- decodeUncompressedScids rest - Right (scid : scids) -{-# INLINE decodeShortChannelIdList #-} +{-# OPTIONS_HADDOCK hide #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric #-} + +-- | +-- Module: Lightning.Protocol.BOLT7.Codec +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- Encoding and decoding of BOLT #7 messages. + +module Lightning.Protocol.BOLT7.Codec ( + EncodeError(..) + , DecodeError(..) + , encode_message + , decode_message + , encode_channel_announcement + , decode_channel_announcement + , encode_node_announcement + , decode_node_announcement + , encode_channel_update + , decode_channel_update + , encode_announcement_signatures + , decode_announcement_signatures + , encode_query_short_channel_ids + , decode_query_short_channel_ids + , encode_reply_short_channel_ids_end + , decode_reply_short_channel_ids_end + , encode_query_channel_range + , decode_query_channel_range + , encode_reply_channel_range + , decode_reply_channel_range + , encode_gossip_timestamp_filter + , decode_gossip_timestamp_filter + ) where + +import Control.DeepSeq (NFData) +import qualified Data.ByteString as BS +import Data.Word (Word8, Word16, Word32, Word64) +import GHC.Generics (Generic) +import Lightning.Protocol.BOLT1 + ( ChainHash, MilliSatoshi, Point, ShortChannelId, Signature + , TlvError, TlvRecord(..), TlvStream ) +import qualified Lightning.Protocol.BOLT1 as BOLT1 +import qualified Lightning.Protocol.BOLT9 as BOLT9 +import Lightning.Protocol.BOLT7.Messages +import Lightning.Protocol.BOLT7.Types + +-- errors --------------------------------------------------------------------- + +-- | Why a message failed to encode. +data EncodeError + = EncodeLengthOverflow + -- ^ a length-prefixed field exceeds 65535 bytes + | EncodeInvalidTlvs + -- ^ a @_tlvs@ field holds a record of a type the message defines + | EncodeCountMismatch + -- ^ query flags, timestamps or checksums don't number one per + -- short channel id + | EncodeInvalidAddresses + -- ^ 'na_unknown_addresses' begins with a descriptor of a known type + deriving (Eq, Show, Generic) + +instance NFData EncodeError + +-- | Why a message failed to decode. +data DecodeError + = DecodeInsufficientBytes + -- ^ the input ended before a field did + | DecodeInvalidPoint + -- ^ a point lacks a compressed-encoding prefix (0x02 or 0x03) + | DecodeInvalidAmount + -- ^ an amount exceeds 21 million BTC + | DecodeInvalidBool + -- ^ a boolean byte is neither 0 nor 1 + | DecodeInvalidShortChannelIds + -- ^ @encoded_short_ids@ lacks an encoding type, or isn't a whole + -- number of short channel ids + | DecodeUnknownEncoding !Word8 + -- ^ an encoded array uses an unknown encoding type (type 1, zlib, + -- is no longer allowed) + | DecodeCountMismatch + -- ^ query flags, timestamps or checksums don't number one per + -- short channel id + | DecodeTlvError !TlvError + -- ^ the message's TLV stream is malformed + | DecodeInvalidTlvValue !Word64 + -- ^ a known TLV record (of the given type) has a malformed value + | DecodeUnknownType !Word16 + -- ^ the message type is not one of BOLT #7's + deriving (Eq, Show, Generic) + +instance NFData DecodeError + +-- messages ------------------------------------------------------------------- + +-- | Encode a 'Message' payload (excluding the 2-byte message type; see +-- 'message_type'). Frame the result with +-- 'Lightning.Protocol.BOLT1.encode_envelope', which enforces the +-- 65535-byte message limit. +encode_message :: Message -> Either EncodeError BS.ByteString +encode_message m = case m of + MsgChannelAnnouncement a -> encode_channel_announcement a + MsgNodeAnnouncement a -> encode_node_announcement a + MsgChannelUpdate a -> Right (encode_channel_update a) + MsgAnnouncementSignatures a -> Right (encode_announcement_signatures a) + MsgQueryShortChannelIds a -> encode_query_short_channel_ids a + MsgReplyShortChannelIdsEnd a -> Right (encode_reply_short_channel_ids_end a) + MsgQueryChannelRange a -> encode_query_channel_range a + MsgReplyChannelRange a -> encode_reply_channel_range a + MsgGossipTimestampFilter a -> Right (encode_gossip_timestamp_filter a) + +-- | Decode a message payload, given its message type (as split off by +-- 'Lightning.Protocol.BOLT1.decode_envelope'). +-- +-- >>> decode_message 260 "\NUL" +-- Left (DecodeUnknownType 260) +decode_message :: Word16 -> BS.ByteString -> Either DecodeError Message +decode_message t bs = case t of + 256 -> MsgChannelAnnouncement <$> decode_channel_announcement bs + 257 -> MsgNodeAnnouncement <$> decode_node_announcement bs + 258 -> MsgChannelUpdate <$> decode_channel_update bs + 259 -> MsgAnnouncementSignatures <$> decode_announcement_signatures bs + 261 -> MsgQueryShortChannelIds <$> decode_query_short_channel_ids bs + 262 -> MsgReplyShortChannelIdsEnd <$> decode_reply_short_channel_ids_end bs + 263 -> MsgQueryChannelRange <$> decode_query_channel_range bs + 264 -> MsgReplyChannelRange <$> decode_reply_channel_range bs + 265 -> MsgGossipTimestampFilter <$> decode_gossip_timestamp_filter bs + _ -> Left (DecodeUnknownType t) + +-- channel_announcement ------------------------------------------------------- + +-- | Encode a t'ChannelAnnouncement' payload. Fails if the features exceed +-- 65535 bytes. +encode_channel_announcement + :: ChannelAnnouncement -> Either EncodeError BS.ByteString +encode_channel_announcement m = do + f <- prefixed (BOLT9.render (ca_features m)) + pure $ mconcat + [ BOLT1.un_signature (ca_node_signature_1 m) + , BOLT1.un_signature (ca_node_signature_2 m) + , BOLT1.un_signature (ca_bitcoin_signature_1 m) + , BOLT1.un_signature (ca_bitcoin_signature_2 m) + , f + , BOLT1.un_chain_hash (ca_chain_hash m) + , BOLT1.encode_short_channel_id (ca_short_channel_id m) + , BOLT1.un_point (ca_node_id_1 m) + , BOLT1.un_point (ca_node_id_2 m) + , BOLT1.un_point (ca_bitcoin_key_1 m) + , BOLT1.un_point (ca_bitcoin_key_2 m) + , BOLT1.encode_tlv_stream (ca_tlvs m) + ] + +-- | Decode a t'ChannelAnnouncement' payload. +decode_channel_announcement + :: BS.ByteString -> Either DecodeError ChannelAnnouncement +decode_channel_announcement b0 = do + (ns1, b1) <- signature b0 + (ns2, b2) <- signature b1 + (bs1, b3) <- signature b2 + (bs2, b4) <- signature b3 + (f, b5) <- u16_prefixed b4 + (ch, b6) <- chain_hash b5 + (s, b7) <- short_channel_id b6 + (n1, b8) <- point b7 + (n2, b9) <- point b8 + (bk1, b10) <- point b9 + (bk2, b11) <- point b10 + ext <- extension b11 + pure ChannelAnnouncement + { ca_node_signature_1 = ns1 + , ca_node_signature_2 = ns2 + , ca_bitcoin_signature_1 = bs1 + , ca_bitcoin_signature_2 = bs2 + , ca_features = BOLT9.parse f + , ca_chain_hash = ch + , ca_short_channel_id = s + , ca_node_id_1 = n1 + , ca_node_id_2 = n2 + , ca_bitcoin_key_1 = bk1 + , ca_bitcoin_key_2 = bk2 + , ca_tlvs = ext + } + +-- node_announcement ---------------------------------------------------------- + +-- | Encode a t'NodeAnnouncement' payload. Fails if the features or the +-- addresses exceed 65535 bytes, or if 'na_unknown_addresses' begins +-- with a descriptor of a known type. +encode_node_announcement + :: NodeAnnouncement -> Either EncodeError BS.ByteString +encode_node_announcement m = do + f <- prefixed (BOLT9.render (na_features m)) + let unknown = na_unknown_addresses m + case BS.uncons unknown of + Just (t, _) | t >= 1 && t <= 5 -> Left EncodeInvalidAddresses + _ -> pure () + as <- prefixed (foldMap encode_address (na_addresses m) <> unknown) + let RgbColor r g b = na_rgb_color m + Alias al = na_alias m + pure $ mconcat + [ BOLT1.un_signature (na_signature m) + , f + , BOLT1.encode_u32 (na_timestamp m) + , BOLT1.un_point (na_node_id m) + , BS.pack [r, g, b] + , al + , as + , BOLT1.encode_tlv_stream (na_tlvs m) + ] + +encode_address :: Address -> BS.ByteString +encode_address a = case a of + AddrIPv4 (IPv4Addr b) p -> BS.cons 1 (b <> BOLT1.encode_u16 p) + AddrIPv6 (IPv6Addr b) p -> BS.cons 2 (b <> BOLT1.encode_u16 p) + AddrTorV2 (TorV2Addr b) -> BS.cons 3 b + AddrTorV3 (TorV3Addr b) p -> BS.cons 4 (b <> BOLT1.encode_u16 p) + AddrDNS (Hostname h) p -> + BS.cons 5 (BS.cons (fromIntegral (BS.length h)) (h <> BOLT1.encode_u16 p)) + +-- | Decode a t'NodeAnnouncement' payload. +-- +-- Address descriptors are parsed up to the first one of an unknown +-- type; it and the bytes after it are kept in 'na_unknown_addresses'. +-- A truncated descriptor of a known type is an error. +decode_node_announcement + :: BS.ByteString -> Either DecodeError NodeAnnouncement +decode_node_announcement b0 = do + (sig, b1) <- signature b0 + (f, b2) <- u16_prefixed b1 + (ts, b3) <- u32 b2 + (nid, b4) <- point b3 + (r, b5) <- u8 b4 + (g, b6) <- u8 b5 + (b, b7) <- u8 b6 + (al, b8) <- bytes 32 b7 + (as, b9) <- u16_prefixed b8 + (known, unknown) <- addresses as + ext <- extension b9 + pure NodeAnnouncement + { na_signature = sig + , na_features = BOLT9.parse f + , na_timestamp = ts + , na_node_id = nid + , na_rgb_color = RgbColor r g b + , na_alias = Alias al + , na_addresses = known + , na_unknown_addresses = unknown + , na_tlvs = ext + } + +-- parse address descriptors, stopping at the first of an unknown type +addresses + :: BS.ByteString -> Either DecodeError ([Address], BS.ByteString) +addresses = go [] + where + go !acc !bs = case BS.uncons bs of + Nothing -> Right (reverse acc, BS.empty) + Just (t, r) -> case t of + 1 -> with_port acc 4 (AddrIPv4 . IPv4Addr) r + 2 -> with_port acc 16 (AddrIPv6 . IPv6Addr) r + 3 -> do + (a, r1) <- bytes 12 r + go (AddrTorV2 (TorV2Addr a) : acc) r1 + 4 -> with_port acc 35 (AddrTorV3 . TorV3Addr) r + 5 -> do + (n, r1) <- u8 r + (h, r2) <- bytes (fromIntegral n) r1 + (p, r3) <- u16 r2 + go (AddrDNS (Hostname h) p : acc) r3 + _ -> Right (reverse acc, bs) + + with_port acc n mk r = do + (a, r1) <- bytes n r + (p, r2) <- u16 r1 + go (mk a p : acc) r2 + +-- channel_update ------------------------------------------------------------- + +-- | Encode a t'ChannelUpdate' payload. +encode_channel_update :: ChannelUpdate -> BS.ByteString +encode_channel_update m = + let MessageFlags mf = cu_message_flags m + ChannelFlags cf = cu_channel_flags m + in mconcat + [ BOLT1.un_signature (cu_signature m) + , BOLT1.un_chain_hash (cu_chain_hash m) + , BOLT1.encode_short_channel_id (cu_short_channel_id m) + , BOLT1.encode_u32 (cu_timestamp m) + , BS.pack [mf, cf] + , BOLT1.encode_u16 (cu_cltv_expiry_delta m) + , BOLT1.encode_milli_satoshi (cu_htlc_minimum_msat m) + , BOLT1.encode_u32 (cu_fee_base_msat m) + , BOLT1.encode_u32 (cu_fee_proportional_millionths m) + , BOLT1.encode_milli_satoshi (cu_htlc_maximum_msat m) + , BOLT1.encode_tlv_stream (cu_tlvs m) + ] + +-- | Decode a t'ChannelUpdate' payload. +-- +-- @htlc_maximum_msat@ is always present; the @must_be_one@ bit of +-- @message_flags@ is kept but not interpreted. +decode_channel_update :: BS.ByteString -> Either DecodeError ChannelUpdate +decode_channel_update b0 = do + (sig, b1) <- signature b0 + (ch, b2) <- chain_hash b1 + (s, b3) <- short_channel_id b2 + (ts, b4) <- u32 b3 + (mf, b5) <- u8 b4 + (cf, b6) <- u8 b5 + (cltv, b7) <- u16 b6 + (hmin, b8) <- milli_satoshi b7 + (fb, b9) <- u32 b8 + (fp, b10) <- u32 b9 + (hmax, b11) <- milli_satoshi b10 + ext <- extension b11 + pure ChannelUpdate + { cu_signature = sig + , cu_chain_hash = ch + , cu_short_channel_id = s + , cu_timestamp = ts + , cu_message_flags = MessageFlags mf + , cu_channel_flags = ChannelFlags cf + , cu_cltv_expiry_delta = cltv + , cu_htlc_minimum_msat = hmin + , cu_fee_base_msat = fb + , cu_fee_proportional_millionths = fp + , cu_htlc_maximum_msat = hmax + , cu_tlvs = ext + } + +-- announcement_signatures ---------------------------------------------------- + +-- | Encode an t'AnnouncementSignatures' payload. +encode_announcement_signatures :: AnnouncementSignatures -> BS.ByteString +encode_announcement_signatures m = mconcat + [ BOLT1.un_channel_id (as_channel_id m) + , BOLT1.encode_short_channel_id (as_short_channel_id m) + , BOLT1.un_signature (as_node_signature m) + , BOLT1.un_signature (as_bitcoin_signature m) + , BOLT1.encode_tlv_stream (as_tlvs m) + ] + +-- | Decode an t'AnnouncementSignatures' payload. +decode_announcement_signatures + :: BS.ByteString -> Either DecodeError AnnouncementSignatures +decode_announcement_signatures b0 = do + (cid, b1) <- need (BOLT1.decode_channel_id b0) + (s, b2) <- short_channel_id b1 + (ns, b3) <- signature b2 + (bs, b4) <- signature b3 + ext <- extension b4 + pure (AnnouncementSignatures cid s ns bs ext) + +-- query_short_channel_ids ---------------------------------------------------- + +-- | Encode a t'QueryShortChannelIds' payload. Fails if the short channel +-- ids exceed the u16 length limit (8191 of them), if the query flags +-- don't number one per short channel id, or if 'qsci_tlvs' holds a +-- record of type 1. +encode_query_short_channel_ids + :: QueryShortChannelIds -> Either EncodeError BS.ByteString +encode_query_short_channel_ids m = do + let scids = qsci_short_channel_ids m + ids <- prefixed (encode_short_ids scids) + flags <- case qsci_query_flags m of + Nothing -> pure [] + Just fs + | length fs /= length scids -> Left EncodeCountMismatch + | otherwise -> pure + [TlvRecord 1 (BS.cons 0 (foldMap (\(QueryFlags w) -> + BOLT1.encode_bigsize w) fs))] + t <- merge [1] flags (qsci_tlvs m) + pure (BOLT1.un_chain_hash (qsci_chain_hash m) <> ids <> t) + +-- | Decode a t'QueryShortChannelIds' payload. +-- +-- Fails on an unknown encoding type (including the deprecated zlib +-- encoding), on @encoded_short_ids@ that isn't a whole number of short +-- channel ids, and on query flags that don't number one per short +-- channel id. +-- +-- >>> let zlib = BS.replicate 32 0 <> "\NUL\STX\SOHx" +-- >>> decode_query_short_channel_ids zlib +-- Left (DecodeUnknownEncoding 1) +decode_query_short_channel_ids + :: BS.ByteString -> Either DecodeError QueryShortChannelIds +decode_query_short_channel_ids b0 = do + (ch, b1) <- chain_hash b0 + (ids, b2) <- u16_prefixed b1 + scids <- short_ids ids + s <- tlvs [1] b2 + flags <- traverse (query_flags_value (length scids)) + (BOLT1.lookup_tlv 1 s) + pure QueryShortChannelIds + { qsci_chain_hash = ch + , qsci_short_channel_ids = scids + , qsci_query_flags = flags + , qsci_tlvs = BOLT1.filter_tlv_stream (/= 1) s + } + +query_flags_value :: Int -> BS.ByteString -> Either DecodeError [QueryFlags] +query_flags_value n v = case BS.uncons v of + Nothing -> Left (DecodeInvalidTlvValue 1) + Just (0, r) -> do + fs <- bigsizes r + if length fs /= n + then Left DecodeCountMismatch + else Right (map QueryFlags fs) + Just (e, _) -> Left (DecodeUnknownEncoding e) + where + bigsizes !r + | BS.null r = Right [] + | otherwise = case BOLT1.decode_bigsize r of + Nothing -> Left (DecodeInvalidTlvValue 1) + Just (w, r1) -> (w :) <$> bigsizes r1 + +-- reply_short_channel_ids_end ------------------------------------------------ + +-- | Encode a t'ReplyShortChannelIdsEnd' payload. +encode_reply_short_channel_ids_end + :: ReplyShortChannelIdsEnd -> BS.ByteString +encode_reply_short_channel_ids_end m = mconcat + [ BOLT1.un_chain_hash (rsce_chain_hash m) + , encode_bool (rsce_full_information m) + , BOLT1.encode_tlv_stream (rsce_tlvs m) + ] + +-- | Decode a t'ReplyShortChannelIdsEnd' payload. +-- +-- >>> decode_reply_short_channel_ids_end (BS.replicate 32 0 <> "\STX") +-- Left DecodeInvalidBool +decode_reply_short_channel_ids_end + :: BS.ByteString -> Either DecodeError ReplyShortChannelIdsEnd +decode_reply_short_channel_ids_end b0 = do + (ch, b1) <- chain_hash b0 + (full, b2) <- bool b1 + ext <- extension b2 + pure (ReplyShortChannelIdsEnd ch full ext) + +-- query_channel_range -------------------------------------------------------- + +-- | Encode a t'QueryChannelRange' payload. Fails if 'qcr_tlvs' holds a +-- record of type 1. +encode_query_channel_range + :: QueryChannelRange -> Either EncodeError BS.ByteString +encode_query_channel_range m = do + let opt = case qcr_query_option m of + Nothing -> [] + Just (QueryOption w) -> [TlvRecord 1 (BOLT1.encode_bigsize w)] + t <- merge [1] opt (qcr_tlvs m) + pure $ mconcat + [ BOLT1.un_chain_hash (qcr_chain_hash m) + , BOLT1.encode_u32 (qcr_first_blocknum m) + , BOLT1.encode_u32 (qcr_number_of_blocks m) + , t + ] + +-- | Decode a t'QueryChannelRange' payload. +decode_query_channel_range + :: BS.ByteString -> Either DecodeError QueryChannelRange +decode_query_channel_range b0 = do + (ch, b1) <- chain_hash b0 + (first, b2) <- u32 b1 + (num, b3) <- u32 b2 + s <- tlvs [1] b3 + opt <- traverse option (BOLT1.lookup_tlv 1 s) + pure QueryChannelRange + { qcr_chain_hash = ch + , qcr_first_blocknum = first + , qcr_number_of_blocks = num + , qcr_query_option = opt + , qcr_tlvs = BOLT1.filter_tlv_stream (/= 1) s + } + where + option v = case BOLT1.decode_bigsize v of + Just (w, r) | BS.null r -> Right (QueryOption w) + _ -> Left (DecodeInvalidTlvValue 1) + +-- reply_channel_range -------------------------------------------------------- + +-- | Encode a t'ReplyChannelRange' payload. Fails if the short channel ids +-- exceed the u16 length limit (8191 of them), if the timestamps or +-- checksums don't number one per short channel id, or if 'rcr_tlvs' +-- holds a record of type 1 or 3. +encode_reply_channel_range + :: ReplyChannelRange -> Either EncodeError BS.ByteString +encode_reply_channel_range m = do + let scids = rcr_short_channel_ids m + n = length scids + count xs + | length xs /= n = Left EncodeCountMismatch + | otherwise = Right () + ids <- prefixed (encode_short_ids scids) + ts <- case rcr_timestamps m of + Nothing -> pure [] + Just xs -> do + count xs + pure [TlvRecord 1 (BS.cons 0 (foldMap + (\(ChannelUpdateTimestamps a b) -> pair a b) xs))] + cs <- case rcr_checksums m of + Nothing -> pure [] + Just xs -> do + count xs + pure [TlvRecord 3 (foldMap + (\(ChannelUpdateChecksums a b) -> pair a b) xs)] + t <- merge [1, 3] (ts <> cs) (rcr_tlvs m) + pure $ mconcat + [ BOLT1.un_chain_hash (rcr_chain_hash m) + , BOLT1.encode_u32 (rcr_first_blocknum m) + , BOLT1.encode_u32 (rcr_number_of_blocks m) + , encode_bool (rcr_sync_complete m) + , ids + , t + ] + where + pair a b = BOLT1.encode_u32 a <> BOLT1.encode_u32 b + +-- | Decode a t'ReplyChannelRange' payload. +-- +-- Fails on an unknown encoding type (including the deprecated zlib +-- encoding), on @encoded_short_ids@ that isn't a whole number of short +-- channel ids, and on timestamps or checksums that don't number one +-- per short channel id. +decode_reply_channel_range + :: BS.ByteString -> Either DecodeError ReplyChannelRange +decode_reply_channel_range b0 = do + (ch, b1) <- chain_hash b0 + (first, b2) <- u32 b1 + (num, b3) <- u32 b2 + (sync, b4) <- bool b3 + (ids, b5) <- u16_prefixed b4 + scids <- short_ids ids + s <- tlvs [1, 3] b5 + let n = length scids + ts <- traverse (timestamps n) (BOLT1.lookup_tlv 1 s) + cs <- traverse (pairs 3 ChannelUpdateChecksums n) (BOLT1.lookup_tlv 3 s) + pure ReplyChannelRange + { rcr_chain_hash = ch + , rcr_first_blocknum = first + , rcr_number_of_blocks = num + , rcr_sync_complete = sync + , rcr_short_channel_ids = scids + , rcr_timestamps = ts + , rcr_checksums = cs + , rcr_tlvs = + BOLT1.filter_tlv_stream (\t -> t /= 1 && t /= 3) s + } + where + timestamps n v = case BS.uncons v of + Nothing -> Left (DecodeInvalidTlvValue 1) + Just (0, r) -> pairs 1 ChannelUpdateTimestamps n r + Just (e, _) -> Left (DecodeUnknownEncoding e) + +-- decode an array of u32 pairs holding n elements +pairs + :: Word64 -> (Word32 -> Word32 -> a) -> Int -> BS.ByteString + -> Either DecodeError [a] +pairs t mk n r + | BS.length r `rem` 8 /= 0 = Left (DecodeInvalidTlvValue t) + | BS.length r `quot` 8 /= n = Left DecodeCountMismatch + | otherwise = Right (go r) + where + go !bs = case BOLT1.decode_u32 bs of + Nothing -> [] + Just (a, r1) -> case BOLT1.decode_u32 r1 of + Nothing -> [] + Just (b, r2) -> mk a b : go r2 + +-- gossip_timestamp_filter ---------------------------------------------------- + +-- | Encode a t'GossipTimestampFilter' payload. +encode_gossip_timestamp_filter :: GossipTimestampFilter -> BS.ByteString +encode_gossip_timestamp_filter m = mconcat + [ BOLT1.un_chain_hash (gtf_chain_hash m) + , BOLT1.encode_u32 (gtf_first_timestamp m) + , BOLT1.encode_u32 (gtf_timestamp_range m) + , BOLT1.encode_tlv_stream (gtf_tlvs m) + ] + +-- | Decode a t'GossipTimestampFilter' payload. +decode_gossip_timestamp_filter + :: BS.ByteString -> Either DecodeError GossipTimestampFilter +decode_gossip_timestamp_filter b0 = do + (ch, b1) <- chain_hash b0 + (first, b2) <- u32 b1 + (range, b3) <- u32 b2 + ext <- extension b3 + pure (GossipTimestampFilter ch first range ext) + +-- encoded short channel ids -------------------------------------------------- + +-- encoding type 0 (uncompressed), the only one allowed +encode_short_ids :: [ShortChannelId] -> BS.ByteString +encode_short_ids = BS.cons 0 . foldMap BOLT1.encode_short_channel_id + +short_ids :: BS.ByteString -> Either DecodeError [ShortChannelId] +short_ids bs = case BS.uncons bs of + Nothing -> Left DecodeInvalidShortChannelIds + Just (0, r) + | BS.length r `rem` 8 == 0 -> Right (go r) + | otherwise -> Left DecodeInvalidShortChannelIds + Just (e, _) -> Left (DecodeUnknownEncoding e) + where + go !r = case BOLT1.decode_short_channel_id r of + Nothing -> [] + Just (s, r1) -> s : go r1 + +-- helpers -------------------------------------------------------------------- + +need :: Maybe a -> Either DecodeError a +need = maybe (Left DecodeInsufficientBytes) Right +{-# INLINE need #-} + +u8 :: BS.ByteString -> Either DecodeError (Word8, BS.ByteString) +u8 = need . BS.uncons +{-# INLINE u8 #-} + +u16 :: BS.ByteString -> Either DecodeError (Word16, BS.ByteString) +u16 = need . BOLT1.decode_u16 +{-# INLINE u16 #-} + +u32 :: BS.ByteString -> Either DecodeError (Word32, BS.ByteString) +u32 = need . BOLT1.decode_u32 +{-# INLINE u32 #-} + +bytes + :: Int -> BS.ByteString + -> Either DecodeError (BS.ByteString, BS.ByteString) +bytes n bs + | BS.length bs < n = Left DecodeInsufficientBytes + | otherwise = Right (BS.splitAt n bs) +{-# INLINE bytes #-} + +u16_prefixed + :: BS.ByteString -> Either DecodeError (BS.ByteString, BS.ByteString) +u16_prefixed = need . BOLT1.decode_u16_prefixed +{-# INLINE u16_prefixed #-} + +bool :: BS.ByteString -> Either DecodeError (Bool, BS.ByteString) +bool bs = do + (b, r) <- u8 bs + case b of + 0 -> Right (False, r) + 1 -> Right (True, r) + _ -> Left DecodeInvalidBool + +signature :: BS.ByteString -> Either DecodeError (Signature, BS.ByteString) +signature = need . BOLT1.decode_signature +{-# INLINE signature #-} + +chain_hash :: BS.ByteString -> Either DecodeError (ChainHash, BS.ByteString) +chain_hash = need . BOLT1.decode_chain_hash +{-# INLINE chain_hash #-} + +short_channel_id + :: BS.ByteString -> Either DecodeError (ShortChannelId, BS.ByteString) +short_channel_id = need . BOLT1.decode_short_channel_id +{-# INLINE short_channel_id #-} + +point :: BS.ByteString -> Either DecodeError (Point, BS.ByteString) +point bs = do + (b, r) <- bytes 33 bs + case BOLT1.point b of + Nothing -> Left DecodeInvalidPoint + Just p -> Right (p, r) + +milli_satoshi + :: BS.ByteString -> Either DecodeError (MilliSatoshi, BS.ByteString) +milli_satoshi bs = do + (w, r) <- need (BOLT1.decode_u64 bs) + case BOLT1.milli_satoshi w of + Nothing -> Left DecodeInvalidAmount + Just a -> Right (a, r) + +-- a TLV stream with the given known types +tlvs :: [Word64] -> BS.ByteString -> Either DecodeError TlvStream +tlvs known bs = either (Left . DecodeTlvError) Right + (BOLT1.decode_tlv_stream (`elem` known) bs) + +-- an extension stream, in which no types are known +extension :: BS.ByteString -> Either DecodeError TlvStream +extension = tlvs [] +{-# INLINE extension #-} + +prefixed :: BS.ByteString -> Either EncodeError BS.ByteString +prefixed bs = + maybe (Left EncodeLengthOverflow) Right (BOLT1.encode_u16_prefixed bs) +{-# INLINE prefixed #-} + +encode_bool :: Bool -> BS.ByteString +encode_bool b = BS.singleton (if b then 1 else 0) +{-# INLINE encode_bool #-} + +-- encode typed records together with the extra records of a @_tlvs@ +-- field, which mustn't use any of the message's known types +merge + :: [Word64] -> [TlvRecord] -> TlvStream -> Either EncodeError BS.ByteString +merge known typed extra + | any ((`elem` known) . tlv_type) rs = Left EncodeInvalidTlvs + | otherwise = + maybe (Left EncodeInvalidTlvs) (Right . BOLT1.encode_tlv_stream) + (BOLT1.tlv_stream (typed <> rs)) + where + rs = BOLT1.un_tlv_stream extra diff --git a/lib/Lightning/Protocol/BOLT7/Hash.hs b/lib/Lightning/Protocol/BOLT7/Hash.hs --- a/lib/Lightning/Protocol/BOLT7/Hash.hs +++ b/lib/Lightning/Protocol/BOLT7/Hash.hs @@ -1,5 +1,4 @@ -{-# OPTIONS_HADDOCK prune #-} - +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE BangPatterns #-} -- | @@ -8,99 +7,117 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- Signature hash computation for BOLT #7 messages. +-- Signature digests, signature verification and checksums for BOLT #7 +-- messages. -- --- These functions compute the double-SHA256 hash that is signed in each --- message type. The hash covers the message content excluding the --- signature field(s). +-- Signatures cover the encoded message after its signature fields, +-- extension included. Since decoding keeps every byte, the digest of a +-- decoded message is the digest of the bytes received. module Lightning.Protocol.BOLT7.Hash ( - -- * Signature hashes - channelAnnouncementHash - , nodeAnnouncementHash - , channelUpdateHash - - -- * Checksums - , channelUpdateChecksum + channel_announcement_hash + , node_announcement_hash + , channel_update_hash + , verify_channel_announcement + , verify_node_announcement + , verify_channel_update + , channel_update_checksum ) where -import Data.ByteString (ByteString) +import qualified Crypto.Curve.Secp256k1 as Secp256k1 +import qualified Crypto.Hash.SHA256 as SHA256 import qualified Data.ByteString as BS import Data.Word (Word32) -import qualified Crypto.Hash.SHA256 as SHA256 +import Lightning.Protocol.BOLT1 (Point, Signature) +import qualified Lightning.Protocol.BOLT1 as BOLT1 import Lightning.Protocol.BOLT7.CRC32C (crc32c) -import Lightning.Protocol.BOLT7.Types (signatureLen, chainHashLen) +import Lightning.Protocol.BOLT7.Codec +import Lightning.Protocol.BOLT7.Messages --- | Double SHA-256 hash (used for Lightning message signing). -doubleSha256 :: ByteString -> ByteString -doubleSha256 = SHA256.hash . SHA256.hash -{-# INLINE doubleSha256 #-} +-- the signed bytes of each message +announcement_signed :: ChannelAnnouncement -> Either EncodeError BS.ByteString +announcement_signed = fmap (BS.drop 256) . encode_channel_announcement +{-# INLINE announcement_signed #-} --- | Compute signature hash for channel_announcement. --- --- The hash covers the message starting at byte offset 256, which is after --- the four 64-byte signatures (node_sig_1, node_sig_2, bitcoin_sig_1, --- bitcoin_sig_2). --- --- Returns the double-SHA256 hash (32 bytes). -channelAnnouncementHash :: ByteString -> ByteString -channelAnnouncementHash !msg = - let offset = 4 * signatureLen - payload = BS.drop offset msg - in doubleSha256 payload -{-# INLINE channelAnnouncementHash #-} +node_signed :: NodeAnnouncement -> Either EncodeError BS.ByteString +node_signed = fmap (BS.drop 64) . encode_node_announcement +{-# INLINE node_signed #-} --- | Compute signature hash for node_announcement. --- --- The hash covers the message starting after the signature field (64 bytes). --- --- Returns the double-SHA256 hash (32 bytes). -nodeAnnouncementHash :: ByteString -> ByteString -nodeAnnouncementHash !msg = - let payload = BS.drop signatureLen msg - in doubleSha256 payload -{-# INLINE nodeAnnouncementHash #-} +update_signed :: ChannelUpdate -> BS.ByteString +update_signed = BS.drop 64 . encode_channel_update +{-# INLINE update_signed #-} --- | Compute signature hash for channel_update. --- --- The hash covers the message starting after the signature field (64 bytes). --- --- Returns the double-SHA256 hash (32 bytes). -channelUpdateHash :: ByteString -> ByteString -channelUpdateHash !msg = - let payload = BS.drop signatureLen msg - in doubleSha256 payload -{-# INLINE channelUpdateHash #-} +double_sha256 :: BS.ByteString -> BS.ByteString +double_sha256 = SHA256.hash . SHA256.hash +{-# INLINE double_sha256 #-} --- | Compute checksum for channel_update. +-- | The digest the four signatures of a t'ChannelAnnouncement' sign: the +-- double SHA-256 of its encoding from offset 256 (after the +-- signatures) to the end. Fails as 'encode_channel_announcement' does. +channel_announcement_hash + :: ChannelAnnouncement -> Either EncodeError BS.ByteString +channel_announcement_hash = fmap double_sha256 . announcement_signed + +-- | The digest the signature of a t'NodeAnnouncement' signs: the double +-- SHA-256 of its encoding after the signature. Fails as +-- 'encode_node_announcement' does. +node_announcement_hash + :: NodeAnnouncement -> Either EncodeError BS.ByteString +node_announcement_hash = fmap double_sha256 . node_signed + +-- | The digest the signature of a t'ChannelUpdate' signs: the double +-- SHA-256 of its encoding after the signature. +channel_update_hash :: ChannelUpdate -> BS.ByteString +channel_update_hash = double_sha256 . update_signed + +-- | Verify the four signatures of a t'ChannelAnnouncement': both node +-- signatures and both bitcoin signatures, each over +-- 'channel_announcement_hash' under the corresponding key. -- --- This is the CRC-32C of the channel_update message excluding the --- signature field (bytes 0-63) and timestamp field (bytes 96-99). +-- As with libsecp256k1, signatures must be in low-s form. A key that +-- isn't a point on the curve fails verification. +verify_channel_announcement :: ChannelAnnouncement -> Bool +verify_channel_announcement m = case announcement_signed m of + Left _ -> False + Right signed -> + let !d = SHA256.hash signed + in verify d (ca_node_id_1 m) (ca_node_signature_1 m) + && verify d (ca_node_id_2 m) (ca_node_signature_2 m) + && verify d (ca_bitcoin_key_1 m) (ca_bitcoin_signature_1 m) + && verify d (ca_bitcoin_key_2 m) (ca_bitcoin_signature_2 m) + +-- | Verify the signature of a t'NodeAnnouncement' under its node id. -- --- The checksum is used in the checksums_tlv of reply_channel_range. +-- As with libsecp256k1, the signature must be in low-s form. +verify_node_announcement :: NodeAnnouncement -> Bool +verify_node_announcement m = case node_signed m of + Left _ -> False + Right signed -> verify (SHA256.hash signed) (na_node_id m) (na_signature m) + +-- | Verify the signature of a t'ChannelUpdate' under the given node id. -- --- Message layout after signature: --- - chain_hash: 32 bytes (offset 64-95) --- - short_channel_id: 8 bytes (offset 96-103) --- - timestamp: 4 bytes (offset 104-107) -- EXCLUDED --- - message_flags: 1 byte (offset 108) --- - channel_flags: 1 byte (offset 109) --- - cltv_expiry_delta: 2 bytes (offset 110-111) --- - htlc_minimum_msat: 8 bytes (offset 112-119) --- - fee_base_msat: 4 bytes (offset 120-123) --- - fee_proportional_millionths: 4 bytes (offset 124-127) --- - htlc_maximum_msat: 8 bytes (offset 128-135, if present) -channelUpdateChecksum :: ByteString -> Word32 -channelUpdateChecksum !msg = - let -- Offset 64: chain_hash (32 bytes) - chainHash = BS.take chainHashLen (BS.drop signatureLen msg) - -- Offset 96: short_channel_id (8 bytes) - scid = BS.take 8 (BS.drop (signatureLen + chainHashLen) msg) - -- Skip timestamp (4 bytes at offset 104) - -- Offset 108 to end: rest of message - restOffset = signatureLen + chainHashLen + 8 + 4 -- 64 + 32 + 8 + 4 = 108 - rest = BS.drop restOffset msg - -- Concatenate: chain_hash + scid + (message without sig and timestamp) - checksumData = BS.concat [chainHash, scid, rest] - in crc32c checksumData -{-# INLINE channelUpdateChecksum #-} +-- The key is that of the channel's t'ChannelAnnouncement' selected by +-- the update's direction: 'ca_node_id_1' for +-- 'Lightning.Protocol.BOLT7.NodeOne', 'ca_node_id_2' for +-- 'Lightning.Protocol.BOLT7.NodeTwo'. As with libsecp256k1, the +-- signature must be in low-s form. +verify_channel_update :: Point -> ChannelUpdate -> Bool +verify_channel_update k m = + verify (SHA256.hash (update_signed m)) k (cu_signature m) + +-- verify a signature over the double SHA-256 of some bytes, given their +-- single SHA-256 (secp256k1's verify_ecdsa hashes once more) +verify :: BS.ByteString -> Point -> Signature -> Bool +verify d k s = + case ( Secp256k1.parse_point (BOLT1.un_point k) + , Secp256k1.parse_sig (BOLT1.un_signature s) ) of + (Just p, Just sig) -> Secp256k1.verify_ecdsa' Secp256k1.precompute d p sig + _ -> False + +-- | The checksum of a t'ChannelUpdate', as used in the @checksums_tlv@ of +-- @reply_channel_range@: the CRC-32C (RFC 3720) of the update without +-- its signature and timestamp. Extension records are included. +channel_update_checksum :: ChannelUpdate -> Word32 +channel_update_checksum m = + let !bs = encode_channel_update m + in crc32c (BS.take 40 (BS.drop 64 bs) <> BS.drop 108 bs) diff --git a/lib/Lightning/Protocol/BOLT7/Messages.hs b/lib/Lightning/Protocol/BOLT7/Messages.hs --- a/lib/Lightning/Protocol/BOLT7/Messages.hs +++ b/lib/Lightning/Protocol/BOLT7/Messages.hs @@ -1,6 +1,4 @@ -{-# OPTIONS_HADDOCK prune #-} - -{-# LANGUAGE BangPatterns #-} +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveGeneric #-} -- | @@ -9,228 +7,189 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- BOLT #7 gossip message type definitions. +-- The messages defined by BOLT #7. module Lightning.Protocol.BOLT7.Messages ( - -- * Message types - MsgType(..) - , msgTypeCode - - -- * Channel announcement + Message(..) + , message_type , ChannelAnnouncement(..) - - -- * Node announcement , NodeAnnouncement(..) - - -- * Channel update , ChannelUpdate(..) - - -- * Announcement signatures , AnnouncementSignatures(..) - - -- * Query messages , QueryShortChannelIds(..) , ReplyShortChannelIdsEnd(..) , QueryChannelRange(..) , ReplyChannelRange(..) , GossipTimestampFilter(..) - - -- * Union type - , Message(..) ) where import Control.DeepSeq (NFData) -import Data.ByteString (ByteString) -import Data.Word (Word8, Word16, Word32) -- Word8 still used by other messages +import qualified Data.ByteString as BS +import Data.Word (Word16, Word32) import GHC.Generics (Generic) -import Lightning.Protocol.BOLT1 (TlvStream) +import Lightning.Protocol.BOLT1 + ( ChainHash, ChannelId, MilliSatoshi, Point, ShortChannelId + , Signature, TlvStream ) +import qualified Lightning.Protocol.BOLT9 as BOLT9 import Lightning.Protocol.BOLT7.Types --- Message type codes ---------------------------------------------------------- - --- | BOLT #7 message type codes. -data MsgType - = MsgChannelAnnouncement -- ^ 256 - | MsgNodeAnnouncement -- ^ 257 - | MsgChannelUpdate -- ^ 258 - | MsgAnnouncementSignatures -- ^ 259 - | MsgQueryShortChannelIds -- ^ 261 - | MsgReplyShortChannelIdsEnd -- ^ 262 - | MsgQueryChannelRange -- ^ 263 - | MsgReplyChannelRange -- ^ 264 - | MsgGossipTimestampFilter -- ^ 265 - deriving (Eq, Show, Generic) - -instance NFData MsgType - --- | Get numeric code for message type. -msgTypeCode :: MsgType -> Word16 -msgTypeCode MsgChannelAnnouncement = 256 -msgTypeCode MsgNodeAnnouncement = 257 -msgTypeCode MsgChannelUpdate = 258 -msgTypeCode MsgAnnouncementSignatures = 259 -msgTypeCode MsgQueryShortChannelIds = 261 -msgTypeCode MsgReplyShortChannelIdsEnd = 262 -msgTypeCode MsgQueryChannelRange = 263 -msgTypeCode MsgReplyChannelRange = 264 -msgTypeCode MsgGossipTimestampFilter = 265 -{-# INLINE msgTypeCode #-} - --- Channel announcement -------------------------------------------------------- - --- | channel_announcement message (type 256). --- --- Announces a public channel to the network. +-- | The @channel_announcement@ message (type 256). data ChannelAnnouncement = ChannelAnnouncement - { channelAnnNodeSig1 :: !Signature -- ^ Signature from node_id_1 - , channelAnnNodeSig2 :: !Signature -- ^ Signature from node_id_2 - , channelAnnBitcoinSig1 :: !Signature -- ^ Signature from bitcoin_key_1 - , channelAnnBitcoinSig2 :: !Signature -- ^ Signature from bitcoin_key_2 - , channelAnnFeatures :: !FeatureBits -- ^ Feature bits - , channelAnnChainHash :: !ChainHash -- ^ Chain identifier - , channelAnnShortChanId :: !ShortChannelId -- ^ Short channel ID - , channelAnnNodeId1 :: !NodeId -- ^ First node (lexicographically) - , channelAnnNodeId2 :: !NodeId -- ^ Second node - , channelAnnBitcoinKey1 :: !Point -- ^ Bitcoin key for node_id_1 - , channelAnnBitcoinKey2 :: !Point -- ^ Bitcoin key for node_id_2 - } - deriving (Eq, Show, Generic) + { ca_node_signature_1 :: !Signature + , ca_node_signature_2 :: !Signature + , ca_bitcoin_signature_1 :: !Signature + , ca_bitcoin_signature_2 :: !Signature + , ca_features :: !BOLT9.FeatureVector + , ca_chain_hash :: !ChainHash + , ca_short_channel_id :: {-# UNPACK #-} !ShortChannelId + , ca_node_id_1 :: !Point + -- ^ the lexicographically lesser node id + , ca_node_id_2 :: !Point + , ca_bitcoin_key_1 :: !Point + , ca_bitcoin_key_2 :: !Point + , ca_tlvs :: !TlvStream + -- ^ extension TLV records (all unknown odd) + } deriving (Eq, Show, Generic) instance NFData ChannelAnnouncement --- Node announcement ----------------------------------------------------------- - --- | node_announcement message (type 257). --- --- Advertises node metadata to the network. +-- | The @node_announcement@ message (type 257). data NodeAnnouncement = NodeAnnouncement - { nodeAnnSignature :: !Signature -- ^ Signature of message - , nodeAnnFeatures :: !FeatureBits -- ^ Feature bits - , nodeAnnTimestamp :: !Timestamp -- ^ Unix timestamp - , nodeAnnNodeId :: !NodeId -- ^ Node public key - , nodeAnnRgbColor :: !RgbColor -- ^ RGB color - , nodeAnnAlias :: !Alias -- ^ Node alias (32 bytes UTF-8) - , nodeAnnAddresses :: ![Address] -- ^ List of addresses - } - deriving (Eq, Show, Generic) + { na_signature :: !Signature + , na_features :: !BOLT9.FeatureVector + , na_timestamp :: {-# UNPACK #-} !Word32 + , na_node_id :: !Point + , na_rgb_color :: !RgbColor + , na_alias :: !Alias + , na_addresses :: ![Address] + -- ^ address descriptors of known types, in order + , na_unknown_addresses :: !BS.ByteString + -- ^ the address bytes from the first descriptor of an unknown type + -- on (empty if there is none), kept as received + , na_tlvs :: !TlvStream + -- ^ extension TLV records (all unknown odd) + } deriving (Eq, Show, Generic) instance NFData NodeAnnouncement --- Channel update -------------------------------------------------------------- - --- | channel_update message (type 258). --- --- Communicates per-direction routing parameters. +-- | The @channel_update@ message (type 258). data ChannelUpdate = ChannelUpdate - { chanUpdateSignature :: !Signature -- ^ Signature of message - , chanUpdateChainHash :: !ChainHash -- ^ Chain identifier - , chanUpdateShortChanId :: !ShortChannelId -- ^ Short channel ID - , chanUpdateTimestamp :: !Timestamp -- ^ Unix timestamp - , chanUpdateMsgFlags :: !MessageFlags -- ^ Message flags - , chanUpdateChanFlags :: !ChannelFlags -- ^ Channel flags - , chanUpdateCltvExpDelta :: !CltvExpiryDelta -- ^ CLTV expiry delta - , chanUpdateHtlcMinMsat :: !HtlcMinimumMsat -- ^ Minimum HTLC msat - , chanUpdateFeeBaseMsat :: !FeeBaseMsat -- ^ Base fee msat - , chanUpdateFeeProportional :: !FeeProportionalMillionths -- ^ Prop fee - , chanUpdateHtlcMaxMsat :: !(Maybe HtlcMaximumMsat) -- ^ Max HTLC (optional) - } - deriving (Eq, Show, Generic) + { cu_signature :: !Signature + , cu_chain_hash :: !ChainHash + , cu_short_channel_id :: {-# UNPACK #-} !ShortChannelId + , cu_timestamp :: {-# UNPACK #-} !Word32 + , cu_message_flags :: {-# UNPACK #-} !MessageFlags + , cu_channel_flags :: {-# UNPACK #-} !ChannelFlags + , cu_cltv_expiry_delta :: {-# UNPACK #-} !Word16 + , cu_htlc_minimum_msat :: {-# UNPACK #-} !MilliSatoshi + , cu_fee_base_msat :: {-# UNPACK #-} !Word32 + , cu_fee_proportional_millionths :: {-# UNPACK #-} !Word32 + , cu_htlc_maximum_msat :: {-# UNPACK #-} !MilliSatoshi + , cu_tlvs :: !TlvStream + -- ^ extension TLV records (all unknown odd) + } deriving (Eq, Show, Generic) instance NFData ChannelUpdate --- Announcement signatures ----------------------------------------------------- - --- | announcement_signatures message (type 259). --- --- Sent between channel peers to enable channel announcement. +-- | The @announcement_signatures@ message (type 259). data AnnouncementSignatures = AnnouncementSignatures - { annSigChannelId :: !ChannelId -- ^ Channel ID - , annSigShortChanId :: !ShortChannelId -- ^ Short channel ID - , annSigNodeSig :: !Signature -- ^ Node signature - , annSigBitcoinSig :: !Signature -- ^ Bitcoin signature - } - deriving (Eq, Show, Generic) + { as_channel_id :: !ChannelId + , as_short_channel_id :: {-# UNPACK #-} !ShortChannelId + , as_node_signature :: !Signature + , as_bitcoin_signature :: !Signature + , as_tlvs :: !TlvStream + -- ^ extension TLV records (all unknown odd) + } deriving (Eq, Show, Generic) instance NFData AnnouncementSignatures --- Query messages -------------------------------------------------------------- - --- | query_short_channel_ids message (type 261). --- --- Requests information about specific channels. +-- | The @query_short_channel_ids@ message (type 261). data QueryShortChannelIds = QueryShortChannelIds - { queryScidsChainHash :: !ChainHash -- ^ Chain identifier - , queryScidsData :: !ByteString -- ^ Encoded short_channel_ids - , queryScidsTlvs :: !TlvStream -- ^ Optional TLV (query_flags) - } - deriving (Eq, Show, Generic) + { qsci_chain_hash :: !ChainHash + , qsci_short_channel_ids :: ![ShortChannelId] + , qsci_query_flags :: !(Maybe [QueryFlags]) + -- ^ @query_flags@ (TLV type 1): one per short channel id + , qsci_tlvs :: !TlvStream + -- ^ unknown odd TLV records + } deriving (Eq, Show, Generic) instance NFData QueryShortChannelIds --- | reply_short_channel_ids_end message (type 262). --- --- Concludes response to query_short_channel_ids. +-- | The @reply_short_channel_ids_end@ message (type 262). data ReplyShortChannelIdsEnd = ReplyShortChannelIdsEnd - { replyScidsChainHash :: !ChainHash -- ^ Chain identifier - , replyScidsFullInfo :: !Word8 -- ^ 1 if complete, 0 otherwise - } - deriving (Eq, Show, Generic) + { rsce_chain_hash :: !ChainHash + , rsce_full_information :: !Bool + , rsce_tlvs :: !TlvStream + -- ^ extension TLV records (all unknown odd) + } deriving (Eq, Show, Generic) instance NFData ReplyShortChannelIdsEnd --- | query_channel_range message (type 263). --- --- Queries channels within a block range. +-- | The @query_channel_range@ message (type 263). data QueryChannelRange = QueryChannelRange - { queryRangeChainHash :: !ChainHash -- ^ Chain identifier - , queryRangeFirstBlock :: !Word32 -- ^ First block number - , queryRangeNumBlocks :: !Word32 -- ^ Number of blocks - , queryRangeTlvs :: !TlvStream -- ^ Optional TLV (query_option) - } - deriving (Eq, Show, Generic) + { qcr_chain_hash :: !ChainHash + , qcr_first_blocknum :: {-# UNPACK #-} !Word32 + , qcr_number_of_blocks :: {-# UNPACK #-} !Word32 + , qcr_query_option :: !(Maybe QueryOption) + -- ^ @query_option@ (TLV type 1) + , qcr_tlvs :: !TlvStream + -- ^ unknown odd TLV records + } deriving (Eq, Show, Generic) instance NFData QueryChannelRange --- | reply_channel_range message (type 264). --- --- Responds to query_channel_range with channel IDs. +-- | The @reply_channel_range@ message (type 264). data ReplyChannelRange = ReplyChannelRange - { replyRangeChainHash :: !ChainHash -- ^ Chain identifier - , replyRangeFirstBlock :: !Word32 -- ^ First block number - , replyRangeNumBlocks :: !Word32 -- ^ Number of blocks - , replyRangeSyncComplete :: !Word8 -- ^ 1 if sync complete - , replyRangeData :: !ByteString -- ^ Encoded short_channel_ids - , replyRangeTlvs :: !TlvStream -- ^ Optional TLVs - } - deriving (Eq, Show, Generic) + { rcr_chain_hash :: !ChainHash + , rcr_first_blocknum :: {-# UNPACK #-} !Word32 + , rcr_number_of_blocks :: {-# UNPACK #-} !Word32 + , rcr_sync_complete :: !Bool + , rcr_short_channel_ids :: ![ShortChannelId] + , rcr_timestamps :: !(Maybe [ChannelUpdateTimestamps]) + -- ^ @timestamps_tlv@ (TLV type 1): one per short channel id + , rcr_checksums :: !(Maybe [ChannelUpdateChecksums]) + -- ^ @checksums_tlv@ (TLV type 3): one per short channel id + , rcr_tlvs :: !TlvStream + -- ^ unknown odd TLV records + } deriving (Eq, Show, Generic) instance NFData ReplyChannelRange --- | gossip_timestamp_filter message (type 265). --- --- Constrains which gossip messages are relayed. +-- | The @gossip_timestamp_filter@ message (type 265). data GossipTimestampFilter = GossipTimestampFilter - { gossipFilterChainHash :: !ChainHash -- ^ Chain identifier - , gossipFilterFirstTimestamp :: !Word32 -- ^ First timestamp - , gossipFilterTimestampRange :: !Word32 -- ^ Timestamp range - } - deriving (Eq, Show, Generic) + { gtf_chain_hash :: !ChainHash + , gtf_first_timestamp :: {-# UNPACK #-} !Word32 + , gtf_timestamp_range :: {-# UNPACK #-} !Word32 + , gtf_tlvs :: !TlvStream + -- ^ extension TLV records (all unknown odd) + } deriving (Eq, Show, Generic) instance NFData GossipTimestampFilter --- Union type ------------------------------------------------------------------ - --- | Union of all BOLT #7 message types. +-- | A BOLT #7 message. data Message - = MsgChanAnn !ChannelAnnouncement - | MsgNodeAnn !NodeAnnouncement - | MsgChanUpd !ChannelUpdate - | MsgAnnSig !AnnouncementSignatures - | MsgQueryScids !QueryShortChannelIds - | MsgReplyScids !ReplyShortChannelIdsEnd - | MsgQueryRange !QueryChannelRange - | MsgReplyRange !ReplyChannelRange - | MsgGossipFilter !GossipTimestampFilter + = MsgChannelAnnouncement !ChannelAnnouncement + | MsgNodeAnnouncement !NodeAnnouncement + | MsgChannelUpdate !ChannelUpdate + | MsgAnnouncementSignatures !AnnouncementSignatures + | MsgQueryShortChannelIds !QueryShortChannelIds + | MsgReplyShortChannelIdsEnd !ReplyShortChannelIdsEnd + | MsgQueryChannelRange !QueryChannelRange + | MsgReplyChannelRange !ReplyChannelRange + | MsgGossipTimestampFilter !GossipTimestampFilter deriving (Eq, Show, Generic) instance NFData Message + +-- | The message type of a 'Message'. +message_type :: Message -> Word16 +message_type m = case m of + MsgChannelAnnouncement _ -> 256 + MsgNodeAnnouncement _ -> 257 + MsgChannelUpdate _ -> 258 + MsgAnnouncementSignatures _ -> 259 + MsgQueryShortChannelIds _ -> 261 + MsgReplyShortChannelIdsEnd _ -> 262 + MsgQueryChannelRange _ -> 263 + MsgReplyChannelRange _ -> 264 + MsgGossipTimestampFilter _ -> 265 diff --git a/lib/Lightning/Protocol/BOLT7/Types.hs b/lib/Lightning/Protocol/BOLT7/Types.hs --- a/lib/Lightning/Protocol/BOLT7/Types.hs +++ b/lib/Lightning/Protocol/BOLT7/Types.hs @@ -1,5 +1,4 @@ -{-# OPTIONS_HADDOCK prune #-} - +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} @@ -9,484 +8,453 @@ -- License: MIT -- Maintainer: Jared Tobin -- --- Core types for BOLT #7 routing gossip. +-- Field types for BOLT #7 gossip messages. module Lightning.Protocol.BOLT7.Types ( - -- * Identifiers - ChainHash - , chainHash - , getChainHash - , mainnetChainHash - , ShortChannelId - , shortChannelId - , mkShortChannelId - , getShortChannelId - , scidBlockHeight - , scidTxIndex - , scidOutputIndex - , formatScid - , ChannelId - , channelId - , getChannelId - - -- * Cryptographic types - , Signature - , signature - , getSignature - , Point - , point - , getPoint - , NodeId - , nodeId - , getNodeId - - -- * Node metadata - , RgbColor - , rgbColor - , getRgbColor - , Alias - , alias - , getAlias - , Timestamp - , FeatureBits - , featureBits - , getFeatureBits - - -- * Address types - , Address(..) - , IPv4Addr - , ipv4Addr - , getIPv4Addr - , IPv6Addr - , ipv6Addr - , getIPv6Addr - , TorV3Addr - , torV3Addr - , getTorV3Addr + -- * Short channel ids + format_short_channel_id - -- * Channel update flags + -- * channel_update flags , MessageFlags(..) - , encodeMessageFlags - , decodeMessageFlags + , Forwarding(..) + , message_flags + , message_flags_forwarding + , has_must_be_one , ChannelFlags(..) - , encodeChannelFlags - , decodeChannelFlags + , Direction(..) + , ChannelStatus(..) + , channel_flags + , channel_flags_direction + , channel_flags_status - -- * Routing parameters - , CltvExpiryDelta(..) - , FeeBaseMsat(..) - , FeeProportionalMillionths(..) - , HtlcMinimumMsat(..) - , HtlcMaximumMsat(..) + -- * node_announcement fields + , RgbColor(..) + , Alias(..) + , alias + , un_alias + , Address(..) + , IPv4Addr(..) + , ipv4_addr + , un_ipv4_addr + , IPv6Addr(..) + , ipv6_addr + , un_ipv6_addr + , TorV2Addr(..) + , tor_v2_addr + , un_tor_v2_addr + , TorV3Addr(..) + , tor_v3_addr + , un_tor_v3_addr + , Hostname(..) + , hostname + , un_hostname + , is_ascii_hostname + , usable_addresses - -- * Constants - , chainHashLen - , shortChannelIdLen - , channelIdLen - , signatureLen - , pointLen - , nodeIdLen - , rgbColorLen - , aliasLen - , ipv4AddrLen - , ipv6AddrLen - , torV3AddrLen + -- * Query fields + , QueryFlags(..) + , QueryFlag(..) + , query_flags + , has_query_flag + , QueryOption(..) + , QueryOptionFlag(..) + , query_option + , has_query_option + , ChannelUpdateTimestamps(..) + , ChannelUpdateChecksums(..) ) where import Control.DeepSeq (NFData) -import Data.Bits (shiftL, shiftR, (.&.), (.|.)) -import Data.ByteString (ByteString) +import Data.Bits ((.|.), bit, testBit) import qualified Data.ByteString as BS import Data.Word (Word8, Word16, Word32, Word64) import GHC.Generics (Generic) - --- Constants ------------------------------------------------------------------- - --- | Length of a chain hash (32 bytes). -chainHashLen :: Int -chainHashLen = 32 -{-# INLINE chainHashLen #-} - --- | Length of a short channel ID (8 bytes). -shortChannelIdLen :: Int -shortChannelIdLen = 8 -{-# INLINE shortChannelIdLen #-} - --- | Length of a channel ID (32 bytes). -channelIdLen :: Int -channelIdLen = 32 -{-# INLINE channelIdLen #-} - --- | Length of a signature (64 bytes). -signatureLen :: Int -signatureLen = 64 -{-# INLINE signatureLen #-} - --- | Length of a compressed public key (33 bytes). -pointLen :: Int -pointLen = 33 -{-# INLINE pointLen #-} - --- | Length of a node ID (33 bytes, same as compressed public key). -nodeIdLen :: Int -nodeIdLen = 33 -{-# INLINE nodeIdLen #-} - --- | Length of RGB color (3 bytes). -rgbColorLen :: Int -rgbColorLen = 3 -{-# INLINE rgbColorLen #-} - --- | Length of node alias (32 bytes). -aliasLen :: Int -aliasLen = 32 -{-# INLINE aliasLen #-} - --- | Length of IPv4 address (4 bytes). -ipv4AddrLen :: Int -ipv4AddrLen = 4 -{-# INLINE ipv4AddrLen #-} +import Lightning.Protocol.BOLT1 + (ShortChannelId, scid_block_height, scid_tx_index, scid_output_index) --- | Length of IPv6 address (16 bytes). -ipv6AddrLen :: Int -ipv6AddrLen = 16 -{-# INLINE ipv6AddrLen #-} +-- short channel ids ---------------------------------------------------------- --- | Length of Tor v3 address (35 bytes). -torV3AddrLen :: Int -torV3AddrLen = 35 -{-# INLINE torV3AddrLen #-} +-- | Render a short channel id in the human-readable format of BOLT #7: +-- block height, transaction index and output index, in decimal, +-- separated by @x@. +-- +-- >>> fmap format_short_channel_id (short_channel_id 539268 845 1) +-- Just "539268x845x1" +format_short_channel_id :: ShortChannelId -> String +format_short_channel_id s = + show (scid_block_height s) ++ "x" ++ show (scid_tx_index s) ++ "x" + ++ show (scid_output_index s) --- Identifiers ----------------------------------------------------------------- +-- channel_update flags ------------------------------------------------------- --- | Chain hash identifying the blockchain (32 bytes). -newtype ChainHash = ChainHash { getChainHash :: ByteString } +-- | The @message_flags@ byte of a @channel_update@: bit 0 is +-- @must_be_one@, bit 1 is @dont_forward@, and the other bits are +-- unassigned. Every byte is a valid value; unassigned bits are kept so +-- that re-encoding reproduces the signed bytes. +newtype MessageFlags = MessageFlags Word8 deriving (Eq, Show, Generic) -instance NFData ChainHash - --- | Smart constructor for ChainHash. Returns Nothing if not 32 bytes. -chainHash :: ByteString -> Maybe ChainHash -chainHash !bs - | BS.length bs == chainHashLen = Just (ChainHash bs) - | otherwise = Nothing -{-# INLINE chainHash #-} - --- | Bitcoin mainnet chain hash (genesis block hash, little-endian). --- --- This is the double-SHA256 of the mainnet genesis block header, reversed --- to little-endian byte order as used in the protocol. -mainnetChainHash :: ChainHash -mainnetChainHash = ChainHash $ BS.pack - [ 0x6f, 0xe2, 0x8c, 0x0a, 0xb6, 0xf1, 0xb3, 0x72 - , 0xc1, 0xa6, 0xa2, 0x46, 0xae, 0x63, 0xf7, 0x4f - , 0x93, 0x1e, 0x83, 0x65, 0xe1, 0x5a, 0x08, 0x9c - , 0x68, 0xd6, 0x19, 0x00, 0x00, 0x00, 0x00, 0x00 - ] - --- | Short channel ID (8 bytes): block height (3) + tx index (3) + output (2). -newtype ShortChannelId = ShortChannelId { getShortChannelId :: ByteString } - deriving (Eq, Show, Generic) +instance NFData MessageFlags -instance NFData ShortChannelId +-- | Whether a @channel_update@ may be relayed to other peers (the +-- @dont_forward@ bit). +data Forwarding + = Forward -- ^ @dont_forward@ is 0 + | DontForward -- ^ @dont_forward@ is 1, as for unannounced channels + deriving (Eq, Ord, Show, Generic) --- | Smart constructor for ShortChannelId. Returns Nothing if not 8 bytes. -shortChannelId :: ByteString -> Maybe ShortChannelId -shortChannelId !bs - | BS.length bs == shortChannelIdLen = Just (ShortChannelId bs) - | otherwise = Nothing -{-# INLINE shortChannelId #-} +instance NFData Forwarding --- | Construct ShortChannelId from components. --- --- Block height and tx index are truncated to 24 bits. +-- | The t'MessageFlags' an origin node sets: @must_be_one@ set, the given +-- @dont_forward@ bit, and no unassigned bits. -- --- >>> mkShortChannelId 539268 845 1 --- ShortChannelId {getShortChannelId = "\NUL\131\132\NUL\ETX-\NUL\SOH"} -mkShortChannelId - :: Word32 -- ^ Block height (24 bits) - -> Word32 -- ^ Transaction index (24 bits) - -> Word16 -- ^ Output index - -> ShortChannelId -mkShortChannelId !block !txIdx !outIdx = ShortChannelId $ BS.pack - [ fromIntegral ((block `shiftR` 16) .&. 0xff) :: Word8 - , fromIntegral ((block `shiftR` 8) .&. 0xff) - , fromIntegral (block .&. 0xff) - , fromIntegral ((txIdx `shiftR` 16) .&. 0xff) - , fromIntegral ((txIdx `shiftR` 8) .&. 0xff) - , fromIntegral (txIdx .&. 0xff) - , fromIntegral ((outIdx `shiftR` 8) .&. 0xff) - , fromIntegral (outIdx .&. 0xff) - ] -{-# INLINE mkShortChannelId #-} - --- | Extract block height from short channel ID (first 3 bytes, big-endian). -scidBlockHeight :: ShortChannelId -> Word32 -scidBlockHeight (ShortChannelId bs) = - let b0 = fromIntegral (BS.index bs 0) - b1 = fromIntegral (BS.index bs 1) - b2 = fromIntegral (BS.index bs 2) - in (b0 `shiftL` 16) .|. (b1 `shiftL` 8) .|. b2 -{-# INLINE scidBlockHeight #-} - --- | Extract transaction index from short channel ID (bytes 3-5, big-endian). -scidTxIndex :: ShortChannelId -> Word32 -scidTxIndex (ShortChannelId bs) = - let b3 = fromIntegral (BS.index bs 3) - b4 = fromIntegral (BS.index bs 4) - b5 = fromIntegral (BS.index bs 5) - in (b3 `shiftL` 16) .|. (b4 `shiftL` 8) .|. b5 -{-# INLINE scidTxIndex #-} - --- | Extract output index from short channel ID (last 2 bytes, big-endian). -scidOutputIndex :: ShortChannelId -> Word16 -scidOutputIndex (ShortChannelId bs) = - let b6 = fromIntegral (BS.index bs 6) - b7 = fromIntegral (BS.index bs 7) - in (b6 `shiftL` 8) .|. b7 -{-# INLINE scidOutputIndex #-} +-- >>> message_flags DontForward +-- MessageFlags 3 +message_flags :: Forwarding -> MessageFlags +message_flags Forward = MessageFlags 0x01 +message_flags DontForward = MessageFlags 0x03 +{-# INLINE message_flags #-} --- | Format short channel ID as human-readable string. --- --- Uses the standard "block x tx x output" notation. +-- | The @dont_forward@ bit of t'MessageFlags'. -- --- >>> formatScid (mkShortChannelId 539268 845 1) --- "539268x845x1" -formatScid :: ShortChannelId -> String -formatScid scid = - show (scidBlockHeight scid) ++ "x" ++ - show (scidTxIndex scid) ++ "x" ++ - show (scidOutputIndex scid) -{-# INLINE formatScid #-} - --- | Channel ID (32 bytes). -newtype ChannelId = ChannelId { getChannelId :: ByteString } - deriving (Eq, Show, Generic) - -instance NFData ChannelId - --- | Smart constructor for ChannelId. Returns Nothing if not 32 bytes. -channelId :: ByteString -> Maybe ChannelId -channelId !bs - | BS.length bs == channelIdLen = Just (ChannelId bs) - | otherwise = Nothing -{-# INLINE channelId #-} +-- >>> message_flags_forwarding (MessageFlags 0x01) +-- Forward +message_flags_forwarding :: MessageFlags -> Forwarding +message_flags_forwarding (MessageFlags w) + | testBit w 1 = DontForward + | otherwise = Forward +{-# INLINE message_flags_forwarding #-} --- Cryptographic types --------------------------------------------------------- +-- | Whether the @must_be_one@ bit is set. Senders must set it; receivers +-- ignore it. +-- +-- >>> has_must_be_one (MessageFlags 0x00) +-- False +has_must_be_one :: MessageFlags -> Bool +has_must_be_one (MessageFlags w) = testBit w 0 +{-# INLINE has_must_be_one #-} --- | Signature (64 bytes). -newtype Signature = Signature { getSignature :: ByteString } +-- | The @channel_flags@ byte of a @channel_update@: bit 0 is +-- @direction@, bit 1 is @disable@, and the other bits are unassigned. +-- Every byte is a valid value; unassigned bits are kept so that +-- re-encoding reproduces the signed bytes. +newtype ChannelFlags = ChannelFlags Word8 deriving (Eq, Show, Generic) -instance NFData Signature +instance NFData ChannelFlags --- | Smart constructor for Signature. Returns Nothing if not 64 bytes. -signature :: ByteString -> Maybe Signature -signature !bs - | BS.length bs == signatureLen = Just (Signature bs) - | otherwise = Nothing -{-# INLINE signature #-} +-- | The node a @channel_update@ originates from. +data Direction + = NodeOne -- ^ @node_id_1@ (@direction@ is 0) + | NodeTwo -- ^ @node_id_2@ (@direction@ is 1) + deriving (Eq, Ord, Show, Generic) --- | Compressed public key (33 bytes). -newtype Point = Point { getPoint :: ByteString } - deriving (Eq, Show, Generic) +instance NFData Direction -instance NFData Point +-- | Whether a channel direction is usable. +data ChannelStatus + = Enabled -- ^ @disable@ is 0 + | Disabled -- ^ @disable@ is 1 + deriving (Eq, Ord, Show, Generic) --- | Smart constructor for Point. Returns Nothing if not 33 bytes. -point :: ByteString -> Maybe Point -point !bs - | BS.length bs == pointLen = Just (Point bs) - | otherwise = Nothing -{-# INLINE point #-} +instance NFData ChannelStatus --- | Node ID (33 bytes, same as compressed public key). +-- | The t'ChannelFlags' for the given direction and status, with no +-- unassigned bits set. -- --- Has Ord instance for lexicographic comparison (required by spec for --- channel announcements where node_id_1 < node_id_2). -newtype NodeId = NodeId { getNodeId :: ByteString } - deriving (Eq, Ord, Show, Generic) +-- >>> channel_flags NodeTwo Disabled +-- ChannelFlags 3 +channel_flags :: Direction -> ChannelStatus -> ChannelFlags +channel_flags d s = ChannelFlags (dir .|. sta) + where + dir = case d of + NodeOne -> 0x00 + NodeTwo -> 0x01 + sta = case s of + Enabled -> 0x00 + Disabled -> 0x02 +{-# INLINE channel_flags #-} -instance NFData NodeId +-- | The @direction@ bit of t'ChannelFlags'. +-- +-- >>> channel_flags_direction (ChannelFlags 0x05) +-- NodeTwo +channel_flags_direction :: ChannelFlags -> Direction +channel_flags_direction (ChannelFlags w) + | testBit w 0 = NodeTwo + | otherwise = NodeOne +{-# INLINE channel_flags_direction #-} --- | Smart constructor for NodeId. Returns Nothing if not 33 bytes. -nodeId :: ByteString -> Maybe NodeId -nodeId !bs - | BS.length bs == nodeIdLen = Just (NodeId bs) - | otherwise = Nothing -{-# INLINE nodeId #-} +-- | The @disable@ bit of t'ChannelFlags'. +-- +-- >>> channel_flags_status (ChannelFlags 0x02) +-- Disabled +channel_flags_status :: ChannelFlags -> ChannelStatus +channel_flags_status (ChannelFlags w) + | testBit w 1 = Disabled + | otherwise = Enabled +{-# INLINE channel_flags_status #-} --- Node metadata --------------------------------------------------------------- +-- node_announcement fields --------------------------------------------------- --- | RGB color (3 bytes). -newtype RgbColor = RgbColor { getRgbColor :: ByteString } +-- | A node's colour: red, green and blue. +data RgbColor = RgbColor + {-# UNPACK #-} !Word8 + {-# UNPACK #-} !Word8 + {-# UNPACK #-} !Word8 deriving (Eq, Show, Generic) instance NFData RgbColor --- | Smart constructor for RgbColor. Returns Nothing if not 3 bytes. -rgbColor :: ByteString -> Maybe RgbColor -rgbColor !bs - | BS.length bs == rgbColorLen = Just (RgbColor bs) - | otherwise = Nothing -{-# INLINE rgbColor #-} - --- | Node alias (32 bytes, UTF-8 padded with zero bytes). -newtype Alias = Alias { getAlias :: ByteString } +-- | A 32-byte node alias. Origin nodes should use UTF-8 padded with zero +-- bytes, but receivers must accept any bytes. +newtype Alias = Alias BS.ByteString deriving (Eq, Show, Generic) instance NFData Alias --- | Smart constructor for Alias. Returns Nothing if not 32 bytes. -alias :: ByteString -> Maybe Alias -alias !bs - | BS.length bs == aliasLen = Just (Alias bs) - | otherwise = Nothing +-- | Construct an t'Alias' from exactly 32 bytes. +-- +-- >>> alias "too short" +-- Nothing +alias :: BS.ByteString -> Maybe Alias +alias bs + | BS.length bs == 32 = Just (Alias bs) + | otherwise = Nothing {-# INLINE alias #-} --- | Timestamp (Unix epoch seconds). -type Timestamp = Word32 +-- | The bytes of an t'Alias'. +un_alias :: Alias -> BS.ByteString +un_alias (Alias bs) = bs +{-# INLINE un_alias #-} --- | Feature bits (variable length). -newtype FeatureBits = FeatureBits { getFeatureBits :: ByteString } +-- | A 4-byte IPv4 address. +newtype IPv4Addr = IPv4Addr BS.ByteString deriving (Eq, Show, Generic) -instance NFData FeatureBits +instance NFData IPv4Addr --- | Smart constructor for FeatureBits (any length). -featureBits :: ByteString -> FeatureBits -featureBits = FeatureBits -{-# INLINE featureBits #-} +-- | Construct an t'IPv4Addr' from exactly 4 bytes. +-- +-- >>> ipv4_addr "\127\NUL\NUL\SOH" +-- Just (IPv4Addr "\DEL\NUL\NUL\SOH") +ipv4_addr :: BS.ByteString -> Maybe IPv4Addr +ipv4_addr bs + | BS.length bs == 4 = Just (IPv4Addr bs) + | otherwise = Nothing +{-# INLINE ipv4_addr #-} --- Address types --------------------------------------------------------------- +-- | The bytes of an t'IPv4Addr'. +un_ipv4_addr :: IPv4Addr -> BS.ByteString +un_ipv4_addr (IPv4Addr bs) = bs +{-# INLINE un_ipv4_addr #-} --- | IPv4 address (4 bytes). -newtype IPv4Addr = IPv4Addr { getIPv4Addr :: ByteString } +-- | A 16-byte IPv6 address. +newtype IPv6Addr = IPv6Addr BS.ByteString deriving (Eq, Show, Generic) -instance NFData IPv4Addr +instance NFData IPv6Addr --- | Smart constructor for IPv4Addr. Returns Nothing if not 4 bytes. -ipv4Addr :: ByteString -> Maybe IPv4Addr -ipv4Addr !bs - | BS.length bs == ipv4AddrLen = Just (IPv4Addr bs) - | otherwise = Nothing -{-# INLINE ipv4Addr #-} +-- | Construct an t'IPv6Addr' from exactly 16 bytes. +ipv6_addr :: BS.ByteString -> Maybe IPv6Addr +ipv6_addr bs + | BS.length bs == 16 = Just (IPv6Addr bs) + | otherwise = Nothing +{-# INLINE ipv6_addr #-} --- | IPv6 address (16 bytes). -newtype IPv6Addr = IPv6Addr { getIPv6Addr :: ByteString } +-- | The bytes of an t'IPv6Addr'. +un_ipv6_addr :: IPv6Addr -> BS.ByteString +un_ipv6_addr (IPv6Addr bs) = bs +{-# INLINE un_ipv6_addr #-} + +-- | The 12 data bytes of a deprecated Tor v2 address descriptor (type +-- 3). They are kept, uninterpreted, so that re-encoding reproduces +-- the signed bytes. +newtype TorV2Addr = TorV2Addr BS.ByteString deriving (Eq, Show, Generic) -instance NFData IPv6Addr +instance NFData TorV2Addr --- | Smart constructor for IPv6Addr. Returns Nothing if not 16 bytes. -ipv6Addr :: ByteString -> Maybe IPv6Addr -ipv6Addr !bs - | BS.length bs == ipv6AddrLen = Just (IPv6Addr bs) - | otherwise = Nothing -{-# INLINE ipv6Addr #-} +-- | Construct a t'TorV2Addr' from exactly 12 bytes. +tor_v2_addr :: BS.ByteString -> Maybe TorV2Addr +tor_v2_addr bs + | BS.length bs == 12 = Just (TorV2Addr bs) + | otherwise = Nothing +{-# INLINE tor_v2_addr #-} --- | Tor v3 onion address (35 bytes: 32 pubkey + 2 checksum + 1 version). -newtype TorV3Addr = TorV3Addr { getTorV3Addr :: ByteString } +-- | The bytes of a t'TorV2Addr'. +un_tor_v2_addr :: TorV2Addr -> BS.ByteString +un_tor_v2_addr (TorV2Addr bs) = bs +{-# INLINE un_tor_v2_addr #-} + +-- | A 35-byte Tor v3 onion service address: a 32-byte ed25519 public +-- key, a 2-byte checksum and a 1-byte version. +newtype TorV3Addr = TorV3Addr BS.ByteString deriving (Eq, Show, Generic) instance NFData TorV3Addr --- | Smart constructor for TorV3Addr. Returns Nothing if not 35 bytes. -torV3Addr :: ByteString -> Maybe TorV3Addr -torV3Addr !bs - | BS.length bs == torV3AddrLen = Just (TorV3Addr bs) - | otherwise = Nothing -{-# INLINE torV3Addr #-} +-- | Construct a t'TorV3Addr' from exactly 35 bytes. +tor_v3_addr :: BS.ByteString -> Maybe TorV3Addr +tor_v3_addr bs + | BS.length bs == 35 = Just (TorV3Addr bs) + | otherwise = Nothing +{-# INLINE tor_v3_addr #-} --- | Network address with port. -data Address - = AddrIPv4 !IPv4Addr !Word16 -- ^ IPv4 address + port - | AddrIPv6 !IPv6Addr !Word16 -- ^ IPv6 address + port - | AddrTorV3 !TorV3Addr !Word16 -- ^ Tor v3 address + port - | AddrDNS !ByteString !Word16 -- ^ DNS hostname + port +-- | The bytes of a t'TorV3Addr'. +un_tor_v3_addr :: TorV3Addr -> BS.ByteString +un_tor_v3_addr (TorV3Addr bs) = bs +{-# INLINE un_tor_v3_addr #-} + +-- | A DNS hostname of at most 255 bytes (the limit of its length byte). +-- +-- BOLT #7 requires hostnames to be ASCII, with other characters +-- Punycode-encoded, but receivers keep whatever bytes they are given; +-- see 'is_ascii_hostname'. +newtype Hostname = Hostname BS.ByteString deriving (Eq, Show, Generic) -instance NFData Address +instance NFData Hostname --- Channel update flags -------------------------------------------------------- +-- | Construct a t'Hostname' from at most 255 bytes. +-- +-- >>> hostname "ln.example.com" +-- Just (Hostname "ln.example.com") +-- >>> hostname (BS.replicate 256 0x61) +-- Nothing +hostname :: BS.ByteString -> Maybe Hostname +hostname bs + | BS.length bs <= 255 = Just (Hostname bs) + | otherwise = Nothing +{-# INLINE hostname #-} --- | Message flags for channel_update. +-- | The bytes of a t'Hostname'. +un_hostname :: Hostname -> BS.ByteString +un_hostname (Hostname bs) = bs +{-# INLINE un_hostname #-} + +-- | Whether a t'Hostname' is non-empty and ASCII, as BOLT #7 requires. -- --- Bit 0: htlc_maximum_msat field is present. -data MessageFlags = MessageFlags - { mfHtlcMaxPresent :: !Bool -- ^ htlc_maximum_msat is present - } +-- >>> fmap is_ascii_hostname (hostname "caf\233") +-- Just False +is_ascii_hostname :: Hostname -> Bool +is_ascii_hostname (Hostname bs) = not (BS.null bs) && BS.all (< 0x80) bs +{-# INLINE is_ascii_hostname #-} + +-- | An address descriptor of a known type, with its port where it has +-- one. +data Address + = AddrIPv4 !IPv4Addr {-# UNPACK #-} !Word16 -- ^ type 1 + | AddrIPv6 !IPv6Addr {-# UNPACK #-} !Word16 -- ^ type 2 + | AddrTorV2 !TorV2Addr -- ^ type 3 (deprecated) + | AddrTorV3 !TorV3Addr {-# UNPACK #-} !Word16 -- ^ type 4 + | AddrDNS !Hostname {-# UNPACK #-} !Word16 -- ^ type 5 deriving (Eq, Show, Generic) -instance NFData MessageFlags +instance NFData Address --- | Encode MessageFlags to Word8. -encodeMessageFlags :: MessageFlags -> Word8 -encodeMessageFlags mf = if mfHtlcMaxPresent mf then 0x01 else 0x00 -{-# INLINE encodeMessageFlags #-} +-- | The addresses a receiver should connect to, per the BOLT #7 receiver +-- rules: drops Tor v2 descriptors, descriptors with port 0, DNS +-- hostnames that are empty or not ASCII, and every DNS descriptor +-- after the first. +usable_addresses :: [Address] -> [Address] +usable_addresses = go False + where + go _ [] = [] + go !dns (a : as) = case a of + AddrIPv4 _ p -> port p + AddrIPv6 _ p -> port p + AddrTorV2 _ -> go dns as + AddrTorV3 _ p -> port p + AddrDNS h p + | dns -> go dns as + | p /= 0 && is_ascii_hostname h -> a : go True as + | otherwise -> go True as + where + port p + | p == 0 = go dns as + | otherwise = a : go dns as --- | Decode Word8 to MessageFlags. -decodeMessageFlags :: Word8 -> MessageFlags -decodeMessageFlags w = MessageFlags { mfHtlcMaxPresent = w .&. 0x01 /= 0 } -{-# INLINE decodeMessageFlags #-} +-- query fields --------------------------------------------------------------- --- | Channel flags for channel_update. --- --- Bit 0: direction (0 = node_id_1 is origin, 1 = node_id_2 is origin). --- Bit 1: disabled (1 = channel disabled). -data ChannelFlags = ChannelFlags - { cfDirection :: !Bool -- ^ True = node_id_2 is origin - , cfDisabled :: !Bool -- ^ True = channel is disabled - } +-- | A @query_flags@ bitfield, sent for each short channel id in a +-- @query_short_channel_ids@. Every value is valid; unassigned bits are +-- kept. +newtype QueryFlags = QueryFlags Word64 deriving (Eq, Show, Generic) -instance NFData ChannelFlags +instance NFData QueryFlags --- | Encode ChannelFlags to Word8. -encodeChannelFlags :: ChannelFlags -> Word8 -encodeChannelFlags cf = - (if cfDirection cf then 0x01 else 0x00) .|. - (if cfDisabled cf then 0x02 else 0x00) -{-# INLINE encodeChannelFlags #-} +-- | The assigned bits of t'QueryFlags'. +data QueryFlag + = WantChannelAnnouncement -- ^ bit 0 + | WantChannelUpdate1 -- ^ bit 1: the @channel_update@ of node 1 + | WantChannelUpdate2 -- ^ bit 2: the @channel_update@ of node 2 + | WantNodeAnnouncement1 -- ^ bit 3: the @node_announcement@ of node 1 + | WantNodeAnnouncement2 -- ^ bit 4: the @node_announcement@ of node 2 + deriving (Eq, Ord, Show, Enum, Bounded, Generic) --- | Decode Word8 to ChannelFlags. -decodeChannelFlags :: Word8 -> ChannelFlags -decodeChannelFlags w = ChannelFlags - { cfDirection = w .&. 0x01 /= 0 - , cfDisabled = w .&. 0x02 /= 0 - } -{-# INLINE decodeChannelFlags #-} +instance NFData QueryFlag --- Routing parameters ---------------------------------------------------------- +-- | The t'QueryFlags' with exactly the given bits set. +-- +-- >>> query_flags [WantChannelAnnouncement, WantChannelUpdate2] +-- QueryFlags 5 +query_flags :: [QueryFlag] -> QueryFlags +query_flags = QueryFlags . foldr (\f acc -> acc .|. bit (fromEnum f)) 0 --- | CLTV expiry delta. -newtype CltvExpiryDelta = CltvExpiryDelta { getCltvExpiryDelta :: Word16 } - deriving (Eq, Ord, Show, Generic) +-- | Whether the given bit is set. +-- +-- >>> has_query_flag WantChannelUpdate1 (QueryFlags 2) +-- True +has_query_flag :: QueryFlag -> QueryFlags -> Bool +has_query_flag f (QueryFlags w) = testBit w (fromEnum f) +{-# INLINE has_query_flag #-} -instance NFData CltvExpiryDelta +-- | The @query_option_flags@ bitfield of a @query_channel_range@. Every +-- value is valid; unassigned bits are kept. +newtype QueryOption = QueryOption Word64 + deriving (Eq, Show, Generic) --- | Base fee in millisatoshis. -newtype FeeBaseMsat = FeeBaseMsat { getFeeBaseMsat :: Word32 } - deriving (Eq, Ord, Show, Generic) +instance NFData QueryOption -instance NFData FeeBaseMsat +-- | The assigned bits of t'QueryOption'. +data QueryOptionFlag + = WantTimestamps -- ^ bit 0 + | WantChecksums -- ^ bit 1 + deriving (Eq, Ord, Show, Enum, Bounded, Generic) --- | Proportional fee in millionths. -newtype FeeProportionalMillionths = FeeProportionalMillionths - { getFeeProportionalMillionths :: Word32 } - deriving (Eq, Ord, Show, Generic) +instance NFData QueryOptionFlag -instance NFData FeeProportionalMillionths +-- | The t'QueryOption' with exactly the given bits set. +-- +-- >>> query_option [WantTimestamps, WantChecksums] +-- QueryOption 3 +query_option :: [QueryOptionFlag] -> QueryOption +query_option = QueryOption . foldr (\f acc -> acc .|. bit (fromEnum f)) 0 --- | Minimum HTLC value in millisatoshis. -newtype HtlcMinimumMsat = HtlcMinimumMsat { getHtlcMinimumMsat :: Word64 } - deriving (Eq, Ord, Show, Generic) +-- | Whether the given bit is set. +-- +-- >>> has_query_option WantChecksums (QueryOption 1) +-- False +has_query_option :: QueryOptionFlag -> QueryOption -> Bool +has_query_option f (QueryOption w) = testBit w (fromEnum f) +{-# INLINE has_query_option #-} -instance NFData HtlcMinimumMsat +-- | The timestamps of a channel's latest @channel_update@s, from +-- @node_id_1@ and @node_id_2@ (0 where there is none). +data ChannelUpdateTimestamps = ChannelUpdateTimestamps + {-# UNPACK #-} !Word32 + {-# UNPACK #-} !Word32 + deriving (Eq, Show, Generic) --- | Maximum HTLC value in millisatoshis. -newtype HtlcMaximumMsat = HtlcMaximumMsat { getHtlcMaximumMsat :: Word64 } - deriving (Eq, Ord, Show, Generic) +instance NFData ChannelUpdateTimestamps -instance NFData HtlcMaximumMsat +-- | The checksums of a channel's latest @channel_update@s, from +-- @node_id_1@ and @node_id_2@ (0 where there is none). +data ChannelUpdateChecksums = ChannelUpdateChecksums + {-# UNPACK #-} !Word32 + {-# UNPACK #-} !Word32 + deriving (Eq, Show, Generic) + +instance NFData ChannelUpdateChecksums diff --git a/lib/Lightning/Protocol/BOLT7/Validate.hs b/lib/Lightning/Protocol/BOLT7/Validate.hs --- a/lib/Lightning/Protocol/BOLT7/Validate.hs +++ b/lib/Lightning/Protocol/BOLT7/Validate.hs @@ -1,6 +1,4 @@ -{-# OPTIONS_HADDOCK prune #-} - -{-# LANGUAGE BangPatterns #-} +{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveGeneric #-} -- | @@ -9,133 +7,101 @@ -- 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. +-- Stateless checks of BOLT #7 messages. module Lightning.Protocol.BOLT7.Validate ( - -- * Error types ValidationError(..) - - -- * Validation functions - , validateChannelAnnouncement - , validateNodeAnnouncement - , validateChannelUpdate - , validateQueryChannelRange - , validateReplyChannelRange + , validate_channel_announcement + , validate_node_announcement + , validate_channel_update + , validate_query_short_channel_ids + , validate_query_channel_range + , validate_reply_channel_range ) where import Control.DeepSeq (NFData) -import Data.Word (Word32, Word64) +import Data.Word (Word64) import GHC.Generics (Generic) -import Lightning.Protocol.BOLT7.Codec (decodeShortChannelIdList) +import Lightning.Protocol.BOLT1 (ShortChannelId) import Lightning.Protocol.BOLT7.Messages import Lightning.Protocol.BOLT7.Types --- | Validation errors. +-- | A rule a message breaks. data ValidationError - = ValidateNodeIdOrdering -- ^ node_id_1 must be < node_id_2 - | ValidateUnknownEvenFeature -- ^ Unknown even feature bit set - | ValidateHtlcAmounts -- ^ htlc_minimum_msat > htlc_maximum_msat - | ValidateBlockOverflow -- ^ first_blocknum + number_of_blocks overflow - | ValidateScidNotAscending -- ^ short_channel_ids not in ascending order + = ValidateNodeIdOrdering + -- ^ @node_id_1@ is not lexicographically less than @node_id_2@ + | ValidateMultipleDns + -- ^ more than one DNS hostname descriptor + | ValidateHtlcAmounts + -- ^ @htlc_minimum_msat@ exceeds @htlc_maximum_msat@ + | ValidateZeroBlocks + -- ^ @number_of_blocks@ is 0 + | ValidateBlockOverflow + -- ^ the block range extends past block 2^32 - 1 + | ValidateScidNotAscending + -- ^ short channel ids are not in strictly ascending order deriving (Eq, Show, Generic) instance NFData ValidationError --- | Validate channel_announcement message. --- --- Checks: +-- | Check that @node_id_1@ is lexicographically less than @node_id_2@; +-- a receiver must ignore the message otherwise. -- --- * node_id_1 < node_id_2 (lexicographic ordering) --- * Feature bits do not contain unknown even bits -validateChannelAnnouncement :: ChannelAnnouncement - -> Either ValidationError () -validateChannelAnnouncement msg = do - -- Check node_id ordering - let nid1 = channelAnnNodeId1 msg - nid2 = channelAnnNodeId2 msg - if nid1 >= nid2 - then Left ValidateNodeIdOrdering - else Right () - -- Check feature bits - validateFeatureBits (channelAnnFeatures msg) +-- Signatures and feature bits are not checked here; see +-- 'Lightning.Protocol.BOLT7.verify_channel_announcement' and +-- ppad-bolt9's @validate_remote@. +validate_channel_announcement + :: ChannelAnnouncement -> Either ValidationError () +validate_channel_announcement m + | ca_node_id_1 m < ca_node_id_2 m = Right () + | otherwise = Left ValidateNodeIdOrdering --- | Validate node_announcement message. --- --- Checks: --- --- * Feature bits do not contain unknown even bits +-- | Check that at most one DNS hostname is announced; a receiver must +-- not forward the message otherwise. -- --- Note: Address list validation (duplicate DNS entries) and alias --- UTF-8 validation are not enforced; the spec allows non-UTF-8 aliases. -validateNodeAnnouncement :: NodeAnnouncement -> Either ValidationError () -validateNodeAnnouncement msg = do - validateFeatureBits (nodeAnnFeatures msg) +-- Descriptors a receiver should merely ignore (Tor v2, port 0, a +-- hostname that isn't ASCII) are left to +-- 'Lightning.Protocol.BOLT7.usable_addresses'. +validate_node_announcement :: NodeAnnouncement -> Either ValidationError () +validate_node_announcement m + | length [ () | AddrDNS _ _ <- na_addresses m ] > 1 = + Left ValidateMultipleDns + | otherwise = Right () --- | Validate channel_update message. --- --- Checks: --- --- * htlc_minimum_msat <= htlc_maximum_msat (if htlc_maximum_msat present) --- --- Note: The spec says message_flags bit 0 MUST be set if htlc_maximum_msat --- is advertised. We don't enforce this at validation time since the codec --- already handles the conditional field based on the flag. -validateChannelUpdate :: ChannelUpdate -> Either ValidationError () -validateChannelUpdate msg = do - case chanUpdateHtlcMaxMsat msg of - Nothing -> Right () - Just htlcMax -> - let htlcMin = chanUpdateHtlcMinMsat msg - in if getHtlcMinimumMsat htlcMin > getHtlcMaximumMsat htlcMax - then Left ValidateHtlcAmounts - else Right () +-- | Check that @htlc_minimum_msat@ does not exceed @htlc_maximum_msat@; +-- a receiver should not route through the channel otherwise. +validate_channel_update :: ChannelUpdate -> Either ValidationError () +validate_channel_update m + | cu_htlc_minimum_msat m > cu_htlc_maximum_msat m = Left ValidateHtlcAmounts + | otherwise = Right () --- | Validate query_channel_range message. --- --- Checks: --- --- * first_blocknum + number_of_blocks does not overflow -validateQueryChannelRange :: QueryChannelRange -> Either ValidationError () -validateQueryChannelRange msg = do - let first = fromIntegral (queryRangeFirstBlock msg) :: Word64 - num = fromIntegral (queryRangeNumBlocks msg) :: Word64 - if first + num > fromIntegral (maxBound :: Word32) - then Left ValidateBlockOverflow - else Right () +-- | Check that the short channel ids are in strictly ascending order, as +-- their encoding requires. +validate_query_short_channel_ids + :: QueryShortChannelIds -> Either ValidationError () +validate_query_short_channel_ids = ascending . qsci_short_channel_ids --- | Validate reply_channel_range message. --- --- Checks: --- --- * Encoded short_channel_ids are in ascending order -validateReplyChannelRange :: ReplyChannelRange -> Either ValidationError () -validateReplyChannelRange msg = - case decodeShortChannelIdList (replyRangeData msg) of - Left _ -> Right () -- Can't decode, skip validation - Right scids -> checkAscending scids +-- | Check that @number_of_blocks@ is at least 1, as the sender must +-- ensure, and that the range ends at or before block 2^32 - 1 (a +-- library rule: such a range can't be represented). +validate_query_channel_range + :: QueryChannelRange -> Either ValidationError () +validate_query_channel_range m + | num == 0 = Left ValidateZeroBlocks + | first + num > 0x100000000 = Left ValidateBlockOverflow + | otherwise = Right () where - checkAscending [] = Right () - checkAscending [_] = Right () - checkAscending (a:b:rest) - | getShortChannelId a < getShortChannelId b = checkAscending (b:rest) - | otherwise = Left ValidateScidNotAscending + first = fromIntegral (qcr_first_blocknum m) :: Word64 + num = fromIntegral (qcr_number_of_blocks m) :: Word64 --- Internal helpers ----------------------------------------------------------- +-- | Check that the short channel ids are in strictly ascending order, as +-- their encoding requires. +validate_reply_channel_range + :: ReplyChannelRange -> Either ValidationError () +validate_reply_channel_range = ascending . rcr_short_channel_ids --- | Validate feature bits - reject unknown even bits. --- --- Per BOLT #9, even feature bits are "required" and odd bits are --- "optional". A node MUST fail if an unknown even bit is set. --- --- For this library, we consider all feature bits as "known" (since we --- don't implement feature negotiation). The caller should validate --- against their own set of supported features. -validateFeatureBits :: FeatureBits -> Either ValidationError () -validateFeatureBits _features = Right () --- Note: Full feature validation requires knowing which features are --- supported by the implementation. For now we accept all features. --- The caller should implement their own feature bit validation. +ascending :: [ShortChannelId] -> Either ValidationError () +ascending (a : rest@(b : _)) + | a < b = ascending rest + | otherwise = Left ValidateScidNotAscending +ascending _ = Right () diff --git a/ppad-bolt7.cabal b/ppad-bolt7.cabal --- a/ppad-bolt7.cabal +++ b/ppad-bolt7.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ppad-bolt7 -version: 0.0.1 +version: 0.1.0 synopsis: Routing gossip per BOLT #7 license: MIT license-file: LICENSE @@ -8,10 +8,10 @@ maintainer: jared@ppad.tech category: Cryptography build-type: Simple -tested-with: GHC == 9.10.3 +tested-with: GHC == { 9.10.3 } extra-doc-files: CHANGELOG description: - Routing gossip protocol, per + Routing gossip, per [BOLT #7](https://github.com/lightning/bolts/blob/master/07-routing-gossip.md). source-repository head @@ -25,6 +25,7 @@ -Wall exposed-modules: Lightning.Protocol.BOLT7 + other-modules: Lightning.Protocol.BOLT7.Codec Lightning.Protocol.BOLT7.CRC32C Lightning.Protocol.BOLT7.Hash @@ -35,24 +36,31 @@ base >= 4.9 && < 5 , bytestring >= 0.9 && < 0.13 , deepseq >= 1.4 && < 1.6 - , ppad-bolt1 >= 0.0.1 && < 0.1 - , ppad-sha256 >= 0.3 && < 0.4 + , ppad-bolt1 >= 0.1 && < 0.2 + , ppad-bolt9 >= 0.1 && < 0.2 + , ppad-secp256k1 >= 0.5.8 && < 0.6 + , ppad-sha256 >= 0.3.2 && < 0.4 test-suite bolt7-tests type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test main-is: Main.hs + other-modules: + Vectors ghc-options: - -rtsopts -Wall -O2 + -rtsopts -Wall build-depends: base , bytestring , ppad-base16 - , ppad-bolt1 >= 0.0.1 && < 0.1 + , ppad-bolt1 , ppad-bolt7 + , ppad-bolt9 + , ppad-secp256k1 + , ppad-sha256 , tasty , tasty-hunit , tasty-quickcheck @@ -62,16 +70,18 @@ default-language: Haskell2010 hs-source-dirs: bench main-is: Main.hs + other-modules: + Fixtures ghc-options: - -rtsopts -O2 -Wall -fno-warn-orphans + -rtsopts -O2 -Wall build-depends: base , bytestring , criterion - , deepseq - , ppad-bolt1 >= 0.0.1 && < 0.1 + , ppad-base16 + , ppad-bolt1 , ppad-bolt7 benchmark bolt7-weigh @@ -79,14 +89,16 @@ default-language: Haskell2010 hs-source-dirs: bench main-is: Weight.hs + other-modules: + Fixtures ghc-options: - -rtsopts -O2 -Wall -fno-warn-orphans + -rtsopts -O2 -Wall build-depends: base , bytestring - , deepseq - , ppad-bolt1 >= 0.0.1 && < 0.1 + , ppad-base16 + , ppad-bolt1 , ppad-bolt7 , weigh diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -2,683 +2,1226 @@ module Main where -import qualified Data.ByteString as BS -import Data.Maybe (fromJust) -import Data.Word (Word16, Word32) -import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream) -import Lightning.Protocol.BOLT7 -import Lightning.Protocol.BOLT7.CRC32C (crc32c) -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.QuickCheck - -main :: IO () -main = defaultMain $ testGroup "ppad-bolt7" [ - type_tests - , channel_announcement_tests - , node_announcement_tests - , channel_update_tests - , announcement_signatures_tests - , query_tests - , scid_list_tests - , hash_tests - , validation_tests - , error_tests - , property_tests - ] - --- Test data helpers ----------------------------------------------------------- - --- | Create a valid ChainHash (32 bytes). -testChainHash :: ChainHash -testChainHash = fromJust $ chainHash (BS.replicate 32 0x01) - --- | Create a valid ShortChannelId (8 bytes). -testShortChannelId :: ShortChannelId -testShortChannelId = fromJust $ shortChannelId (BS.replicate 8 0xab) - --- | Create a valid ChannelId (32 bytes). -testChannelId :: ChannelId -testChannelId = fromJust $ channelId (BS.replicate 32 0xcd) - --- | Create a valid Signature (64 bytes). -testSignature :: Signature -testSignature = fromJust $ signature (BS.replicate 64 0xee) - --- | Create a valid Point (33 bytes). -testPoint :: Point -testPoint = fromJust $ point (BS.pack $ 0x02 : replicate 32 0xff) - --- | Create a valid NodeId (33 bytes). -testNodeId :: NodeId -testNodeId = fromJust $ nodeId (BS.pack $ 0x03 : replicate 32 0xaa) - --- | Create a second valid NodeId (33 bytes). -testNodeId2 :: NodeId -testNodeId2 = fromJust $ nodeId (BS.pack $ 0x02 : replicate 32 0xbb) - --- | Create a valid RgbColor (3 bytes). -testRgbColor :: RgbColor -testRgbColor = fromJust $ rgbColor (BS.pack [0xff, 0x00, 0x00]) - --- | Create a valid Alias (32 bytes). -testAlias :: Alias -testAlias = fromJust $ alias (BS.pack $ replicate 32 0x00) - --- | Empty TLV stream for messages. -emptyTlvs :: TlvStream -emptyTlvs = unsafeTlvStream [] - --- | Empty feature bits. -emptyFeatures :: FeatureBits -emptyFeatures = featureBits BS.empty - --- Type Tests ------------------------------------------------------------------ - -type_tests :: TestTree -type_tests = testGroup "Types" [ - testGroup "ShortChannelId" [ - testCase "scidBlockHeight" $ do - -- 8 bytes: block=0x123456, tx=0x789abc, output=0xdef0 - let scid = fromJust $ shortChannelId (BS.pack - [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0]) - scidBlockHeight scid @?= 0x123456 - , testCase "scidTxIndex" $ do - let scid = fromJust $ shortChannelId (BS.pack - [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0]) - scidTxIndex scid @?= 0x789abc - , testCase "scidOutputIndex" $ do - let scid = fromJust $ shortChannelId (BS.pack - [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0]) - scidOutputIndex scid @?= 0xdef0 - , testCase "mkShortChannelId roundtrip" $ do - let scid = mkShortChannelId 539268 845 1 - scidBlockHeight scid @?= 539268 - scidTxIndex scid @?= 845 - scidOutputIndex scid @?= 1 - , testCase "formatScid" $ do - let scid = mkShortChannelId 539268 845 1 - formatScid scid @?= "539268x845x1" - , testCase "formatScid zero values" $ do - let scid = mkShortChannelId 0 0 0 - formatScid scid @?= "0x0x0" - ] - , testGroup "Smart constructors" [ - testCase "chainHash rejects wrong length" $ do - chainHash (BS.replicate 31 0x00) @?= Nothing - chainHash (BS.replicate 33 0x00) @?= Nothing - , testCase "shortChannelId rejects wrong length" $ do - shortChannelId (BS.replicate 7 0x00) @?= Nothing - shortChannelId (BS.replicate 9 0x00) @?= Nothing - , testCase "signature rejects wrong length" $ do - signature (BS.replicate 63 0x00) @?= Nothing - signature (BS.replicate 65 0x00) @?= Nothing - , testCase "point rejects wrong length" $ do - point (BS.replicate 32 0x00) @?= Nothing - point (BS.replicate 34 0x00) @?= Nothing - ] - , testGroup "Constants" [ - testCase "mainnetChainHash has correct length" $ do - BS.length (getChainHash mainnetChainHash) @?= 32 - ] - , testGroup "NodeId ordering" [ - testCase "NodeId Ord is lexicographic" $ do - let n1 = fromJust $ nodeId (BS.pack $ 0x02 : replicate 32 0x00) - n2 = fromJust $ nodeId (BS.pack $ 0x03 : replicate 32 0x00) - n1 < n2 @?= True - n2 < n1 @?= False - ] - ] - --- Channel Announcement Tests -------------------------------------------------- - -channel_announcement_tests :: TestTree -channel_announcement_tests = testGroup "ChannelAnnouncement" [ - testCase "encode/decode roundtrip" $ do - let msg = ChannelAnnouncement - { channelAnnNodeSig1 = testSignature - , channelAnnNodeSig2 = testSignature - , channelAnnBitcoinSig1 = testSignature - , channelAnnBitcoinSig2 = testSignature - , channelAnnFeatures = emptyFeatures - , channelAnnChainHash = testChainHash - , channelAnnShortChanId = testShortChannelId - , channelAnnNodeId1 = testNodeId - , channelAnnNodeId2 = testNodeId2 - , channelAnnBitcoinKey1 = testPoint - , channelAnnBitcoinKey2 = testPoint - } - encoded = encodeChannelAnnouncement msg - case decodeChannelAnnouncement encoded of - Right (decoded, _) -> decoded @?= msg - Left e -> assertFailure $ "decode failed: " ++ show e - ] - --- Node Announcement Tests ----------------------------------------------------- - -node_announcement_tests :: TestTree -node_announcement_tests = testGroup "NodeAnnouncement" [ - testCase "encode/decode roundtrip with no addresses" $ do - let msg = NodeAnnouncement - { nodeAnnSignature = testSignature - , nodeAnnFeatures = emptyFeatures - , nodeAnnTimestamp = 1234567890 - , nodeAnnNodeId = testNodeId - , nodeAnnRgbColor = testRgbColor - , nodeAnnAlias = testAlias - , nodeAnnAddresses = [] - } - case encodeNodeAnnouncement msg of - Left e -> assertFailure $ "encode failed: " ++ show e - Right encoded -> case decodeNodeAnnouncement encoded of - Right (decoded, _) -> decoded @?= msg - Left e -> assertFailure $ "decode failed: " ++ show e - , testCase "encode/decode roundtrip with IPv4 address" $ do - let ipv4 = fromJust $ ipv4Addr (BS.pack [127, 0, 0, 1]) - msg = NodeAnnouncement - { nodeAnnSignature = testSignature - , nodeAnnFeatures = emptyFeatures - , nodeAnnTimestamp = 1234567890 - , nodeAnnNodeId = testNodeId - , nodeAnnRgbColor = testRgbColor - , nodeAnnAlias = testAlias - , nodeAnnAddresses = [AddrIPv4 ipv4 9735] - } - case encodeNodeAnnouncement msg of - Left e -> assertFailure $ "encode failed: " ++ show e - Right encoded -> case decodeNodeAnnouncement encoded of - Right (decoded, _) -> decoded @?= msg - Left e -> assertFailure $ "decode failed: " ++ show e - ] - --- Channel Update Tests -------------------------------------------------------- - -channel_update_tests :: TestTree -channel_update_tests = testGroup "ChannelUpdate" [ - testCase "encode/decode roundtrip without htlc_maximum_msat" $ do - let msg = ChannelUpdate - { chanUpdateSignature = testSignature - , chanUpdateChainHash = testChainHash - , chanUpdateShortChanId = testShortChannelId - , chanUpdateTimestamp = 1234567890 - , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } - , chanUpdateChanFlags = ChannelFlags - { cfDirection = True, cfDisabled = False } - , chanUpdateCltvExpDelta = CltvExpiryDelta 144 - , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 - , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 - , chanUpdateFeeProportional = FeeProportionalMillionths 100 - , chanUpdateHtlcMaxMsat = Nothing - } - encoded = encodeChannelUpdate msg - case decodeChannelUpdate encoded of - Right (decoded, _) -> decoded @?= msg - Left e -> assertFailure $ "decode failed: " ++ show e - , testCase "encode/decode roundtrip with htlc_maximum_msat" $ do - let msg = ChannelUpdate - { chanUpdateSignature = testSignature - , chanUpdateChainHash = testChainHash - , chanUpdateShortChanId = testShortChannelId - , chanUpdateTimestamp = 1234567890 - , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = True } - , chanUpdateChanFlags = ChannelFlags - { cfDirection = False, cfDisabled = False } - , chanUpdateCltvExpDelta = CltvExpiryDelta 40 - , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 - , chanUpdateFeeBaseMsat = FeeBaseMsat 500 - , chanUpdateFeeProportional = FeeProportionalMillionths 50 - , chanUpdateHtlcMaxMsat = Just (HtlcMaximumMsat 1000000000) - } - encoded = encodeChannelUpdate msg - case decodeChannelUpdate encoded of - Right (decoded, _) -> decoded @?= msg - Left e -> assertFailure $ "decode failed: " ++ show e - ] - --- Announcement Signatures Tests ----------------------------------------------- - -announcement_signatures_tests :: TestTree -announcement_signatures_tests = testGroup "AnnouncementSignatures" [ - testCase "encode/decode roundtrip" $ do - let msg = AnnouncementSignatures - { annSigChannelId = testChannelId - , annSigShortChanId = testShortChannelId - , annSigNodeSig = testSignature - , annSigBitcoinSig = testSignature - } - encoded = encodeAnnouncementSignatures msg - case decodeAnnouncementSignatures encoded of - Right (decoded, _) -> decoded @?= msg - Left e -> assertFailure $ "decode failed: " ++ show e - ] - --- Query Tests ----------------------------------------------------------------- - -query_tests :: TestTree -query_tests = testGroup "Query Messages" [ - testGroup "QueryShortChannelIds" [ - testCase "encode/decode roundtrip" $ do - let msg = QueryShortChannelIds - { queryScidsChainHash = testChainHash - , queryScidsData = BS.replicate 24 0xab -- 3 SCIDs - , queryScidsTlvs = emptyTlvs - } - case encodeQueryShortChannelIds msg of - Left e -> assertFailure $ "encode failed: " ++ show e - Right encoded -> case decodeQueryShortChannelIds encoded of - Right (decoded, _) -> do - queryScidsChainHash decoded @?= queryScidsChainHash msg - queryScidsData decoded @?= queryScidsData msg - Left e -> assertFailure $ "decode failed: " ++ show e - ] - , testGroup "ReplyShortChannelIdsEnd" [ - testCase "encode/decode roundtrip" $ do - let msg = ReplyShortChannelIdsEnd - { replyScidsChainHash = testChainHash - , replyScidsFullInfo = 1 - } - encoded = encodeReplyShortChannelIdsEnd msg - case decodeReplyShortChannelIdsEnd encoded of - Right (decoded, _) -> decoded @?= msg - Left e -> assertFailure $ "decode failed: " ++ show e - ] - , testGroup "QueryChannelRange" [ - testCase "encode/decode roundtrip" $ do - let msg = QueryChannelRange - { queryRangeChainHash = testChainHash - , queryRangeFirstBlock = 600000 - , queryRangeNumBlocks = 10000 - , queryRangeTlvs = emptyTlvs - } - encoded = encodeQueryChannelRange msg - case decodeQueryChannelRange encoded of - Right (decoded, _) -> do - queryRangeChainHash decoded @?= queryRangeChainHash msg - queryRangeFirstBlock decoded @?= queryRangeFirstBlock msg - queryRangeNumBlocks decoded @?= queryRangeNumBlocks msg - Left e -> assertFailure $ "decode failed: " ++ show e - ] - , testGroup "ReplyChannelRange" [ - testCase "encode/decode roundtrip" $ do - let msg = ReplyChannelRange - { replyRangeChainHash = testChainHash - , replyRangeFirstBlock = 600000 - , replyRangeNumBlocks = 10000 - , replyRangeSyncComplete = 1 - , replyRangeData = BS.replicate 16 0xcd - , replyRangeTlvs = emptyTlvs - } - case encodeReplyChannelRange msg of - Left e -> assertFailure $ "encode failed: " ++ show e - Right encoded -> case decodeReplyChannelRange encoded of - Right (decoded, _) -> do - replyRangeChainHash decoded @?= replyRangeChainHash msg - replyRangeFirstBlock decoded @?= replyRangeFirstBlock msg - replyRangeNumBlocks decoded @?= replyRangeNumBlocks msg - replyRangeSyncComplete decoded @?= replyRangeSyncComplete msg - replyRangeData decoded @?= replyRangeData msg - Left e -> assertFailure $ "decode failed: " ++ show e - ] - , testGroup "GossipTimestampFilter" [ - testCase "encode/decode roundtrip" $ do - let msg = GossipTimestampFilter - { gossipFilterChainHash = testChainHash - , gossipFilterFirstTimestamp = 1609459200 - , gossipFilterTimestampRange = 86400 - } - encoded = encodeGossipTimestampFilter msg - case decodeGossipTimestampFilter encoded of - Right (decoded, _) -> decoded @?= msg - Left e -> assertFailure $ "decode failed: " ++ show e - ] - ] - --- SCID List Tests ------------------------------------------------------------ - -scid_list_tests :: TestTree -scid_list_tests = testGroup "SCID List Encoding" [ - testCase "encode/decode roundtrip empty list" $ do - let encoded = encodeShortChannelIdList [] - case decodeShortChannelIdList encoded of - Right decoded -> decoded @?= [] - Left e -> assertFailure $ "decode failed: " ++ show e - , testCase "encode/decode roundtrip single SCID" $ do - let scids = [mkShortChannelId 539268 845 1] - encoded = encodeShortChannelIdList scids - case decodeShortChannelIdList encoded of - Right decoded -> decoded @?= scids - Left e -> assertFailure $ "decode failed: " ++ show e - , testCase "encode/decode roundtrip multiple SCIDs" $ do - let scids = [ mkShortChannelId 100000 1 0 - , mkShortChannelId 200000 2 1 - , mkShortChannelId 300000 3 2 - ] - encoded = encodeShortChannelIdList scids - case decodeShortChannelIdList encoded of - Right decoded -> decoded @?= scids - Left e -> assertFailure $ "decode failed: " ++ show e - , testCase "encoding has correct format" $ do - let scids = [mkShortChannelId 1 2 3] - encoded = encodeShortChannelIdList scids - -- First byte should be 0 (encoding type) - BS.index encoded 0 @?= 0 - -- Total length: 1 (type) + 8 (SCID) = 9 - BS.length encoded @?= 9 - , testCase "decode rejects unknown encoding type" $ do - -- Encoding type 1 (zlib compressed) is not supported - let badEncoded = BS.cons 1 (getShortChannelId testShortChannelId) - case decodeShortChannelIdList badEncoded of - Left _ -> pure () - Right _ -> assertFailure "should reject encoding type 1" - ] - --- Hash Tests ----------------------------------------------------------------- - -hash_tests :: TestTree -hash_tests = testGroup "Hash Functions" [ - testGroup "CRC32C" [ - testCase "known test vector '123456789'" $ do - -- Standard CRC-32C test vector - crc32c "123456789" @?= 0xe3069283 - , testCase "empty string" $ do - crc32c "" @?= 0x00000000 - ] - , testGroup "Signature Hashes" [ - testCase "channelAnnouncementHash produces 32 bytes" $ do - -- Create a minimal valid encoded message - let msg = encodeChannelAnnouncement ChannelAnnouncement - { channelAnnNodeSig1 = testSignature - , channelAnnNodeSig2 = testSignature - , channelAnnBitcoinSig1 = testSignature - , channelAnnBitcoinSig2 = testSignature - , channelAnnFeatures = emptyFeatures - , channelAnnChainHash = testChainHash - , channelAnnShortChanId = testShortChannelId - , channelAnnNodeId1 = testNodeId - , channelAnnNodeId2 = testNodeId2 - , channelAnnBitcoinKey1 = testPoint - , channelAnnBitcoinKey2 = testPoint - } - hashVal = channelAnnouncementHash msg - BS.length hashVal @?= 32 - , testCase "nodeAnnouncementHash produces 32 bytes" $ do - case encodeNodeAnnouncement NodeAnnouncement - { nodeAnnSignature = testSignature - , nodeAnnFeatures = emptyFeatures - , nodeAnnTimestamp = 1234567890 - , nodeAnnNodeId = testNodeId - , nodeAnnRgbColor = testRgbColor - , nodeAnnAlias = testAlias - , nodeAnnAddresses = [] - } of - Left e -> assertFailure $ "encode failed: " ++ show e - Right msg -> do - let hashVal = nodeAnnouncementHash msg - BS.length hashVal @?= 32 - , testCase "channelUpdateHash produces 32 bytes" $ do - let msg = encodeChannelUpdate ChannelUpdate - { chanUpdateSignature = testSignature - , chanUpdateChainHash = testChainHash - , chanUpdateShortChanId = testShortChannelId - , chanUpdateTimestamp = 1234567890 - , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } - , chanUpdateChanFlags = ChannelFlags - { cfDirection = False, cfDisabled = False } - , chanUpdateCltvExpDelta = CltvExpiryDelta 144 - , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 - , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 - , chanUpdateFeeProportional = FeeProportionalMillionths 100 - , chanUpdateHtlcMaxMsat = Nothing - } - hashVal = channelUpdateHash msg - BS.length hashVal @?= 32 - ] - , testGroup "Checksum" [ - testCase "channelUpdateChecksum produces consistent result" $ do - -- The checksum should be deterministic - let msg = encodeChannelUpdate ChannelUpdate - { chanUpdateSignature = testSignature - , chanUpdateChainHash = testChainHash - , chanUpdateShortChanId = testShortChannelId - , chanUpdateTimestamp = 1234567890 - , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } - , chanUpdateChanFlags = ChannelFlags - { cfDirection = False, cfDisabled = False } - , chanUpdateCltvExpDelta = CltvExpiryDelta 144 - , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 - , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 - , chanUpdateFeeProportional = FeeProportionalMillionths 100 - , chanUpdateHtlcMaxMsat = Nothing - } - cs1 = channelUpdateChecksum msg - cs2 = channelUpdateChecksum msg - cs1 @?= cs2 - , testCase "different timestamps produce same checksum" $ do - -- Checksum excludes timestamp field - let msg1 = encodeChannelUpdate ChannelUpdate - { chanUpdateSignature = testSignature - , chanUpdateChainHash = testChainHash - , chanUpdateShortChanId = testShortChannelId - , chanUpdateTimestamp = 1000000000 - , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } - , chanUpdateChanFlags = ChannelFlags - { cfDirection = False, cfDisabled = False } - , chanUpdateCltvExpDelta = CltvExpiryDelta 144 - , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 - , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 - , chanUpdateFeeProportional = FeeProportionalMillionths 100 - , chanUpdateHtlcMaxMsat = Nothing - } - msg2 = encodeChannelUpdate ChannelUpdate - { chanUpdateSignature = testSignature - , chanUpdateChainHash = testChainHash - , chanUpdateShortChanId = testShortChannelId - , chanUpdateTimestamp = 2000000000 - , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } - , chanUpdateChanFlags = ChannelFlags - { cfDirection = False, cfDisabled = False } - , chanUpdateCltvExpDelta = CltvExpiryDelta 144 - , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 - , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 - , chanUpdateFeeProportional = FeeProportionalMillionths 100 - , chanUpdateHtlcMaxMsat = Nothing - } - channelUpdateChecksum msg1 @?= channelUpdateChecksum msg2 - ] - ] - --- Validation Tests ----------------------------------------------------------- - -validation_tests :: TestTree -validation_tests = testGroup "Validation" [ - testGroup "ChannelAnnouncement" [ - testCase "valid announcement passes" $ do - let msg = ChannelAnnouncement - { channelAnnNodeSig1 = testSignature - , channelAnnNodeSig2 = testSignature - , channelAnnBitcoinSig1 = testSignature - , channelAnnBitcoinSig2 = testSignature - , channelAnnFeatures = emptyFeatures - , channelAnnChainHash = testChainHash - , channelAnnShortChanId = testShortChannelId - , channelAnnNodeId1 = testNodeId2 -- 0x02... < 0x03... - , channelAnnNodeId2 = testNodeId -- 0x03... - , channelAnnBitcoinKey1 = testPoint - , channelAnnBitcoinKey2 = testPoint - } - validateChannelAnnouncement msg @?= Right () - , testCase "rejects wrong node_id order" $ do - let msg = ChannelAnnouncement - { channelAnnNodeSig1 = testSignature - , channelAnnNodeSig2 = testSignature - , channelAnnBitcoinSig1 = testSignature - , channelAnnBitcoinSig2 = testSignature - , channelAnnFeatures = emptyFeatures - , channelAnnChainHash = testChainHash - , channelAnnShortChanId = testShortChannelId - , channelAnnNodeId1 = testNodeId -- 0x03... > 0x02... - , channelAnnNodeId2 = testNodeId2 -- 0x02... - , channelAnnBitcoinKey1 = testPoint - , channelAnnBitcoinKey2 = testPoint - } - validateChannelAnnouncement msg @?= Left ValidateNodeIdOrdering - ] - , testGroup "ChannelUpdate" [ - testCase "valid update passes" $ do - let msg = ChannelUpdate - { chanUpdateSignature = testSignature - , chanUpdateChainHash = testChainHash - , chanUpdateShortChanId = testShortChannelId - , chanUpdateTimestamp = 1234567890 - , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = True } - , chanUpdateChanFlags = ChannelFlags - { cfDirection = False, cfDisabled = False } - , chanUpdateCltvExpDelta = CltvExpiryDelta 144 - , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 - , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 - , chanUpdateFeeProportional = FeeProportionalMillionths 100 - , chanUpdateHtlcMaxMsat = Just (HtlcMaximumMsat 1000000000) - } - validateChannelUpdate msg @?= Right () - , testCase "rejects htlc_min > htlc_max" $ do - let msg = ChannelUpdate - { chanUpdateSignature = testSignature - , chanUpdateChainHash = testChainHash - , chanUpdateShortChanId = testShortChannelId - , chanUpdateTimestamp = 1234567890 - , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = True } - , chanUpdateChanFlags = ChannelFlags - { cfDirection = False, cfDisabled = False } - , chanUpdateCltvExpDelta = CltvExpiryDelta 144 - , chanUpdateHtlcMinMsat = HtlcMinimumMsat 2000000000 -- > htlcMax - , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 - , chanUpdateFeeProportional = FeeProportionalMillionths 100 - , chanUpdateHtlcMaxMsat = Just (HtlcMaximumMsat 1000000000) - } - validateChannelUpdate msg @?= Left ValidateHtlcAmounts - ] - , testGroup "QueryChannelRange" [ - testCase "valid range passes" $ do - let msg = QueryChannelRange - { queryRangeChainHash = testChainHash - , queryRangeFirstBlock = 600000 - , queryRangeNumBlocks = 10000 - , queryRangeTlvs = emptyTlvs - } - validateQueryChannelRange msg @?= Right () - , testCase "rejects overflow" $ do - let msg = QueryChannelRange - { queryRangeChainHash = testChainHash - , queryRangeFirstBlock = maxBound -- 0xFFFFFFFF - , queryRangeNumBlocks = 10 - , queryRangeTlvs = emptyTlvs - } - validateQueryChannelRange msg @?= Left ValidateBlockOverflow - ] - ] - --- Error Tests ----------------------------------------------------------------- - -error_tests :: TestTree -error_tests = testGroup "Error Conditions" [ - testGroup "Insufficient Bytes" [ - testCase "decodeChannelAnnouncement empty" $ do - case decodeChannelAnnouncement BS.empty of - Left DecodeInsufficientBytes -> pure () - other -> assertFailure $ "expected insufficient: " ++ show other - , testCase "decodeChannelUpdate too short" $ do - case decodeChannelUpdate (BS.replicate 50 0x00) of - Left DecodeInsufficientBytes -> pure () - other -> assertFailure $ "expected insufficient: " ++ show other - , testCase "decodeAnnouncementSignatures too short" $ do - case decodeAnnouncementSignatures (BS.replicate 50 0x00) of - Left DecodeInsufficientBytes -> pure () - other -> assertFailure $ "expected insufficient: " ++ show other - , testCase "decodeGossipTimestampFilter too short" $ do - case decodeGossipTimestampFilter (BS.replicate 30 0x00) of - Left DecodeInsufficientBytes -> pure () - other -> assertFailure $ "expected insufficient: " ++ show other - ] - ] - --- Property Tests -------------------------------------------------------------- - -property_tests :: TestTree -property_tests = testGroup "Properties" [ - testProperty "ChannelAnnouncement roundtrip" propChannelAnnouncementRoundtrip - , testProperty "ChannelUpdate roundtrip" propChannelUpdateRoundtrip - , testProperty "AnnouncementSignatures roundtrip" - propAnnouncementSignaturesRoundtrip - , testProperty "GossipTimestampFilter roundtrip" - propGossipTimestampFilterRoundtrip - ] - --- Property: ChannelAnnouncement roundtrip -propChannelAnnouncementRoundtrip :: Property -propChannelAnnouncementRoundtrip = property $ do - let msg = ChannelAnnouncement - { channelAnnNodeSig1 = testSignature - , channelAnnNodeSig2 = testSignature - , channelAnnBitcoinSig1 = testSignature - , channelAnnBitcoinSig2 = testSignature - , channelAnnFeatures = emptyFeatures - , channelAnnChainHash = testChainHash - , channelAnnShortChanId = testShortChannelId - , channelAnnNodeId1 = testNodeId - , channelAnnNodeId2 = testNodeId2 - , channelAnnBitcoinKey1 = testPoint - , channelAnnBitcoinKey2 = testPoint - } - encoded = encodeChannelAnnouncement msg - case decodeChannelAnnouncement encoded of - Right (decoded, _) -> decoded == msg - Left _ -> False - --- Property: ChannelUpdate roundtrip -propChannelUpdateRoundtrip :: Word32 -> Word16 -> Property -propChannelUpdateRoundtrip timestamp cltvDelta = property $ do - let msg = ChannelUpdate - { chanUpdateSignature = testSignature - , chanUpdateChainHash = testChainHash - , chanUpdateShortChanId = testShortChannelId - , chanUpdateTimestamp = timestamp - , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } - , chanUpdateChanFlags = ChannelFlags - { cfDirection = False, cfDisabled = False } - , chanUpdateCltvExpDelta = CltvExpiryDelta cltvDelta - , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 - , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 - , chanUpdateFeeProportional = FeeProportionalMillionths 100 - , chanUpdateHtlcMaxMsat = Nothing - } - encoded = encodeChannelUpdate msg - case decodeChannelUpdate encoded of - Right (decoded, _) -> decoded == msg - Left _ -> False - --- Property: AnnouncementSignatures roundtrip -propAnnouncementSignaturesRoundtrip :: Property -propAnnouncementSignaturesRoundtrip = property $ do - let msg = AnnouncementSignatures - { annSigChannelId = testChannelId - , annSigShortChanId = testShortChannelId - , annSigNodeSig = testSignature - , annSigBitcoinSig = testSignature - } - encoded = encodeAnnouncementSignatures msg - case decodeAnnouncementSignatures encoded of - Right (decoded, _) -> decoded == msg - Left _ -> False - --- Property: GossipTimestampFilter roundtrip -propGossipTimestampFilterRoundtrip :: Word32 -> Word32 -> Property -propGossipTimestampFilterRoundtrip firstTs tsRange = property $ do - let msg = GossipTimestampFilter - { gossipFilterChainHash = testChainHash - , gossipFilterFirstTimestamp = firstTs - , gossipFilterTimestampRange = tsRange - } - encoded = encodeGossipTimestampFilter msg - case decodeGossipTimestampFilter encoded of - Right (decoded, _) -> decoded == msg - Left _ -> False +import Data.Bits ((.&.), (.|.), shiftR, xor) +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base16 as B16 +import Data.Word (Word8, Word16, Word32, Word64) +import Lightning.Protocol.BOLT1 + ( ChainHash, Point, ShortChannelId(..), Signature, TlvError(..) + , TlvRecord(..), TlvStream ) +import qualified Lightning.Protocol.BOLT1 as BOLT1 +import Lightning.Protocol.BOLT7 +import qualified Lightning.Protocol.BOLT9 as BOLT9 +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck hiding ((.&.)) +import Vectors + +main :: IO () +main = defaultMain $ testGroup "ppad-bolt7" [ + field_tests + , spec_vector_tests + , mainnet_tests + , node_announcement_tests + , channel_update_tests + , query_tests + , other_message_tests + , encode_error_tests + , dispatch_tests + , validation_tests + , checksum_tests + , property_tests + ] + +-- helpers -------------------------------------------------------------------- + +must :: String -> Maybe a -> IO a +must what = maybe (assertFailure ("unexpected Nothing: " ++ what)) pure + +expectRight :: Show e => String -> Either e a -> IO a +expectRight what = + either (\e -> assertFailure (what ++ " failed: " ++ show e)) pure + +hex :: BS.ByteString -> IO BS.ByteString +hex h = must ("hex " ++ show h) (B16.decode h) + +-- total helpers for pure contexts (properties) +chain_hash_of :: Word8 -> Maybe ChainHash +chain_hash_of w = BOLT1.chain_hash (BS.replicate 32 w) + +big_endian :: Int -> Word64 -> BS.ByteString +big_endian n w = + BS.pack [ fromIntegral (w `shiftR` (8 * i)) | i <- [n - 1, n - 2 .. 0] ] + +u16be :: Int -> BS.ByteString +u16be = big_endian 2 . fromIntegral + +-- replace the byte at an offset (no-op past the end) +set_byte :: Int -> Word8 -> BS.ByteString -> BS.ByteString +set_byte i w bs + | i < 0 || i >= BS.length bs = bs + | otherwise = BS.take i bs <> BS.singleton w <> BS.drop (i + 1) bs + +-- | Fixture values, built with the smart constructors. +data Fx = Fx + { fx_chain :: ChainHash + , fx_sig :: Signature + , fx_node_1 :: Point + , fx_node_2 :: Point + , fx_cid :: BOLT1.ChannelId + , fx_scid :: ShortChannelId + , fx_alias :: Alias + , fx_scids :: [ShortChannelId] + } + +fixtures :: IO Fx +fixtures = do + ch <- must "chain_hash" (chain_hash_of 0x01) + sg <- must "signature" (BOLT1.signature (BS.replicate 64 0xee)) + n1 <- must "point" (BOLT1.point (BS.cons 0x02 (BS.replicate 32 0xbb))) + n2 <- must "point" (BOLT1.point (BS.cons 0x03 (BS.replicate 32 0xaa))) + ci <- must "channel_id" (BOLT1.channel_id (BS.replicate 32 0xcd)) + sc <- must "short_channel_id" (BOLT1.short_channel_id 539268 845 1) + al <- must "alias" (alias (BS.replicate 32 0)) + ss <- must "short_channel_ids" $ traverse + (\(b, t, o) -> BOLT1.short_channel_id b t o) + [(100000, 1, 0), (200000, 2, 1), (300000, 3, 2)] + pure Fx + { fx_chain = ch + , fx_sig = sg + , fx_node_1 = n1 + , fx_node_2 = n2 + , fx_cid = ci + , fx_scid = sc + , fx_alias = al + , fx_scids = ss + } + +msat :: Word64 -> IO BOLT1.MilliSatoshi +msat = must "milli_satoshi" . BOLT1.milli_satoshi + +update_fixture :: Fx -> IO ChannelUpdate +update_fixture fx = do + hmin <- msat 1000 + hmax <- msat 1000000000 + pure ChannelUpdate + { cu_signature = fx_sig fx + , cu_chain_hash = fx_chain fx + , cu_short_channel_id = fx_scid fx + , cu_timestamp = 1234567890 + , cu_message_flags = message_flags Forward + , cu_channel_flags = channel_flags NodeOne Enabled + , cu_cltv_expiry_delta = 144 + , cu_htlc_minimum_msat = hmin + , cu_fee_base_msat = 1000 + , cu_fee_proportional_millionths = 100 + , cu_htlc_maximum_msat = hmax + , cu_tlvs = BOLT1.empty_tlv_stream + } + +announcement_fixture :: Fx -> ChannelAnnouncement +announcement_fixture fx = ChannelAnnouncement + { ca_node_signature_1 = fx_sig fx + , ca_node_signature_2 = fx_sig fx + , ca_bitcoin_signature_1 = fx_sig fx + , ca_bitcoin_signature_2 = fx_sig fx + , ca_features = BOLT9.empty + , ca_chain_hash = fx_chain fx + , ca_short_channel_id = fx_scid fx + , ca_node_id_1 = fx_node_1 fx + , ca_node_id_2 = fx_node_2 fx + , ca_bitcoin_key_1 = fx_node_1 fx + , ca_bitcoin_key_2 = fx_node_2 fx + , ca_tlvs = BOLT1.empty_tlv_stream + } + +node_fixture :: Fx -> [Address] -> NodeAnnouncement +node_fixture fx addrs = NodeAnnouncement + { na_signature = fx_sig fx + , na_features = BOLT9.empty + , na_timestamp = 1234567890 + , na_node_id = fx_node_2 fx + , na_rgb_color = RgbColor 0xff 0x00 0x00 + , na_alias = fx_alias fx + , na_addresses = addrs + , na_unknown_addresses = BS.empty + , na_tlvs = BOLT1.empty_tlv_stream + } + +tlvs_of :: [TlvRecord] -> IO TlvStream +tlvs_of = must "tlv_stream" . BOLT1.tlv_stream + +-- field types ---------------------------------------------------------------- + +field_tests :: TestTree +field_tests = testGroup "field types" [ + testCase "format_short_channel_id" $ do + let fmt b t o = + fmap format_short_channel_id (BOLT1.short_channel_id b t o) + fmt 539268 845 1 @?= Just "539268x845x1" + fmt 0 0 0 @?= Just "0x0x0" + fmt 0xffffff 0xffffff 0xffff @?= Just "16777215x16777215x65535" + , testCase "message_flags" $ do + message_flags Forward @?= MessageFlags 0x01 + message_flags DontForward @?= MessageFlags 0x03 + map (message_flags_forwarding . MessageFlags) [0, 1, 2, 3, 0xfd] + @?= [Forward, Forward, DontForward, DontForward, Forward] + map (has_must_be_one . MessageFlags) [0, 1, 2, 0xfe] + @?= [False, True, False, False] + , testCase "channel_flags" $ do + [ channel_flags d s | d <- [NodeOne, NodeTwo], s <- [Enabled, Disabled] ] + @?= map ChannelFlags [0, 2, 1, 3] + map (channel_flags_direction . ChannelFlags) [0x04, 0x05, 0xfe] + @?= [NodeOne, NodeTwo, NodeOne] + map (channel_flags_status . ChannelFlags) [0x04, 0x06, 0xfd] + @?= [Enabled, Disabled, Enabled] + , testCase "query_flags" $ do + query_flags [] @?= QueryFlags 0 + query_flags [minBound .. maxBound] @?= QueryFlags 31 + query_flags [WantNodeAnnouncement2, WantChannelUpdate1] @?= QueryFlags 18 + map (`has_query_flag` QueryFlags 0x25) [minBound .. maxBound] + @?= [True, False, True, False, False] + , testCase "query_option" $ do + query_option [WantChecksums] @?= QueryOption 2 + map (`has_query_option` QueryOption 0x05) [minBound .. maxBound] + @?= [True, False] + , testCase "fixed-size constructors check lengths" $ do + let lens mk = [ mk (BS.replicate n 0) /= Nothing | n <- [0 .. 40] ] + only n = [ k == n | k <- [0 .. 40 :: Int] ] + lens alias @?= only 32 + lens ipv4_addr @?= only 4 + lens ipv6_addr @?= only 16 + lens tor_v2_addr @?= only 12 + lens tor_v3_addr @?= only 35 + , testCase "hostname" $ do + fmap un_hostname (hostname "ln.example.com") @?= Just "ln.example.com" + fmap un_hostname (hostname "") @?= Just "" + fmap (BS.length . un_hostname) (hostname (BS.replicate 255 0x61)) + @?= Just 255 + hostname (BS.replicate 256 0x61) @?= Nothing + let ascii h = fmap is_ascii_hostname (hostname h) + ascii "xn--caf-dma" @?= Just True + ascii "caf\233" @?= Just False + ascii "\0\255" @?= Just False + ascii "" @?= Just False + , testCase "usable_addresses" $ do + v4 <- must "ipv4" (ipv4_addr "\127\0\0\1") + v6 <- must "ipv6" (ipv6_addr (BS.replicate 16 1)) + t2 <- must "tor v2" (tor_v2_addr (BS.replicate 12 0xaa)) + t3 <- must "tor v3" (tor_v3_addr (BS.replicate 35 0xbb)) + h1 <- must "hostname" (hostname "a.example.com") + h2 <- must "hostname" (hostname "b.example.com") + bad <- must "hostname" (hostname "caf\233") + usable_addresses + [ AddrIPv4 v4 9735, AddrTorV2 t2, AddrIPv6 v6 0, AddrTorV3 t3 9735 + , AddrDNS h1 9735, AddrDNS h2 9735, AddrIPv6 v6 9735 ] + @?= [ AddrIPv4 v4 9735, AddrTorV3 t3 9735, AddrDNS h1 9735 + , AddrIPv6 v6 9735 ] + -- a hostname that is ignored still counts as the first + usable_addresses [AddrDNS bad 9735, AddrDNS h1 9735] @?= [] + usable_addresses [AddrDNS h1 0, AddrDNS h2 9735] @?= [] + ] + +-- extended-queries.json ------------------------------------------------------ + +-- the vectors' chain hash (regtest) +regtest :: IO ChainHash +regtest = hex + "0f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e2206" + >>= must "chain_hash" . BOLT1.chain_hash + +scids :: [(Word32, Word32, Word16)] -> IO [ShortChannelId] +scids = must "short_channel_id" + . traverse (\(b, t, o) -> BOLT1.short_channel_id b t o) + +-- decode a vector, compare with the expected message, and re-encode the +-- expected message +known_answer :: BS.ByteString -> Message -> Assertion +known_answer h expected = do + wire <- hex h + (t, payload) <- expectRight "decode_envelope" (BOLT1.decode_envelope wire) + decode_message t payload @?= Right expected + message_type expected @?= t + encode_message expected @?= Right payload + +rejected :: BS.ByteString -> DecodeError -> Assertion +rejected h err = do + wire <- hex h + (t, payload) <- expectRight "decode_envelope" (BOLT1.decode_envelope wire) + decode_message t payload @?= Left err + +spec_vector_tests :: TestTree +spec_vector_tests = testGroup "bolt07/extended-queries.json" $ + case query_vectors of + [v0, v1, v2, v3, v4, v5, v6, v7, v8, v9] -> [ + testCase "0: query_channel_range" $ do + ch <- regtest + known_answer v0 $ MsgQueryChannelRange + (QueryChannelRange ch 100000 1500 Nothing BOLT1.empty_tlv_stream) + , testCase "1: query_channel_range with query_option" $ do + ch <- regtest + known_answer v1 $ MsgQueryChannelRange $ QueryChannelRange ch + 35000 100 (Just (query_option [WantTimestamps, WantChecksums])) + BOLT1.empty_tlv_stream + , testCase "2: reply_channel_range" $ do + ch <- regtest + ss <- scids [(0, 0, 142), (0, 0, 15465), (0, 69, 42692)] + known_answer v2 $ MsgReplyChannelRange + (ReplyChannelRange ch 756230 1500 True ss Nothing Nothing + BOLT1.empty_tlv_stream) + , testCase "3: reply_channel_range, zlib (rejected)" $ + rejected v3 (DecodeUnknownEncoding 1) + , testCase "4: reply_channel_range with timestamps and checksums" $ do + ch <- regtest + ss <- scids [(0, 0, 12355), (0, 7, 30934), (0, 70, 57793)] + known_answer v4 $ MsgReplyChannelRange $ + ReplyChannelRange ch 122334 1500 True ss + (Just [ ChannelUpdateTimestamps 164545 948165 + , ChannelUpdateTimestamps 489645 4786864 + , ChannelUpdateTimestamps 46456 9788415 ]) + (Just [ ChannelUpdateChecksums 1111 2222 + , ChannelUpdateChecksums 3333 4444 + , ChannelUpdateChecksums 5555 6666 ]) + BOLT1.empty_tlv_stream + , testCase "5: reply_channel_range, zlib (rejected)" $ + rejected v5 (DecodeUnknownEncoding 1) + , testCase "6: query_short_channel_ids" $ do + ch <- regtest + ss <- scids [(0, 0, 142), (0, 0, 15465), (0, 69, 42692)] + known_answer v6 $ MsgQueryShortChannelIds + (QueryShortChannelIds ch ss Nothing BOLT1.empty_tlv_stream) + , testCase "7: query_short_channel_ids, zlib (rejected)" $ + rejected v7 (DecodeUnknownEncoding 1) + , testCase "8: query_short_channel_ids, zlib query_flags (rejected)" $ + rejected v8 (DecodeUnknownEncoding 1) + , testCase "9: query_short_channel_ids, zlib (rejected)" $ + rejected v9 (DecodeUnknownEncoding 1) + ] + _ -> [testCase "vector count" (assertFailure "expected 10 vectors")] + +-- mainnet gossip ------------------------------------------------------------- + +decoded_announcements :: IO [(BS.ByteString, ChannelAnnouncement)] +decoded_announcements = traverse go mainnet_announcements + where + go v = do + p <- hex (av_payload v) + a <- expectRight "decode_channel_announcement" + (decode_channel_announcement p) + pure (p, a) + +-- the key of the node that signed an update +signer :: ChannelAnnouncement -> ChannelUpdate -> Point +signer a u = case channel_flags_direction (cu_channel_flags u) of + NodeOne -> ca_node_id_1 a + NodeTwo -> ca_node_id_2 a + +other :: ChannelAnnouncement -> ChannelUpdate -> Point +other a u = case channel_flags_direction (cu_channel_flags u) of + NodeOne -> ca_node_id_2 a + NodeTwo -> ca_node_id_1 a + +mainnet_tests :: TestTree +mainnet_tests = testGroup "mainnet gossip" [ + testCase "channel_announcements: decode, re-encode, hash, verify" $ do + anns <- decoded_announcements + length anns @?= 6 + mapM_ (\(v, (p, a)) -> do + encode_channel_announcement a @?= Right p + d <- hex (av_digest v) + channel_announcement_hash a @?= Right d + assertBool "signatures verify" (verify_channel_announcement a) + validate_channel_announcement a @?= Right ()) + (zip mainnet_announcements anns) + , testCase "channel_announcement fields" $ do + anns <- decoded_announcements + (_, a) <- must "first announcement" (safe_head anns) + mainnet <- hex + "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + n1 <- hex + "02bb5e47ee26aca1654ce092d9d06eac15d953210c737f2220e2d7e54c4f108677" + n2 <- hex + "030b828fd1e42549fbc2f1d0960ec3663362c41777d3d87fe1b8e1d4bf063abcaa" + format_short_channel_id (ca_short_channel_id a) @?= "850052x2992x1" + BOLT1.un_chain_hash (ca_chain_hash a) @?= mainnet + BOLT9.render (ca_features a) @?= BS.empty + BOLT1.un_point (ca_node_id_1 a) @?= n1 + BOLT1.un_point (ca_node_id_2 a) @?= n2 + BOLT1.un_tlv_stream (ca_tlvs a) @?= [] + , testCase "channel_announcement: tampering breaks verification" $ do + anns <- decoded_announcements + (p, a) <- must "first announcement" (safe_head anns) + -- change the short channel id (signed) + let p' = set_byte 295 0xff p + a' <- expectRight "decode" (decode_channel_announcement p') + assertBool "tampered" (not (verify_channel_announcement a')) + let swapped = a { ca_node_signature_1 = ca_node_signature_2 a + , ca_node_signature_2 = ca_node_signature_1 a } + assertBool "swapped" (not (verify_channel_announcement swapped)) + , testCase "channel_updates: decode, re-encode, hash, checksum, verify" $ do + anns <- decoded_announcements + length mainnet_updates @?= 13 + mapM_ (\v -> do + p <- hex (uv_payload v) + u <- expectRight "decode_channel_update" (decode_channel_update p) + (_, a) <- must "announcement" (safe_index anns (uv_ann v)) + cu_short_channel_id u @?= ca_short_channel_id a + encode_channel_update u @?= p + d <- hex (uv_digest v) + channel_update_hash u @?= d + channel_update_checksum u @?= uv_checksum v + assertBool "verifies under its signer" + (verify_channel_update (signer a u) u) + assertBool "fails under the other node" + (not (verify_channel_update (other a u) u))) + mainnet_updates + , testCase "channel_update fields (136 bytes)" $ do + u <- update_vector 1 + BS.length (encode_channel_update u) @?= 136 + format_short_channel_id (cu_short_channel_id u) @?= "850052x2992x1" + cu_timestamp u @?= 1776493010 + cu_message_flags u @?= MessageFlags 0x01 + cu_channel_flags u @?= channel_flags NodeTwo Disabled + cu_cltv_expiry_delta u @?= 80 + BOLT1.un_milli_satoshi (cu_htlc_minimum_msat u) @?= 1000 + cu_fee_base_msat u @?= 1000 + cu_fee_proportional_millionths u @?= 800 + BOLT1.un_milli_satoshi (cu_htlc_maximum_msat u) @?= 2970000000 + BOLT1.un_tlv_stream (cu_tlvs u) @?= [] + , testCase "channel_update fields (148 bytes, inbound-fee extension)" $ do + u <- update_vector 0 + ext <- hex "00000000ffffffed" + cu_timestamp u @?= 1779047542 + cu_channel_flags u @?= channel_flags NodeOne Enabled + cu_cltv_expiry_delta u @?= 100 + cu_fee_base_msat u @?= 0 + cu_fee_proportional_millionths u @?= 5000 + BOLT1.un_milli_satoshi (cu_htlc_maximum_msat u) @?= 2970000000 + BOLT1.un_tlv_stream (cu_tlvs u) @?= [TlvRecord 55555 ext] + , testCase "a real update with htlc_minimum_msat > htlc_maximum_msat" $ do + u <- update_vector 8 + validate_channel_update u @?= Left ValidateHtlcAmounts + , testCase "dropping the extension breaks verification" $ do + anns <- decoded_announcements + (_, a) <- must "announcement" (safe_head anns) + u <- update_vector 0 + let u' = u { cu_tlvs = BOLT1.empty_tlv_stream } + assertBool "with" (verify_channel_update (signer a u) u) + assertBool "without" (not (verify_channel_update (signer a u) u')) + ] + where + update_vector i = do + v <- must "update vector" (safe_index mainnet_updates i) + p <- hex (uv_payload v) + expectRight "decode_channel_update" (decode_channel_update p) + +safe_head :: [a] -> Maybe a +safe_head (x : _) = Just x +safe_head [] = Nothing + +safe_index :: [a] -> Int -> Maybe a +safe_index xs i + | i < 0 = Nothing + | otherwise = safe_head (drop i xs) + +-- node_announcement ---------------------------------------------------------- + +-- a node_announcement payload carrying the given address bytes +node_wire :: Fx -> BS.ByteString -> BS.ByteString +node_wire fx addrs = mconcat + [ BS.replicate 64 0xee -- signature + , u16be 0 -- flen + , BS.pack [0x49, 0x96, 0x02, 0xd2] -- timestamp + , BOLT1.un_point (fx_node_2 fx) + , BS.pack [0xff, 0x00, 0x00] + , BS.replicate 32 0 + , u16be (BS.length addrs) + , addrs + ] + +-- address descriptors (port 9735) +desc_v4, desc_v6, desc_tor_v2, desc_tor_v3 :: BS.ByteString +desc_v4 = BS.pack [1, 127, 0, 0, 1, 0x26, 0x07] +desc_v6 = BS.pack (2 : replicate 15 0 ++ [1, 0x26, 0x07]) +desc_tor_v2 = BS.cons 3 (BS.replicate 12 0xaa) +desc_tor_v3 = BS.cons 4 (BS.replicate 35 0xbb) <> u16be 9735 + +desc_dns :: BS.ByteString -> BS.ByteString +desc_dns h = BS.pack [5, fromIntegral (BS.length h)] <> h <> u16be 9735 + +-- decode the addresses of a node_announcement built by node_wire, and +-- check that it re-encodes exactly +addrs_of + :: Fx -> BS.ByteString -> IO (Either DecodeError ([Address], BS.ByteString)) +addrs_of fx bytes = do + let wire = node_wire fx bytes + case decode_node_announcement wire of + Left e -> pure (Left e) + Right n -> do + encode_node_announcement n @?= Right wire + pure (Right (na_addresses n, na_unknown_addresses n)) + +node_announcement_tests :: TestTree +node_announcement_tests = testGroup "node_announcement" [ + testCase "signed vector: fields, re-encoding, hash, verification" $ do + let (h, dh) = node_announcement_vector + p <- hex h + d <- hex dh + n <- expectRight "decode" (decode_node_announcement p) + fs <- hex "08000000000002aaa2" + nid <- hex + "0324653eac434488002cc06bbfb7f10fe18991e35f9fe4302dbea6d2353dc0ab1c" + v4 <- must "ipv4" (ipv4_addr "\127\0\0\1") + v6 <- must "ipv6" (ipv6_addr (BS.replicate 15 0 <> "\1")) + t2 <- must "tor v2" (tor_v2_addr (BS.replicate 12 0xaa)) + t3 <- must "tor v3" (tor_v3_addr (BS.replicate 35 0xbb)) + dns <- must "hostname" (hostname "ln.example.com") + BOLT9.render (na_features n) @?= fs + na_timestamp n @?= 1700000000 + BOLT1.un_point (na_node_id n) @?= nid + na_rgb_color n @?= RgbColor 0x31 0x41 0x59 + BS.takeWhile (/= 0) (un_alias (na_alias n)) @?= "ppad-bolt7" + na_addresses n @?= + [ AddrIPv4 v4 9735, AddrIPv6 v6 9735, AddrTorV2 t2 + , AddrTorV3 t3 9735, AddrDNS dns 9735 ] + na_unknown_addresses n @?= "\x06\x01\x02\x03" + BOLT1.un_tlv_stream (na_tlvs n) @?= [TlvRecord 101 "ext"] + encode_node_announcement n @?= Right p + node_announcement_hash n @?= Right d + assertBool "verifies" (verify_node_announcement n) + assertBool "tampered" + (not (verify_node_announcement n { na_timestamp = 1700000001 })) + usable_addresses (na_addresses n) @?= + [ AddrIPv4 v4 9735, AddrIPv6 v6 9735, AddrTorV3 t3 9735 + , AddrDNS dns 9735 ] + validate_node_announcement n @?= Right () + , testCase "keeps deprecated Tor v2 descriptors" $ do + fx <- fixtures + r <- addrs_of fx (desc_v4 <> desc_tor_v2 <> desc_v6 <> desc_tor_v3) + fmap (map kind . fst) r @?= Right [1, 3, 2, 4] + , testCase "stops at the first unknown type, keeping the rest" $ do + fx <- fixtures + let rest = BS.pack [6, 1, 2, 3] <> desc_v6 + r <- addrs_of fx (desc_v4 <> rest) + fmap (\(as, u) -> (map kind as, u)) r @?= Right ([1], rest) + , testCase "stops at a type-0 descriptor" $ do + fx <- fixtures + let bytes = BS.singleton 0 <> desc_v4 + r <- addrs_of fx bytes + fmap (\(as, u) -> (map kind as, u)) r @?= Right ([], bytes) + , testCase "keeps descriptors with port 0" $ do + fx <- fixtures + v4 <- must "ipv4" (ipv4_addr "\127\0\0\1") + r <- addrs_of fx (BS.pack [1, 127, 0, 0, 1, 0, 0]) + r @?= Right ([AddrIPv4 v4 0], BS.empty) + , testCase "keeps empty and non-ASCII hostnames" $ do + fx <- fixtures + r <- addrs_of fx (desc_dns "" <> desc_dns "\xff\&ab") + fmap (map (\a -> case a of + AddrDNS h _ -> un_hostname h + _ -> "?") . fst) r + @?= Right ["", "\xff\&ab"] + , testCase "rejects a truncated descriptor of a known type" $ do + fx <- fixtures + let truncated bytes = decode_node_announcement (node_wire fx bytes) + @?= Left DecodeInsufficientBytes + truncated (BS.pack [1, 127, 0, 0]) + truncated (BS.pack [2, 0, 0]) + truncated (BS.pack [3, 1, 2, 3]) + truncated (BS.cons 4 (BS.replicate 36 0)) + truncated (BS.pack [5, 4, 0x61]) + , testCase "rejects a node_id without a compressed prefix" $ do + fx <- fixtures + let wire = set_byte 70 0x04 (node_wire fx BS.empty) + decode_node_announcement wire @?= Left DecodeInvalidPoint + , testCase "na_unknown_addresses must not begin with a known type" $ do + fx <- fixtures + let with u = encode_node_announcement + (node_fixture fx []) { na_unknown_addresses = u } + mapM_ (\t -> with (BS.pack [t, 0]) @?= Left EncodeInvalidAddresses) + [1 .. 5] + assertBool "type 0" (either (const False) (const True) + (with (BS.pack [0, 1]))) + assertBool "type 6" (either (const False) (const True) + (with (BS.pack [6, 1]))) + , testCase "extension with an unknown even type is rejected" $ do + fx <- fixtures + decode_node_announcement (node_wire fx BS.empty <> "\x02\x00") + @?= Left (DecodeTlvError (TlvUnknownEvenType 2)) + ] + where + kind :: Address -> Int + kind a = case a of + AddrIPv4 _ _ -> 1 + AddrIPv6 _ _ -> 2 + AddrTorV2 _ -> 3 + AddrTorV3 _ _ -> 4 + AddrDNS _ _ -> 5 + +-- channel_update ------------------------------------------------------------- + +channel_update_tests :: TestTree +channel_update_tests = testGroup "channel_update" [ + testCase "encoder writes the flags and htlc_maximum_msat" $ do + u <- fixtures >>= update_fixture + let wire = encode_channel_update u + BS.length wire @?= 136 + BS.indexMaybe wire 108 @?= Just 0x01 + BS.indexMaybe wire 109 @?= Just 0x00 + BS.drop 128 wire @?= BS.pack [0, 0, 0, 0, 0x3b, 0x9a, 0xca, 0] + , testCase "dont_forward" $ do + u <- fixtures >>= update_fixture + let wire = encode_channel_update + u { cu_message_flags = message_flags DontForward } + BS.indexMaybe wire 108 @?= Just 0x03 + d <- expectRight "decode" (decode_channel_update wire) + message_flags_forwarding (cu_message_flags d) @?= DontForward + , testCase "keeps a clear must_be_one bit" $ do + u <- fixtures >>= update_fixture + let wire = set_byte 108 0x00 (encode_channel_update u) + d <- expectRight "decode" (decode_channel_update wire) + d @?= u { cu_message_flags = MessageFlags 0 } + encode_channel_update d @?= wire + , testCase "keeps unassigned flag bits" $ do + u <- fixtures >>= update_fixture + let wire = set_byte 109 0xfd + (set_byte 108 0xfc (encode_channel_update u)) + d <- expectRight "decode" (decode_channel_update wire) + cu_message_flags d @?= MessageFlags 0xfc + cu_channel_flags d @?= ChannelFlags 0xfd + channel_flags_direction (cu_channel_flags d) @?= NodeTwo + channel_flags_status (cu_channel_flags d) @?= Enabled + encode_channel_update d @?= wire + , testCase "keeps extension records" $ do + u <- fixtures >>= update_fixture + ext <- tlvs_of [TlvRecord 55555 "\0\0\0\0\xff\xff\xff\xed"] + let wire = encode_channel_update u { cu_tlvs = ext } + BS.length wire @?= 148 + decode_channel_update wire @?= Right u { cu_tlvs = ext } + , testCase "rejects a missing htlc_maximum_msat" $ do + u <- fixtures >>= update_fixture + decode_channel_update (BS.take 128 (encode_channel_update u)) + @?= Left DecodeInsufficientBytes + , testCase "rejects amounts above 21M BTC" $ do + u <- fixtures >>= update_fixture + let wire = encode_channel_update u + over = big_endian 8 0x1d24b2dfac520001 + at off = BS.take off wire <> over <> BS.drop (off + 8) wire + decode_channel_update (at 112) @?= Left DecodeInvalidAmount + decode_channel_update (at 128) @?= Left DecodeInvalidAmount + max_msat <- msat 0x1d24b2dfac520000 + fmap cu_htlc_maximum_msat (decode_channel_update + (BS.take 128 wire <> big_endian 8 0x1d24b2dfac520000)) + @?= Right max_msat + , testCase "rejects a malformed extension" $ do + u <- fixtures >>= update_fixture + let wire = encode_channel_update u + decode_channel_update (wire <> "\x02\x00") + @?= Left (DecodeTlvError (TlvUnknownEvenType 2)) + decode_channel_update (wire <> "\x01\x05\xaa") + @?= Left (DecodeTlvError TlvTruncated) + decode_channel_update (wire <> "\xfd\x00\x01\x00") + @?= Left (DecodeTlvError TlvNonMinimalBigSize) + , testCase "rejects truncated input" $ + decode_channel_update (BS.replicate 50 0) + @?= Left DecodeInsufficientBytes + ] + +-- queries -------------------------------------------------------------------- + +-- payload builders +qsci_wire :: Fx -> BS.ByteString -> BS.ByteString -> BS.ByteString +qsci_wire fx ids tlvs = + BOLT1.un_chain_hash (fx_chain fx) <> u16be (BS.length ids) <> ids <> tlvs + +qcr_wire :: Fx -> BS.ByteString -> BS.ByteString +qcr_wire fx tlvs = mconcat + [ BOLT1.un_chain_hash (fx_chain fx) + , big_endian 4 600000 + , big_endian 4 10000 + , tlvs + ] + +rcr_wire :: Fx -> Word8 -> BS.ByteString -> BS.ByteString -> BS.ByteString +rcr_wire fx sync ids tlvs = mconcat + [ BOLT1.un_chain_hash (fx_chain fx) + , big_endian 4 600000 + , big_endian 4 10000 + , BS.singleton sync + , u16be (BS.length ids) + , ids + , tlvs + ] + +-- encoded_short_ids for some short channel ids +encoded_ids :: [ShortChannelId] -> BS.ByteString +encoded_ids ss = BS.cons 0 (foldMap BOLT1.encode_short_channel_id ss) + +-- TLV stream rules for a query decoder, given its known types and the +-- unknown records it keeps +tlv_stream_tests + :: String + -> BS.ByteString + -> (Fx -> BS.ByteString -> Either DecodeError [TlvRecord]) + -> TestTree +tlv_stream_tests name known dec = testGroup name [ + testCase "empty stream" $ do + fx <- fixtures + dec fx BS.empty @?= Right [] + , testCase "keeps unknown odd types" $ do + fx <- fixtures + dec fx (BS.pack [5, 1, 0x2a, 7, 0]) @?= + Right [TlvRecord 5 "\x2a", TlvRecord 7 ""] + , testCase "rejects unknown even types" $ do + fx <- fixtures + dec fx (BS.pack [2, 0]) @?= Left (DecodeTlvError (TlvUnknownEvenType 2)) + , testCase "rejects a length past the end" $ do + fx <- fixtures + dec fx (BS.pack [5, 5, 0xaa]) @?= Left (DecodeTlvError TlvTruncated) + , testCase "rejects repeated types" $ do + fx <- fixtures + dec fx (BS.pack [5, 0, 5, 0]) + @?= Left (DecodeTlvError TlvNotStrictlyIncreasing) + , testCase "rejects a non-minimal BigSize" $ do + fx <- fixtures + dec fx (BS.pack [0xfd, 0x00, 0x05, 0x00]) + @?= Left (DecodeTlvError TlvNonMinimalBigSize) + , testCase "known records are typed, not kept as unknown" $ do + fx <- fixtures + dec fx known @?= Right [] + dec fx (known <> BS.pack [5, 0]) @?= Right [TlvRecord 5 ""] + ] + +query_tests :: TestTree +query_tests = testGroup "queries" [ + tlv_stream_tests "query_short_channel_ids TLVs" (BS.pack [1, 2, 0, 0]) + $ \fx tlvs -> + fmap (BOLT1.un_tlv_stream . qsci_tlvs) + (decode_query_short_channel_ids + (qsci_wire fx (encoded_ids [fx_scid fx]) tlvs)) + , tlv_stream_tests "query_channel_range TLVs" (BS.pack [1, 1, 3]) + $ \fx tlvs -> + fmap (BOLT1.un_tlv_stream . qcr_tlvs) + (decode_query_channel_range (qcr_wire fx tlvs)) + , tlv_stream_tests "reply_channel_range TLVs" + (BS.pack ([1, 9] ++ replicate 9 0 ++ [3, 8] ++ replicate 8 0)) + $ \fx tlvs -> + fmap (BOLT1.un_tlv_stream . rcr_tlvs) + (decode_reply_channel_range + (rcr_wire fx 1 (encoded_ids [fx_scid fx]) tlvs)) + , testGroup "query_short_channel_ids" [ + testCase "query_flags" $ do + fx <- fixtures + let ss = take 2 (fx_scids fx) + wire = qsci_wire fx (encoded_ids ss) + (BS.pack [1, 3, 0, 0x01, 0x1f]) + m = QueryShortChannelIds (fx_chain fx) ss + (Just [QueryFlags 1, QueryFlags 31]) BOLT1.empty_tlv_stream + decode_query_short_channel_ids wire @?= Right m + encode_query_short_channel_ids m @?= Right wire + , testCase "query_flags beyond one byte" $ do + fx <- fixtures + let ss = take 1 (fx_scids fx) + wire = qsci_wire fx (encoded_ids ss) + (BS.pack [1, 4, 0, 0xfd, 0x01, 0x00]) + fmap qsci_query_flags (decode_query_short_channel_ids wire) + @?= Right (Just [QueryFlags 256]) + , testCase "rejects a query flag count mismatch" $ do + fx <- fixtures + let ss = take 2 (fx_scids fx) + wire = qsci_wire fx (encoded_ids ss) (BS.pack [1, 2, 0, 0x01]) + decode_query_short_channel_ids wire @?= Left DecodeCountMismatch + , testCase "rejects malformed query_flags" $ do + fx <- fixtures + let with tlv = decode_query_short_channel_ids + (qsci_wire fx (encoded_ids [fx_scid fx]) tlv) + with (BS.pack [1, 0]) @?= Left (DecodeInvalidTlvValue 1) + with (BS.pack [1, 4, 0, 0xfd, 0x00, 0x01]) + @?= Left (DecodeInvalidTlvValue 1) + with (BS.pack [1, 2, 0, 0xfd]) @?= Left (DecodeInvalidTlvValue 1) + with (BS.pack [1, 2, 1, 0x01]) @?= Left (DecodeUnknownEncoding 1) + , testCase "rejects malformed encoded_short_ids" $ do + fx <- fixtures + let with ids = decode_query_short_channel_ids (qsci_wire fx ids "") + with BS.empty @?= Left DecodeInvalidShortChannelIds + with (BS.cons 0 (BS.replicate 7 0)) + @?= Left DecodeInvalidShortChannelIds + with (BS.cons 0 (BS.replicate 9 0)) + @?= Left DecodeInvalidShortChannelIds + with (BS.cons 1 (BS.replicate 8 0)) @?= Left (DecodeUnknownEncoding 1) + with (BS.cons 2 (BS.replicate 8 0)) @?= Left (DecodeUnknownEncoding 2) + , testCase "an empty list still carries its encoding type" $ do + fx <- fixtures + let m = QueryShortChannelIds (fx_chain fx) [] Nothing + BOLT1.empty_tlv_stream + wire = qsci_wire fx (BS.singleton 0) "" + encode_query_short_channel_ids m @?= Right wire + decode_query_short_channel_ids wire @?= Right m + ] + , testGroup "query_channel_range" [ + testCase "query_option" $ do + fx <- fixtures + let wire = qcr_wire fx (BS.pack [1, 3, 0xfd, 0x01, 0x00]) + fmap qcr_query_option (decode_query_channel_range wire) + @?= Right (Just (QueryOption 256)) + , testCase "rejects malformed query_option" $ do + fx <- fixtures + let with tlv = decode_query_channel_range (qcr_wire fx tlv) + with (BS.pack [1, 0]) @?= Left (DecodeInvalidTlvValue 1) + with (BS.pack [1, 2, 3, 0]) @?= Left (DecodeInvalidTlvValue 1) + with (BS.pack [1, 3, 0xfd, 0x00, 0x03]) + @?= Left (DecodeInvalidTlvValue 1) + , testCase "rejects truncated input" $ do + fx <- fixtures + decode_query_channel_range (BS.take 39 (qcr_wire fx "")) + @?= Left DecodeInsufficientBytes + ] + , testGroup "reply_channel_range" [ + testCase "rejects malformed timestamps" $ do + fx <- fixtures + let ss = take 2 (fx_scids fx) + with tlv = decode_reply_channel_range + (rcr_wire fx 1 (encoded_ids ss) tlv) + with (BS.pack [1, 0]) @?= Left (DecodeInvalidTlvValue 1) + with (BS.pack [1, 9, 1] <> BS.replicate 8 0) + @?= Left (DecodeUnknownEncoding 1) + with (BS.pack [1, 9, 0] <> BS.replicate 8 0) + @?= Left DecodeCountMismatch + with (BS.pack [1, 13, 0] <> BS.replicate 12 0) + @?= Left (DecodeInvalidTlvValue 1) + , testCase "rejects malformed checksums" $ do + fx <- fixtures + let ss = take 2 (fx_scids fx) + with tlv = decode_reply_channel_range + (rcr_wire fx 1 (encoded_ids ss) tlv) + with (BS.pack [3, 8] <> BS.replicate 8 0) @?= Left DecodeCountMismatch + with (BS.pack [3, 12] <> BS.replicate 12 0) + @?= Left (DecodeInvalidTlvValue 3) + fmap rcr_checksums (with (BS.pack [3, 16] <> BS.replicate 16 0)) + @?= Right (Just (replicate 2 (ChannelUpdateChecksums 0 0))) + , testCase "rejects a sync_complete other than 0 or 1" $ do + fx <- fixtures + let with s = fmap rcr_sync_complete (decode_reply_channel_range + (rcr_wire fx s (encoded_ids []) "")) + with 0 @?= Right False + with 1 @?= Right True + with 2 @?= Left DecodeInvalidBool + , testCase "rejects malformed encoded_short_ids" $ do + fx <- fixtures + let with ids = decode_reply_channel_range (rcr_wire fx 1 ids "") + with BS.empty @?= Left DecodeInvalidShortChannelIds + with (BS.cons 0 (BS.replicate 12 0)) + @?= Left DecodeInvalidShortChannelIds + with (BS.cons 1 (BS.replicate 8 0)) @?= Left (DecodeUnknownEncoding 1) + ] + ] + +-- other messages ------------------------------------------------------------- + +other_message_tests :: TestTree +other_message_tests = testGroup "other messages" [ + testCase "reply_short_channel_ids_end" $ do + fx <- fixtures + let ch = BOLT1.un_chain_hash (fx_chain fx) + ext <- tlvs_of [TlvRecord 9 "x"] + decode_reply_short_channel_ids_end (ch <> "\x01") + @?= Right (ReplyShortChannelIdsEnd (fx_chain fx) True + BOLT1.empty_tlv_stream) + decode_reply_short_channel_ids_end (ch <> "\x00\x09\x01x") + @?= Right (ReplyShortChannelIdsEnd (fx_chain fx) False ext) + decode_reply_short_channel_ids_end (ch <> "\x02") + @?= Left DecodeInvalidBool + decode_reply_short_channel_ids_end ch @?= Left DecodeInsufficientBytes + , testCase "announcement_signatures" $ do + fx <- fixtures + ext <- tlvs_of [TlvRecord 1 "a"] + let m = AnnouncementSignatures (fx_cid fx) (fx_scid fx) (fx_sig fx) + (fx_sig fx) ext + wire = encode_announcement_signatures m + BS.length wire @?= 32 + 8 + 64 + 64 + 3 + decode_announcement_signatures wire @?= Right m + decode_announcement_signatures (BS.take 167 wire) + @?= Left DecodeInsufficientBytes + -- type 1 is odd, so it may appear in an extension; 2 may not + decode_announcement_signatures (BS.take 168 wire <> "\x02\x00") + @?= Left (DecodeTlvError (TlvUnknownEvenType 2)) + , testCase "gossip_timestamp_filter" $ do + fx <- fixtures + let m = GossipTimestampFilter (fx_chain fx) 1609459200 86400 + BOLT1.empty_tlv_stream + wire = encode_gossip_timestamp_filter m + BS.drop 32 wire @?= BS.pack [0x5f, 0xee, 0x66, 0x00, 0, 1, 0x51, 0x80] + decode_gossip_timestamp_filter wire @?= Right m + decode_gossip_timestamp_filter (BS.take 39 wire) + @?= Left DecodeInsufficientBytes + , testCase "channel_announcement rejects bad points" $ do + fx <- fixtures + wire <- expectRight "encode" + (encode_channel_announcement (announcement_fixture fx)) + -- node_id_1 starts after the signatures, features, chain hash + -- and short channel id + decode_channel_announcement (set_byte 298 0x04 wire) + @?= Left DecodeInvalidPoint + decode_channel_announcement (BS.take 429 wire) + @?= Left DecodeInsufficientBytes + ] + +-- encoding errors ------------------------------------------------------------ + +encode_error_tests :: TestTree +encode_error_tests = testGroup "encoding errors" [ + testCase "channel_announcement features" $ do + fx <- fixtures + let feats n = (announcement_fixture fx) + { ca_features = BOLT9.parse (BS.replicate n 1) } + encode_channel_announcement (feats 65536) @?= Left EncodeLengthOverflow + wire <- expectRight "encode" (encode_channel_announcement (feats 65535)) + decode_channel_announcement wire @?= Right (feats 65535) + , testCase "node_announcement features and addresses" $ do + fx <- fixtures + v4 <- must "ipv4" (ipv4_addr "\127\0\0\1") + let base = node_fixture fx [] + encode_node_announcement base + { na_features = BOLT9.parse (BS.replicate 65536 1) } + @?= Left EncodeLengthOverflow + -- 10923 IPv4 descriptors take 65538 bytes + let v4s n = node_fixture fx (replicate n (AddrIPv4 v4 1)) + encode_node_announcement (v4s 10923) @?= Left EncodeLengthOverflow + wire <- expectRight "encode" (encode_node_announcement (v4s 9362)) + fmap (length . na_addresses) (decode_node_announcement wire) + @?= Right 9362 + , testCase "short channel id lists" $ do + fx <- fixtures + let ids n = map ShortChannelId [1 .. n] + q n = QueryShortChannelIds (fx_chain fx) (ids n) Nothing + BOLT1.empty_tlv_stream + r n = ReplyChannelRange (fx_chain fx) 0 1 True (ids n) Nothing + Nothing BOLT1.empty_tlv_stream + encode_query_short_channel_ids (q 8192) @?= Left EncodeLengthOverflow + encode_reply_channel_range (r 8192) @?= Left EncodeLengthOverflow + wire <- expectRight "encode" (encode_query_short_channel_ids (q 8191)) + decode_query_short_channel_ids wire @?= Right (q 8191) + , testCase "count mismatches" $ do + fx <- fixtures + let ss = fx_scids fx + q = QueryShortChannelIds (fx_chain fx) ss (Just [QueryFlags 1]) + BOLT1.empty_tlv_stream + r = ReplyChannelRange (fx_chain fx) 0 1 True ss Nothing Nothing + BOLT1.empty_tlv_stream + encode_query_short_channel_ids q @?= Left EncodeCountMismatch + encode_reply_channel_range r + { rcr_timestamps = Just [ChannelUpdateTimestamps 1 2] } + @?= Left EncodeCountMismatch + encode_reply_channel_range r + { rcr_checksums = Just (replicate 4 (ChannelUpdateChecksums 1 2)) } + @?= Left EncodeCountMismatch + , testCase "extra records must not use known types" $ do + fx <- fixtures + t1 <- tlvs_of [TlvRecord 1 "\0"] + t3 <- tlvs_of [TlvRecord 3 ""] + t5 <- tlvs_of [TlvRecord 5 ""] + let q = QueryShortChannelIds (fx_chain fx) [] Nothing + c = QueryChannelRange (fx_chain fx) 0 1 Nothing + r = ReplyChannelRange (fx_chain fx) 0 1 True [] Nothing Nothing + encode_query_short_channel_ids (q t1) @?= Left EncodeInvalidTlvs + encode_query_channel_range (c t1) @?= Left EncodeInvalidTlvs + encode_reply_channel_range (r t1) @?= Left EncodeInvalidTlvs + encode_reply_channel_range (r t3) @?= Left EncodeInvalidTlvs + wire <- expectRight "encode" (encode_reply_channel_range (r t5)) + decode_reply_channel_range wire @?= Right (r t5) + ] + +-- dispatch ------------------------------------------------------------------- + +dispatch_tests :: TestTree +dispatch_tests = testGroup "dispatch" [ + testCase "unknown message types" $ + mapM_ (\t -> decode_message t "" @?= Left (DecodeUnknownType t)) + [0, 16, 255, 260, 266, 32768] + , testCase "message types" $ do + fx <- fixtures + u <- update_fixture fx + let e = BOLT1.empty_tlv_stream + ms = [ MsgChannelAnnouncement (announcement_fixture fx) + , MsgNodeAnnouncement (node_fixture fx []) + , MsgChannelUpdate u + , MsgAnnouncementSignatures (AnnouncementSignatures + (fx_cid fx) (fx_scid fx) (fx_sig fx) (fx_sig fx) e) + , MsgQueryShortChannelIds + (QueryShortChannelIds (fx_chain fx) [] Nothing e) + , MsgReplyShortChannelIdsEnd + (ReplyShortChannelIdsEnd (fx_chain fx) True e) + , MsgQueryChannelRange + (QueryChannelRange (fx_chain fx) 0 1 Nothing e) + , MsgReplyChannelRange (ReplyChannelRange + (fx_chain fx) 0 1 True [] Nothing Nothing e) + , MsgGossipTimestampFilter + (GossipTimestampFilter (fx_chain fx) 0 1 e) + ] + map message_type ms @?= [256, 257, 258, 259, 261, 262, 263, 264, 265] + mapM_ (\m -> do + p <- expectRight "encode" (encode_message m) + decode_message (message_type m) p @?= Right m) + ms + ] + +-- validation ----------------------------------------------------------------- + +validation_tests :: TestTree +validation_tests = testGroup "validation" [ + testCase "channel_announcement node id order" $ do + fx <- fixtures + let a = announcement_fixture fx + validate_channel_announcement a @?= Right () + validate_channel_announcement + a { ca_node_id_1 = fx_node_2 fx, ca_node_id_2 = fx_node_1 fx } + @?= Left ValidateNodeIdOrdering + validate_channel_announcement a { ca_node_id_2 = fx_node_1 fx } + @?= Left ValidateNodeIdOrdering + , testCase "node_announcement DNS hostnames" $ do + fx <- fixtures + v4 <- must "ipv4" (ipv4_addr "\127\0\0\1") + h1 <- must "hostname" (hostname "a.example.com") + h2 <- must "hostname" (hostname "b.example.com") + validate_node_announcement + (node_fixture fx [AddrIPv4 v4 1, AddrDNS h1 1]) + @?= Right () + validate_node_announcement (node_fixture fx [AddrDNS h1 1, AddrDNS h2 1]) + @?= Left ValidateMultipleDns + , testCase "channel_update htlc amounts" $ do + fx <- fixtures + u <- update_fixture fx + big <- msat 2000000000 + validate_channel_update u @?= Right () + validate_channel_update + u { cu_htlc_minimum_msat = cu_htlc_maximum_msat u } @?= Right () + validate_channel_update u { cu_htlc_minimum_msat = big } + @?= Left ValidateHtlcAmounts + , testCase "query_channel_range block range" $ do + fx <- fixtures + let q f n = validate_query_channel_range + (QueryChannelRange (fx_chain fx) f n Nothing + BOLT1.empty_tlv_stream) + q 600000 10000 @?= Right () + q 600000 0 @?= Left ValidateZeroBlocks + q maxBound 1 @?= Right () + q maxBound 2 @?= Left ValidateBlockOverflow + q 0 maxBound @?= Right () + q 1 maxBound @?= Right () + q 2 maxBound @?= Left ValidateBlockOverflow + , testCase "short channel ids ascend" $ do + fx <- fixtures + let ss = fx_scids fx + e = BOLT1.empty_tlv_stream + r xs = validate_reply_channel_range + (ReplyChannelRange (fx_chain fx) 0 1 True xs Nothing Nothing e) + q xs = validate_query_short_channel_ids + (QueryShortChannelIds (fx_chain fx) xs Nothing e) + r ss @?= Right () + r [] @?= Right () + r (reverse ss) @?= Left ValidateScidNotAscending + r (take 1 ss <> take 1 ss) @?= Left ValidateScidNotAscending + q ss @?= Right () + q (reverse ss) @?= Left ValidateScidNotAscending + ] + +-- checksums ------------------------------------------------------------------ + +-- an independent, table-driven CRC-32C +crc32c_ref :: BS.ByteString -> Word32 +crc32c_ref = xor 0xffffffff . BS.foldl' step 0xffffffff + where + step c b = (c `shiftR` 8) + `xor` table (fromIntegral ((c `xor` fromIntegral b) .&. 0xff)) + table :: Word32 -> Word32 + table n = go (8 :: Int) n + where + go 0 x = x + go k x + | x .&. 1 == 1 = go (k - 1) ((x `shiftR` 1) `xor` 0x82f63b78) + | otherwise = go (k - 1) (x `shiftR` 1) + +-- the checksum per BOLT #7: the update without signature and timestamp +checksum_ref :: BS.ByteString -> Word32 +checksum_ref wire = + crc32c_ref (BS.take 40 (BS.drop 64 wire) <> BS.drop 108 wire) + +checksum_tests :: TestTree +checksum_tests = testGroup "checksums" [ + testCase "reference CRC-32C matches RFC 3720 vectors" $ do + crc32c_ref "123456789" @?= 0xe3069283 + crc32c_ref (BS.replicate 32 0x00) @?= 0x8a9136aa + crc32c_ref (BS.replicate 32 0xff) @?= 0x62a8ab43 + crc32c_ref (BS.pack [0 .. 31]) @?= 0x46dd794e + crc32c_ref (BS.pack [31, 30 .. 0]) @?= 0x113fdb5c + , testCase "checksum ignores signature and timestamp" $ do + fx <- fixtures + u <- update_fixture fx + sig <- must "signature" (BOLT1.signature (BS.replicate 64 0x11)) + channel_update_checksum u { cu_signature = sig, cu_timestamp = 1 } + @?= channel_update_checksum u + assertBool "covers the fees" + (channel_update_checksum u { cu_fee_base_msat = 1001 } + /= channel_update_checksum u) + , testProperty "checksum matches the reference" $ + forAll gen_channel_update $ \u -> + channel_update_checksum u === checksum_ref (encode_channel_update u) + ] + +-- properties ----------------------------------------------------------------- + +property_tests :: TestTree +property_tests = testGroup "properties" [ + testProperty "real gossip re-encodes exactly" $ + forAll (elements samples) $ \(t, h) -> + case B16.decode h of + Nothing -> counterexample "bad hex" False + Just p -> fmap encode_message (decode_message t p) + === Right (Right p) + , testProperty "mutated real gossip re-encodes exactly, if it decodes" $ + forAll (elements samples) $ \(t, h) -> + forAll arbitrary $ \(NonNegative i, w) -> + case B16.decode h of + Nothing -> counterexample "bad hex" False + Just p -> + let p' = set_byte (i `mod` BS.length p) w p + in case decode_message t p' of + Left _ -> property True + Right m -> encode_message m === Right p' + , testProperty "messages round-trip" $ + forAll gen_message $ \m -> case encode_message m of + Left e -> counterexample (show e) False + Right p -> decode_message (message_type m) p === Right m + , testProperty "channel_flags accessors" $ \w -> + let f = ChannelFlags w + in channel_flags (channel_flags_direction f) (channel_flags_status f) + === ChannelFlags (w .&. 0x03) + , testProperty "message_flags accessors" $ \w -> + let f = MessageFlags w + in message_flags (message_flags_forwarding f) + === MessageFlags (w .&. 0x02 .|. 0x01) + , testProperty "query_flags sets exactly its bits" $ + forAll (sublistOf [minBound .. maxBound]) $ \fs -> + map (`has_query_flag` query_flags fs) [minBound .. maxBound] + === map (`elem` fs) [minBound .. maxBound] + , testProperty "query_option sets exactly its bits" $ + forAll (sublistOf [minBound .. maxBound]) $ \fs -> + map (`has_query_option` query_option fs) [minBound .. maxBound] + === map (`elem` fs) [minBound .. maxBound] + ] + +-- (type, hex payload) of every embedded real or signed message +samples :: [(Word16, BS.ByteString)] +samples = + [ (256, av_payload v) | v <- mainnet_announcements ] + <> [ (258, uv_payload v) | v <- mainnet_updates ] + <> [ (257, fst node_announcement_vector) ] + +-- generators ----------------------------------------------------------------- + +gen_bytes :: Int -> Gen BS.ByteString +gen_bytes n = BS.pack <$> vectorOf n arbitrary + +gen_var_bytes :: Int -> Gen BS.ByteString +gen_var_bytes m = choose (0, m) >>= gen_bytes + +gen_chain_hash :: Gen ChainHash +gen_chain_hash = gen_bytes 32 `suchThatMap` BOLT1.chain_hash + +gen_signature :: Gen Signature +gen_signature = gen_bytes 64 `suchThatMap` BOLT1.signature + +gen_point :: Gen Point +gen_point = do + h <- elements [0x02, 0x03] + b <- gen_bytes 32 + pure (BS.cons h b) `suchThatMap` BOLT1.point + +gen_scid :: Gen ShortChannelId +gen_scid = ShortChannelId <$> arbitrary + +gen_msat :: Gen BOLT1.MilliSatoshi +gen_msat = choose (0, 0x1d24b2dfac520000) `suchThatMap` BOLT1.milli_satoshi + +gen_features :: Gen BOLT9.FeatureVector +gen_features = BOLT9.parse <$> gen_var_bytes 8 + +-- TLV records of distinct odd types at or above the given minimum +gen_tlvs :: Word64 -> Gen TlvStream +gen_tlvs lo = do + n <- choose (0, 3) + ts <- vectorOf n (choose (lo `div` 2, 40000)) + rs <- traverse (\t -> TlvRecord (2 * t + 1) <$> gen_var_bytes 10) ts + pure rs `suchThatMap` BOLT1.tlv_stream + +gen_address :: Gen Address +gen_address = oneof + [ AddrIPv4 <$> (gen_bytes 4 `suchThatMap` ipv4_addr) <*> arbitrary + , AddrIPv6 <$> (gen_bytes 16 `suchThatMap` ipv6_addr) <*> arbitrary + , AddrTorV2 <$> (gen_bytes 12 `suchThatMap` tor_v2_addr) + , AddrTorV3 <$> (gen_bytes 35 `suchThatMap` tor_v3_addr) <*> arbitrary + , AddrDNS <$> (gen_var_bytes 40 `suchThatMap` hostname) <*> arbitrary + ] + +gen_unknown_addresses :: Gen BS.ByteString +gen_unknown_addresses = oneof + [ pure BS.empty + , BS.cons <$> elements (0 : [6 .. 255]) <*> gen_var_bytes 10 + ] + +gen_channel_announcement :: Gen ChannelAnnouncement +gen_channel_announcement = ChannelAnnouncement + <$> gen_signature <*> gen_signature <*> gen_signature <*> gen_signature + <*> gen_features <*> gen_chain_hash <*> gen_scid + <*> gen_point <*> gen_point <*> gen_point <*> gen_point + <*> gen_tlvs 0 + +gen_node_announcement :: Gen NodeAnnouncement +gen_node_announcement = NodeAnnouncement + <$> gen_signature <*> gen_features <*> arbitrary <*> gen_point + <*> (RgbColor <$> arbitrary <*> arbitrary <*> arbitrary) + <*> (gen_bytes 32 `suchThatMap` alias) + <*> listOf gen_address <*> gen_unknown_addresses <*> gen_tlvs 0 + +gen_channel_update :: Gen ChannelUpdate +gen_channel_update = ChannelUpdate + <$> gen_signature <*> gen_chain_hash <*> gen_scid <*> arbitrary + <*> (MessageFlags <$> arbitrary) <*> (ChannelFlags <$> arbitrary) + <*> arbitrary <*> gen_msat <*> arbitrary <*> arbitrary <*> gen_msat + <*> gen_tlvs 0 + +-- a list of short channel ids and, maybe, one entry for each +gen_scids_with :: Gen a -> Gen ([ShortChannelId], Maybe [a]) +gen_scids_with g = do + ss <- listOf gen_scid + xs <- oneof [pure Nothing, Just <$> vectorOf (length ss) g] + pure (ss, xs) + +gen_message :: Gen Message +gen_message = oneof + [ MsgChannelAnnouncement <$> gen_channel_announcement + , MsgNodeAnnouncement <$> gen_node_announcement + , MsgChannelUpdate <$> gen_channel_update + , MsgAnnouncementSignatures <$> (AnnouncementSignatures + <$> (gen_bytes 32 `suchThatMap` BOLT1.channel_id) <*> gen_scid + <*> gen_signature <*> gen_signature <*> gen_tlvs 0) + , MsgQueryShortChannelIds <$> do + (ss, fs) <- gen_scids_with (QueryFlags <$> arbitrary) + QueryShortChannelIds <$> gen_chain_hash <*> pure ss <*> pure fs + <*> gen_tlvs 3 + , MsgReplyShortChannelIdsEnd <$> (ReplyShortChannelIdsEnd + <$> gen_chain_hash <*> arbitrary <*> gen_tlvs 0) + , MsgQueryChannelRange <$> (QueryChannelRange + <$> gen_chain_hash <*> arbitrary <*> arbitrary + <*> oneof [pure Nothing, Just . QueryOption <$> arbitrary] + <*> gen_tlvs 3) + , MsgReplyChannelRange <$> do + (ss, ts) <- gen_scids_with + (ChannelUpdateTimestamps <$> arbitrary <*> arbitrary) + cs <- oneof [pure Nothing, Just <$> vectorOf (length ss) + (ChannelUpdateChecksums <$> arbitrary <*> arbitrary)] + ReplyChannelRange <$> gen_chain_hash <*> arbitrary <*> arbitrary + <*> arbitrary <*> pure ss <*> pure ts <*> pure cs <*> gen_tlvs 5 + , MsgGossipTimestampFilter <$> (GossipTimestampFilter + <$> gen_chain_hash <*> arbitrary <*> arbitrary <*> gen_tlvs 0) + ] diff --git a/test/Vectors.hs b/test/Vectors.hs new file mode 100644 --- /dev/null +++ b/test/Vectors.hs @@ -0,0 +1,376 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Vectors +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- Test vectors: real mainnet gossip, and the extended gossip query +-- vectors of BOLT #7 (bolt07/extended-queries.json). Hex strings. + +module Vectors ( + AnnVector(..) + , UpdateVector(..) + , mainnet_announcements + , mainnet_updates + , node_announcement_vector + , query_vectors + ) where + +import qualified Data.ByteString as BS +import Data.Word (Word32) + +-- mainnet gossip ------------------------------------------------------------- + +-- Real mainnet channel_announcements and channel_updates, as captured +-- from a peer. Payloads exclude the 2-byte message type. The digests +-- (double SHA-256 of the signed bytes) and CRC-32C checksums were +-- computed independently of this library. + +-- | A channel_announcement payload and its signature digest. +data AnnVector = AnnVector + { av_payload :: !BS.ByteString -- ^ hex + , av_digest :: !BS.ByteString -- ^ hex + } + +-- | A channel_update payload, its signature digest and checksum, and +-- the index of its channel's announcement in 'mainnet_announcements'. +data UpdateVector = UpdateVector + { uv_payload :: !BS.ByteString -- ^ hex + , uv_digest :: !BS.ByteString -- ^ hex + , uv_checksum :: !Word32 + , uv_ann :: !Int + } + +mainnet_announcements :: [AnnVector] +mainnet_announcements = [ + -- 850052x2992x1 + AnnVector (mconcat + [ "3c256c270126d2c52ab5464fa959d627e9baec8c76bd2b81d34b47c4efb03290" + , "40126ea7a0f8d31420976dc28ff684dc63f62620fa10dbac4fe3d417ca5690c1" + , "b7fe1de61f5dd2b8368886d6c98f625c9110198e57c14fac93d4eff34e19ce5f" + , "5dc6fef4501e8105c8f9b82d6d0b348f5840864445b071ae7a741b5eb92d2ec0" + , "ab85681e4e1e85144bbbd8757c14cee92468d2c5ac84345cb28931b6fed5e339" + , "00ed9dd363db630f31248cfa933a3667cbf87bb78a48a442e81c652686355365" + , "ff33164c7588f0a753d50c4d52dd4a81c611fa47b4e950dfc9e3379a12ef7834" + , "781c0900b90f56a5a49893446d03c8d283c3c093e3c8c682ff6cb40d70d9eebc" + , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000" + , "00000cf884000bb0000102bb5e47ee26aca1654ce092d9d06eac15d953210c73" + , "7f2220e2d7e54c4f108677030b828fd1e42549fbc2f1d0960ec3663362c41777" + , "d3d87fe1b8e1d4bf063abcaa02bc3f260955062a4f427704edef1864c76d6777" + , "fe81bed43a5f6297dda1c7ca9203523e164f4f9fbdea978c6570d56b13ca8338" + , "430e6794ff74cf6aa0dbda71dd2d" + ]) + "3dc0e5a431551c44f2afd49cda2d3bf2a5f1b9cc86ef93db8953c17dd1ef4ded" + -- 850013x1067x1 + , AnnVector (mconcat + [ "f37bf5c2f2c11c79541fe16c2a5d63b8795d583ba72f8f1ec9160bbe02a7101d" + , "519aa61c125737f82a67be9a586da3e04f941907d9a9c59dd77dd2ae965df2cd" + , "f3e247f3f0227ef24baa2ede50f1844e12db674ac4ea53644d701521951ab3c5" + , "49eb93a75d6984cb5ca7a5872f0a27f6aa3608a5dfe4468e3f941af8c86425d3" + , "4c1ac5663d72b2934d74b20a2f364f3cd09c6528d47e09f9be99be54b1338b0e" + , "6bf9ee1bad5bf92cc95de7b0d268d92e9c671f2cfe51a0f5edbf93bf7ee9232e" + , "20e7d157eefa4b3615e176f61cad5543584188c9d890209f192c0118f162c77f" + , "4259dc4c6aec293913bd59211a9a876cad93d7f7961e027de731e48171688ddb" + , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000" + , "00000cf85d00042b00010322d0e43b3d92d30ed187f4e101a9a9605c3ee5fc97" + , "21e6dac3ce3d7732fbb13e037f990e61acee8a7697966afd29dd88f3b1f8a7b1" + , "4d625c4f8742bd952003a59003359448149bdca64024ab6c2243ab555f9313aa" + , "49ee1da0b1dd0ce1c575b2cca202dfb90cceb72720dd3d3ea168e53ed64d506e" + , "4c277fde46946843ee8eab54ab3b" + ]) + "f753e841682abc578fd12650fe47dac6094ab7882d47026bd3b6055e9060e993" + -- 850043x3419x1 + , AnnVector (mconcat + [ "0269559b5385e499d1ec6283c2ec0a0a5b93d45f6cce2d5f69709a9fd3382722" + , "063a230e7c0fca1b198ed81fc36658c259f70475074f336c7d146d7cb4042de2" + , "74162681acf44507e98656d6311fc2a8a85ef7bebd34fde195c244623704b8bf" + , "77d8e2965bdbc7ae483d8d2e2ef41cee147ada06440c1501af0a502f54f8d060" + , "3ed003cb101583b0986c54994f985e88b730f80a600706b6ac1de2b8030e3961" + , "388ad7d4a6d7b0d2718374f52ef4b4ab7f7523ba839d922f362613a283615328" + , "54b9165b22d4f86be8f7503f0149b36db4bbba3496bcb6fb989c558bea04c2d0" + , "1e6fbddfbec938a1c9fdd841339b7f5ecc40e33cc1df7da7b76da52f72078e7d" + , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000" + , "00000cf87b000d5b0001020b831768ded7615eef25b34639c14b912496137ff5" + , "218ad3277d0efd57a32e0902bb5e47ee26aca1654ce092d9d06eac15d953210c" + , "737f2220e2d7e54c4f10867703a9be624c84cde9e7452b108942cb7c3c642a1c" + , "37ab6468b031c605bb103cb5ab038ace825c070bc5af8d326b534ef6ab38ec04" + , "adbbfa859b00369cc86fbacc3e38" + ]) + "473c18a52a826efc39367a38a98d9226511289f7e33c38906faeecf890ecdf0f" + -- 850292x3675x0 + , AnnVector (mconcat + [ "76d849642499e76439884821fe95628a274e059a77a5cad5039836d40a63cc52" + , "04aa8748f7a284eaf0e22450d37b51feb293391ae2460ce328826af35ab9da8e" + , "e052bd9578c74e5a0180294141d66f8f78ec2928456db4eab4062f31c1666bd9" + , "30a220d211b8a438f9ad9c9169e3bd197ab1452b784f91f22529d4144fc19c28" + , "c0a83de0ec63b53e71f119b37983f687ee947521b8c9d044917fbb8a0e9a8c2a" + , "26ac05a821fdf1bac3a764ab9f08c293ed0b01e6dad17ad4da991b403cdfe576" + , "d49813544db805ae2afbe85572915e4145df0dc55cfd15396bd6f4abbbc9a052" + , "4e8577ed60f5d058706ca9e3fb970d54b707c598e258727b8da2df2a168f4f42" + , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000" + , "00000cf974000e5b0000020cd843f3128386ac5551647496d57aeb0b5259611d" + , "7ebb9314cae7711565354803bd743abf0f94b6d208d1c3c47aa8e958d6ddd8aa" + , "4e8c910c6e1d6b8dd7413a93024c95a299224252655af8a9a8d07da1313b8efc" + , "1dda8964d652ccb81ac5253e0d039404ec864e4efc233af1c781c872048493bc" + , "df6d284746293cf5f2b2790af0de" + ]) + "d0f087817bde3d17c5c6f9eb5a9d7c0d14f2498d0c58ebfbd4e8bccfa536ff05" + -- 853240x888x2 + , AnnVector (mconcat + [ "f4e2a166440900d15e319812df9c5ffeab61e15f417febb18c1fc07dcc701700" + , "3fecf1c075d39f4e134e5061a00de59161378f6855cefa71687f710678cc4c27" + , "e010bc600453f7ac4b84c5f5243dc2b6447af512110c1ef11173a1498a71bc6f" + , "535607ccf9f64e87ea9641413bd3ad2ec7d96d711f5de0106bf23fd172215f18" + , "fd12d34bffebe0d64900e944b4fd7ad81f26adb5ed4ea0099ef3c53e09034178" + , "693af5a55308d341e8af0dddd19eed46438174cdc2e9c65f9ff14844c4d991c4" + , "37f97805f017d56205f387b24f22d620ea474ba6f837ae114cef015022d55841" + , "2eca08400137adc856e80254b61783a77941f9550a0d008ef567c0acfa8e9155" + , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000" + , "00000d04f8000378000202ad898fce14604311ebe871e1053fa248a25e683803" + , "a8e599f168fba79bad5f5202c2ecfd7e7646f7a249491c565737b5c9f83863c2" + , "3b88e752f2d624e026f5fde702519af7e8fa7c6c47858108d1ab7eb9b531a594" + , "34314c804174ccb0bb658d0f5e03562b849da8a6e3f17d1585f53011eabeb53d" + , "b6eb23066af87bb81e8adbd0eb1a" + ]) + "cd04212b8a16a7367adb8314e37698b50ad54a9c901d21586fdd1420fba78431" + -- 855691x1739x0 + , AnnVector (mconcat + [ "2bd9078e1b73e459703af26014f26f43426961f70e0f289545559bcc5f75cd74" + , "5dc4beba17a15301df594267c92fd9e563d75982cc406e095162bdd931107d84" + , "e98528d5322f18e203805b372049a2eb32aadd3a26ad2fa733a06279635e8dca" + , "4d778a9c4a1ae260ae581562bd5e57298db70e48308ee2ba8c8bdb91db062e21" + , "41e5a4396bdc112449c9d2f572f88c1fa610620825ac3fa6bb04a1bfd6cc34a4" + , "5fb5a00ec08371146305eb845d2ea98b4f60c8bff4e5e589315c34c6af95863e" + , "6c01bdbd7c589bc448b4f0805e9756b2dcfcd5812df8b507cbf2ae488d6519a3" + , "12841bcf0f3707f1934b00f845cbe05b67d085d1a4367c8820659285e8760952" + , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000" + , "00000d0e8b0006cb000002439112f98b6f4828e1a7426bfbece166bd36837d7d" + , "ea4225a75ebd1d96864a070324ba2392e25bff76abd0b1f7e4b53b5f82aa53fd" + , "dc3419b051b6c801db9e2247039adc288b1728f289ca4ac30e4b258a19f776c2" + , "0e3190f259d759cd672c5f943803e45a0234b0649ba3d599e10df0339a36c140" + , "652b5efa18b7c17fadfd5b754888" + ]) + "0092fb593a97482cd7a0dc9ed4954e90eb1ca0700ca55f7a0183674a5faf27ea" + ] + +mainnet_updates :: [UpdateVector] +mainnet_updates = [ + -- 850052x2992x1, 148 bytes, channel_flags 0 + UpdateVector (mconcat + [ "1c3f0859cb3f4494919c3dcc80d22bbf1e25e378bd95f071530833c2371c33d7" + , "0766012ebef1cd79b299a54d0d29bea2ef6feca1d6cfa188864c95d7eea7e9a4" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0cf884000bb000016a0a1c760100006400000000000003e80000000000001388" + , "00000000b1069a80fdd9030800000000ffffffed" + ]) + "b1989933c26561ab2cdcc49b471aee5f6e0403a5eb7b88a908cb19cfee0556b9" + 0xf0a89fda 0 + -- 850052x2992x1, 136 bytes, channel_flags 3 + , UpdateVector (mconcat + [ "261e3d1f1b77b4a606c20dbe5b395e35703adc82fd9320b88e892f51547b93e9" + , "060f793d8cfd93d2063060a692c31749d0eb3dd351f3e4bbc562d00f89472a42" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0cf884000bb0000169e321d20103005000000000000003e8000003e800000320" + , "00000000b1069a80" + ]) + "5c9960b6fef9fa0d53073895420159e856c7c5f33fdeb694b163a832efe6b8e3" + 0x1da953bd 0 + -- 850013x1067x1, 136 bytes, channel_flags 1 + , UpdateVector (mconcat + [ "7619128817aadc3c4da18103c468f8c0869f03394e815a7386a81bf74eabb76f" + , "357c67e0353b25b173bb67a57185db0d39b8bc3736538e58376ccd184cadf539" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0cf85d00042b000169e334b80101005000000000000003e8000003e800000001" + , "00000022ce4c6080" + ]) + "b3d7e24cfbf4d578e3d8ded39d2885fec322c57355e7a513879c72665014e094" + 0xb28659fc 1 + -- 850043x3419x1, 136 bytes, channel_flags 0 + , UpdateVector (mconcat + [ "f0b2facf82a20cb2c33b12337fd54f4553decff2abc86c20fb7059b890d2f16f" + , "11d604798b3829ba0367c1898ea21fbb0d50570e70812119ecc069ecde21785a" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0cf87b000d5b000169e3810f0100006400000000000f424000000000000000c3" + , "000000001d8119c0" + ]) + "1b2702991ef2d85cc3dffdc390a3a597f3651d00803e6e08581fd8140694ddf4" + 0x036645d4 2 + -- 850043x3419x1, 148 bytes, channel_flags 1 + , UpdateVector (mconcat + [ "c93858ef07309fe98c1690521634ad3a55c715500cdf4d31eef8d6f412613c0a" + , "491df28ec2e7c4a5288a5bf2848d18486d9cf4eeb3f41befeaedf1e121416438" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0cf87b000d5b000169e3810f0101006400000000000003e80000000000001388" + , "000000009ae5c730fdd9030800000000fffffa95" + ]) + "6deeb53e1859601e9b2b859dccace2dd9f85dc6d0605d6d7a966329d2633df1c" + 0x878e5ea4 2 + -- 850052x2992x1, 148 bytes, channel_flags 2 + , UpdateVector (mconcat + [ "3bf18f613f864d7b9907c98915cf4cbec8d4ac5245f5c66ca3d93571074d8c4f" + , "3cbc7963377020145f9645ead56f462537384e43cba27ac4b73d9e734275fe6a" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0cf884000bb0000169e3478f0102006400000000000003e80000000000001066" + , "00000000b1069a80fdd9030800000000fffffab8" + ]) + "3af8a43926c24d2707cecf621fb7906cc1feb4c6880b0fde3de19bb5da7e5649" + 0x5ba7913c 0 + -- 850292x3675x0, 136 bytes, channel_flags 2 + , UpdateVector (mconcat + [ "ee28b4d0ce3abded3c43d5d990a40020b255df072cc76a9fdfd8482aed0c81c1" + , "02e7e124dcd74acaaf5cf0773cbd10a828b721925cb54f7569cca335f6a9237c" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0cf974000e5b000069e37c460102002800000000000003e8000003e800000001" + , "0000000076046700" + ]) + "43949a9fa1993b3375b7fc2e3a35e35ceb28766907f3d738fa8f46b9ba02474f" + 0x9d4f0032 3 + -- 853240x888x2, 148 bytes, channel_flags 3 + , UpdateVector (mconcat + [ "c5cfd6f873caf8ad9207f10db0b618bbf4db86e31b64ad6d0d2aca0a14de8899" + , "261b3b94e7eff8317f77c3fee62941e660361dd3ed4213a94a7bb13fee71dcc8" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0d04f8000378000269e32992010300900000000000005208000000000000017a" + , "000000001dcd6500fdd903080000000000000000" + ]) + "a6d2ea4523ee28ad1f117ac2cffbb6bf29aa5cc6f7f58d2dc058a999563c9560" + 0x172a10e7 4 + -- 855691x1739x0, 136 bytes, channel_flags 0 + , UpdateVector (mconcat + [ "0f325a044bff29a14636b22023d2a44abf939e34b776020907627b4c72488ed9" + , "70b357c059e7a110611bb2093d9fffdd00028a84fc08aea155a57d4b79434410" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0d0e8b0006cb000069e046c70100004800000000000003e80000000000000147" + , "0000000000000000" + ]) + "d00785fd5793d86401fb54de019d4094fbff37416d9f611a55fc8fe9a5f536c4" + 0x368d3c11 5 + -- 850013x1067x1, 148 bytes, channel_flags 0 + , UpdateVector (mconcat + [ "2faeaef5708bde4ce33a2145bca38544d9d3c4431c6e10210f6fab36c37306f2" + , "53ab90c2d5ec3710c6f481dab4735e398fa83eec94b2d5a9bd41df26a92bce7b" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0cf85d00042b000169e33b320100009000000000000003e8000000000000109a" + , "00000022ce4c6080fdd903080000000000000000" + ]) + "1acb192f08b4dfb70359cebc337e6ed2cc985b74e70dacc9ecdc1bd957a56923" + 0xf4948aaf 1 + -- 850292x3675x0, 136 bytes, channel_flags 1 + , UpdateVector (mconcat + [ "6bbb96e7af06e5a35815d7bfc1777ee680cb7d2f728855cc8373baf469e1d375" + , "3aa3f7023a796ead27e8fc37e9509358c6e8c2e9ee6a71db5c8dc9c044a3395c" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0cf974000e5b000069e37c840101005000000000000003e80000000000000064" + , "0000000076046700" + ]) + "cf3744188962bb9ab7a9847f9b21624c488ec250e780c728c1f9d0032d2ff3a2" + 0xe7e9397e 3 + -- 853240x888x2, 136 bytes, channel_flags 0 + , UpdateVector (mconcat + [ "49ac69d15fbdb35e1022bbe10d4c319fcc981c488e8120a6c6630caa81d96326" + , "335ac4948bbaa6bd24811550700c98fcb6af26f00f173d94fa1f060962e8d829" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0d04f8000378000269dea9690100005000000000000003e8000003e8000003e7" + , "00000000ec08ce00" + ]) + "14e2befbe15ea11b5094628ce2ceb1e22a325ed7a7fc03300641e0d7785e32f1" + 0xe265c205 4 + -- 855691x1739x0, 136 bytes, channel_flags 1 + , UpdateVector (mconcat + [ "337910ec557c3c04ad42130175e9c783179bb6e0627b36e96b5c635795e4f500" + , "2f11d94319a52c930fd166643709f1b97c096c64cbf412f620f53158c45054eb" + , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000" + , "0d0e8b0006cb000069e2cb460101005000000000000003e8000000000000000a" + , "000000012a05f200" + ]) + "bc08450188a2eb2f1e4fa964a5f11d458a06ce4a00010f86980fbb68c7d8f033" + 0x822c67ea 5 + ] + +-- node_announcement ---------------------------------------------------------- + +-- | A node_announcement payload signed with the secret key 0x4242..42, +-- and its signature digest (computed independently of this library). +-- It carries one descriptor of each known type, a descriptor of the +-- unknown type 6, and an extension record of type 101. +node_announcement_vector :: (BS.ByteString, BS.ByteString) +node_announcement_vector = (mconcat + [ "edbd2df19aee2f072d9665e2d9a2807fbcd4be6876f6863955ea11870e411e66" + , "063a31dcef14f1983524f87e108ee556b3a6646c873cd4bbcc07512c8f5e8f6a" + , "000908000000000002aaa26553f1000324653eac434488002cc06bbfb7f10fe1" + , "8991e35f9fe4302dbea6d2353dc0ab1c314159707061642d626f6c7437000000" + , "000000000000000000000000000000000000000063017f000001260702000000" + , "00000000000000000000000001260703aaaaaaaaaaaaaaaaaaaaaaaa04bbbbbb" + , "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb" + , "2607050e6c6e2e6578616d706c652e636f6d2607060102036503657874" + ] + , "c81748f1075dce2da919ce8a52fe59fec409aa10208b8ffc227f5292af5f0abf") + +-- extended gossip queries ---------------------------------------------------- + +-- | The vectors of bolt07/extended-queries.json, in order: messages with +-- their 2-byte type, in hex. +query_vectors :: [BS.ByteString] +query_vectors = [ + -- 0: QueryChannelRange + mconcat + [ "01070f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e" + , "2206000186a0000005dc" + ] + -- 1: QueryChannelRange + , mconcat + [ "01070f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e" + , "2206000088b800000064010103" + ] + -- 2: ReplyChannelRange, UNCOMPRESSED + , mconcat + [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e" + , "2206000b8a06000005dc01001900000000000000008e0000000000003c690000" + , "00000045a6c4" + ] + -- 3: ReplyChannelRange, COMPRESSED_ZLIB + , mconcat + [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e" + , "2206000006400000006e01001601789c636000833e08659309a65878be010010" + , "a9023a" + ] + -- 4: ReplyChannelRange, UNCOMPRESSED + , mconcat + [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e" + , "22060001ddde000005dc01001900000000000000304300000000000778d60000" + , "00000046e1c1011900000282c1000e77c5000778ad00490ab00000b57800955b" + , "ff031800000457000008ae00000d050000115c000015b300001a0a" + ] + -- 5: ReplyChannelRange, COMPRESSED_ZLIB + , mconcat + [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e" + , "22060001ddde000005dc01001801789c63600001036730c55e710d4cbb3d3c08" + , "0017c303b1012201789c63606a3ac8c0577e9481bd622d8327d7060686ad150c" + , "53a3ff0300554707db031800000457000008ae00000d050000115c000015b300" + , "001a0a" + ] + -- 6: QueryShortChannelIds, UNCOMPRESSED + , mconcat + [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e" + , "2206001900000000000000008e0000000000003c69000000000045a6c4" + ] + -- 7: QueryShortChannelIds, COMPRESSED_ZLIB + , mconcat + [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e" + , "2206001801789c63600001c12b608a69e73e30edbaec0800203b040e" + ] + -- 8: QueryShortChannelIds, UNCOMPRESSED + , mconcat + [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e" + , "22060019000000000000002fc80000000000003cc4000000000045a6c4010c01" + , "789c6364620100000e0008" + ] + -- 9: QueryShortChannelIds, COMPRESSED_ZLIB + , mconcat + [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e" + , "2206001801789c63600001f30a30c5b0cd144cb92e3b020017c6034a010c0178" + , "9c6364620100000e0008" + ] + ]