commit c51ce0bfe60ad6541235f06fe6a5161a25bdf7a0
parent 70c295b436c01cc5a8b550fb836edd90f1bc472a
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 14:39:55 +0400
Merge impl/modernize: 0.1.0 API
Ports ppad-bolt7 to ppad-bolt1 0.1.0 and ppad-bolt9, and reworks the
API for release.
- One public module, Lightning.Protocol.BOLT7, with snake_case names
and per-record field prefixes (ca_, na_, cu_, as_, qsci_, rsce_,
qcr_, rcr_, gtf_). Submodules are internal.
- Fundamental types come from bolt1 (Point for node ids and bitcoin
keys, ShortChannelId and its codec, MilliSatoshi for the htlc
limits, TLV streams) and feature fields are bolt9 FeatureVectors.
- Every decoder takes a payload (without the 2-byte type), consumes
all of it, and keeps every byte: message_flags and channel_flags
whole, with typed accessors for must_be_one, dont_forward, direction
and disable; address descriptors from the first unknown type on;
Tor v2 descriptors; extension TLV records. All 27,426 messages in
lux's gossip.bin decode and re-encode byte-exactly, and their
signatures verify.
- Query messages have typed short channel id lists, query_flags,
query_option, timestamps and checksums, with one-per-id counts
checked when decoding and encoding. Encoding types other than 0,
including the deprecated zlib, are rejected, as is an
encoded_short_ids without its encoding byte.
- Digests and checksums take typed messages; verify_* functions check
signatures with ppad-secp256k1. decode_message dispatches on a
message type. usable_addresses applies the receiver's address
rules. The feature-bit stub, unproduced error constructors, MsgType,
the length constants and the raw SCID list codecs are gone.
- Tests assert the bolt07 extended-queries vectors, real mainnet
announcements and updates (digests, checksums and signatures), a
signed node_announcement, every rejection rule, and round-trip
properties, including over the embedded real gossip. Benchmarks and
docs are rewritten; the spec copy is updated to 1aadb719.
Diffstat:
20 files changed, 3457 insertions(+), 3551 deletions(-)
diff --git a/AGENTS.md b/AGENTS.md
@@ -6,10 +6,11 @@ Specification: https://github.com/lightning/bolts/blob/master/07-routing-gossip.
## Project Structure
-- `lib/` - library source (Lightning.Protocol.BOLT7)
+- `lib/` - library source (public API: Lightning.Protocol.BOLT7;
+ submodules are internal)
- `test/` - tests (tasty + tasty-hunit)
- `bench/` - benchmarks (criterion for timing, weigh for allocations)
-- `etc/` - reference materials (BOLT spec)
+- `etc/` - reference materials (BOLT spec, pinned upstream commit)
- `flake.nix` - nix flake for dependency and build management
- `ppad-bolt7.cabal` - cabal package definition
- `CLAUDE.md` / `AGENTS.md` - keep these in sync
@@ -135,5 +136,4 @@ When planning work:
The flake.nix follows ppad conventions:
- Uses ppad-nixpkgs as base
- Follows references to avoid duplication
-- Supports LLVM backend via cabal flag
- Provides devShell with ghc, cabal, cc, llvm
diff --git a/CHANGELOG b/CHANGELOG
@@ -0,0 +1,38 @@
+# Changelog
+
+- 0.1.0 (UNRELEASED)
+ * 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/CLAUDE.md b/CLAUDE.md
@@ -6,10 +6,11 @@ Specification: https://github.com/lightning/bolts/blob/master/07-routing-gossip.
## Project Structure
-- `lib/` - library source (Lightning.Protocol.BOLT7)
+- `lib/` - library source (public API: Lightning.Protocol.BOLT7;
+ submodules are internal)
- `test/` - tests (tasty + tasty-hunit)
- `bench/` - benchmarks (criterion for timing, weigh for allocations)
-- `etc/` - reference materials (BOLT spec)
+- `etc/` - reference materials (BOLT spec, pinned upstream commit)
- `flake.nix` - nix flake for dependency and build management
- `ppad-bolt7.cabal` - cabal package definition
- `CLAUDE.md` / `AGENTS.md` - keep these in sync
@@ -135,5 +136,4 @@ When planning work:
The flake.nix follows ppad conventions:
- Uses ppad-nixpkgs as base
- Follows references to avoid duplication
-- Supports LLVM backend via cabal flag
- Provides devShell with ghc, cabal, cc, llvm
diff --git a/README.md b/README.md
@@ -4,9 +4,15 @@
[](https://docs.ppad.tech/bolt7)
-A pure Haskell implementation of
-[BOLT #7](https://github.com/lightning/bolts/blob/master/07-routing-gossip.md)
-(Lightning Network routing gossip protocol).
+A pure Haskell implementation of Lightning Network routing gossip,
+[BOLT #7][bolt7]: the `channel_announcement`, `node_announcement`,
+`channel_update` and `announcement_signatures` messages, the gossip
+queries, signature digests and verification, and `channel_update`
+checksums.
+
+Decoding keeps every byte of a message (unassigned flag bits, unknown
+address descriptors, extension TLV records), so a decoded message
+re-encodes exactly and its signatures still verify.
## Usage
@@ -14,69 +20,122 @@ A sample GHCi session:
```
> :set -XOverloadedStrings
+ > import qualified Data.ByteString as BS
+ > import qualified Data.ByteString.Base16 as B16
+ > import qualified Lightning.Protocol.BOLT1 as BOLT1
+ > import Lightning.Protocol.BOLT7
>
- > -- import qualified
- > import qualified Lightning.Protocol.BOLT7 as B7
+ > -- a channel_update payload from mainnet gossip
+ > :{
+ | let Just wire = B16.decode $ mconcat
+ | [ "1c3f0859cb3f4494919c3dcc80d22bbf1e25e378bd95f071530833c2371c33d7"
+ | , "0766012ebef1cd79b299a54d0d29bea2ef6feca1d6cfa188864c95d7eea7e9a4"
+ | , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ | , "0cf884000bb000016a0a1c760100006400000000000003e80000000000001388"
+ | , "00000000b1069a80fdd9030800000000ffffffed" ]
+ | :}
+ > let Right upd = decode_channel_update wire
+ > format_short_channel_id (cu_short_channel_id upd)
+ "850052x2992x1"
+ > channel_flags_direction (cu_channel_flags upd)
+ NodeOne
+ > cu_fee_proportional_millionths upd
+ 5000
>
- > -- decode a gossip_timestamp_filter from wire bytes (after msg type)
- > -- wire contains: 32-byte chain_hash, 4-byte first_timestamp,
- > -- 4-byte timestamp_range
- > case B7.decodeGossipTimestampFilter wire of
- > Left err -> print err
- > Right (msg, rest) -> print (B7.gossipFilterFirstTimestamp msg)
- 1609459200
+ > -- extension records (here LND's inbound fees) are kept, so the
+ > -- update re-encodes exactly and its signature verifies
+ > BOLT1.un_tlv_stream (cu_tlvs upd)
+ [TlvRecord {tlv_type = 55555, tlv_value = "\NUL\NUL\NUL\NUL\255\255\255\237"}]
+ > encode_channel_update upd == wire
+ True
+ > :{
+ | let Just node_1 = BOLT1.point =<< B16.decode
+ | "02bb5e47ee26aca1654ce092d9d06eac15d953210c737f2220e2d7e54c4f108677"
+ | :}
+ > verify_channel_update node_1 upd
+ True
+ > verify_channel_update node_1 upd { cu_fee_base_msat = 1 }
+ False
>
- > -- construct and encode a gossip_timestamp_filter
- > let msg = B7.GossipTimestampFilter B7.mainnetChainHash 1609459200 86400
- > let encoded = B7.encodeGossipTimestampFilter msg
+ > -- dispatch on a message type, as split off by BOLT1.decode_envelope
+ > fmap message_type (decode_message 258 wire)
+ Right 258
>
- > -- validate a channel_announcement before processing
- > case B7.validateChannelAnnouncement announcement of
- > Left B7.ValidateNodeIdOrdering -> putStrLn "invalid node ordering"
- > Right () -> putStrLn "valid"
+ > -- gossip queries have typed fields
+ > let Just chain = BOLT1.chain_hash (BS.replicate 32 0)
+ > let opt = Just (query_option [WantTimestamps])
+ > let q = QueryChannelRange chain 800000 1000 opt BOLT1.empty_tlv_stream
+ > let Right payload = encode_query_channel_range q
+ > decode_query_channel_range payload == Right q
+ True
>
- > -- compute the hash for signature verification
- > let sigHash = B7.channelAnnouncementHash encodedAnnouncement
- > -- verify signatures with ppad-secp256k1 (separate library)
+ > -- the deprecated zlib encoding is rejected
+ > decode_reply_channel_range (BS.replicate 41 0 <> "\NUL\STX\SOHx")
+ Left (DecodeUnknownEncoding 1)
```
-## Overview
+## Documentation
-ppad-bolt7 provides types and codecs for BOLT #7 gossip messages:
+Haddocks (API documentation, etc.) are hosted at
+[docs.ppad.tech/bolt7](https://docs.ppad.tech/bolt7).
-* `channel_announcement` (256)
-* `node_announcement` (257)
-* `channel_update` (258)
-* `announcement_signatures` (259)
-* `query_short_channel_ids` (261)
-* `reply_short_channel_ids_end` (262)
-* `query_channel_range` (263)
-* `reply_channel_range` (264)
-* `gossip_timestamp_filter` (265)
+## Specification
-## Documentation
+This library implements BOLT #7 as of lightning/bolts commit
+[1aadb719][spec] (2026-09-21); a copy lives in `etc/`. Fundamental
+types come from [ppad-bolt1][bolt1] and feature vectors from
+[ppad-bolt9][bolt9].
-Haddock documentation is available at
-[docs.ppad.tech/bolt7](https://docs.ppad.tech/bolt7).
+Not implemented:
+
+* The zlib encoding (type 1) of `encoded_short_ids` and its kin, which
+ the specification forbids; messages using it fail to decode.
+* Signing. The digest functions give what a node signs, with e.g.
+ [ppad-secp256k1][secp], to create announcements and updates.
+* Rules that need state or chain access: timestamp ordering,
+ blacklisting, funding output checks, chain hash filtering, rebroadcast
+ and pruning policy. Feature-bit rules are left to ppad-bolt9.
+
+Checksums cover a `channel_update`'s extension records, per the
+specification's wording.
+
+## Performance
+
+The aim is best-in-class performance for pure Haskell code. Run the
+benchmarks with:
+
+```
+$ cabal bench
+```
## Security
-This is a pre-release version of the library and makes no claims about
-security whatsoever.
+This library has received no security audit. Decoding validates every
+field the specification constrains, and rejects unknown even TLV types.
+Signature verification uses ppad-secp256k1 and, like libsecp256k1,
+accepts only low-s signatures.
## Development
-A Nix development shell is provided via flake. Enter it with:
+You'll require [Nix][nixos] with [flake][flake] support enabled. Enter a
+development shell with:
```
$ nix develop
```
-Then use `cabal` as usual:
+Then do e.g.:
```
-$ cabal build
-$ cabal test
-$ cabal bench
+$ cabal repl ppad-bolt7
```
+to get a REPL for the main library.
+
+[bolt7]: https://github.com/lightning/bolts/blob/master/07-routing-gossip.md
+[bolt1]: https://git.ppad.tech/bolt1
+[bolt9]: https://git.ppad.tech/bolt9
+[secp]: https://git.ppad.tech/secp256k1
+[spec]: https://github.com/lightning/bolts/tree/1aadb719b4007c4cea0ba6e36b08c4fb53788dee
+[nixos]: https://nixos.org/
+[flake]: https://nixos.org/manual/nix/unstable/command-ref/new-cli/nix3-flake.html
diff --git a/bench/Fixtures.hs b/bench/Fixtures.hs
@@ -0,0 +1,116 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module: Fixtures
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Benchmark inputs: real mainnet gossip, a signed node_announcement, and
+-- large gossip query replies.
+
+module Fixtures (
+ Fixtures(..)
+ , fixtures
+ ) where
+
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as B16
+import qualified Lightning.Protocol.BOLT1 as BOLT1
+import Lightning.Protocol.BOLT7
+
+data Fixtures = Fixtures
+ { f_ann_bytes :: !BS.ByteString
+ , f_ann :: !ChannelAnnouncement
+ , f_upd_bytes :: !BS.ByteString
+ , f_upd :: !ChannelUpdate
+ , f_upd_key :: !BOLT1.Point
+ , f_node_bytes :: !BS.ByteString
+ , f_node :: !NodeAnnouncement
+ , f_qsci_bytes :: !BS.ByteString
+ , f_qsci :: !QueryShortChannelIds
+ , f_rcr_bytes :: !BS.ByteString
+ , f_rcr :: !ReplyChannelRange
+ }
+
+-- | The fixtures, or 'Nothing' if one fails to build.
+fixtures :: Maybe Fixtures
+fixtures = do
+ ann_bytes <- B16.decode ann_hex
+ ann <- right (decode_channel_announcement ann_bytes)
+ upd_bytes <- B16.decode upd_hex
+ upd <- right (decode_channel_update upd_bytes)
+ node_bytes <- B16.decode node_hex
+ node <- right (decode_node_announcement node_bytes)
+ ch <- BOLT1.chain_hash (BS.replicate 32 0x6f)
+ let ids = [ BOLT1.ShortChannelId (0x0cf88400000000 + 0x10000 * i)
+ | i <- [1 .. 1000] ]
+ qsci = QueryShortChannelIds ch ids
+ (Just (map (\i -> QueryFlags (i `mod` 32)) [1 .. 1000]))
+ BOLT1.empty_tlv_stream
+ rcr = ReplyChannelRange ch 850000 10000 True ids
+ (Just [ ChannelUpdateTimestamps (1776493010 + i) (1776493020 + i)
+ | i <- [1 .. 1000] ])
+ (Just [ ChannelUpdateChecksums (0x1da953bd + i) (0xf0a89fda + i)
+ | i <- [1 .. 1000] ])
+ BOLT1.empty_tlv_stream
+ qsci_bytes <- right (encode_query_short_channel_ids qsci)
+ rcr_bytes <- right (encode_reply_channel_range rcr)
+ pure Fixtures
+ { f_ann_bytes = ann_bytes
+ , f_ann = ann
+ , f_upd_bytes = upd_bytes
+ , f_upd = upd
+ , f_upd_key = ca_node_id_1 ann
+ , f_node_bytes = node_bytes
+ , f_node = node
+ , f_qsci_bytes = qsci_bytes
+ , f_qsci = qsci
+ , f_rcr_bytes = rcr_bytes
+ , f_rcr = rcr
+ }
+ where
+ right :: Either e a -> Maybe a
+ right = either (const Nothing) Just
+
+-- channel_announcement for 850052x2992x1
+ann_hex :: BS.ByteString
+ann_hex = mconcat
+ [ "3c256c270126d2c52ab5464fa959d627e9baec8c76bd2b81d34b47c4efb03290"
+ , "40126ea7a0f8d31420976dc28ff684dc63f62620fa10dbac4fe3d417ca5690c1"
+ , "b7fe1de61f5dd2b8368886d6c98f625c9110198e57c14fac93d4eff34e19ce5f"
+ , "5dc6fef4501e8105c8f9b82d6d0b348f5840864445b071ae7a741b5eb92d2ec0"
+ , "ab85681e4e1e85144bbbd8757c14cee92468d2c5ac84345cb28931b6fed5e339"
+ , "00ed9dd363db630f31248cfa933a3667cbf87bb78a48a442e81c652686355365"
+ , "ff33164c7588f0a753d50c4d52dd4a81c611fa47b4e950dfc9e3379a12ef7834"
+ , "781c0900b90f56a5a49893446d03c8d283c3c093e3c8c682ff6cb40d70d9eebc"
+ , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"
+ , "00000cf884000bb0000102bb5e47ee26aca1654ce092d9d06eac15d953210c73"
+ , "7f2220e2d7e54c4f108677030b828fd1e42549fbc2f1d0960ec3663362c41777"
+ , "d3d87fe1b8e1d4bf063abcaa02bc3f260955062a4f427704edef1864c76d6777"
+ , "fe81bed43a5f6297dda1c7ca9203523e164f4f9fbdea978c6570d56b13ca8338"
+ , "430e6794ff74cf6aa0dbda71dd2d"
+ ]
+
+-- a channel_update for it from node_id_1, with an inbound-fee extension
+upd_hex :: BS.ByteString
+upd_hex = mconcat
+ [ "1c3f0859cb3f4494919c3dcc80d22bbf1e25e378bd95f071530833c2371c33d7"
+ , "0766012ebef1cd79b299a54d0d29bea2ef6feca1d6cfa188864c95d7eea7e9a4"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0cf884000bb000016a0a1c760100006400000000000003e80000000000001388"
+ , "00000000b1069a80fdd9030800000000ffffffed"
+ ]
+
+-- a node_announcement with one address descriptor of each type
+node_hex :: BS.ByteString
+node_hex = mconcat
+ [ "edbd2df19aee2f072d9665e2d9a2807fbcd4be6876f6863955ea11870e411e66"
+ , "063a31dcef14f1983524f87e108ee556b3a6646c873cd4bbcc07512c8f5e8f6a"
+ , "000908000000000002aaa26553f1000324653eac434488002cc06bbfb7f10fe1"
+ , "8991e35f9fe4302dbea6d2353dc0ab1c314159707061642d626f6c7437000000"
+ , "000000000000000000000000000000000000000063017f000001260702000000"
+ , "00000000000000000000000001260703aaaaaaaaaaaaaaaaaaaaaaaa04bbbbbb"
+ , "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+ , "2607050e6c6e2e6578616d706c652e636f6d2607060102036503657874"
+ ]
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,363 +1,62 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-- |
-- Module: Main
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Criterion timing benchmarks for BOLT #7 gossip codecs.
+-- Criterion timing benchmarks for ppad-bolt7.
module Main where
import Criterion.Main
-import qualified Data.ByteString as BS
-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)
+import Fixtures
import Lightning.Protocol.BOLT7
-
--- Test data construction ------------------------------------------------------
-
--- | 32 zero bytes for chain hashes, etc.
-zeroBytes32 :: BS.ByteString
-zeroBytes32 = BS.replicate 32 0x00
-{-# NOINLINE zeroBytes32 #-}
-
--- | 8 zero bytes for short channel IDs.
-zeroBytes8 :: BS.ByteString
-zeroBytes8 = BS.replicate 8 0x00
-{-# NOINLINE zeroBytes8 #-}
-
--- | 64-byte signature.
-testSignature :: Signature
-testSignature = case signature (BS.replicate 64 0x01) of
- Just s -> s
- Nothing -> error "testSignature: invalid"
-{-# NOINLINE testSignature #-}
-
--- | 33-byte compressed public key (02 prefix + 32 zero bytes).
-testPoint :: Point
-testPoint = case point (BS.cons 0x02 zeroBytes32) of
- Just p -> p
- Nothing -> error "testPoint: invalid"
-{-# NOINLINE testPoint #-}
-
--- | 32-byte chain hash.
-testChainHash :: ChainHash
-testChainHash = case chainHash zeroBytes32 of
- Just h -> h
- Nothing -> error "testChainHash: invalid"
-{-# NOINLINE testChainHash #-}
-
--- | 8-byte short channel ID.
-testShortChannelId :: ShortChannelId
-testShortChannelId = case scidFromBytes 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 scidFromBytes (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 =
- case encodeChannelAnnouncement testChannelAnnouncement of
- Right bs -> bs
- Left _ -> error "encodedChannelAnnouncement: encode failed"
-{-# 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
- , chanUpdateChanFlags = ChannelFlags NodeOne Enabled
- , chanUpdateCltvExpDelta = CltvExpiryDelta 144
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 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 = BlockHeight 700000
- , queryRangeNumBlocks = BlockCount 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 = BlockHeight 700000
- , replyRangeNumBlocks = BlockCount 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
- ]
- , bgroup "gossip_timestamp_filter"
- [ bench "encode" $
- nf encodeGossipTimestampFilter testGossipTimestampFilter
- , bench "decode" $
- nf decodeGossipTimestampFilter encodedGossipTimestampFilter
- ]
- , bgroup "scid_list"
- [ bench "encode (100)" $ nf encodeShortChannelIdList testScidList
- , bench "decode (100)" $ nf decodeShortChannelIdList encodedScidList
- ]
- , bgroup "hash"
- [ bench "channelAnnouncementHash" $
- nf channelAnnouncementHash encodedChannelAnnouncement
- , bench "nodeAnnouncementHash" $
- nf nodeAnnouncementHash encodedNodeAnnouncement
- , bench "channelUpdateHash" $
- nf channelUpdateHash encodedChannelUpdate
- , bench "channelUpdateChecksum" $
- nf channelUpdateChecksum encodedChannelUpdate
- ]
- , bgroup "validate"
- [ bench "channelAnnouncement" $
- nf validateChannelAnnouncement testChannelAnnouncement
- , bench "nodeAnnouncement" $
- nf validateNodeAnnouncement testNodeAnnouncement
- , bench "channelUpdate" $
- nf validateChannelUpdate testChannelUpdate
- , bench "queryChannelRange" $
- nf validateQueryChannelRange testQueryChannelRange
- , bench "replyChannelRange" $
- nf validateReplyChannelRange testReplyChannelRange
- ]
- ]
+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 "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 "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 "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 "validate_reply_channel_range (1000 ids)" $
+ nf validate_reply_channel_range (f_rcr f)
+ ]
+ ]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -1,361 +1,44 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-- |
-- Module: Main
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Weigh allocation benchmarks for BOLT #7 gossip codecs.
+-- Weigh allocation benchmarks for ppad-bolt7.
module Main where
-import qualified Data.ByteString as BS
-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)
+import Fixtures
import Lightning.Protocol.BOLT7
+import System.Exit (exitFailure)
import Weigh
--- Test data construction ------------------------------------------------------
-
--- | 32 zero bytes for chain hashes, etc.
-zeroBytes32 :: BS.ByteString
-zeroBytes32 = BS.replicate 32 0x00
-{-# NOINLINE zeroBytes32 #-}
-
--- | 8 zero bytes for short channel IDs.
-zeroBytes8 :: BS.ByteString
-zeroBytes8 = BS.replicate 8 0x00
-{-# NOINLINE zeroBytes8 #-}
-
--- | 64-byte signature.
-testSignature :: Signature
-testSignature = case signature (BS.replicate 64 0x01) of
- Just s -> s
- Nothing -> error "testSignature: invalid"
-{-# NOINLINE testSignature #-}
-
--- | 33-byte compressed public key (02 prefix + 32 zero bytes).
-testPoint :: Point
-testPoint = case point (BS.cons 0x02 zeroBytes32) of
- Just p -> p
- Nothing -> error "testPoint: invalid"
-{-# NOINLINE testPoint #-}
-
--- | 32-byte chain hash.
-testChainHash :: ChainHash
-testChainHash = case chainHash zeroBytes32 of
- Just h -> h
- Nothing -> error "testChainHash: invalid"
-{-# NOINLINE testChainHash #-}
-
--- | 8-byte short channel ID.
-testShortChannelId :: ShortChannelId
-testShortChannelId = case scidFromBytes 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 scidFromBytes (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
- , chanUpdateChanFlags = ChannelFlags NodeOne Enabled
- , chanUpdateCltvExpDelta = CltvExpiryDelta 144
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 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 = BlockHeight 700000
- , queryRangeNumBlocks = BlockCount 10000
- , queryRangeTlvs = tlvs
- }
-
--- | Construct ReplyChannelRange message.
-mkReplyChannelRange :: ChainHash -> TlvStream -> ReplyChannelRange
-mkReplyChannelRange !ch !tlvs = ReplyChannelRange
- { replyRangeChainHash = ch
- , replyRangeFirstBlock = BlockHeight 700000
- , replyRangeNumBlocks = BlockCount 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 =
- case encodeChannelAnnouncement testChannelAnnouncement of
- Right bs -> bs
- Left _ -> error "encodedChannelAnnouncement: encode failed"
-{-# 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/etc/07-routing-gossip.md b/etc/07-routing-gossip.md
@@ -86,6 +86,8 @@ A node:
- If the `open_channel` message has the `announce_channel` bit set AND a `shutdown` message has not been sent:
- After `channel_ready` has been sent and received AND the funding transaction has enough confirmations to ensure that it won't be reorganized:
- MUST send `announcement_signatures` for the funding transaction.
+ - After `splice_locked` has been sent and received AND the splice transaction has enough confirmations to ensure that it won't be reorganized:
+ - MUST send `announcement_signatures` for the matching splice transaction.
- Otherwise:
- MUST NOT send the `announcement_signatures` message.
- Upon reconnection (once the above timing requirements have been met):
@@ -93,19 +95,23 @@ A node:
- MUST send its own `announcement_signatures` message.
- If it receives `announcement_signatures` for the funding transaction:
- MUST respond with its own `announcement_signatures` message.
+ - If it has NOT previously received `announcement_signatures` for a splice transaction:
+ - MUST SET the `announcement_signatures` bit in the `retransmit_flags` of `my_current_funding_locked`.
+ - If the `announcement_signatures` bit is set in the *remote* `retransmit_flags`:
+ - MUST retransmit its `announcement_signatures` message.
A recipient node:
- - If the `short_channel_id` is NOT correct:
- - SHOULD send a `warning` and close the connection, or send an
- `error` and fail the channel.
+ - If the `short_channel_id` doesn't match one of its funding transactions:
+ - SHOULD send a `warning`.
- If the `node_signature` OR the `bitcoin_signature` is NOT correct:
- - MAY send a `warning` and close the connection, or send an
- `error` and fail the channel.
+ - MAY send a `warning` and close the connection, or send an `error` and fail the channel.
- If it has sent AND received a valid `announcement_signatures` message:
- If the funding transaction has at least 6 confirmations:
- SHOULD queue the `channel_announcement` message for its peers.
- If it has not sent `channel_ready`:
- SHOULD defer handling the `announcement_signatures` until after it has sent `channel_ready`.
+ - If it has not sent `splice_locked` for the transaction matching this `short_channel_id`:
+ - SHOULD defer handling the `announcement_signatures` until after it has sent `splice_locked`.
### Rationale
@@ -113,6 +119,12 @@ Channels must not be announced before the funding transaction has enough
confirmations, because a blockchain reorganization would otherwise invalidate
the `short_channel_id`.
+When splicing is used, a `channel_announcement` is generated for every splice
+transaction once both sides have sent `splice_locked`. This lets the network
+know that the transaction spending a currently active channel is a splice and
+not a closing transaction, and this channel can still be used with its updated
+`short_channel_id`.
+
## The `channel_announcement` Message
This gossip message contains ownership information regarding a channel. It ties
@@ -162,9 +174,18 @@ The origin node:
that the channel was opened within:
- for the _Bitcoin blockchain_:
- MUST set `chain_hash` value (encoded in hex) equal to `6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000`.
- - MUST set `short_channel_id` to refer to the confirmed funding transaction,
- as specified in [BOLT #2](02-peer-protocol.md#the-channel_ready-message).
- - Note: the corresponding output MUST be a P2WSH, as described in [BOLT #3](03-transactions.md#funding-transaction-output).
+ - When announcing a channel creation:
+ - MUST set `short_channel_id` to refer to the confirmed funding transaction,
+ as specified in [BOLT #2](02-peer-protocol.md#the-channel_ready-message).
+ - When announcing a splice transaction:
+ - MUST set `short_channel_id` to refer to the confirmed splice transaction
+ for which `splice_locked` has been sent and received, as specified in
+ [BOLT #2](02-peer-protocol.md#the-splice_locked-message).
+ - SHOULD keep relaying payments that use the `short_channel_id`s of its
+ previous `channel_announcement`s.
+ - SHOULD send a new `channel_update` using the `short_channel_id` that
+ matches the latest `channel_announcement`.
+ - Note: the corresponding output MUST be a P2WSH, as described in [BOLT #3](03-transactions.md#funding-transaction-output).
- MUST set `node_id_1` and `node_id_2` to the public keys of the two nodes
operating the channel, such that `node_id_1` is the lexicographically-lesser of the
two compressed keys sorted in ascending lexicographic order.
@@ -189,6 +210,10 @@ The origin node:
The receiving node:
- MUST verify the integrity AND authenticity of the message by verifying the
signatures.
+ - if `node_id_1` is not lexicographically less than `node_id_2`:
+ - SHOULD send a `warning`.
+ - MAY close the connection.
+ - MUST ignore the message.
- if there is an unknown even bit in the `features` field:
- MUST NOT attempt to route messages through the channel.
- if the `short_channel_id`'s output does NOT correspond to a P2WSH (using
@@ -253,9 +278,11 @@ optional) features will have _odd_ feature bits, while incompatible features
will have _even_ feature bits
(["It's OK to be odd!"](00-introduction.md#glossary-and-terminology-guide)).
-A delay of 72 blocks is used when forgetting a channel on funding output spend
-as to permit a new `channel_announcement` to propagate which indicates this
-channel was spliced.
+A delay of 72 blocks is used when forgetting a channel after detecting that it
+has been spent: this can allow a new `channel_announcement` to propagate to
+indicate that this channel was spliced and not closed. Thanks to this delay,
+payments can still be relayed on the channel while the splice transaction is
+waiting for enough confirmations.
## The `node_announcement` Message
@@ -319,8 +346,7 @@ The origin node:
- MUST place address descriptors in ascending order.
- SHOULD NOT place any zero-typed address descriptors anywhere.
- SHOULD use placement only for aligning fields that follow `addresses`.
- - MUST NOT create a `type 1`, `type 2` or `type 5` address descriptor with
- `port` equal to 0.
+ - MUST NOT create an address descriptor with `port` equal to 0.
- SHOULD ensure `ipv4_addr` AND `ipv6_addr` are routable addresses.
- MUST set `features` according to [BOLT #9](09-features.md#assigned-features-flags)
- SHOULD set `flen` to the minimum length required to hold the `features`
@@ -351,7 +377,7 @@ any future fields appended to the end):
- SHOULD send a `warning`.
- MAY close the connection.
- if `port` is equal to 0:
- - SHOULD ignore `ipv6_addr` OR `ipv4_addr` OR `hostname`.
+ - SHOULD ignore that address descriptor.
- if `node_id` is NOT previously known from a `channel_announcement` message,
OR if `timestamp` is NOT greater than the last-received `node_announcement`
from this `node_id`:
@@ -819,7 +845,7 @@ The receiver of `query_channel_range`:
- MUST set `sync_complete` to `false` if this is not the final `reply_channel_range`.
- the final `reply_channel_range` message:
- MUST have `first_blocknum` plus `number_of_blocks` equal or greater than the `query_channel_range` `first_blocknum` plus `number_of_blocks`.
- - MUST set `sync_complete` to `true`.
+ - MUST set `sync_complete` to `true`.
If the incoming message includes `query_option`, the receiver MAY append additional information to its reply:
- if bit 0 in `query_option_flags` is set, the receiver MAY append a `timestamps_tlv` that contains `channel_update` timestamps for all `short_channel_id`s in `encoded_short_ids`
diff --git a/flake.lock b/flake.lock
@@ -149,16 +149,19 @@
"nixpkgs"
],
"ppad-base16": "ppad-base16",
+ "ppad-bolt9": [
+ "ppad-bolt9"
+ ],
"ppad-nixpkgs": [
"ppad-nixpkgs"
]
},
"locked": {
- "lastModified": 1783709539,
- "narHash": "sha256-bXqV4/qYZFbZeG8PHlnr+PVyTZ3E0ZIi+mgCu49iamw=",
+ "lastModified": 1791625140,
+ "narHash": "sha256-DgMZKJlpLQcrNLSuzOM+bF2QQKsaVKigzSjkyOEockQ=",
"ref": "master",
- "rev": "507af14c14be9fbaa27992357aa25e40c443daee",
- "revCount": 33,
+ "rev": "b4b4b507bf0be00435a15c448ef2366ed0c22581",
+ "revCount": 43,
"type": "git",
"url": "git://git.ppad.tech/bolt1.git"
},
@@ -168,6 +171,37 @@
"url": "git://git.ppad.tech/bolt1.git"
}
},
+ "ppad-bolt9": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-bolt9",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-bolt9",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1791624953,
+ "narHash": "sha256-DWafVJvu2LTXkAI/zH0Q0BqTrjLo0c7hyTvaW/9N0VM=",
+ "ref": "master",
+ "rev": "280946ab905a374c8c6d4a37678a4cc362551ab9",
+ "revCount": 39,
+ "type": "git",
+ "url": "git://git.ppad.tech/bolt9.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/bolt9.git"
+ }
+ },
"ppad-fixed": {
"inputs": {
"flake-utils": [
@@ -386,6 +420,7 @@
"nixpkgs"
],
"ppad-bolt1": "ppad-bolt1",
+ "ppad-bolt9": "ppad-bolt9",
"ppad-nixpkgs": "ppad-nixpkgs",
"ppad-secp256k1": "ppad-secp256k1",
"ppad-sha256": "ppad-sha256"
diff --git a/flake.nix b/flake.nix
@@ -7,6 +7,13 @@
url = "git://git.ppad.tech/bolt1.git";
ref = "master";
inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
+ inputs.ppad-bolt9.follows = "ppad-bolt9";
+ };
+ ppad-bolt9 = {
+ type = "git";
+ url = "git://git.ppad.tech/bolt9.git";
+ ref = "master";
+ inputs.ppad-nixpkgs.follows = "ppad-nixpkgs";
};
ppad-secp256k1 = {
type = "git";
@@ -31,7 +38,7 @@
};
outputs = { self, nixpkgs, flake-utils, ppad-nixpkgs
- , ppad-bolt1, ppad-secp256k1, ppad-sha256 }:
+ , ppad-bolt1, ppad-bolt9, ppad-secp256k1, ppad-sha256 }:
flake-utils.lib.eachDefaultSystem (system:
let
lib = "ppad-bolt7";
@@ -42,10 +49,7 @@
clang = pkgs.llvmPackages_19.clang;
bolt1 = ppad-bolt1.packages.${system}.default;
- bolt1-llvm =
- hlib.addBuildTools
- (hlib.enableCabalFlag bolt1 "llvm")
- [ llvm clang ];
+ bolt9 = ppad-bolt9.packages.${system}.default;
secp256k1 = ppad-secp256k1.packages.${system}.default;
secp256k1-llvm =
@@ -60,7 +64,8 @@
[ llvm clang ];
hpkgs = pkgs.haskell.packages.ghc910.extend (new: old: {
- ppad-bolt1 = bolt1-llvm;
+ ppad-bolt1 = bolt1;
+ ppad-bolt9 = bolt9;
ppad-secp256k1 = secp256k1-llvm;
ppad-sha256 = sha256-llvm;
${lib} = new.callCabal2nix lib ./. {
diff --git a/lib/Lightning/Protocol/BOLT7.hs b/lib/Lightning/Protocol/BOLT7.hs
@@ -6,105 +6,132 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Routing gossip protocol for the Lightning Network, per
--- [BOLT #7](https://github.com/lightning/bolts/blob/master/07-routing-gossip.md).
+-- 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.
--
--- = Overview
+-- Fundamental types (chain hashes, points, signatures, short channel
+-- ids, amounts, TLV streams) come from ppad-bolt1, and feature vectors
+-- from ppad-bolt9.
--
--- 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.
--- The hash functions take the received payload (the bytes after the
--- 2-byte message type):
---
--- @
--- -- Compute the hash that should be signed
--- case channelAnnouncementHash payload of
--- Nothing -> rejectMessage -- too short to be a channel_announcement
--- Just sigHash -> verifyWith sigHash -- e.g. using ppad-secp256k1
--- @
---
--- = Protocol overview
---
--- BOLT #7 defines gossip messages for routing in the Lightning Network.
--- Nodes use these messages to build a view of the channel graph.
+-- 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
-
- -- * Message types
- -- | Re-exported from "Lightning.Protocol.BOLT7.Messages".
- , module Lightning.Protocol.BOLT7.Messages
-
- -- * Codec functions
- -- | Re-exported from "Lightning.Protocol.BOLT7.Codec".
- , module Lightning.Protocol.BOLT7.Codec
-
- -- * Hash functions
- -- | Re-exported from "Lightning.Protocol.BOLT7.Hash".
- , module Lightning.Protocol.BOLT7.Hash
-
- -- * Validation functions
- -- | Re-exported from "Lightning.Protocol.BOLT7.Validate".
- , module Lightning.Protocol.BOLT7.Validate
-
- -- $messagetypes
-
- -- ** Channel announcement
- -- $announcement
-
- -- ** Node announcement
- -- $nodeannouncement
-
- -- ** Channel updates
- -- $updates
-
- -- ** Gossip queries
- -- $queries
+ -- * Messages
+ Message(..)
+ , message_type
+ , ChannelAnnouncement(..)
+ , NodeAnnouncement(..)
+ , ChannelUpdate(..)
+ , AnnouncementSignatures(..)
+ , QueryShortChannelIds(..)
+ , ReplyShortChannelIdsEnd(..)
+ , QueryChannelRange(..)
+ , ReplyChannelRange(..)
+ , GossipTimestampFilter(..)
+
+ -- * Encoding and decoding
+ , encode_message
+ , decode_message
+ , EncodeError(..)
+ , DecodeError(..)
+
+ -- ** 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
+
+ -- * 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
+ , ValidationError(..)
+ , validate_channel_announcement
+ , validate_node_announcement
+ , validate_channel_update
+ , validate_query_short_channel_ids
+ , validate_query_channel_range
+ , validate_reply_channel_range
+
+ -- * 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
+
+ -- * node_announcement fields
+ , RgbColor(..)
+ , Alias
+ , alias
+ , un_alias
+
+ -- ** 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
+
+ -- * Query fields
+ , QueryFlags(..)
+ , QueryFlag(..)
+ , query_flags
+ , has_query_flag
+ , QueryOption(..)
+ , QueryOptionFlag(..)
+ , query_option
+ , has_query_option
+ , ChannelUpdateTimestamps(..)
+ , ChannelUpdateChecksums(..)
+
+ -- * Short channel ids
+ , format_short_channel_id
) where
import Lightning.Protocol.BOLT7.Codec
@@ -112,46 +139,3 @@ import Lightning.Protocol.BOLT7.Hash
import Lightning.Protocol.BOLT7.Messages
import Lightning.Protocol.BOLT7.Types
import Lightning.Protocol.BOLT7.Validate
-
--- $messagetypes
---
--- BOLT #7 defines the following message types:
---
--- * 256: channel_announcement
--- * 257: node_announcement
--- * 258: channel_update
--- * 259: announcement_signatures
--- * 261: query_short_channel_ids
--- * 262: reply_short_channel_ids_end
--- * 263: query_channel_range
--- * 264: reply_channel_range
--- * 265: gossip_timestamp_filter
-
--- $announcement
---
--- Channel announcement messages:
---
--- * channel_announcement (256) - public channel announcement
--- * announcement_signatures (259) - signatures enabling announcement
-
--- $nodeannouncement
---
--- Node announcement message:
---
--- * node_announcement (257) - advertises node metadata
-
--- $updates
---
--- Channel update message:
---
--- * channel_update (258) - per-direction routing parameters
-
--- $queries
---
--- Gossip query messages:
---
--- * query_short_channel_ids (261) - request specific channel info
--- * reply_short_channel_ids_end (262) - concludes query response
--- * query_channel_range (263) - query channels in block range
--- * reply_channel_range (264) - response with channel IDs
--- * gossip_timestamp_filter (265) - constrain relayed gossip
diff --git a/lib/Lightning/Protocol/BOLT7/CRC32C.hs b/lib/Lightning/Protocol/BOLT7/CRC32C.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
-- |
@@ -6,44 +7,43 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- CRC-32C (Castagnoli) implementation for BOLT #7 checksums.
---
--- This is an internal helper module implementing CRC-32C as specified
--- in RFC 3720. CRC-32C uses the Castagnoli polynomial 0x1EDC6F41.
+-- CRC-32C (Castagnoli), per RFC 3720, for @channel_update@ checksums.
module Lightning.Protocol.BOLT7.CRC32C (
crc32c
) where
-import Data.Bits (shiftR, xor, (.&.))
-import Data.ByteString (ByteString)
+import Data.Bits (complement, shiftL, shiftR, xor, (.&.), (.|.))
import qualified Data.ByteString as BS
+import qualified Data.ByteString.Unsafe as BU
import Data.Word (Word8, Word32)
--- | CRC-32C polynomial (Castagnoli): 0x1EDC6F41 reflected = 0x82F63B78
-crc32cPoly :: Word32
-crc32cPoly = 0x82F63B78
-{-# INLINE crc32cPoly #-}
-
--- | Compute CRC-32C of a bytestring.
---
--- >>> crc32c "123456789"
--- 0xe3069283
-crc32c :: ByteString -> Word32
-crc32c = xor 0xFFFFFFFF . BS.foldl' updateByte 0xFFFFFFFF
+-- | The CRC-32C of a byte string.
+crc32c :: BS.ByteString -> Word32
+crc32c = complement . BS.foldl' step 0xFFFFFFFF
+ where
+ step !c !b = (c `shiftR` 8) `xor` entry (fromIntegral c `xor` b)
{-# INLINE crc32c #-}
--- | Update CRC with a single byte.
-updateByte :: Word32 -> Word8 -> Word32
-updateByte !crc !byte =
- let crc' = crc `xor` fromIntegral byte
- in go 8 crc'
+-- the table entry for a byte, read from 'table'
+entry :: Word8 -> Word32
+entry i =
+ let !o = 4 * fromIntegral i -- at most 1020, within the 1024-byte table
+ byte k = fromIntegral (BU.unsafeIndex table (o + k)) :: Word32
+ in byte 0 .|. (byte 1 `shiftL` 8) .|. (byte 2 `shiftL` 16)
+ .|. (byte 3 `shiftL` 24)
+{-# INLINE entry #-}
+
+-- the 256 table entries, little-endian
+table :: BS.ByteString
+table = fst (BS.unfoldrN 1024 byte 0)
where
- go :: Int -> Word32 -> Word32
+ byte :: Int -> Maybe (Word8, Int)
+ byte k = Just
+ (fromIntegral (go (8 :: Int) (fromIntegral (k `shiftR` 2))
+ `shiftR` (8 * (k .&. 3))), k + 1)
+ -- the Castagnoli polynomial 0x1EDC6F41, bit-reflected
+ poly = 0x82F63B78 :: Word32
go 0 !c = c
- go !n !c =
- let c' = if c .&. 1 /= 0
- then (c `shiftR` 1) `xor` crc32cPoly
- else c `shiftR` 1
- in go (n - 1) c'
-{-# INLINE updateByte #-}
+ go n !c = go (n - 1) ((c `shiftR` 1) `xor` (poly .&. negate (c .&. 1)))
+{-# NOINLINE table #-}
diff --git a/lib/Lightning/Protocol/BOLT7/Codec.hs b/lib/Lightning/Protocol/BOLT7/Codec.hs
@@ -1,5 +1,4 @@
-{-# OPTIONS_HADDOCK prune #-}
-
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -9,666 +8,697 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Encoding and decoding for BOLT #7 gossip messages.
+-- Encoding and decoding of BOLT #7 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
+ , 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 Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Word (Word8, Word16, Word32, Word64)
import GHC.Generics (Generic)
-import Lightning.Protocol.BOLT1 (TlvStream)
-import qualified Lightning.Protocol.BOLT1.Prim as Prim
-import qualified Lightning.Protocol.BOLT1.TLV as TLV
+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
--- Error types -----------------------------------------------------------------
+-- errors ---------------------------------------------------------------------
--- | Encoding errors.
+-- | Why a message failed to encode.
data EncodeError
- = EncodeLengthOverflow -- ^ Field too large for u16 length prefix
+ = 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
--- | Decoding errors.
+-- | Why a message failed to decode.
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
+ = 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
--- 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, failing if the length does not fit
--- in a u16.
-encodeLenPrefixed :: ByteString -> Either EncodeError ByteString
-encodeLenPrefixed bs
- | len > 65535 = Left EncodeLengthOverflow
- | otherwise = Right (Prim.encodeU16 (fromIntegral len) <> bs)
- where
- !len = BS.length 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 #-}
-
--- | Decode a TLV stream per BOLT #1, given the known types: a
--- malformed stream or an unknown even type is an error, and unknown
--- odd types are skipped.
-decodeTlvs :: [Word64] -> ByteString -> Either DecodeError TlvStream
-decodeTlvs known bs = case TLV.decodeTlvStreamWith (`elem` known) bs of
- Left _ -> Left DecodeTlvError
- Right t -> Right t
-{-# INLINE decodeTlvs #-}
-
--- 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 scidFromBytes
-{-# 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).
---
--- Follows the BOLT #7 receiver rules for address descriptors:
+-- 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').
--
--- * parsing stops at the first descriptor of an unknown type, and
--- the remaining address bytes are ignored;
--- * deprecated Tor v2 descriptors (type 3) are skipped;
--- * descriptors with port 0 are skipped;
--- * DNS descriptors whose hostname is empty or not ASCII are
--- skipped.
---
--- A descriptor of a known type that @addrlen@ cannot hold is a
--- decoding error.
-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
- (typ, d1) <- decodeU8 d
- case typ of
- 1 -> fixedAddr ipv4AddrLen (fmap AddrIPv4 . ipv4Addr) d1
- 2 -> fixedAddr ipv6AddrLen (fmap AddrIPv6 . ipv6Addr) d1
- 3 -> do -- Tor v2 (deprecated; 10-byte onion + port)
- (_, d2) <- decodeBytes 12 d1
- parseAddrs d2
- 4 -> fixedAddr torV3AddrLen (fmap AddrTorV3 . torV3Addr) d1
- 5 -> do -- DNS hostname
- (hostLen, d2) <- decodeU8 d1
- (hostBytes, d3) <- decodeBytes (fromIntegral hostLen) d2
- (port, d4) <- decodeU16 d3
- keep (fmap AddrDNS (hostname hostBytes)) port d4
- _ -> Right [] -- unknown type: ignore the rest
-
- fixedAddr :: Int -> (ByteString -> Maybe (Word16 -> Address))
- -> ByteString -> Either DecodeError [Address]
- fixedAddr len mk d = do
- (addrBytes, d1) <- decodeBytes len d
- (port, d2) <- decodeU16 d1
- keep (mk addrBytes) port d2
-
- keep :: Maybe (Word16 -> Address) -> Word16 -> ByteString
- -> Either DecodeError [Address]
- keep mk port d = case mk of
- Just f | port /= 0 -> fmap (f port :) (parseAddrs d)
- _ -> parseAddrs d
-
--- Channel announcement --------------------------------------------------------
-
--- | Encode channel_announcement message.
---
--- Fails with 'EncodeLengthOverflow' if the feature bits exceed 65535
--- bytes.
-encodeChannelAnnouncement :: ChannelAnnouncement
- -> Either EncodeError ByteString
-encodeChannelAnnouncement msg = do
- features <- encodeLenPrefixed (getFeatureBits (channelAnnFeatures msg))
- Right $ mconcat
- [ unSignature (channelAnnNodeSig1 msg)
- , unSignature (channelAnnNodeSig2 msg)
- , unSignature (channelAnnBitcoinSig1 msg)
- , unSignature (channelAnnBitcoinSig2 msg)
- , features
- , unChainHash (channelAnnChainHash msg)
- , scidToBytes (channelAnnShortChanId msg)
- , getNodeId (channelAnnNodeId1 msg)
- , getNodeId (channelAnnNodeId2 msg)
- , unPoint (channelAnnBitcoinKey1 msg)
- , unPoint (channelAnnBitcoinKey2 msg)
+-- >>> 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 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.
---
--- Fails with 'EncodeLengthOverflow' if the feature bits or the
--- encoded addresses exceed 65535 bytes.
-encodeNodeAnnouncement :: NodeAnnouncement -> Either EncodeError ByteString
-encodeNodeAnnouncement msg = do
- features <- encodeLenPrefixed (getFeatureBits (nodeAnnFeatures msg))
- addrs <- encodeLenPrefixed =<< encodeAddresses (nodeAnnAddresses msg)
- Right $ mconcat
- [ unSignature (nodeAnnSignature msg)
- , features
- , Prim.encodeU32 (nodeAnnTimestamp msg)
- , getNodeId (nodeAnnNodeId msg)
- , getRgbColor (nodeAnnRgbColor msg)
- , getAlias (nodeAnnAlias msg)
- , addrs
+-- | 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 list.
-encodeAddresses :: [Address] -> Either EncodeError ByteString
-encodeAddresses addrs = Right $ mconcat (map encodeAddress addrs)
+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
- 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 h port) =
- let !host = getHostname h
- in mconcat
- [ BS.singleton 5
- , BS.singleton (fromIntegral $ BS.length host)
- , host
- , Prim.encodeU16 port
+ 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 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.
+-- | Decode a t'ChannelUpdate' payload.
--
--- The message_flags byte is always 0x01: bit 0 (@must_be_one@) is
--- set, as BOLT #7 requires, and no other bit is.
-encodeChannelUpdate :: ChannelUpdate -> ByteString
-encodeChannelUpdate msg = mconcat
- [ unSignature (chanUpdateSignature msg)
- , unChainHash (chanUpdateChainHash msg)
- , scidToBytes (chanUpdateShortChanId msg)
- , Prim.encodeU32 (chanUpdateTimestamp msg)
- , BS.singleton 0x01
- , 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))
- , Prim.encodeU64
- (getHtlcMaximumMsat (chanUpdateHtlcMaxMsat msg))
+-- @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 channel_update message.
+-- | 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.
--
--- The message_flags byte is read from the wire but not stored.
--- Per BOLT #7, @htlc_maximum_msat@ is always present, and
--- receivers ignore the @must_be_one@ bit.
-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
- (_msgFlags, bs5) <- decodeU8 bs4
- (chanFlagsRaw, bs6) <- decodeU8 bs5
- (cltvDelta, bs7) <- decodeU16 bs6
- (htlcMin, bs8) <- decodeU64 bs7
- (feeBase, bs9) <- decodeU32 bs8
- (feeProp, bs10) <- decodeU32 bs9
- (htlcMax, rest) <- decodeU64 bs10
- let msg = ChannelUpdate
- { chanUpdateSignature = sig
- , chanUpdateChainHash = chainH
- , chanUpdateShortChanId = scid
- , chanUpdateTimestamp = timestamp
- , chanUpdateChanFlags = decodeChannelFlags chanFlagsRaw
- , chanUpdateCltvExpDelta = CltvExpiryDelta cltvDelta
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat htlcMin
- , chanUpdateFeeBaseMsat = FeeBaseMsat feeBase
- , chanUpdateFeeProportional =
- FeeProportionalMillionths feeProp
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat htlcMax
- }
- Right (msg, rest)
-
--- Announcement signatures -----------------------------------------------------
-
--- | Encode announcement_signatures message.
-encodeAnnouncementSignatures :: AnnouncementSignatures -> ByteString
-encodeAnnouncementSignatures msg = mconcat
- [ unChannelId (annSigChannelId msg)
- , scidToBytes (annSigShortChanId msg)
- , unSignature (annSigNodeSig msg)
- , unSignature (annSigBitcoinSig msg)
+-- 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 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.
+-- | Decode a t'ReplyShortChannelIdsEnd' payload.
--
--- Fails with 'EncodeLengthOverflow' if the encoded short_channel_ids
--- exceed 65535 bytes.
-encodeQueryShortChannelIds :: QueryShortChannelIds
- -> Either EncodeError ByteString
-encodeQueryShortChannelIds msg = do
- scidData <- encodeLenPrefixed (queryScidsData msg)
- Right $ mconcat
- [ unChainHash (queryScidsChainHash msg)
- , scidData
- , TLV.encodeTlvStream (queryScidsTlvs msg)
+-- >>> 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 query_short_channel_ids message.
+-- | 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.
--
--- The only known TLV type is 1 (query_flags). A malformed TLV
--- stream or an unknown even type is 'DecodeTlvError'.
-decodeQueryShortChannelIds :: ByteString
- -> Either DecodeError
- (QueryShortChannelIds, ByteString)
-decodeQueryShortChannelIds bs = do
- (chainH, bs1) <- decodeChainHash bs
- (scidData, bs2) <- decodeLenPrefixed bs1
- tlvs <- decodeTlvs [1] bs2
- 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
- [ unChainHash (replyScidsChainHash msg)
- , BS.singleton (replyScidsFullInfo msg)
+-- 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 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
- [ unChainHash (queryRangeChainHash msg)
- , Prim.encodeU32
- (getBlockHeight (queryRangeFirstBlock msg))
- , Prim.encodeU32
- (getBlockCount (queryRangeNumBlocks msg))
- , TLV.encodeTlvStream (queryRangeTlvs msg)
- ]
+-- | 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
--- | Decode query_channel_range message.
---
--- The only known TLV type is 1 (query_option). A malformed TLV
--- stream or an unknown even type is 'DecodeTlvError'.
-decodeQueryChannelRange :: ByteString
- -> Either DecodeError
- (QueryChannelRange, ByteString)
-decodeQueryChannelRange bs = do
- (chainH, bs1) <- decodeChainHash bs
- (firstBlock, bs2) <- decodeU32 bs1
- (numBlocks, bs3) <- decodeU32 bs2
- tlvs <- decodeTlvs [1] bs3
- let msg = QueryChannelRange
- { queryRangeChainHash = chainH
- , queryRangeFirstBlock = BlockHeight firstBlock
- , queryRangeNumBlocks = BlockCount numBlocks
- , queryRangeTlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- | Encode reply_channel_range message.
---
--- Fails with 'EncodeLengthOverflow' if the encoded short_channel_ids
--- exceed 65535 bytes.
-encodeReplyChannelRange :: ReplyChannelRange
- -> Either EncodeError ByteString
-encodeReplyChannelRange msg = do
- rangeData <- encodeLenPrefixed (replyRangeData msg)
- Right $ mconcat
- [ unChainHash (replyRangeChainHash msg)
- , Prim.encodeU32
- (getBlockHeight (replyRangeFirstBlock msg))
- , Prim.encodeU32
- (getBlockCount (replyRangeNumBlocks msg))
- , BS.singleton (replyRangeSyncComplete msg)
- , rangeData
- , TLV.encodeTlvStream (replyRangeTlvs msg)
- ]
+-- helpers --------------------------------------------------------------------
--- | Decode reply_channel_range message.
---
--- The known TLV types are 1 (timestamps_tlv) and 3
--- (checksums_tlv). A malformed TLV stream or an unknown even type
--- is 'DecodeTlvError'.
-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
- tlvs <- decodeTlvs [1, 3] bs5
- let msg = ReplyChannelRange
- { replyRangeChainHash = chainH
- , replyRangeFirstBlock = BlockHeight firstBlock
- , replyRangeNumBlocks = BlockCount numBlocks
- , replyRangeSyncComplete = syncComplete
- , replyRangeData = rangeData
- , replyRangeTlvs = tlvs
- }
- Right (msg, BS.empty)
-
--- | Encode gossip_timestamp_filter message.
-encodeGossipTimestampFilter :: GossipTimestampFilter -> ByteString
-encodeGossipTimestampFilter msg = mconcat
- [ unChainHash (gossipFilterChainHash msg)
- , Prim.encodeU32 (gossipFilterFirstTimestamp msg)
- , Prim.encodeU32 (gossipFilterTimestampRange msg)
- ]
+need :: Maybe a -> Either DecodeError a
+need = maybe (Left DecodeInsufficientBytes) Right
+{-# INLINE need #-}
--- | 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 scidToBytes 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
+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
- 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 scidFromBytes scidBytes of
- Nothing -> Left DecodeInvalidShortChannelId
- Just scid -> do
- scids <- decodeUncompressedScids rest
- Right (scid : scids)
-{-# INLINE decodeShortChannelIdList #-}
+ rs = BOLT1.un_tlv_stream extra
diff --git 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,139 +7,117 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Signature hash computation for BOLT #7 messages.
---
--- These functions compute the double-SHA256 hash that is signed in each
--- message type. The hash covers the message content excluding the
--- signature field(s).
+-- Signature digests, signature verification and checksums for BOLT #7
+-- messages.
--
--- Each function takes the message payload as received: the bytes after
--- the 2-byte message type. The signatures cover every byte of that
--- payload, so hash the received bytes rather than a re-encoding of a
--- decoded message. Each function returns 'Nothing' if the input is too
--- short to hold the message.
+-- 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 qualified Lightning.Protocol.BOLT1.Prim as Prim
+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, shortChannelIdLen, pointLen, nodeIdLen
- , rgbColorLen, aliasLen )
+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 #-}
--- | Read the big-endian u16 at an offset, if present.
-u16At :: Int -> ByteString -> Maybe Int
-u16At off bs = fmap (fromIntegral . fst) (Prim.decodeU16 (BS.drop off bs))
-{-# INLINE u16At #-}
+node_signed :: NodeAnnouncement -> Either EncodeError BS.ByteString
+node_signed = fmap (BS.drop 64) . encode_node_announcement
+{-# INLINE node_signed #-}
--- | Length of a channel_update without extension bytes (136).
-channelUpdateLen :: Int
-channelUpdateLen = signatureLen + chainHashLen + shortChannelIdLen + 32
-{-# INLINE channelUpdateLen #-}
+update_signed :: ChannelUpdate -> BS.ByteString
+update_signed = BS.drop 64 . encode_channel_update
+{-# INLINE update_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), or 'Nothing' if the input
--- cannot hold the fields of a channel_announcement with its declared
--- feature length.
-channelAnnouncementHash :: ByteString -> Maybe ByteString
-channelAnnouncementHash !msg = do
- let !offset = 4 * signatureLen
- flen <- u16At offset msg
- -- features, chain_hash, short_channel_id, node_ids, bitcoin_keys
- let !minLen = offset + 2 + flen + chainHashLen + shortChannelIdLen
- + 2 * nodeIdLen + 2 * pointLen
- if BS.length msg < minLen
- then Nothing
- else Just (doubleSha256 (BS.drop offset msg))
-{-# INLINE channelAnnouncementHash #-}
+double_sha256 :: BS.ByteString -> BS.ByteString
+double_sha256 = SHA256.hash . SHA256.hash
+{-# INLINE double_sha256 #-}
--- | 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), or 'Nothing' if the input
--- cannot hold the fields of a node_announcement with its declared
--- feature and address lengths.
-nodeAnnouncementHash :: ByteString -> Maybe ByteString
-nodeAnnouncementHash !msg = do
- flen <- u16At signatureLen msg
- -- features, timestamp, node_id, rgb_color, alias
- let !addrOff = signatureLen + 2 + flen + 4 + nodeIdLen + rgbColorLen
- + aliasLen
- addrlen <- u16At addrOff msg
- if BS.length msg < addrOff + 2 + addrlen
- then Nothing
- else Just (doubleSha256 (BS.drop signatureLen msg))
-{-# INLINE nodeAnnouncementHash #-}
+-- | 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
--- | 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), or 'Nothing' if the input
--- is shorter than a channel_update (136 bytes).
-channelUpdateHash :: ByteString -> Maybe ByteString
-channelUpdateHash !msg
- | BS.length msg < channelUpdateLen = Nothing
- | otherwise = Just (doubleSha256 (BS.drop signatureLen msg))
-{-# INLINE channelUpdateHash #-}
+-- | 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
--- | Compute checksum for channel_update.
---
--- This is the CRC-32C of the channel_update message excluding the
--- signature field (bytes 0-63) and timestamp field (bytes 104-107).
+-- | 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.
--
--- The checksum is used in the checksums_tlv of reply_channel_range.
+-- 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.
--
--- Returns 'Nothing' if the input is shorter than a channel_update
--- (136 bytes).
+-- 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)
-channelUpdateChecksum :: ByteString -> Maybe Word32
-channelUpdateChecksum !msg
- | BS.length msg < channelUpdateLen = Nothing
- | otherwise = Just (crc32c checksumData)
- where
- -- 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]
-{-# 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
@@ -1,6 +1,4 @@
-{-# OPTIONS_HADDOCK prune #-}
-
-{-# LANGUAGE BangPatterns #-}
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE DeriveGeneric #-}
-- |
@@ -9,240 +7,189 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- BOLT #7 gossip message type definitions.
+-- The messages defined by BOLT #7.
module Lightning.Protocol.BOLT7.Messages (
- -- * Message types
- MsgType(..)
- , msgTypeCode
-
- -- * Channel announcement
+ Message(..)
+ , message_type
, ChannelAnnouncement(..)
-
- -- * Node announcement
, NodeAnnouncement(..)
-
- -- * Channel update
, ChannelUpdate(..)
-
- -- * Announcement signatures
, AnnouncementSignatures(..)
-
- -- * Query messages
, QueryShortChannelIds(..)
, ReplyShortChannelIdsEnd(..)
, QueryChannelRange(..)
, ReplyChannelRange(..)
, GossipTimestampFilter(..)
-
- -- * Union type
- , Message(..)
) where
import Control.DeepSeq (NFData)
-import Data.ByteString (ByteString)
-import Data.Word (Word8, Word16, Word32)
+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 message_flags field is not stored: the encoder always
--- writes bit 0 (@must_be_one@), and the decoder ignores it.
+-- | 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
- , chanUpdateChanFlags :: !ChannelFlags
- -- ^ Channel flags
- , chanUpdateCltvExpDelta :: !CltvExpiryDelta
- -- ^ CLTV expiry delta
- , chanUpdateHtlcMinMsat :: !HtlcMinimumMsat
- -- ^ Minimum HTLC msat
- , chanUpdateFeeBaseMsat :: !FeeBaseMsat
- -- ^ Base fee msat
- , chanUpdateFeeProportional :: !FeeProportionalMillionths
- -- ^ Proportional fee
- , chanUpdateHtlcMaxMsat :: !HtlcMaximumMsat
- -- ^ Max HTLC msat
- }
- 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 :: !BlockHeight -- ^ First block number
- , queryRangeNumBlocks :: !BlockCount -- ^ Number of blocks
- , queryRangeTlvs :: !TlvStream -- ^ Optional TLV
- }
- 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 :: !BlockHeight -- ^ First block
- , replyRangeNumBlocks :: !BlockCount -- ^ Block count
- , replyRangeSyncComplete :: !Word8 -- ^ 1 if complete
- , replyRangeData :: !ByteString -- ^ Encoded SCIDs
- , 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
@@ -1,5 +1,4 @@
-{-# OPTIONS_HADDOCK prune #-}
-
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -9,467 +8,453 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Core types for BOLT #7 routing gossip.
+-- Field types for BOLT #7 gossip messages.
module Lightning.Protocol.BOLT7.Types (
- -- * Identifiers (re-exported from BOLT1)
- ChainHash(..)
- , chainHash
- , unChainHash
- , mainnetChainHash
- , ShortChannelId(..)
- , shortChannelId
- , scidBlockHeight
- , scidTxIndex
- , scidOutputIndex
- , scidWord64
- , scidFromBytes
- , scidToBytes
- , formatScid
- , ChannelId(..)
- , channelId
- , unChannelId
-
- -- * Cryptographic types (re-exported from BOLT1)
- , Signature(..)
- , signature
- , unSignature
- , Point(..)
- , point
- , unPoint
- , NodeId
- , nodeId
- , getNodeId
-
- -- * Node metadata
- , RgbColor
- , rgbColor
- , getRgbColor
- , Alias
- , alias
- , getAlias
- , Timestamp
- , FeatureBits
- , featureBits
- , getFeatureBits
+ -- * Short channel ids
+ format_short_channel_id
+
+ -- * 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
- -- * Address types
+ -- * node_announcement fields
+ , RgbColor(..)
+ , Alias(..)
+ , alias
+ , un_alias
, Address(..)
- , IPv4Addr
- , ipv4Addr
- , getIPv4Addr
- , IPv6Addr
- , ipv6Addr
- , getIPv6Addr
- , TorV3Addr
- , torV3Addr
- , getTorV3Addr
- , Hostname
+ , 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
- , getHostname
-
- -- * Channel update flags
- , Direction(..)
- , ChannelStatus(..)
- , ChannelFlags(..)
- , encodeChannelFlags
- , decodeChannelFlags
-
- -- * Routing parameters
- , CltvExpiryDelta(..)
- , FeeBaseMsat(..)
- , FeeProportionalMillionths(..)
- , HtlcMinimumMsat(..)
- , HtlcMaximumMsat(..)
-
- -- * Block range types
- , BlockHeight(..)
- , BlockCount(..)
-
- -- * Constants
- , chainHashLen
- , shortChannelIdLen
- , channelIdLen
- , signatureLen
- , pointLen
- , nodeIdLen
- , rgbColorLen
- , aliasLen
- , ipv4AddrLen
- , ipv6AddrLen
- , torV3AddrLen
+ , un_hostname
+ , is_ascii_hostname
+ , usable_addresses
+
+ -- * 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)
-import Lightning.Protocol.BOLT1.Prim
- ( ChainHash(..), unChainHash, chainHash
- , ShortChannelId(..), shortChannelId
- , scidBlockHeight, scidTxIndex, scidOutputIndex, scidWord64
- , ChannelId(..), unChannelId, channelId
- , Signature(..), unSignature, signature
- , Point(..), unPoint, point
- )
-
--- Constants -------------------------------------------------------------------
-
--- | Length of a chain hash (32 bytes).
-chainHashLen :: Int
-chainHashLen = 32
-{-# INLINE chainHashLen #-}
-
--- | Length of a short channel ID (8 bytes).
-shortChannelIdLen :: Int
-shortChannelIdLen = 8
-{-# INLINE shortChannelIdLen #-}
-
--- | Length of a channel ID (32 bytes).
-channelIdLen :: Int
-channelIdLen = 32
-{-# INLINE channelIdLen #-}
-
--- | Length of a signature (64 bytes).
-signatureLen :: Int
-signatureLen = 64
-{-# INLINE signatureLen #-}
-
--- | Length of a compressed public key (33 bytes).
-pointLen :: Int
-pointLen = 33
-{-# INLINE pointLen #-}
-
--- | Length of a node ID (33 bytes, same as compressed public key).
-nodeIdLen :: Int
-nodeIdLen = 33
-{-# INLINE nodeIdLen #-}
-
--- | Length of RGB color (3 bytes).
-rgbColorLen :: Int
-rgbColorLen = 3
-{-# INLINE rgbColorLen #-}
-
--- | Length of node alias (32 bytes).
-aliasLen :: Int
-aliasLen = 32
-{-# INLINE aliasLen #-}
-
--- | Length of IPv4 address (4 bytes).
-ipv4AddrLen :: Int
-ipv4AddrLen = 4
-{-# INLINE ipv4AddrLen #-}
-
--- | Length of IPv6 address (16 bytes).
-ipv6AddrLen :: Int
-ipv6AddrLen = 16
-{-# INLINE ipv6AddrLen #-}
-
--- | Length of Tor v3 address (35 bytes).
-torV3AddrLen :: Int
-torV3AddrLen = 35
-{-# INLINE torV3AddrLen #-}
-
--- Identifiers -----------------------------------------------------------------
-
--- | Bitcoin mainnet chain hash (genesis block hash, little-endian).
-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
- ]
-
--- | Parse ShortChannelId from 8 big-endian bytes.
-scidFromBytes :: ByteString -> Maybe ShortChannelId
-scidFromBytes !bs
- | BS.length bs /= shortChannelIdLen = Nothing
- | otherwise =
- let !w = (fromIntegral (BS.index bs 0) `shiftL` 56)
- .|. (fromIntegral (BS.index bs 1) `shiftL` 48)
- .|. (fromIntegral (BS.index bs 2) `shiftL` 40)
- .|. (fromIntegral (BS.index bs 3) `shiftL` 32)
- .|. (fromIntegral (BS.index bs 4) `shiftL` 24)
- .|. (fromIntegral (BS.index bs 5) `shiftL` 16)
- .|. (fromIntegral (BS.index bs 6) `shiftL` 8)
- .|. fromIntegral (BS.index bs 7) :: Word64
- in Just (ShortChannelId w)
-{-# INLINE scidFromBytes #-}
-
--- | Encode ShortChannelId as 8 big-endian bytes.
-scidToBytes :: ShortChannelId -> ByteString
-scidToBytes !sci =
- let !w = scidWord64 sci
- in BS.pack
- [ fromIntegral (w `shiftR` 56)
- , fromIntegral (w `shiftR` 48)
- , fromIntegral (w `shiftR` 40)
- , fromIntegral (w `shiftR` 32)
- , fromIntegral (w `shiftR` 24)
- , fromIntegral (w `shiftR` 16)
- , fromIntegral (w `shiftR` 8)
- , fromIntegral w
- ]
-{-# INLINE scidToBytes #-}
-
--- | Format short channel ID as human-readable string.
-formatScid :: ShortChannelId -> String
-formatScid sci =
- show (scidBlockHeight sci) ++ "x" ++
- show (scidTxIndex sci) ++ "x" ++
- show (scidOutputIndex sci)
-{-# INLINE formatScid #-}
-
--- Cryptographic types ---------------------------------------------------------
-
--- | Node ID (33 bytes, same as compressed public key).
+import Lightning.Protocol.BOLT1
+ (ShortChannelId, scid_block_height, scid_tx_index, scid_output_index)
+
+-- short channel ids ----------------------------------------------------------
+
+-- | 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@.
--
--- 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)
+-- >>> 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)
+
+-- channel_update flags -------------------------------------------------------
+
+-- | 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 NodeId
+instance NFData MessageFlags
--- | 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 #-}
+-- | 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)
--- Node metadata ---------------------------------------------------------------
+instance NFData Forwarding
--- | RGB color (3 bytes).
-newtype RgbColor = RgbColor { getRgbColor :: ByteString }
+-- | The t'MessageFlags' an origin node sets: @must_be_one@ set, the given
+-- @dont_forward@ bit, and no unassigned bits.
+--
+-- >>> message_flags DontForward
+-- MessageFlags 3
+message_flags :: Forwarding -> MessageFlags
+message_flags Forward = MessageFlags 0x01
+message_flags DontForward = MessageFlags 0x03
+{-# INLINE message_flags #-}
+
+-- | The @dont_forward@ bit of t'MessageFlags'.
+--
+-- >>> 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 #-}
+
+-- | 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 #-}
+
+-- | 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 RgbColor
+instance NFData ChannelFlags
--- | 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 #-}
+-- | 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)
--- | Node alias (32 bytes, UTF-8 padded with zero bytes).
-newtype Alias = Alias { getAlias :: ByteString }
- deriving (Eq, Show, Generic)
+instance NFData Direction
-instance NFData Alias
+-- | Whether a channel direction is usable.
+data ChannelStatus
+ = Enabled -- ^ @disable@ is 0
+ | Disabled -- ^ @disable@ is 1
+ deriving (Eq, Ord, Show, Generic)
--- | Smart constructor for Alias. Returns Nothing if not 32 bytes.
-alias :: ByteString -> Maybe Alias
-alias !bs
- | BS.length bs == aliasLen = Just (Alias bs)
- | otherwise = Nothing
-{-# INLINE alias #-}
+instance NFData ChannelStatus
+
+-- | The t'ChannelFlags' for the given direction and status, with no
+-- unassigned bits set.
+--
+-- >>> 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 #-}
--- | Timestamp (Unix epoch seconds).
-type Timestamp = Word32
+-- | 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 #-}
+
+-- | 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_announcement fields ---------------------------------------------------
+
+-- | A node's colour: red, green and blue.
+data RgbColor = RgbColor
+ {-# UNPACK #-} !Word8
+ {-# UNPACK #-} !Word8
+ {-# UNPACK #-} !Word8
+ deriving (Eq, Show, Generic)
--- | Feature bits (variable length).
-newtype FeatureBits = FeatureBits { getFeatureBits :: ByteString }
+instance NFData RgbColor
+
+-- | 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 FeatureBits
+instance NFData Alias
--- | Smart constructor for FeatureBits (any length).
-featureBits :: ByteString -> FeatureBits
-featureBits = FeatureBits
-{-# INLINE featureBits #-}
+-- | 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 #-}
--- Address types ---------------------------------------------------------------
+-- | The bytes of an t'Alias'.
+un_alias :: Alias -> BS.ByteString
+un_alias (Alias bs) = bs
+{-# INLINE un_alias #-}
--- | IPv4 address (4 bytes).
-newtype IPv4Addr = IPv4Addr { getIPv4Addr :: ByteString }
+-- | A 4-byte IPv4 address.
+newtype IPv4Addr = IPv4Addr BS.ByteString
deriving (Eq, Show, Generic)
instance NFData IPv4Addr
--- | Smart constructor for IPv4Addr. Returns Nothing if not 4 bytes.
-ipv4Addr :: ByteString -> Maybe IPv4Addr
-ipv4Addr !bs
- | BS.length bs == ipv4AddrLen = Just (IPv4Addr bs)
- | otherwise = Nothing
-{-# INLINE ipv4Addr #-}
-
--- | IPv6 address (16 bytes).
-newtype IPv6Addr = IPv6Addr { getIPv6Addr :: ByteString }
+-- | 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 #-}
+
+-- | The bytes of an t'IPv4Addr'.
+un_ipv4_addr :: IPv4Addr -> BS.ByteString
+un_ipv4_addr (IPv4Addr bs) = bs
+{-# INLINE un_ipv4_addr #-}
+
+-- | A 16-byte IPv6 address.
+newtype IPv6Addr = IPv6Addr BS.ByteString
deriving (Eq, Show, Generic)
instance NFData IPv6Addr
--- | Smart constructor for IPv6Addr. Returns Nothing if not 16 bytes.
-ipv6Addr :: ByteString -> Maybe IPv6Addr
-ipv6Addr !bs
- | BS.length bs == ipv6AddrLen = Just (IPv6Addr bs)
- | otherwise = Nothing
-{-# INLINE ipv6Addr #-}
+-- | 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 #-}
+
+-- | 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 TorV2Addr
--- | Tor v3 onion address (35 bytes: 32 pubkey + 2 checksum + 1 version).
-newtype TorV3Addr = TorV3Addr { getTorV3Addr :: ByteString }
+-- | 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 #-}
+
+-- | 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 #-}
+
+-- | 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 #-}
--- | DNS hostname (1-255 ASCII bytes).
+-- | A DNS hostname of at most 255 bytes (the limit of its length byte).
--
--- Per BOLT #7 address descriptor type 5, the hostname is
--- a length-prefixed DNS name whose bytes MUST be ASCII
--- (non-ASCII names are Punycode-encoded). The length byte
--- limits it to 255 bytes.
-newtype Hostname = Hostname { getHostname :: ByteString }
+-- 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 Hostname
--- | Smart constructor for Hostname.
+-- | Construct a t'Hostname' from at most 255 bytes.
--
--- Returns Nothing if the hostname is empty, exceeds 255
--- bytes, or contains a non-ASCII byte.
-hostname :: ByteString -> Maybe Hostname
-hostname !bs
- | BS.null bs = Nothing
- | BS.length bs > 255 = Nothing
- | BS.any (> 0x7f) bs = Nothing
- | otherwise = Just (Hostname bs)
+-- >>> 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 #-}
--- | Network address with port.
+-- | 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.
+--
+-- >>> 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 !Word16 -- ^ IPv4 address + port
- | AddrIPv6 !IPv6Addr !Word16 -- ^ IPv6 address + port
- | AddrTorV3 !TorV3Addr !Word16 -- ^ Tor v3 address + port
- | AddrDNS !Hostname !Word16 -- ^ DNS hostname + port
+ = 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 Address
--- Channel update flags --------------------------------------------------------
+-- | 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
+
+-- query fields ---------------------------------------------------------------
+
+-- | 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)
--- | Direction of a channel_update.
---
--- Per BOLT #7, bit 0 of channel_flags indicates which node
--- is the origin of the update.
-data Direction
- = NodeOne -- ^ Update from node_id_1 (bit 0 = 0)
- | NodeTwo -- ^ Update from node_id_2 (bit 0 = 1)
- deriving (Eq, Ord, Show, Generic)
+instance NFData QueryFlags
-instance NFData Direction
+-- | 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)
--- | Channel enabled\/disabled status.
---
--- Per BOLT #7, bit 1 of channel_flags indicates whether
--- the channel is disabled.
-data ChannelStatus
- = Enabled -- ^ Channel is active (bit 1 = 0)
- | Disabled -- ^ Channel is disabled (bit 1 = 1)
- deriving (Eq, Ord, Show, Generic)
+instance NFData QueryFlag
-instance NFData ChannelStatus
+-- | 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
--- | Channel flags for channel_update.
+-- | Whether the given bit is set.
--
--- Bit 0: direction (0 = node_id_1, 1 = node_id_2).
--- Bit 1: disabled (0 = enabled, 1 = disabled).
-data ChannelFlags = ChannelFlags
- { cfDirection :: !Direction -- ^ Update origin
- , cfStatus :: !ChannelStatus -- ^ Channel status
- }
+-- >>> 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 #-}
+
+-- | 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)
-instance NFData ChannelFlags
-
--- | Encode ChannelFlags to Word8.
-encodeChannelFlags :: ChannelFlags -> Word8
-encodeChannelFlags cf =
- dir .|. sta
- where
- dir = case cfDirection cf of
- NodeOne -> 0x00
- NodeTwo -> 0x01
- sta = case cfStatus cf of
- Enabled -> 0x00
- Disabled -> 0x02
-{-# INLINE encodeChannelFlags #-}
-
--- | Decode Word8 to ChannelFlags.
-decodeChannelFlags :: Word8 -> ChannelFlags
-decodeChannelFlags w = ChannelFlags
- { cfDirection = if w .&. 0x01 /= 0
- then NodeTwo
- else NodeOne
- , cfStatus = if w .&. 0x02 /= 0
- then Disabled
- else Enabled
- }
-{-# INLINE decodeChannelFlags #-}
-
--- Routing parameters ----------------------------------------------------------
-
--- | CLTV expiry delta.
-newtype CltvExpiryDelta = CltvExpiryDelta { getCltvExpiryDelta :: Word16 }
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData CltvExpiryDelta
-
--- | Base fee in millisatoshis.
-newtype FeeBaseMsat = FeeBaseMsat { getFeeBaseMsat :: Word32 }
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData FeeBaseMsat
-
--- | Proportional fee in millionths.
-newtype FeeProportionalMillionths = FeeProportionalMillionths
- { getFeeProportionalMillionths :: Word32 }
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData FeeProportionalMillionths
-
--- | Minimum HTLC value in millisatoshis.
-newtype HtlcMinimumMsat = HtlcMinimumMsat { getHtlcMinimumMsat :: Word64 }
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData HtlcMinimumMsat
+instance NFData QueryOption
--- | Maximum HTLC value in millisatoshis.
-newtype HtlcMaximumMsat = HtlcMaximumMsat
- { getHtlcMaximumMsat :: Word64 }
- deriving (Eq, Ord, Show, Generic)
+-- | The assigned bits of t'QueryOption'.
+data QueryOptionFlag
+ = WantTimestamps -- ^ bit 0
+ | WantChecksums -- ^ bit 1
+ deriving (Eq, Ord, Show, Enum, Bounded, Generic)
-instance NFData HtlcMaximumMsat
+instance NFData QueryOptionFlag
--- Block range types -----------------------------------------------------------
+-- | 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
--- | Absolute block height.
+-- | Whether the given bit is set.
--
--- Used in query_channel_range and reply_channel_range for
--- the first_blocknum field.
-newtype BlockHeight = BlockHeight
- { getBlockHeight :: Word32 }
- deriving (Eq, Ord, Show, Generic)
+-- >>> 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 #-}
+
+-- | 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)
-instance NFData BlockHeight
+instance NFData ChannelUpdateTimestamps
--- | Block count (relative duration).
---
--- Used in query_channel_range and reply_channel_range for
--- the number_of_blocks field.
-newtype BlockCount = BlockCount
- { getBlockCount :: Word32 }
- deriving (Eq, Ord, Show, Generic)
+-- | 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 BlockCount
+instance NFData ChannelUpdateChecksums
diff --git 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,143 +7,101 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Validation functions for BOLT #7 gossip messages.
---
--- These functions check message invariants as specified in BOLT #7.
--- They do NOT verify cryptographic signatures; that requires the
--- actual public keys and is left to the caller.
+-- Stateless checks of BOLT #7 messages.
module Lightning.Protocol.BOLT7.Validate (
- -- * Error types
ValidationError(..)
-
- -- * Validation functions
- , validateChannelAnnouncement
- , validateNodeAnnouncement
- , validateChannelUpdate
- , validateQueryChannelRange
- , validateReplyChannelRange
+ , validate_channel_announcement
+ , validate_node_announcement
+ , validate_channel_update
+ , validate_query_short_channel_ids
+ , validate_query_channel_range
+ , validate_reply_channel_range
) where
import Control.DeepSeq (NFData)
-import Data.Word (Word32, Word64)
+import Data.Word (Word64)
import GHC.Generics (Generic)
-import Lightning.Protocol.BOLT7.Codec (decodeShortChannelIdList)
+import Lightning.Protocol.BOLT1 (ShortChannelId)
import Lightning.Protocol.BOLT7.Messages
import Lightning.Protocol.BOLT7.Types
--- | Validation errors.
+-- | A rule a message breaks.
data ValidationError
- = ValidateNodeIdOrdering -- ^ node_id_1 must be < node_id_2
- | ValidateUnknownEvenFeature -- ^ Unknown even feature bit set
- | ValidateHtlcAmounts -- ^ htlc_minimum_msat > htlc_maximum_msat
- | ValidateBlockOverflow -- ^ first_blocknum + number_of_blocks overflow
- | ValidateScidNotAscending -- ^ short_channel_ids not in ascending order
- | ValidateMultipleDns -- ^ more than one DNS hostname address
- | ValidateScidEncoding -- ^ encoded_short_ids cannot be decoded
+ = 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.
+-- | Check that at most one DNS hostname is announced; a receiver must
+-- not forward the message otherwise.
--
--- Checks:
---
--- * Feature bits do not contain unknown even bits
--- * At most one DNS hostname address. Per BOLT #7 the origin MUST
--- NOT announce more than one; a receiver SHOULD ignore all but the
--- first, and MUST NOT forward the message.
---
--- Note: alias UTF-8 validation is not enforced; the spec allows
--- non-UTF-8 aliases.
-validateNodeAnnouncement :: NodeAnnouncement -> Either ValidationError ()
-validateNodeAnnouncement msg = do
- validateFeatureBits (nodeAnnFeatures msg)
- if length [ () | AddrDNS _ _ <- nodeAnnAddresses msg ] > 1
- then Left ValidateMultipleDns
- else Right ()
+-- 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
-validateChannelUpdate :: ChannelUpdate
- -> Either ValidationError ()
-validateChannelUpdate msg
- | getHtlcMinimumMsat (chanUpdateHtlcMinMsat msg)
- > getHtlcMaximumMsat (chanUpdateHtlcMaxMsat msg)
- = Left ValidateHtlcAmounts
+-- | 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
- (getBlockHeight (queryRangeFirstBlock msg))
- :: Word64
- num = fromIntegral
- (getBlockCount (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 decode: the encoding type is 0
--- (uncompressed; type 1, zlib, MUST NOT be used) and the data is
--- a whole number of short_channel_ids
--- * Encoded short_channel_ids are in ascending order
-validateReplyChannelRange :: ReplyChannelRange -> Either ValidationError ()
-validateReplyChannelRange msg =
- case decodeShortChannelIdList (replyRangeData msg) of
- Left _ -> Left ValidateScidEncoding
- 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)
- | a < 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
@@ -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 @@ author: Jared Tobin
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 @@ library
-Wall
exposed-modules:
Lightning.Protocol.BOLT7
+ other-modules:
Lightning.Protocol.BOLT7.Codec
Lightning.Protocol.BOLT7.CRC32C
Lightning.Protocol.BOLT7.Hash
@@ -35,25 +36,31 @@ library
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-secp256k1 >= 0.5.5 && < 0.6
+ , ppad-bolt9
+ , ppad-secp256k1
+ , ppad-sha256
, tasty
, tasty-hunit
, tasty-quickcheck
@@ -63,16 +70,18 @@ benchmark bolt7-bench
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
@@ -80,14 +89,16 @@ benchmark bolt7-weigh
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
@@ -2,1241 +2,1220 @@
module Main where
-import qualified Crypto.Curve.Secp256k1 as Secp256k1
+import Data.Bits ((.&.), (.|.), shiftR, xor)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
-import Data.Maybe (fromJust)
-import Data.Word (Word8, Word16, Word32)
+import Data.Word (Word8, Word16, Word32, Word64)
import Lightning.Protocol.BOLT1
- (TlvRecord(..), TlvStream, unTlvStream, unsafeTlvStream)
+ ( ChainHash, Point, ShortChannelId(..), Signature, TlvError(..)
+ , TlvRecord(..), TlvStream )
+import qualified Lightning.Protocol.BOLT1 as BOLT1
import Lightning.Protocol.BOLT7
-import Lightning.Protocol.BOLT7.CRC32C (crc32c)
+import qualified Lightning.Protocol.BOLT9 as BOLT9
import Test.Tasty
import Test.Tasty.HUnit
-import Test.Tasty.QuickCheck
+import Test.Tasty.QuickCheck hiding ((.&.))
+import Vectors
main :: IO ()
main = defaultMain $ testGroup "ppad-bolt7" [
- type_tests
- , channel_announcement_tests
+ field_tests
+ , spec_vector_tests
+ , mainnet_tests
, node_announcement_tests
, channel_update_tests
- , announcement_signatures_tests
, query_tests
- , scid_list_tests
- , hash_tests
+ , other_message_tests
+ , encode_error_tests
+ , dispatch_tests
, validation_tests
- , error_tests
- , mainnet_tests
+ , checksum_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 $ scidFromBytes (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
-
--- | Total ShortChannelId constructor for test fixtures.
-mkScid :: Word32 -> Word32 -> Word16 -> ShortChannelId
-mkScid b t o = case shortChannelId b t o of
- Just s -> s
- Nothing -> error "mkScid: invalid test fixture"
-
--- | A channel_update fixture.
-testChannelUpdate :: ChannelUpdate
-testChannelUpdate = ChannelUpdate
- { chanUpdateSignature = testSignature
- , chanUpdateChainHash = testChainHash
- , chanUpdateShortChanId = testShortChannelId
- , chanUpdateTimestamp = 1234567890
- , chanUpdateChanFlags = ChannelFlags
- { cfDirection = NodeOne, cfStatus = Enabled }
- , chanUpdateCltvExpDelta = CltvExpiryDelta 144
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 1000000000
- }
+-- helpers --------------------------------------------------------------------
--- | Unwrap a Maybe, failing the test on Nothing.
-expectJust :: String -> Maybe a -> IO a
-expectJust what = maybe (assertFailure ("unexpected Nothing: " ++ what)) pure
-
--- | A node_announcement fixture with the given addresses.
-testNodeAnn :: [Address] -> NodeAnnouncement
-testNodeAnn addrs = NodeAnnouncement
- { nodeAnnSignature = testSignature
- , nodeAnnFeatures = emptyFeatures
- , nodeAnnTimestamp = 1234567890
- , nodeAnnNodeId = testNodeId
- , nodeAnnRgbColor = testRgbColor
- , nodeAnnAlias = testAlias
- , nodeAnnAddresses = addrs
- }
+must :: String -> Maybe a -> IO a
+must what = maybe (assertFailure ("unexpected Nothing: " ++ what)) pure
--- | A channel_announcement fixture with the given features.
-testChannelAnn :: FeatureBits -> ChannelAnnouncement
-testChannelAnn feats = ChannelAnnouncement
- { channelAnnNodeSig1 = testSignature
- , channelAnnNodeSig2 = testSignature
- , channelAnnBitcoinSig1 = testSignature
- , channelAnnBitcoinSig2 = testSignature
- , channelAnnFeatures = feats
- , channelAnnChainHash = testChainHash
- , channelAnnShortChanId = testShortChannelId
- , channelAnnNodeId1 = testNodeId2
- , channelAnnNodeId2 = testNodeId
- , channelAnnBitcoinKey1 = testPoint
- , channelAnnBitcoinKey2 = testPoint
- }
+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] ]
--- | Replace the byte at an offset (no-op past the end).
-setByte :: Int -> Word8 -> BS.ByteString -> BS.ByteString
-setByte i w bs
+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
--- 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 $ scidFromBytes (BS.pack
- [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0])
- scidBlockHeight scid @?= 0x123456
- , testCase "scidTxIndex" $ do
- let scid = fromJust $ scidFromBytes (BS.pack
- [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0])
- scidTxIndex scid @?= 0x789abc
- , testCase "scidOutputIndex" $ do
- let scid = fromJust $ scidFromBytes (BS.pack
- [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0])
- scidOutputIndex scid @?= 0xdef0
- , testCase "shortChannelId roundtrip" $ do
- let scid = fromJust $ shortChannelId 539268 845 1
- scidBlockHeight scid @?= 539268
- scidTxIndex scid @?= 845
- scidOutputIndex scid @?= 1
- , testCase "formatScid" $ do
- let scid = fromJust $ shortChannelId 539268 845 1
- formatScid scid @?= "539268x845x1"
- , testCase "formatScid zero values" $ do
- let scid = fromJust $ shortChannelId 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 "scidFromBytes rejects wrong length" $ do
- scidFromBytes (BS.replicate 7 0x00) @?= Nothing
- scidFromBytes (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 (unChainHash 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
- ]
- ]
+-- | 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
+ }
--- 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
- }
- case encodeChannelAnnouncement msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeChannelAnnouncement encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+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] @?= []
]
--- Node Announcement Tests -----------------------------------------------------
+-- 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
-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
- , testGroup "address descriptors" [
- testCase "skips deprecated Tor v2 descriptors" $ do
- v4 <- addrV4
- v6 <- addrV6
- decodeAddrs (descV4 <> descTorV2 <> descV6) @?= Right [v4, v6]
- , testCase "stops at the first unknown type" $ do
- v4 <- addrV4
- let wire = descV4 <> BS.pack [6, 1, 2, 3] <> descV6
- decodeAddrs wire @?= Right [v4]
- -- the ignored bytes are still consumed as part of addrlen
- fmap snd (decodeNodeAnnouncement (nodeAnnWire wire))
- @?= Right BS.empty
- , testCase "stops at a type-0 descriptor" $
- decodeAddrs (BS.singleton 0 <> descV4) @?= Right []
- , testCase "skips descriptors with port 0" $ do
- v6 <- addrV6
- let v4port0 = BS.pack [1, 127, 0, 0, 1, 0, 0]
- decodeAddrs (v4port0 <> descV6) @?= Right [v6]
- , testCase "skips empty and non-ASCII hostnames" $ do
- h <- expectJust "hostname" (hostname "ln.example.com")
- let wire = descDns "" <> descDns "\xff\&ab"
- <> descDns "ln.example.com"
- decodeAddrs wire @?= Right [AddrDNS h 9735]
- , testCase "rejects a truncated descriptor of a known type" $ do
- decodeAddrs (BS.pack [1, 127, 0, 0])
- @?= Left DecodeInsufficientBytes
- decodeAddrs (BS.pack [3, 1, 2, 3])
- @?= Left DecodeInsufficientBytes
- decodeAddrs (BS.pack [5, 4, 0x61])
- @?= Left DecodeInsufficientBytes
- , testCase "hostname rejects non-ASCII bytes" $ do
- hostname "\0\255" @?= Nothing
- hostname "caf\233" @?= Nothing
- fmap getHostname (hostname "xn--caf-dma") @?= Just "xn--caf-dma"
- ]
+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)
--- | node_announcement payload carrying the given address bytes.
-nodeAnnWire :: BS.ByteString -> BS.ByteString
-nodeAnnWire addrs = mconcat
+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
- , BS.pack [0, 0] -- flen
+ , u16be 0 -- flen
, BS.pack [0x49, 0x96, 0x02, 0xd2] -- timestamp
- , getNodeId testNodeId
- , getRgbColor testRgbColor
- , getAlias testAlias
+ , BOLT1.un_point (fx_node_2 fx)
+ , BS.pack [0xff, 0x00, 0x00]
+ , BS.replicate 32 0
, u16be (BS.length addrs)
, addrs
]
--- | Decode the addresses of a node_announcement built by 'nodeAnnWire'.
-decodeAddrs :: BS.ByteString -> Either DecodeError [Address]
-decodeAddrs = fmap (nodeAnnAddresses . fst) . decodeNodeAnnouncement
- . nodeAnnWire
+-- 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))
--- | Big-endian u16 (low 16 bits).
-u16be :: Int -> BS.ByteString
-u16be n = BS.pack [fromIntegral (n `div` 256), fromIntegral 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
--- | Address descriptors (port 9735) and the values they decode to.
-descV4, descV6, descTorV2 :: BS.ByteString
-descV4 = BS.pack [1, 127, 0, 0, 1, 0x26, 0x07]
-descV6 = BS.pack (2 : replicate 15 0 ++ [1, 0x26, 0x07])
-descTorV2 = BS.cons 3 (BS.replicate 12 0xaa)
+-- channel_update -------------------------------------------------------------
-descDns :: BS.ByteString -> BS.ByteString
-descDns h = BS.pack [5, fromIntegral (BS.length h)] <> h <> u16be 9735
+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
+ ]
-addrV4, addrV6 :: IO Address
-addrV4 = fmap (`AddrIPv4` 9735)
- (expectJust "ipv4" (ipv4Addr (BS.pack [127, 0, 0, 1])))
-addrV6 = fmap (`AddrIPv6` 9735)
- (expectJust "ipv6" (ipv6Addr (BS.pack (replicate 15 0 ++ [1]))))
+-- queries --------------------------------------------------------------------
--- Channel Update Tests --------------------------------------------------------
+-- 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
-channel_update_tests :: TestTree
-channel_update_tests = testGroup "ChannelUpdate" [
- testCase "encode/decode roundtrip (NodeTwo)" $ do
- let msg = ChannelUpdate
- { chanUpdateSignature = testSignature
- , chanUpdateChainHash = testChainHash
- , chanUpdateShortChanId = testShortChannelId
- , chanUpdateTimestamp = 1234567890
- , chanUpdateChanFlags = ChannelFlags
- { cfDirection = NodeTwo, cfStatus = Enabled }
- , chanUpdateCltvExpDelta = CltvExpiryDelta 144
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 1000000000
- }
- encoded = encodeChannelUpdate msg
- case decodeChannelUpdate encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "encode/decode roundtrip (NodeOne)" $ do
- let msg = ChannelUpdate
- { chanUpdateSignature = testSignature
- , chanUpdateChainHash = testChainHash
- , chanUpdateShortChanId = testShortChannelId
- , chanUpdateTimestamp = 1234567890
- , chanUpdateChanFlags = ChannelFlags
- { cfDirection = NodeOne, cfStatus = Enabled }
- , chanUpdateCltvExpDelta = CltvExpiryDelta 40
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 500
- , chanUpdateFeeProportional = FeeProportionalMillionths 50
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 1000000000
- }
- encoded = encodeChannelUpdate msg
- case decodeChannelUpdate encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "encoder sets must_be_one and emits htlc_maximum_msat" $ do
- let encoded = encodeChannelUpdate testChannelUpdate
- BS.length encoded @?= 136
- BS.take 1 (BS.drop 108 encoded) @?= BS.singleton 0x01
- BS.drop 128 encoded @?= BS.pack [0, 0, 0, 0, 0x3b, 0x9a, 0xca, 0]
- , testCase "decodes htlc_maximum_msat when must_be_one is clear" $ do
- -- receivers ignore must_be_one; the field is always present
- let wire = setByte 108 0x00 (encodeChannelUpdate testChannelUpdate)
- case decodeChannelUpdate wire of
- Right (decoded, rest) -> do
- decoded @?= testChannelUpdate
- rest @?= BS.empty
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "rejects update without htlc_maximum_msat" $ do
- let wire = BS.take 128 (encodeChannelUpdate testChannelUpdate)
- decodeChannelUpdate wire @?= Left DecodeInsufficientBytes
+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
]
--- 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
+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
]
--- Query Tests -----------------------------------------------------------------
+-- 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 "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
+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 "QueryChannelRange" [
- testCase "encode/decode roundtrip" $ do
- let msg = QueryChannelRange
- { queryRangeChainHash = testChainHash
- , queryRangeFirstBlock = BlockHeight 600000
- , queryRangeNumBlocks = BlockCount 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 = BlockHeight 600000
- , replyRangeNumBlocks = BlockCount 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 "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 "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
+ , 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)
]
- , tlvStreamTests "query_short_channel_ids TLVs" [1] $ \tlvs ->
- fmap (unTlvStream . queryScidsTlvs . fst)
- (decodeQueryShortChannelIds (mconcat
- [ unChainHash testChainHash
- , u16be 9
- , encodeShortChannelIdList [testShortChannelId]
- , tlvs
- ]))
- , tlvStreamTests "query_channel_range TLVs" [1] $ \tlvs ->
- fmap (unTlvStream . queryRangeTlvs . fst)
- (decodeQueryChannelRange (mconcat
- [ unChainHash testChainHash
- , BS.pack [0, 9, 0x27, 0xc0] -- first_blocknum 600000
- , BS.pack [0, 0, 0x27, 0x10] -- number_of_blocks 10000
- , tlvs
- ]))
- , tlvStreamTests "reply_channel_range TLVs" [1, 3] $ \tlvs ->
- fmap (unTlvStream . replyRangeTlvs . fst)
- (decodeReplyChannelRange (mconcat
- [ unChainHash testChainHash
- , BS.pack [0, 9, 0x27, 0xc0] -- first_blocknum 600000
- , BS.pack [0, 0, 0x27, 0x10] -- number_of_blocks 10000
- , BS.singleton 1 -- sync_complete
- , u16be 9
- , encodeShortChannelIdList [testShortChannelId]
- , tlvs
- ]))
]
--- | TLV stream tests for a query decoder, given its known TLV types
--- and a function decoding a message that ends in the given TLV bytes.
-tlvStreamTests
- :: String
- -> [Word8]
- -> (BS.ByteString -> Either DecodeError [TlvRecord])
- -> TestTree
-tlvStreamTests name known dec = testGroup name [
- testCase "empty stream" $
- dec BS.empty @?= Right []
- , testCase "keeps known types" $
- dec (BS.pack (concatMap (\t -> [t, 1, 0x2a]) known))
- @?= Right [TlvRecord (fromIntegral t) "\x2a" | t <- known]
- , testCase "skips unknown odd types" $
- dec (BS.pack [5, 0]) @?= Right []
- , testCase "rejects unknown even types" $
- dec (BS.pack [2, 0]) @?= Left DecodeTlvError
- , testCase "rejects a length past the end" $
- dec (BS.pack [1, 5, 0xaa]) @?= Left DecodeTlvError
- , testCase "rejects repeated types" $
- dec (BS.pack [1, 0, 1, 0]) @?= Left DecodeTlvError
- , testCase "rejects a non-minimal BigSize" $
- dec (BS.pack [0xfd, 0x00, 0x01, 0x00]) @?= Left DecodeTlvError
+-- 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
]
--- 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 = [mkScid 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 = [ mkScid 100000 1 0
- , mkScid 200000 2 1
- , mkScid 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 = [mkScid 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 (scidToBytes testShortChannelId)
- case decodeShortChannelIdList badEncoded of
- Left _ -> pure ()
- Right _ -> assertFailure "should reject encoding type 1"
+-- 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)
]
--- 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
- case encodeChannelAnnouncement ChannelAnnouncement
- { channelAnnNodeSig1 = testSignature
- , channelAnnNodeSig2 = testSignature
- , channelAnnBitcoinSig1 = testSignature
- , channelAnnBitcoinSig2 = testSignature
- , channelAnnFeatures = emptyFeatures
- , channelAnnChainHash = testChainHash
- , channelAnnShortChanId = testShortChannelId
- , channelAnnNodeId1 = testNodeId
- , channelAnnNodeId2 = testNodeId2
- , channelAnnBitcoinKey1 = testPoint
- , channelAnnBitcoinKey2 = testPoint
- } of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right msg -> do
- let hashVal = channelAnnouncementHash msg
- fmap BS.length hashVal @?= Just 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
- fmap BS.length hashVal @?= Just 32
- , testCase "channelUpdateHash produces 32 bytes" $ do
- let msg = encodeChannelUpdate ChannelUpdate
- { chanUpdateSignature = testSignature
- , chanUpdateChainHash = testChainHash
- , chanUpdateShortChanId = testShortChannelId
- , chanUpdateTimestamp = 1234567890
- , chanUpdateChanFlags = ChannelFlags
- { cfDirection = NodeOne
- , cfStatus = Enabled }
- , chanUpdateCltvExpDelta = CltvExpiryDelta 144
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 1000000000
- }
- hashVal = channelUpdateHash msg
- fmap BS.length hashVal @?= Just 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
- , chanUpdateChanFlags = ChannelFlags
- { cfDirection = NodeOne
- , cfStatus = Enabled }
- , chanUpdateCltvExpDelta = CltvExpiryDelta 144
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 1000000000
- }
- 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
- , chanUpdateChanFlags = ChannelFlags
- { cfDirection = NodeOne
- , cfStatus = Enabled }
- , chanUpdateCltvExpDelta = CltvExpiryDelta 144
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 1000000000
- }
- msg2 = encodeChannelUpdate ChannelUpdate
- { chanUpdateSignature = testSignature
- , chanUpdateChainHash = testChainHash
- , chanUpdateShortChanId = testShortChannelId
- , chanUpdateTimestamp = 2000000000
- , chanUpdateChanFlags = ChannelFlags
- { cfDirection = NodeOne
- , cfStatus = Enabled }
- , chanUpdateCltvExpDelta = CltvExpiryDelta 144
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 1000000000
- }
- channelUpdateChecksum msg1 @?= channelUpdateChecksum msg2
- ]
- , testGroup "Input length" [
- testCase "channel_update needs 136 bytes" $ do
- let wire = encodeChannelUpdate testChannelUpdate
- channelUpdateHash (BS.take 135 wire) @?= Nothing
- channelUpdateChecksum (BS.take 135 wire) @?= Nothing
- channelUpdateChecksum "short" @?= Nothing
- fmap BS.length (channelUpdateHash wire) @?= Just 32
- assertBool "checksum" (channelUpdateChecksum wire /= Nothing)
- , testCase "channel_announcement needs its declared features" $
- case encodeChannelAnnouncement
- (testChannelAnn (featureBits (BS.pack [1, 2]))) of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right wire -> do
- fmap BS.length (channelAnnouncementHash wire) @?= Just 32
- channelAnnouncementHash (BS.take (BS.length wire - 1) wire)
- @?= Nothing
- -- claim one more feature byte than present
- channelAnnouncementHash (setByte 257 3 wire) @?= Nothing
- channelAnnouncementHash (BS.take 257 wire) @?= Nothing
- , testCase "node_announcement needs its declared addresses" $ do
- v4 <- addrV4
- case encodeNodeAnnouncement (testNodeAnn [v4]) of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right wire -> do
- fmap BS.length (nodeAnnouncementHash wire) @?= Just 32
- nodeAnnouncementHash (BS.take (BS.length wire - 1) wire)
- @?= Nothing
- -- claim one more address byte than present (addrlen 8)
- nodeAnnouncementHash (setByte 139 8 wire) @?= Nothing
- nodeAnnouncementHash (BS.take 139 wire) @?= Nothing
- ]
+-- 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 Tests -----------------------------------------------------------
+-- validation -----------------------------------------------------------------
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 "NodeAnnouncement" [
- testCase "one DNS hostname passes" $ do
- h <- expectJust "hostname" (hostname "ln.example.com")
- v4 <- addrV4
- validateNodeAnnouncement (testNodeAnn [v4, AddrDNS h 9735])
- @?= Right ()
- , testCase "rejects more than one DNS hostname" $ do
- h1 <- expectJust "hostname" (hostname "a.example.com")
- h2 <- expectJust "hostname" (hostname "b.example.com")
- validateNodeAnnouncement
- (testNodeAnn [AddrDNS h1 9735, AddrDNS h2 9735])
- @?= Left ValidateMultipleDns
- ]
- , testGroup "ChannelUpdate" [
- testCase "valid update passes" $ do
- let msg = ChannelUpdate
- { chanUpdateSignature = testSignature
- , chanUpdateChainHash = testChainHash
- , chanUpdateShortChanId = testShortChannelId
- , chanUpdateTimestamp = 1234567890
- , chanUpdateChanFlags = ChannelFlags
- { cfDirection = NodeOne
- , cfStatus = Enabled }
- , chanUpdateCltvExpDelta = CltvExpiryDelta 144
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 1000000000
- }
- validateChannelUpdate msg @?= Right ()
- , testCase "rejects htlc_min > htlc_max" $ do
- let msg = ChannelUpdate
- { chanUpdateSignature = testSignature
- , chanUpdateChainHash = testChainHash
- , chanUpdateShortChanId = testShortChannelId
- , chanUpdateTimestamp = 1234567890
- , chanUpdateChanFlags = ChannelFlags
- { cfDirection = NodeOne
- , cfStatus = Enabled }
- , chanUpdateCltvExpDelta = CltvExpiryDelta 144
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 2000000000 -- > htlcMax
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 1000000000
- }
- validateChannelUpdate msg @?= Left ValidateHtlcAmounts
- ]
- , testGroup "QueryChannelRange" [
- testCase "valid range passes" $ do
- let msg = QueryChannelRange
- { queryRangeChainHash = testChainHash
- , queryRangeFirstBlock = BlockHeight 600000
- , queryRangeNumBlocks = BlockCount 10000
- , queryRangeTlvs = emptyTlvs
- }
- validateQueryChannelRange msg @?= Right ()
- , testCase "rejects overflow" $ do
- let msg = QueryChannelRange
- { queryRangeChainHash = testChainHash
- , queryRangeFirstBlock = BlockHeight maxBound
- , queryRangeNumBlocks = BlockCount 10
- , queryRangeTlvs = emptyTlvs
- }
- validateQueryChannelRange msg @?= Left ValidateBlockOverflow
- ]
- , testGroup "ReplyChannelRange" [
- testCase "ascending short_channel_ids pass" $
- validateReplyChannelRange (testReplyRange
- (encodeShortChannelIdList [mkScid 1 0 0, mkScid 2 0 0]))
- @?= Right ()
- , testCase "rejects descending short_channel_ids" $
- validateReplyChannelRange (testReplyRange
- (encodeShortChannelIdList [mkScid 2 0 0, mkScid 1 0 0]))
- @?= Left ValidateScidNotAscending
- , testCase "rejects zlib encoding (type 1)" $
- validateReplyChannelRange (testReplyRange (BS.cons 1
- (scidToBytes (mkScid 2 0 0) <> scidToBytes (mkScid 1 0 0))))
- @?= Left ValidateScidEncoding
- , testCase "rejects an unknown encoding type" $
- validateReplyChannelRange (testReplyRange (BS.cons 2
- (scidToBytes (mkScid 1 0 0))))
- @?= Left ValidateScidEncoding
- , testCase "rejects a partial short_channel_id" $
- validateReplyChannelRange (testReplyRange (BS.cons 0
- (scidToBytes (mkScid 1 0 0) <> BS.replicate 7 0)))
- @?= Left ValidateScidEncoding
- ]
- ]
-
--- | A reply_channel_range fixture with the given encoded_short_ids.
-testReplyRange :: BS.ByteString -> ReplyChannelRange
-testReplyRange scids = ReplyChannelRange
- { replyRangeChainHash = testChainHash
- , replyRangeFirstBlock = BlockHeight 0
- , replyRangeNumBlocks = BlockCount 10
- , replyRangeSyncComplete = 1
- , replyRangeData = scids
- , replyRangeTlvs = emptyTlvs
- }
-
--- 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
- ]
- , testGroup "Length overflow" [
- testCase "channel_announcement features" $ do
- let feats n = featureBits (BS.replicate n 0x01)
- encodeChannelAnnouncement (testChannelAnn (feats 65536))
- @?= Left EncodeLengthOverflow
- case encodeChannelAnnouncement (testChannelAnn (feats 65535)) of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right wire -> fmap fst (decodeChannelAnnouncement wire)
- @?= Right (testChannelAnn (feats 65535))
- , testCase "node_announcement features" $ do
- let msg = (testNodeAnn [])
- { nodeAnnFeatures = featureBits (BS.replicate 65536 0x01) }
- encodeNodeAnnouncement msg @?= Left EncodeLengthOverflow
- , testCase "node_announcement addresses" $ do
- v4 <- addrV4
- -- 10923 IPv4 descriptors take 65538 bytes
- encodeNodeAnnouncement (testNodeAnn (replicate 10923 v4))
- @?= Left EncodeLengthOverflow
- case encodeNodeAnnouncement (testNodeAnn (replicate 9362 v4)) of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right wire -> fmap (length . nodeAnnAddresses . fst)
- (decodeNodeAnnouncement wire) @?= Right 9362
- , testCase "query_short_channel_ids encoded_short_ids" $ do
- let msg = QueryShortChannelIds
- { queryScidsChainHash = testChainHash
- , queryScidsData = BS.replicate 65536 0x00
- , queryScidsTlvs = emptyTlvs
- }
- encodeQueryShortChannelIds msg @?= Left EncodeLengthOverflow
- , testCase "reply_channel_range encoded_short_ids" $ do
- let msg = ReplyChannelRange
- { replyRangeChainHash = testChainHash
- , replyRangeFirstBlock = BlockHeight 600000
- , replyRangeNumBlocks = BlockCount 10000
- , replyRangeSyncComplete = 1
- , replyRangeData = BS.replicate 65536 0x00
- , replyRangeTlvs = emptyTlvs
- }
- encodeReplyChannelRange msg @?= Left EncodeLengthOverflow
- ]
+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
]
--- Mainnet Gossip Tests --------------------------------------------------------
+-- checksums ------------------------------------------------------------------
--- Real mainnet gossip for short_channel_id 850052x2992x1: its
--- channel_announcement and one channel_update per direction. Payloads
--- exclude the 2-byte message type. The digests and checksums were
--- computed independently of this library.
-
-mainnet_tests :: TestTree
-mainnet_tests = testGroup "Mainnet gossip" [
- testCase "fixtures decode from hex" $ do
- BS.length mainnetChanAnn @?= 430
- BS.length mainnetUpdate136 @?= 136
- BS.length mainnetUpdate148 @?= 148
- , testGroup "channel_announcement" [
- testCase "decodes" $ do
- (ann, rest) <- expectRight "decode"
- (decodeChannelAnnouncement mainnetChanAnn)
- rest @?= BS.empty
- formatScid (channelAnnShortChanId ann) @?= "850052x2992x1"
- channelAnnChainHash ann @?= mainnetChainHash
- getFeatureBits (channelAnnFeatures ann) @?= BS.empty
- getNodeId (channelAnnNodeId1 ann) @?= mainnetNodeId1
- getNodeId (channelAnnNodeId2 ann) @?= mainnetNodeId2
- validateChannelAnnouncement ann @?= Right ()
- , testCase "re-encodes byte-exact" $ do
- (ann, _) <- expectRight "decode"
- (decodeChannelAnnouncement mainnetChanAnn)
- encodeChannelAnnouncement ann @?= Right mainnetChanAnn
- , testCase "signature hash" $
- channelAnnouncementHash mainnetChanAnn @?= Just (hex
- "3dc0e5a431551c44f2afd49cda2d3bf2a5f1b9cc86ef93db8953c17dd1ef4ded")
- , testCase "all four signatures verify" $ do
- (ann, _) <- expectRight "decode"
- (decodeChannelAnnouncement mainnetChanAnn)
- h <- expectJust "hash" (channelAnnouncementHash mainnetChanAnn)
- let nid = getNodeId
- btc = unPoint
- assertBool "node_sig_1" $
- verifySig h (nid (channelAnnNodeId1 ann)) (channelAnnNodeSig1 ann)
- assertBool "node_sig_2" $
- verifySig h (nid (channelAnnNodeId2 ann)) (channelAnnNodeSig2 ann)
- assertBool "bitcoin_sig_1" $
- verifySig h (btc (channelAnnBitcoinKey1 ann))
- (channelAnnBitcoinSig1 ann)
- assertBool "bitcoin_sig_2" $
- verifySig h (btc (channelAnnBitcoinKey2 ann))
- (channelAnnBitcoinSig2 ann)
- assertBool "node_sig_1 does not verify under node_id_2" $
- not (verifySig h (nid (channelAnnNodeId2 ann))
- (channelAnnNodeSig1 ann))
- ]
- , testGroup "channel_update (136 bytes)" [
- testCase "decodes" $ do
- (upd, rest) <- expectRight "decode"
- (decodeChannelUpdate mainnetUpdate136)
- rest @?= BS.empty
- formatScid (chanUpdateShortChanId upd) @?= "850052x2992x1"
- chanUpdateChainHash upd @?= mainnetChainHash
- chanUpdateTimestamp upd @?= 1776493010
- chanUpdateChanFlags upd @?= ChannelFlags NodeTwo Disabled
- chanUpdateCltvExpDelta upd @?= CltvExpiryDelta 80
- chanUpdateHtlcMinMsat upd @?= HtlcMinimumMsat 1000
- chanUpdateFeeBaseMsat upd @?= FeeBaseMsat 1000
- chanUpdateFeeProportional upd @?= FeeProportionalMillionths 800
- chanUpdateHtlcMaxMsat upd @?= HtlcMaximumMsat 2970000000
- validateChannelUpdate upd @?= Right ()
- , testCase "re-encodes byte-exact" $ do
- (upd, _) <- expectRight "decode"
- (decodeChannelUpdate mainnetUpdate136)
- encodeChannelUpdate upd @?= mainnetUpdate136
- , testCase "signature hash" $
- channelUpdateHash mainnetUpdate136 @?= Just (hex
- "5c9960b6fef9fa0d53073895420159e856c7c5f33fdeb694b163a832efe6b8e3")
- , testCase "signature verifies under node_id_2" $ do
- (upd, _) <- expectRight "decode"
- (decodeChannelUpdate mainnetUpdate136)
- h <- expectJust "hash" (channelUpdateHash mainnetUpdate136)
- let sig = chanUpdateSignature upd
- assertBool "node_id_2" (verifySig h mainnetNodeId2 sig)
- assertBool "not node_id_1" (not (verifySig h mainnetNodeId1 sig))
- , testCase "checksum" $
- channelUpdateChecksum mainnetUpdate136 @?= Just 0x1da953bd
- ]
- , testGroup "channel_update (148 bytes, with extension)" [
- testCase "decodes, leaving the extension as rest" $ do
- (upd, rest) <- expectRight "decode"
- (decodeChannelUpdate mainnetUpdate148)
- -- an LND inbound-fee TLV (type 55555) after htlc_maximum_msat
- rest @?= hex "fdd9030800000000ffffffed"
- chanUpdateTimestamp upd @?= 1779047542
- chanUpdateChanFlags upd @?= ChannelFlags NodeOne Enabled
- chanUpdateCltvExpDelta upd @?= CltvExpiryDelta 100
- chanUpdateHtlcMinMsat upd @?= HtlcMinimumMsat 1000
- chanUpdateFeeBaseMsat upd @?= FeeBaseMsat 0
- chanUpdateFeeProportional upd @?= FeeProportionalMillionths 5000
- chanUpdateHtlcMaxMsat upd @?= HtlcMaximumMsat 2970000000
- , testCase "re-encodes the fixed fields byte-exact" $ do
- -- the record does not keep extension bytes
- (upd, rest) <- expectRight "decode"
- (decodeChannelUpdate mainnetUpdate148)
- encodeChannelUpdate upd <> rest @?= mainnetUpdate148
- , testCase "signature hash covers the extension" $
- channelUpdateHash mainnetUpdate148 @?= Just (hex
- "b1989933c26561ab2cdcc49b471aee5f6e0403a5eb7b88a908cb19cfee0556b9")
- , testCase "signature verifies under node_id_1" $ do
- (upd, _) <- expectRight "decode"
- (decodeChannelUpdate mainnetUpdate148)
- h <- expectJust "hash" (channelUpdateHash mainnetUpdate148)
- let sig = chanUpdateSignature upd
- assertBool "node_id_1" (verifySig h mainnetNodeId1 sig)
- assertBool "not node_id_2" (not (verifySig h mainnetNodeId2 sig))
- , testCase "checksum includes the extension" $
- channelUpdateChecksum mainnetUpdate148 @?= Just 0xf0a89fda
- ]
+-- 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)
]
--- | Unwrap an Either, failing the test on Left.
-expectRight :: Show e => String -> Either e a -> IO a
-expectRight what =
- either (\e -> assertFailure (what ++ " failed: " ++ show e)) pure
+-- properties -----------------------------------------------------------------
--- | Decode hex (empty on malformed input; the fixture length test
--- catches that).
-hex :: BS.ByteString -> BS.ByteString
-hex = maybe BS.empty id . B16.decode
-
--- | Verify a compact ECDSA signature over a digest.
-verifySig :: BS.ByteString -> BS.ByteString -> Signature -> Bool
-verifySig digest pub sig =
- case (Secp256k1.parse_point pub, Secp256k1.parse_sig (unSignature sig)) of
- (Just p, Just s) -> Secp256k1._verify_ecdsa_no_hash digest p s
- _ -> False
-
-mainnetNodeId1, mainnetNodeId2 :: BS.ByteString
-mainnetNodeId1 = hex
- "02bb5e47ee26aca1654ce092d9d06eac15d953210c737f2220e2d7e54c4f108677"
-mainnetNodeId2 = hex
- "030b828fd1e42549fbc2f1d0960ec3663362c41777d3d87fe1b8e1d4bf063abcaa"
-
-mainnetChanAnn :: BS.ByteString
-mainnetChanAnn = hex $ mconcat
- [ "3c256c270126d2c52ab5464fa959d627e9baec8c76bd2b81d34b47c4efb03290"
- , "40126ea7a0f8d31420976dc28ff684dc63f62620fa10dbac4fe3d417ca5690c1"
- , "b7fe1de61f5dd2b8368886d6c98f625c9110198e57c14fac93d4eff34e19ce5f"
- , "5dc6fef4501e8105c8f9b82d6d0b348f5840864445b071ae7a741b5eb92d2ec0"
- , "ab85681e4e1e85144bbbd8757c14cee92468d2c5ac84345cb28931b6fed5e339"
- , "00ed9dd363db630f31248cfa933a3667cbf87bb78a48a442e81c652686355365"
- , "ff33164c7588f0a753d50c4d52dd4a81c611fa47b4e950dfc9e3379a12ef7834"
- , "781c0900b90f56a5a49893446d03c8d283c3c093e3c8c682ff6cb40d70d9eebc"
- , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"
- , "00000cf884000bb0000102bb5e47ee26aca1654ce092d9d06eac15d953210c73"
- , "7f2220e2d7e54c4f108677030b828fd1e42549fbc2f1d0960ec3663362c41777"
- , "d3d87fe1b8e1d4bf063abcaa02bc3f260955062a4f427704edef1864c76d6777"
- , "fe81bed43a5f6297dda1c7ca9203523e164f4f9fbdea978c6570d56b13ca8338"
- , "430e6794ff74cf6aa0dbda71dd2d"
+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]
]
--- | Direction 1, disabled.
-mainnetUpdate136 :: BS.ByteString
-mainnetUpdate136 = hex $ mconcat
- [ "261e3d1f1b77b4a606c20dbe5b395e35703adc82fd9320b88e892f51547b93e9"
- , "060f793d8cfd93d2063060a692c31749d0eb3dd351f3e4bbc562d00f89472a42"
- , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
- , "0cf884000bb0000169e321d20103005000000000000003e8000003e800000320"
- , "00000000b1069a80"
+-- (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
]
--- | Direction 0, enabled, with a 12-byte extension.
-mainnetUpdate148 :: BS.ByteString
-mainnetUpdate148 = hex $ mconcat
- [ "1c3f0859cb3f4494919c3dcc80d22bbf1e25e378bd95f071530833c2371c33d7"
- , "0766012ebef1cd79b299a54d0d29bea2ef6feca1d6cfa188864c95d7eea7e9a4"
- , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
- , "0cf884000bb000016a0a1c760100006400000000000003e80000000000001388"
- , "00000000b1069a80fdd9030800000000ffffffed"
+gen_unknown_addresses :: Gen BS.ByteString
+gen_unknown_addresses = oneof
+ [ pure BS.empty
+ , BS.cons <$> elements (0 : [6 .. 255]) <*> gen_var_bytes 10
]
--- 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
- , testProperty "ChannelFlags encode/decode roundtrip"
- propChannelFlagsRoundtrip
- , testProperty "ShortChannelId bytes roundtrip"
- propScidBytesRoundtrip
- , testProperty "Hostname validates length bounds"
- propHostnameValidation
- , testProperty "SCID list encode/decode roundtrip"
- propScidListRoundtrip
+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)
]
-
--- 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
- }
- case encodeChannelAnnouncement msg of
- Left _ -> False
- Right encoded -> 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
- , chanUpdateChanFlags = ChannelFlags
- { cfDirection = NodeOne
- , cfStatus = Enabled }
- , chanUpdateCltvExpDelta = CltvExpiryDelta cltvDelta
- , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000
- , chanUpdateFeeBaseMsat = FeeBaseMsat 1000
- , chanUpdateFeeProportional = FeeProportionalMillionths 100
- , chanUpdateHtlcMaxMsat = HtlcMaximumMsat 1000000000
- }
- 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
-
--- Property: ChannelFlags encode/decode roundtrip
-propChannelFlagsRoundtrip :: Property
-propChannelFlagsRoundtrip =
- forAll genChannelFlags $ \cf ->
- decodeChannelFlags (encodeChannelFlags cf) == cf
- where
- genChannelFlags :: Gen ChannelFlags
- genChannelFlags = ChannelFlags
- <$> elements [NodeOne, NodeTwo]
- <*> elements [Enabled, Disabled]
-
--- Property: ShortChannelId bytes roundtrip
-propScidBytesRoundtrip :: Property
-propScidBytesRoundtrip =
- forAll (choose (0, 0xFFFFFF)) $ \bh ->
- forAll (choose (0, 0xFFFFFF)) $ \ti ->
- forAll arbitrary $ \oi ->
- case shortChannelId bh ti oi of
- Nothing -> False
- Just scid ->
- scidFromBytes (scidToBytes scid)
- == Just scid
-
--- Property: Hostname validates length bounds
-propHostnameValidation :: NonNegative Int -> Property
-propHostnameValidation (NonNegative n) = property $
- let len = n `mod` 300
- bs = BS.replicate len 0x61
- in case hostname bs of
- Just _ -> len >= 1 && len <= 255
- Nothing -> len == 0 || len > 255
-
--- Property: SCID list encode/decode roundtrip
-propScidListRoundtrip :: Property
-propScidListRoundtrip =
- forAll (listOf genScid) $ \scids ->
- case decodeShortChannelIdList
- (encodeShortChannelIdList scids) of
- Right decoded -> decoded == scids
- Left _ -> False
- where
- genScid :: Gen ShortChannelId
- genScid = do
- bh <- choose (0, 0xFFFFFF)
- ti <- choose (0, 0xFFFFFF)
- oi <- arbitrary
- case shortChannelId bh ti oi of
- Just s -> pure s
- Nothing -> pure testShortChannelId
diff --git a/test/Vectors.hs b/test/Vectors.hs
@@ -0,0 +1,376 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module: Vectors
+-- Copyright: (c) 2025 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Test vectors: real mainnet gossip, and the extended gossip query
+-- vectors of BOLT #7 (bolt07/extended-queries.json). Hex strings.
+
+module Vectors (
+ AnnVector(..)
+ , UpdateVector(..)
+ , mainnet_announcements
+ , mainnet_updates
+ , node_announcement_vector
+ , query_vectors
+ ) where
+
+import qualified Data.ByteString as BS
+import Data.Word (Word32)
+
+-- mainnet gossip --------------------------------------------------------------
+
+-- Real mainnet channel_announcements and channel_updates, as captured
+-- from a peer. Payloads exclude the 2-byte message type. The digests
+-- (double SHA-256 of the signed bytes) and CRC-32C checksums were
+-- computed independently of this library.
+
+-- | A channel_announcement payload and its signature digest.
+data AnnVector = AnnVector
+ { av_payload :: !BS.ByteString -- ^ hex
+ , av_digest :: !BS.ByteString -- ^ hex
+ }
+
+-- | A channel_update payload, its signature digest and checksum, and
+-- the index of its channel's announcement in 'mainnet_announcements'.
+data UpdateVector = UpdateVector
+ { uv_payload :: !BS.ByteString -- ^ hex
+ , uv_digest :: !BS.ByteString -- ^ hex
+ , uv_checksum :: !Word32
+ , uv_ann :: !Int
+ }
+
+mainnet_announcements :: [AnnVector]
+mainnet_announcements = [
+ -- 850052x2992x1
+ AnnVector (mconcat
+ [ "3c256c270126d2c52ab5464fa959d627e9baec8c76bd2b81d34b47c4efb03290"
+ , "40126ea7a0f8d31420976dc28ff684dc63f62620fa10dbac4fe3d417ca5690c1"
+ , "b7fe1de61f5dd2b8368886d6c98f625c9110198e57c14fac93d4eff34e19ce5f"
+ , "5dc6fef4501e8105c8f9b82d6d0b348f5840864445b071ae7a741b5eb92d2ec0"
+ , "ab85681e4e1e85144bbbd8757c14cee92468d2c5ac84345cb28931b6fed5e339"
+ , "00ed9dd363db630f31248cfa933a3667cbf87bb78a48a442e81c652686355365"
+ , "ff33164c7588f0a753d50c4d52dd4a81c611fa47b4e950dfc9e3379a12ef7834"
+ , "781c0900b90f56a5a49893446d03c8d283c3c093e3c8c682ff6cb40d70d9eebc"
+ , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"
+ , "00000cf884000bb0000102bb5e47ee26aca1654ce092d9d06eac15d953210c73"
+ , "7f2220e2d7e54c4f108677030b828fd1e42549fbc2f1d0960ec3663362c41777"
+ , "d3d87fe1b8e1d4bf063abcaa02bc3f260955062a4f427704edef1864c76d6777"
+ , "fe81bed43a5f6297dda1c7ca9203523e164f4f9fbdea978c6570d56b13ca8338"
+ , "430e6794ff74cf6aa0dbda71dd2d"
+ ])
+ "3dc0e5a431551c44f2afd49cda2d3bf2a5f1b9cc86ef93db8953c17dd1ef4ded"
+ -- 850013x1067x1
+ , AnnVector (mconcat
+ [ "f37bf5c2f2c11c79541fe16c2a5d63b8795d583ba72f8f1ec9160bbe02a7101d"
+ , "519aa61c125737f82a67be9a586da3e04f941907d9a9c59dd77dd2ae965df2cd"
+ , "f3e247f3f0227ef24baa2ede50f1844e12db674ac4ea53644d701521951ab3c5"
+ , "49eb93a75d6984cb5ca7a5872f0a27f6aa3608a5dfe4468e3f941af8c86425d3"
+ , "4c1ac5663d72b2934d74b20a2f364f3cd09c6528d47e09f9be99be54b1338b0e"
+ , "6bf9ee1bad5bf92cc95de7b0d268d92e9c671f2cfe51a0f5edbf93bf7ee9232e"
+ , "20e7d157eefa4b3615e176f61cad5543584188c9d890209f192c0118f162c77f"
+ , "4259dc4c6aec293913bd59211a9a876cad93d7f7961e027de731e48171688ddb"
+ , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"
+ , "00000cf85d00042b00010322d0e43b3d92d30ed187f4e101a9a9605c3ee5fc97"
+ , "21e6dac3ce3d7732fbb13e037f990e61acee8a7697966afd29dd88f3b1f8a7b1"
+ , "4d625c4f8742bd952003a59003359448149bdca64024ab6c2243ab555f9313aa"
+ , "49ee1da0b1dd0ce1c575b2cca202dfb90cceb72720dd3d3ea168e53ed64d506e"
+ , "4c277fde46946843ee8eab54ab3b"
+ ])
+ "f753e841682abc578fd12650fe47dac6094ab7882d47026bd3b6055e9060e993"
+ -- 850043x3419x1
+ , AnnVector (mconcat
+ [ "0269559b5385e499d1ec6283c2ec0a0a5b93d45f6cce2d5f69709a9fd3382722"
+ , "063a230e7c0fca1b198ed81fc36658c259f70475074f336c7d146d7cb4042de2"
+ , "74162681acf44507e98656d6311fc2a8a85ef7bebd34fde195c244623704b8bf"
+ , "77d8e2965bdbc7ae483d8d2e2ef41cee147ada06440c1501af0a502f54f8d060"
+ , "3ed003cb101583b0986c54994f985e88b730f80a600706b6ac1de2b8030e3961"
+ , "388ad7d4a6d7b0d2718374f52ef4b4ab7f7523ba839d922f362613a283615328"
+ , "54b9165b22d4f86be8f7503f0149b36db4bbba3496bcb6fb989c558bea04c2d0"
+ , "1e6fbddfbec938a1c9fdd841339b7f5ecc40e33cc1df7da7b76da52f72078e7d"
+ , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"
+ , "00000cf87b000d5b0001020b831768ded7615eef25b34639c14b912496137ff5"
+ , "218ad3277d0efd57a32e0902bb5e47ee26aca1654ce092d9d06eac15d953210c"
+ , "737f2220e2d7e54c4f10867703a9be624c84cde9e7452b108942cb7c3c642a1c"
+ , "37ab6468b031c605bb103cb5ab038ace825c070bc5af8d326b534ef6ab38ec04"
+ , "adbbfa859b00369cc86fbacc3e38"
+ ])
+ "473c18a52a826efc39367a38a98d9226511289f7e33c38906faeecf890ecdf0f"
+ -- 850292x3675x0
+ , AnnVector (mconcat
+ [ "76d849642499e76439884821fe95628a274e059a77a5cad5039836d40a63cc52"
+ , "04aa8748f7a284eaf0e22450d37b51feb293391ae2460ce328826af35ab9da8e"
+ , "e052bd9578c74e5a0180294141d66f8f78ec2928456db4eab4062f31c1666bd9"
+ , "30a220d211b8a438f9ad9c9169e3bd197ab1452b784f91f22529d4144fc19c28"
+ , "c0a83de0ec63b53e71f119b37983f687ee947521b8c9d044917fbb8a0e9a8c2a"
+ , "26ac05a821fdf1bac3a764ab9f08c293ed0b01e6dad17ad4da991b403cdfe576"
+ , "d49813544db805ae2afbe85572915e4145df0dc55cfd15396bd6f4abbbc9a052"
+ , "4e8577ed60f5d058706ca9e3fb970d54b707c598e258727b8da2df2a168f4f42"
+ , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"
+ , "00000cf974000e5b0000020cd843f3128386ac5551647496d57aeb0b5259611d"
+ , "7ebb9314cae7711565354803bd743abf0f94b6d208d1c3c47aa8e958d6ddd8aa"
+ , "4e8c910c6e1d6b8dd7413a93024c95a299224252655af8a9a8d07da1313b8efc"
+ , "1dda8964d652ccb81ac5253e0d039404ec864e4efc233af1c781c872048493bc"
+ , "df6d284746293cf5f2b2790af0de"
+ ])
+ "d0f087817bde3d17c5c6f9eb5a9d7c0d14f2498d0c58ebfbd4e8bccfa536ff05"
+ -- 853240x888x2
+ , AnnVector (mconcat
+ [ "f4e2a166440900d15e319812df9c5ffeab61e15f417febb18c1fc07dcc701700"
+ , "3fecf1c075d39f4e134e5061a00de59161378f6855cefa71687f710678cc4c27"
+ , "e010bc600453f7ac4b84c5f5243dc2b6447af512110c1ef11173a1498a71bc6f"
+ , "535607ccf9f64e87ea9641413bd3ad2ec7d96d711f5de0106bf23fd172215f18"
+ , "fd12d34bffebe0d64900e944b4fd7ad81f26adb5ed4ea0099ef3c53e09034178"
+ , "693af5a55308d341e8af0dddd19eed46438174cdc2e9c65f9ff14844c4d991c4"
+ , "37f97805f017d56205f387b24f22d620ea474ba6f837ae114cef015022d55841"
+ , "2eca08400137adc856e80254b61783a77941f9550a0d008ef567c0acfa8e9155"
+ , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"
+ , "00000d04f8000378000202ad898fce14604311ebe871e1053fa248a25e683803"
+ , "a8e599f168fba79bad5f5202c2ecfd7e7646f7a249491c565737b5c9f83863c2"
+ , "3b88e752f2d624e026f5fde702519af7e8fa7c6c47858108d1ab7eb9b531a594"
+ , "34314c804174ccb0bb658d0f5e03562b849da8a6e3f17d1585f53011eabeb53d"
+ , "b6eb23066af87bb81e8adbd0eb1a"
+ ])
+ "cd04212b8a16a7367adb8314e37698b50ad54a9c901d21586fdd1420fba78431"
+ -- 855691x1739x0
+ , AnnVector (mconcat
+ [ "2bd9078e1b73e459703af26014f26f43426961f70e0f289545559bcc5f75cd74"
+ , "5dc4beba17a15301df594267c92fd9e563d75982cc406e095162bdd931107d84"
+ , "e98528d5322f18e203805b372049a2eb32aadd3a26ad2fa733a06279635e8dca"
+ , "4d778a9c4a1ae260ae581562bd5e57298db70e48308ee2ba8c8bdb91db062e21"
+ , "41e5a4396bdc112449c9d2f572f88c1fa610620825ac3fa6bb04a1bfd6cc34a4"
+ , "5fb5a00ec08371146305eb845d2ea98b4f60c8bff4e5e589315c34c6af95863e"
+ , "6c01bdbd7c589bc448b4f0805e9756b2dcfcd5812df8b507cbf2ae488d6519a3"
+ , "12841bcf0f3707f1934b00f845cbe05b67d085d1a4367c8820659285e8760952"
+ , "00006fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d619000000"
+ , "00000d0e8b0006cb000002439112f98b6f4828e1a7426bfbece166bd36837d7d"
+ , "ea4225a75ebd1d96864a070324ba2392e25bff76abd0b1f7e4b53b5f82aa53fd"
+ , "dc3419b051b6c801db9e2247039adc288b1728f289ca4ac30e4b258a19f776c2"
+ , "0e3190f259d759cd672c5f943803e45a0234b0649ba3d599e10df0339a36c140"
+ , "652b5efa18b7c17fadfd5b754888"
+ ])
+ "0092fb593a97482cd7a0dc9ed4954e90eb1ca0700ca55f7a0183674a5faf27ea"
+ ]
+
+mainnet_updates :: [UpdateVector]
+mainnet_updates = [
+ -- 850052x2992x1, 148 bytes, channel_flags 0
+ UpdateVector (mconcat
+ [ "1c3f0859cb3f4494919c3dcc80d22bbf1e25e378bd95f071530833c2371c33d7"
+ , "0766012ebef1cd79b299a54d0d29bea2ef6feca1d6cfa188864c95d7eea7e9a4"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0cf884000bb000016a0a1c760100006400000000000003e80000000000001388"
+ , "00000000b1069a80fdd9030800000000ffffffed"
+ ])
+ "b1989933c26561ab2cdcc49b471aee5f6e0403a5eb7b88a908cb19cfee0556b9"
+ 0xf0a89fda 0
+ -- 850052x2992x1, 136 bytes, channel_flags 3
+ , UpdateVector (mconcat
+ [ "261e3d1f1b77b4a606c20dbe5b395e35703adc82fd9320b88e892f51547b93e9"
+ , "060f793d8cfd93d2063060a692c31749d0eb3dd351f3e4bbc562d00f89472a42"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0cf884000bb0000169e321d20103005000000000000003e8000003e800000320"
+ , "00000000b1069a80"
+ ])
+ "5c9960b6fef9fa0d53073895420159e856c7c5f33fdeb694b163a832efe6b8e3"
+ 0x1da953bd 0
+ -- 850013x1067x1, 136 bytes, channel_flags 1
+ , UpdateVector (mconcat
+ [ "7619128817aadc3c4da18103c468f8c0869f03394e815a7386a81bf74eabb76f"
+ , "357c67e0353b25b173bb67a57185db0d39b8bc3736538e58376ccd184cadf539"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0cf85d00042b000169e334b80101005000000000000003e8000003e800000001"
+ , "00000022ce4c6080"
+ ])
+ "b3d7e24cfbf4d578e3d8ded39d2885fec322c57355e7a513879c72665014e094"
+ 0xb28659fc 1
+ -- 850043x3419x1, 136 bytes, channel_flags 0
+ , UpdateVector (mconcat
+ [ "f0b2facf82a20cb2c33b12337fd54f4553decff2abc86c20fb7059b890d2f16f"
+ , "11d604798b3829ba0367c1898ea21fbb0d50570e70812119ecc069ecde21785a"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0cf87b000d5b000169e3810f0100006400000000000f424000000000000000c3"
+ , "000000001d8119c0"
+ ])
+ "1b2702991ef2d85cc3dffdc390a3a597f3651d00803e6e08581fd8140694ddf4"
+ 0x036645d4 2
+ -- 850043x3419x1, 148 bytes, channel_flags 1
+ , UpdateVector (mconcat
+ [ "c93858ef07309fe98c1690521634ad3a55c715500cdf4d31eef8d6f412613c0a"
+ , "491df28ec2e7c4a5288a5bf2848d18486d9cf4eeb3f41befeaedf1e121416438"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0cf87b000d5b000169e3810f0101006400000000000003e80000000000001388"
+ , "000000009ae5c730fdd9030800000000fffffa95"
+ ])
+ "6deeb53e1859601e9b2b859dccace2dd9f85dc6d0605d6d7a966329d2633df1c"
+ 0x878e5ea4 2
+ -- 850052x2992x1, 148 bytes, channel_flags 2
+ , UpdateVector (mconcat
+ [ "3bf18f613f864d7b9907c98915cf4cbec8d4ac5245f5c66ca3d93571074d8c4f"
+ , "3cbc7963377020145f9645ead56f462537384e43cba27ac4b73d9e734275fe6a"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0cf884000bb0000169e3478f0102006400000000000003e80000000000001066"
+ , "00000000b1069a80fdd9030800000000fffffab8"
+ ])
+ "3af8a43926c24d2707cecf621fb7906cc1feb4c6880b0fde3de19bb5da7e5649"
+ 0x5ba7913c 0
+ -- 850292x3675x0, 136 bytes, channel_flags 2
+ , UpdateVector (mconcat
+ [ "ee28b4d0ce3abded3c43d5d990a40020b255df072cc76a9fdfd8482aed0c81c1"
+ , "02e7e124dcd74acaaf5cf0773cbd10a828b721925cb54f7569cca335f6a9237c"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0cf974000e5b000069e37c460102002800000000000003e8000003e800000001"
+ , "0000000076046700"
+ ])
+ "43949a9fa1993b3375b7fc2e3a35e35ceb28766907f3d738fa8f46b9ba02474f"
+ 0x9d4f0032 3
+ -- 853240x888x2, 148 bytes, channel_flags 3
+ , UpdateVector (mconcat
+ [ "c5cfd6f873caf8ad9207f10db0b618bbf4db86e31b64ad6d0d2aca0a14de8899"
+ , "261b3b94e7eff8317f77c3fee62941e660361dd3ed4213a94a7bb13fee71dcc8"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0d04f8000378000269e32992010300900000000000005208000000000000017a"
+ , "000000001dcd6500fdd903080000000000000000"
+ ])
+ "a6d2ea4523ee28ad1f117ac2cffbb6bf29aa5cc6f7f58d2dc058a999563c9560"
+ 0x172a10e7 4
+ -- 855691x1739x0, 136 bytes, channel_flags 0
+ , UpdateVector (mconcat
+ [ "0f325a044bff29a14636b22023d2a44abf939e34b776020907627b4c72488ed9"
+ , "70b357c059e7a110611bb2093d9fffdd00028a84fc08aea155a57d4b79434410"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0d0e8b0006cb000069e046c70100004800000000000003e80000000000000147"
+ , "0000000000000000"
+ ])
+ "d00785fd5793d86401fb54de019d4094fbff37416d9f611a55fc8fe9a5f536c4"
+ 0x368d3c11 5
+ -- 850013x1067x1, 148 bytes, channel_flags 0
+ , UpdateVector (mconcat
+ [ "2faeaef5708bde4ce33a2145bca38544d9d3c4431c6e10210f6fab36c37306f2"
+ , "53ab90c2d5ec3710c6f481dab4735e398fa83eec94b2d5a9bd41df26a92bce7b"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0cf85d00042b000169e33b320100009000000000000003e8000000000000109a"
+ , "00000022ce4c6080fdd903080000000000000000"
+ ])
+ "1acb192f08b4dfb70359cebc337e6ed2cc985b74e70dacc9ecdc1bd957a56923"
+ 0xf4948aaf 1
+ -- 850292x3675x0, 136 bytes, channel_flags 1
+ , UpdateVector (mconcat
+ [ "6bbb96e7af06e5a35815d7bfc1777ee680cb7d2f728855cc8373baf469e1d375"
+ , "3aa3f7023a796ead27e8fc37e9509358c6e8c2e9ee6a71db5c8dc9c044a3395c"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0cf974000e5b000069e37c840101005000000000000003e80000000000000064"
+ , "0000000076046700"
+ ])
+ "cf3744188962bb9ab7a9847f9b21624c488ec250e780c728c1f9d0032d2ff3a2"
+ 0xe7e9397e 3
+ -- 853240x888x2, 136 bytes, channel_flags 0
+ , UpdateVector (mconcat
+ [ "49ac69d15fbdb35e1022bbe10d4c319fcc981c488e8120a6c6630caa81d96326"
+ , "335ac4948bbaa6bd24811550700c98fcb6af26f00f173d94fa1f060962e8d829"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0d04f8000378000269dea9690100005000000000000003e8000003e8000003e7"
+ , "00000000ec08ce00"
+ ])
+ "14e2befbe15ea11b5094628ce2ceb1e22a325ed7a7fc03300641e0d7785e32f1"
+ 0xe265c205 4
+ -- 855691x1739x0, 136 bytes, channel_flags 1
+ , UpdateVector (mconcat
+ [ "337910ec557c3c04ad42130175e9c783179bb6e0627b36e96b5c635795e4f500"
+ , "2f11d94319a52c930fd166643709f1b97c096c64cbf412f620f53158c45054eb"
+ , "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+ , "0d0e8b0006cb000069e2cb460101005000000000000003e8000000000000000a"
+ , "000000012a05f200"
+ ])
+ "bc08450188a2eb2f1e4fa964a5f11d458a06ce4a00010f86980fbb68c7d8f033"
+ 0x822c67ea 5
+ ]
+
+-- node_announcement ----------------------------------------------------------
+
+-- | A node_announcement payload signed with the secret key 0x4242..42,
+-- and its signature digest (computed independently of this library).
+-- It carries one descriptor of each known type, a descriptor of the
+-- unknown type 6, and an extension record of type 101.
+node_announcement_vector :: (BS.ByteString, BS.ByteString)
+node_announcement_vector = (mconcat
+ [ "edbd2df19aee2f072d9665e2d9a2807fbcd4be6876f6863955ea11870e411e66"
+ , "063a31dcef14f1983524f87e108ee556b3a6646c873cd4bbcc07512c8f5e8f6a"
+ , "000908000000000002aaa26553f1000324653eac434488002cc06bbfb7f10fe1"
+ , "8991e35f9fe4302dbea6d2353dc0ab1c314159707061642d626f6c7437000000"
+ , "000000000000000000000000000000000000000063017f000001260702000000"
+ , "00000000000000000000000001260703aaaaaaaaaaaaaaaaaaaaaaaa04bbbbbb"
+ , "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
+ , "2607050e6c6e2e6578616d706c652e636f6d2607060102036503657874"
+ ]
+ , "c81748f1075dce2da919ce8a52fe59fec409aa10208b8ffc227f5292af5f0abf")
+
+-- extended gossip queries ----------------------------------------------------
+
+-- | The vectors of bolt07/extended-queries.json, in order: messages with
+-- their 2-byte type, in hex.
+query_vectors :: [BS.ByteString]
+query_vectors = [
+ -- 0: QueryChannelRange
+ mconcat
+ [ "01070f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"
+ , "2206000186a0000005dc"
+ ]
+ -- 1: QueryChannelRange
+ , mconcat
+ [ "01070f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"
+ , "2206000088b800000064010103"
+ ]
+ -- 2: ReplyChannelRange, UNCOMPRESSED
+ , mconcat
+ [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"
+ , "2206000b8a06000005dc01001900000000000000008e0000000000003c690000"
+ , "00000045a6c4"
+ ]
+ -- 3: ReplyChannelRange, COMPRESSED_ZLIB
+ , mconcat
+ [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"
+ , "2206000006400000006e01001601789c636000833e08659309a65878be010010"
+ , "a9023a"
+ ]
+ -- 4: ReplyChannelRange, UNCOMPRESSED
+ , mconcat
+ [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"
+ , "22060001ddde000005dc01001900000000000000304300000000000778d60000"
+ , "00000046e1c1011900000282c1000e77c5000778ad00490ab00000b57800955b"
+ , "ff031800000457000008ae00000d050000115c000015b300001a0a"
+ ]
+ -- 5: ReplyChannelRange, COMPRESSED_ZLIB
+ , mconcat
+ [ "01080f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"
+ , "22060001ddde000005dc01001801789c63600001036730c55e710d4cbb3d3c08"
+ , "0017c303b1012201789c63606a3ac8c0577e9481bd622d8327d7060686ad150c"
+ , "53a3ff0300554707db031800000457000008ae00000d050000115c000015b300"
+ , "001a0a"
+ ]
+ -- 6: QueryShortChannelIds, UNCOMPRESSED
+ , mconcat
+ [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"
+ , "2206001900000000000000008e0000000000003c69000000000045a6c4"
+ ]
+ -- 7: QueryShortChannelIds, COMPRESSED_ZLIB
+ , mconcat
+ [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"
+ , "2206001801789c63600001c12b608a69e73e30edbaec0800203b040e"
+ ]
+ -- 8: QueryShortChannelIds, UNCOMPRESSED
+ , mconcat
+ [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"
+ , "22060019000000000000002fc80000000000003cc4000000000045a6c4010c01"
+ , "789c6364620100000e0008"
+ ]
+ -- 9: QueryShortChannelIds, COMPRESSED_ZLIB
+ , mconcat
+ [ "01050f9188f13cb7b2c71f2a335e3a4fc328bf5beb436012afca590b1a11466e"
+ , "2206001801789c63600001f30a30c5b0cd144cb92e3b020017c6034a010c0178"
+ , "9c6364620100000e0008"
+ ]
+ ]
