commit 02a53481ba70917cc169593e234fe2d8187cb026
parent ebb7e66910178255c24a5798056b685901d2a7a4
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 14:07:54 +0400
lib: port to ppad-bolt1 0.1.0 and rework the API
Exports everything from Lightning.Protocol.BOLT7 with snake_case
names; the submodules are internal. Uses bolt1's Point, ShortChannelId,
MilliSatoshi and TLV streams, and bolt9's FeatureVector, rather than
local copies.
Decoders take a payload, consume all of it, and keep every byte:
message_flags and channel_flags are stored whole (with typed accessors
for must_be_one, dont_forward, direction and disable), address
descriptors after the first of an unknown type are kept raw, Tor v2
descriptors are kept, and trailing bytes form an extension TLV stream.
Encoding a decoded message thus reproduces it, so its signatures
verify.
Query messages have typed fields: short channel id lists, query_flags,
query_option, timestamps and checksums, with the one-per-id counts
checked on both sides. Encoding types other than 0 (including zlib)
are rejected, as is an encoded_short_ids without an encoding byte.
Signature digests and checksums now take typed messages, and
verify_channel_announcement, verify_node_announcement and
verify_channel_update check signatures with ppad-secp256k1.
Adds a dispatcher (decode_message over a type and payload), and drops
the feature-bit validation stub, unproduced error constructors, the
MsgType enumeration, the length constants and the raw short channel id
list codecs.
Diffstat:
8 files changed, 1483 insertions(+), 1610 deletions(-)
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,28 @@
-- 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, shiftR, xor, (.&.))
import qualified Data.ByteString as BS
import Data.Word (Word8, Word32)
--- | CRC-32C polynomial (Castagnoli): 0x1EDC6F41 reflected = 0x82F63B78
-crc32cPoly :: Word32
-crc32cPoly = 0x82F63B78
-{-# INLINE crc32cPoly #-}
+-- the Castagnoli polynomial 0x1EDC6F41, bit-reflected
+poly :: Word32
+poly = 0x82F63B78
--- | 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
{-# 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'
+step :: Word32 -> Word8 -> Word32
+step !crc !byte = go (8 :: Int) (crc `xor` fromIntegral byte)
where
- go :: Int -> Word32 -> Word32
go 0 !c = c
- go !n !c =
- let c' = if c .&. 1 /= 0
- then (c `shiftR` 1) `xor` crc32cPoly
- else c `shiftR` 1
- in go (n - 1) c'
-{-# INLINE updateByte #-}
+ go n !c = go (n - 1) ((c `shiftR` 1) `xor` (poly .&. negate (c .&. 1)))
+{-# INLINE step #-}
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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 '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 'Hostname'.
+un_hostname :: Hostname -> BS.ByteString
+un_hostname (Hostname bs) = bs
+{-# INLINE un_hostname #-}
+
+-- | Whether a '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 '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 '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 '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 '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
@@ -65,14 +72,15 @@ benchmark bolt7-bench
main-is: Main.hs
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
@@ -82,12 +90,13 @@ benchmark bolt7-weigh
main-is: Weight.hs
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
