commit 280946ab905a374c8c6d4a37678a4cc362551ab9
parent 3beb830dccaebfcd243a38189187341717982289
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 13:35:53 +0400
Merge impl/modernize: 0.1.0 API redesign
Prepares ppad-bolt9 0.1.0 as the shared feature-vector library for the
other bolts, against lightning/bolts@1aadb719.
API (single exposed module Lightning.Protocol.BOLT9, snake_case):
- FeatureVector is abstract. parse is total and keeps the received
bytes, so render (parse bs) == bs (gossip signatures cover them);
every other operation encodes minimally. Equality ignores leading
zero bytes. empty, union, set_bit/clear_bit/test_bit/set_bits with
Int indices.
- Feature is a closed enumeration of the BOLT #9 table, now including
zero_fee_commitments (40/41), option_splice (62/63) and
option_onion_messages_only_channels (66/67), with total accessors
for bits, names, contexts, dependencies and the ASSUMED flag. The
name-string table and the containers dependency are gone.
- set_feature (clears the other bit), set_feature_with_deps,
clear_feature, test_feature (both bits set counts as Required) and
list_features.
- Context has one constructor per spec context (I, N, C, 9, B, T); C-
and C+ are not contexts.
- validate_local enforces the origin rules: no unknown bits, no pair
with both bits, features only in their contexts (empty-context
features allowed in I, N and 9), dependencies set. validate_remote
enforces each context's receiver rules: unknown even bits and
dependencies for init and invoices, unknown even bits for
announcements, any unknown bit for allowed_features. A dependency on
an ASSUMED feature counts as met. Both return
Either (NonEmpty ValidationError) ().
- ChannelType and BasicChannelType model BOLT #2 channel types; the
channel_type context is validated against them.
- Removes RequiredBit, OptionalBit, BitIndex, KnownFeature, the
name-based lookups, setFeatureForContext, validateNoBothBits,
highestSetBit and the duplicate bit operations.
Tests assert the feature table against the spec and cover the BOLT #11
invoice feature vectors, the BOLT #4 route-blinding allowed_features
vectors, every channel type, negative cases for each rule per context,
and properties over arbitrary vectors. Haddock and README examples are
checked against the API. Benchmarks cover the main operations.
Also refreshes etc/09-features.md, bumps the version to 0.1.0 and
updates the README, CHANGELOG and AGENTS.md.
Diffstat:
14 files changed, 1387 insertions(+), 1814 deletions(-)
diff --git a/AGENTS.md b/AGENTS.md
@@ -139,5 +139,4 @@ When planning work:
The flake.nix follows ppad conventions:
- Uses ppad-nixpkgs as base
- Follows references to avoid duplication
-- Supports LLVM backend via cabal flag
- Provides devShell with ghc, cabal, cc, llvm
diff --git a/CHANGELOG b/CHANGELOG
@@ -1,4 +1,31 @@
# Changelog
-- 0.0.1 (unreleased)
+- 0.1.0 (UNRELEASED)
+ * Breaking: the API is redesigned and now lives entirely in
+ Lightning.Protocol.BOLT9, with snake_case names. The submodules,
+ the bit-index newtypes, the name-based feature lookups and the
+ duplicate bit operations are gone.
+
+ * Breaking: features are a closed enumeration matching the BOLT #9
+ table at lightning/bolts@1aadb719, which adds zero_fee_commitments,
+ option_splice and option_onion_messages_only_channels.
+
+ * Breaking: contexts follow the spec. C- and C+ are no longer
+ contexts, and channel_type is validated as a BOLT #2 channel type
+ (the new ChannelType) rather than as a feature vector.
+
+ * FeatureVector preserves received bytes exactly for re-encoding,
+ compares equal regardless of leading zero bytes, and gains union.
+
+ * Fixes remote validation, which skipped the dependency check, let
+ bits above 65535 wrap onto known features, and applied the init
+ rules in every context. Local validation now rejects unknown bits,
+ and a dependency on an ASSUMED feature counts as met.
+
+ * Fixes setting a feature, which could leave both bits of its pair
+ set.
+
+ * Drops the dependency on containers.
+
+- 0.0.1 (2026-04-18)
* Initial release.
diff --git a/README.md b/README.md
@@ -4,22 +4,11 @@
[](https://docs.ppad.tech/bolt9)
-A Haskell implementation of Lightning Network feature flags (BOLT #9),
-providing type-safe feature vectors with validation and wire format
-encoding.
-
-## Overview
-
-BOLT #9 defines feature flags that Lightning nodes advertise to indicate
-support for optional protocol features. Features are represented as bit
-positions in a variable-length bit vector:
-
-- **Even bits** (0, 2, 4, ...) indicate *required* support
-- **Odd bits** (1, 3, 5, ...) indicate *optional* support
-
-For example, `basic_mpp` (multi-part payments) uses bits 16/17. A node
-setting bit 16 requires peers to support it; bit 17 indicates optional
-support.
+A pure Haskell implementation of Lightning Network feature flags, per
+[BOLT #9][bolt9]: an abstract feature vector type that preserves its
+wire bytes, the table of known features with their contexts and
+dependencies, sender- and receiver-side validation for each context,
+and BOLT #2 channel types.
## Usage
@@ -27,48 +16,39 @@ A sample GHCi session:
```
> :set -XOverloadedStrings
- > import Lightning.Protocol.BOLT9
- > import Data.Maybe (fromJust)
>
- > -- Look up features by name
- > let mpp = fromJust $ featureByName "basic_mpp"
- > featureBaseBit mpp
- 16
- > featureDependencies mpp
- ["payment_secret"]
+ > -- import qualified
+ > import qualified Lightning.Protocol.BOLT9 as BOLT9
>
- > -- Build a feature vector with optional basic_mpp support
- > let fv = setFeature mpp False empty
- > hasFeature mpp fv
- Just False
+ > -- build a feature vector for an init message, with dependencies
+ > let opt = BOLT9.Optional
+ > let fv = BOLT9.set_feature_with_deps BOLT9.OptionZeroconf opt BOLT9.empty
+ > BOLT9.list_features fv
+ [(OptionScidAlias,Optional),(OptionZeroconf,Optional)]
>
- > -- Validation catches missing dependencies
- > validateLocal Init fv
- Left [MissingDependency "basic_mpp" "payment_secret"]
- >
- > -- Add the dependency
- > let ps = fromJust $ featureByName "payment_secret"
- > let fv' = setFeature ps False $ setFeature mpp False empty
- > validateLocal Init fv'
+ > -- check it against the sender's rules, then encode it
+ > BOLT9.validate_local BOLT9.InitContext fv
Right ()
+ > BOLT9.render fv
+ "\b\128\NUL\NUL\NUL\NUL\NUL"
>
- > -- Render to wire format (compact, no leading zeros)
- > render fv'
- "\STX\128"
- >
- > -- Parse from wire format
- > let fv'' = parse "\STX\128"
- > listFeatures fv''
- [(Feature {featureName = "payment_secret", ...},False),
- (Feature {featureName = "basic_mpp", ...},False)]
+ > -- a received vector keeps its exact bytes
+ > let theirs = BOLT9.parse "\NUL\STX\NUL\NUL"
+ > BOLT9.render theirs
+ "\NUL\STX\NUL\NUL"
+ > BOLT9.test_feature BOLT9.BasicMpp theirs
+ Just Optional
>
- > -- Remote validation: unknown optional bits are OK
- > validateRemote Init (setBit 201 empty)
+ > -- check it against the receiver's rules for init
+ > BOLT9.validate_remote BOLT9.InitContext theirs
Right ()
+ > BOLT9.validate_remote BOLT9.InitContext (BOLT9.set_bit 100 theirs)
+ Left (UnknownBit 100 :| [])
>
- > -- But unknown required bits are rejected
- > validateRemote Init (setBit 200 empty)
- Left [UnknownRequiredBit 200]
+ > -- channel types follow BOLT #2
+ > let ct = BOLT9.ChannelType BOLT9.BasicAnchors False True
+ > BOLT9.channel_type (BOLT9.channel_type_features ct) == Just ct
+ True
```
## Documentation
@@ -76,10 +56,36 @@ A sample GHCi session:
Haddocks (API documentation, etc.) are hosted at
[docs.ppad.tech/bolt9](https://docs.ppad.tech/bolt9).
+## Specification
+
+The library implements BOLT #9 as of [lightning/bolts@1aadb719][spec]
+(2026-09-21), a copy of which lives in `etc/09-features.md`, together
+with the feature-vector rules of BOLTs #1, #2, #4, #7 and #11 for each
+context.
+
+Not implemented:
+
+* Feature fields of BOLT #12 offers, invoice requests and invoices,
+ which the BOLT #9 table assigns no context.
+* The BOLT #11 encoding of features as 5-bit groups.
+* BOLT #1's notions of *offered* and *negotiated* features.
+* BOLT #2's rule against `option_scid_alias` in the channel type of an
+ announced channel, which depends on `channel_flags`.
+* BOLT #4's check that a payment uses only features in
+ `allowed_features`.
+* The `C-` and `C+` presentation rules for `channel_announcement`. No
+ feature in the table uses them, or `C`.
+* The receiving requirements specific to each feature, which BOLT #9
+ defers to the linked sections of the other BOLTs.
+
+BOLT #2 defines `zero_fee_commitments` as a basic channel type, though
+the BOLT #9 table doesn't list it in the `T` context; `ChannelType`
+follows BOLT #2.
+
## Performance
-The aim is best-in-class performance for feature flag handling.
-Benchmarks are available under `bench/` and can be run with:
+The aim is best-in-class performance for pure Haskell code. Run the
+benchmark suite with:
```
$ cabal bench
@@ -87,7 +93,8 @@ $ cabal bench
## Security
-This is a pre-release library and makes no claims about security whatsoever.
+This is a pre-release library and makes no claims about security
+whatsoever.
## Development
@@ -106,10 +113,7 @@ $ cabal repl ppad-bolt9
to get a REPL for the main library.
-## Attribution
-
-This library implements the Lightning Network BOLT #9 specification:
-https://github.com/lightning/bolts/blob/master/09-features.md
-
+[bolt9]: https://github.com/lightning/bolts/blob/master/09-features.md
+[spec]: https://github.com/lightning/bolts/blob/1aadb719b4007c4cea0ba6e36b08c4fb53788dee/09-features.md
[nixos]: https://nixos.org/
[flake]: https://nixos.org/manual/nix/unstable/command-ref/new-cli/nix3-flake.html
diff --git a/bench/Fixtures.hs b/bench/Fixtures.hs
@@ -1,57 +1,36 @@
module Fixtures (
- -- * ByteString fixtures
- typicalBytes
- , emptyBytes
- , largeBytes
-
- -- * FeatureVector fixtures
- , typicalFV
- , emptyFV
- , validFV
- , unknownBitsFV
+ typical
+ , padded
+ , large
+ , maximal
+ , zeroconf_type
+ , zeroconf_type_features
) where
-import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Lightning.Protocol.BOLT9 as B9
--- ByteString fixtures --------------------------------------------------------
-
--- | A typical 8-byte feature vector with several common features set:
--- basic_mpp (bit 17), option_anchors (bit 23), option_route_blinding (bit 25)
-typicalBytes :: ByteString
-typicalBytes = BS.pack [0x02, 0x82, 0x00, 0x00]
-
--- | Empty ByteString for parsing.
-emptyBytes :: ByteString
-emptyBytes = BS.empty
-
--- | Large 64-byte feature vector for stress testing.
-largeBytes :: ByteString
-largeBytes = BS.pack $ replicate 64 0xAA
+-- | An init feature vector of the sort deployed nodes send (8 bytes).
+typical :: B9.FeatureVector
+typical = foldr B9.set_bit B9.empty
+ [1, 5, 7, 8, 11, 12, 14, 17, 23, 25, 27, 35, 39, 45, 47, 51, 61]
--- FeatureVector fixtures -----------------------------------------------------
+-- | 'typical' with four leading zero bytes.
+padded :: B9.FeatureVector
+padded = B9.parse (BS.replicate 4 0 <> B9.render typical)
--- | A typical feature vector with common features set (optional bits):
--- basic_mpp (17), option_anchors (23), option_route_blinding (25)
-typicalFV :: B9.FeatureVector
-typicalFV = B9.parse typicalBytes
+-- | 64 bytes with every odd bit set.
+large :: B9.FeatureVector
+large = B9.parse (BS.replicate 64 0xAA)
--- | Empty feature vector.
-emptyFV :: B9.FeatureVector
-emptyFV = B9.empty
+-- | A maximum-length (65535-byte) vector with every bit set.
+maximal :: B9.FeatureVector
+maximal = B9.parse (BS.replicate 65535 0xFF)
--- | A valid feature vector for validation benchmarks.
--- Sets payment_secret (required for basic_mpp dependency) and basic_mpp.
-validFV :: B9.FeatureVector
-validFV = B9.setBit 15 -- payment_secret (optional)
- $ B9.setBit 17 -- basic_mpp (optional)
- $ B9.setBit 23 -- option_anchors (optional)
- $ B9.empty
+-- | An anchors channel type with both variations.
+zeroconf_type :: B9.ChannelType
+zeroconf_type = B9.ChannelType B9.BasicAnchors True True
--- | A feature vector with unknown bits for remote validation.
--- Contains a known feature plus an unknown odd bit (safe to ignore).
-unknownBitsFV :: B9.FeatureVector
-unknownBitsFV = B9.setBit 15 -- payment_secret (optional, known)
- $ B9.setBit 99 -- unknown odd bit (should be ignored)
- $ B9.empty
+-- | The vector for 'zeroconf_type'.
+zeroconf_type_features :: B9.FeatureVector
+zeroconf_type_features = B9.channel_type_features zeroconf_type
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -1,42 +1,48 @@
module Main where
import Criterion.Main
-import Data.Maybe (fromJust)
import qualified Lightning.Protocol.BOLT9 as B9
import Fixtures
-basic_mpp :: B9.Feature
-basic_mpp = fromJust (B9.featureByName "basic_mpp")
-
main :: IO ()
main = defaultMain [
- bgroup "parse" [
- bench "typical (8 bytes)" $ nf B9.parse typicalBytes
- , bench "empty" $ nf B9.parse emptyBytes
- , bench "large (64 bytes)" $ nf B9.parse largeBytes
- ]
-
- , bgroup "render" [
- bench "typical" $ nf B9.render typicalFV
- , bench "empty" $ nf B9.render emptyFV
+ bgroup "vector" [
+ bench "union" $ nf (B9.union typical) large
+ , bench "set_bit" $ nf (B9.set_bit 101) typical
+ , bench "clear_bit" $ nf (B9.clear_bit 17) typical
+ , bench "test_bit" $ nf (B9.test_bit 17) typical
+ , bench "set_bits" $ nf B9.set_bits typical
+ , bench "== (leading zeros)" $ nf (== typical) padded
]
- , bgroup "bit-ops" [
- bench "setBit" $ nf (B9.setBit 50) typicalFV
- , bench "testBit" $ nf (B9.testBit 17) typicalFV
- , bench "hasFeature" $
- nf (flip B9.hasFeature typicalFV) basic_mpp
+ , bgroup "feature" [
+ bench "set_feature" $
+ nf (B9.set_feature B9.OptionSplice B9.Optional) typical
+ , bench "set_feature_with_deps" $
+ nf (B9.set_feature_with_deps B9.OptionZeroconf B9.Optional)
+ B9.empty
+ , bench "test_feature" $ nf (B9.test_feature B9.BasicMpp) typical
+ , bench "list_features" $ nf B9.list_features typical
+ , bench "feature_by_bit" $ nf B9.feature_by_bit 51
]
, bgroup "validate" [
- bench "validateLocal (valid)" $
- nf (B9.validateLocal B9.Init) validFV
- , bench "validateRemote (unknown bits)" $
- nf (B9.validateRemote B9.Init) unknownBitsFV
+ bench "validate_local (init)" $
+ nf (B9.validate_local B9.InitContext) typical
+ , bench "validate_remote (init)" $
+ nf (B9.validate_remote B9.InitContext) typical
+ , bench "validate_remote (init, 64 bytes)" $
+ nf (B9.validate_remote B9.InitContext) large
+ , bench "validate_remote (init, 65535 bytes)" $
+ nf (B9.validate_remote B9.InitContext) maximal
+ , bench "validate_remote (channel_type)" $
+ nf (B9.validate_remote B9.ChannelTypeContext)
+ zeroconf_type_features
]
- , bgroup "lookup" [
- bench "featureByBit" $ nf B9.featureByBit 16
- , bench "featureByName" $ nf B9.featureByName "basic_mpp"
+ , bgroup "channel type" [
+ bench "channel_type" $ nf B9.channel_type zeroconf_type_features
+ , bench "channel_type_features" $
+ nf B9.channel_type_features zeroconf_type
]
]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -1,21 +1,18 @@
module Main where
-import Weigh
import qualified Lightning.Protocol.BOLT9 as B9
+import Weigh
import Fixtures
main :: IO ()
main = mainWith $ do
- func "FeatureVector (5 features)" mkFiveFeatures ()
- func "validateLocal" (B9.validateLocal B9.Init) validFV
- func "listFeatures" B9.listFeatures validFV
-
--- | Create a FeatureVector with 5 features set.
-mkFiveFeatures :: () -> B9.FeatureVector
-mkFiveFeatures _ =
- B9.setBit 15 -- payment_secret
- $ B9.setBit 17 -- basic_mpp
- $ B9.setBit 23 -- option_anchors
- $ B9.setBit 25 -- option_route_blinding
- $ B9.setBit 27 -- option_shutdown_anysegwit
- $ B9.empty
+ func "union" (B9.union typical) large
+ func "set_feature" (B9.set_feature B9.OptionSplice B9.Optional) typical
+ func "set_feature_with_deps"
+ (B9.set_feature_with_deps B9.OptionZeroconf B9.Optional) B9.empty
+ func "list_features" B9.list_features typical
+ func "validate_local (init)" (B9.validate_local B9.InitContext) typical
+ func "validate_remote (init)" (B9.validate_remote B9.InitContext) typical
+ func "validate_remote (init, 64 bytes)"
+ (B9.validate_remote B9.InitContext) large
+ func "channel_type" B9.channel_type zeroconf_type_features
diff --git a/etc/09-features.md b/etc/09-features.md
@@ -47,14 +47,17 @@ The Context column decodes as follows:
| 26/27 | `option_shutdown_anysegwit` | Future segwit versions allowed in `shutdown` | IN | | [BOLT #2][bolt02-shutdown] |
| 28/29 | `option_dual_fund` | Use v2 of channel open, enables dual funding | IN | | [BOLT #2](02-peer-protocol.md) |
| 34/35 | `option_quiesce` | Support for `stfu` message | IN | | [BOLT #2][bolt02-quiescence] |
-| 36/37 | `option_attribution_data` | Can generate/relay attribution data in `update_fail_htlc` and `update_fulfill_htlc` | IN9 | | [BOLT #4][bolt04-attribution-data] |
-| 38/39 | `option_onion_messages` | Can forward onion messages | IN | | [BOLT #7](04-onion-routing.md#onion-messages) |
+| 36/37 | `option_attribution_data` | Can generate/relay attribution data and `fulfillment_payload` | IN9 | | [BOLT #4][bolt04-attribution-data], [successful payments][bolt04-successful-payments] |
+| 38/39 | `option_onion_messages` | Can forward onion messages | IN | | [BOLT #4](04-onion-routing.md#onion-messages) |
+| 40/41 | `zero_fee_commitments` | Zero-fee commitment and HTLC transactions | IN | `option_channel_type` | [BOLT #3][bolt03-shared-anchor] |
| 42/43 | `option_provide_storage` | Can store other nodes' encrypted backup data | IN | | [BOLT #1](01-messaging.md#peer-storage) |
| 44/45 | `option_channel_type` | ASSUMED | | | |
| 46/47 | `option_scid_alias` | Supply channel aliases for routing | INT | | [BOLT #2][bolt02-channel-ready] |
| 48/49 | `option_payment_metadata` | Payment metadata in tlv record | 9 | | [BOLT #11](11-payment-encoding.md#tagged-fields) |
| 50/51 | `option_zeroconf` | Understands zeroconf channel types | INT | `option_scid_alias` | [BOLT #2][bolt02-channel-ready] |
| 60/61 | `option_simple_close` | Simplified closing negotiation | IN | `option_shutdown_anysegwit` | [BOLT #2][bolt02-simple-close] |
+| 62/63 | `option_splice` | Allows replacing the funding transaction with a new one | IN | | [BOLT #2](02-peer-protocol.md#channel-splicing) |
+| 66/67 | `option_onion_messages_only_channels` | Only accepts onion messages from peers with a channel | IN | `option_onion_messages` | [BOLT #4](04-onion-routing.md#onion-messages) |
## Requirements
@@ -101,10 +104,12 @@ This work is licensed under a [Creative Commons Attribution 4.0 International Li
[bolt02-open]: 02-peer-protocol.md#the-open_channel-message
[bolt02-simple-close]: 02-peer-protocol.md#closing-negotiation-closing_complete-and-closing_sig
[bolt03-htlc-tx]: 03-transactions.md#htlc-timeout-and-htlc-success-transactions
+[bolt03-shared-anchor]: 03-transactions.md#shared_anchor-output-zero_fee_commitments
[bolt02-shutdown]: 02-peer-protocol.md#closing-initiation-shutdown
[bolt02-quiescence]: 02-peer-protocol.md#channel-quiescence
[bolt02-channel-ready]: 02-peer-protocol.md#the-channel_ready-message
[bolt04-attribution-data]: 04-onion-routing.md#returning-errors
+[bolt04-successful-payments]: 04-onion-routing.md#successful-payments
[bolt07-sync]: 07-routing-gossip.md#initial-sync
[bolt07-query]: 07-routing-gossip.md#query-messages
[bolt04-mpp]: 04-onion-routing.md#basic-multi-part-payments
diff --git a/lib/Lightning/Protocol/BOLT9.hs b/lib/Lightning/Protocol/BOLT9.hs
@@ -11,132 +11,707 @@
-- Feature flags for the Lightning Network, per
-- [BOLT #9](https://github.com/lightning/bolts/blob/master/09-features.md).
--
--- == Overview
+-- A feature vector is a big-endian bit field. Features are assigned
+-- pairs of bits: setting the even bit means the feature is required,
+-- setting the odd bit means it is optional (/it's ok to be odd/).
--
--- BOLT #9 defines feature flags that Lightning nodes advertise to indicate
--- support for optional protocol features. Features are represented as bit
--- positions in a variable-length bit vector, where even bits indicate
--- required (compulsory) support and odd bits indicate optional support.
+-- The examples below assume:
--
--- This library provides:
+-- >>> :set -XOverloadedStrings
+-- >>> import Lightning.Protocol.BOLT9
--
--- * Type-safe feature vectors with efficient bit manipulation
--- * A complete table of known features from the BOLT #9 specification
--- * Validation for both locally-created and remotely-received vectors
--- * Context-aware validation (init, node_announcement, invoice, etc.)
+-- Build a vector, check it before sending it, and render it:
--
--- == Quick Start
+-- >>> let fv = set_feature_with_deps OptionZeroconf Optional empty
+-- >>> list_features fv
+-- [(OptionScidAlias,Optional),(OptionZeroconf,Optional)]
+-- >>> validate_local InitContext fv
+-- Right ()
+-- >>> render fv
+-- "\b\128\NUL\NUL\NUL\NUL\NUL"
--
--- Create a feature vector and set some features:
+-- Check a vector received from a peer:
--
--- >>> import Lightning.Protocol.BOLT9
--- >>> let Just mpp = featureByName "basic_mpp"
--- >>> let fv = setFeature mpp Optional empty
--- >>> hasFeature mpp fv
--- Just Optional
+-- >>> validate_remote InitContext (parse "\DLE\NUL\NUL")
+-- Left (UnknownBit 20 :| [])
+-- >>> validate_remote InitContext (parse "\STX\NUL\NUL")
+-- Right ()
+
+module Lightning.Protocol.BOLT9 (
+ -- * Feature vectors
+ FeatureVector
+ , parse
+ , render
+ , empty
+ , union
+
+ -- * Bits
+ , set_bit
+ , clear_bit
+ , test_bit
+ , set_bits
+
+ -- * Known features
+ , Feature(..)
+ , known_features
+ , feature_by_bit
+ , feature_bit
+ , feature_name
+ , feature_contexts
+ , feature_dependencies
+ , feature_assumed
+
+ -- * Feature operations
+ , FeatureLevel(..)
+ , set_feature
+ , set_feature_with_deps
+ , clear_feature
+ , test_feature
+ , list_features
+
+ -- * Validation
+ , Context(..)
+ , ValidationError(..)
+ , validate_local
+ , validate_remote
+
+ -- * Channel types
+ , ChannelType(..)
+ , BasicChannelType(..)
+ , channel_type
+ , channel_type_features
+ ) where
+
+import Control.DeepSeq (NFData(..))
+import qualified Data.Bits as B
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import Data.List (find)
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Maybe (isNothing)
+import Data.Word (Word8)
+import GHC.Generics (Generic)
+
+-- feature vectors -----------------------------------------------------------
+
+-- | A feature vector.
+--
+-- Bit 0 is the least significant bit of the last byte. A vector
+-- produced by 'parse' keeps its bytes exactly, so 'render' gives
+-- them back unchanged (signatures over gossip messages cover them).
+-- Every other operation produces a minimally-encoded vector, i.e.
+-- one without leading zero bytes.
--
--- Validate a feature vector for a specific context:
+-- Equality ignores leading zero bytes.
--
--- >>> validateLocal Init fv
--- Left [MissingDependency "basic_mpp" "payment_secret"]
+-- >>> parse "\NUL\STX" == parse "\STX"
+-- True
+-- >>> set_bit 1 empty
+-- parse "\STX"
+newtype FeatureVector = FeatureVector ByteString
+
+instance Eq FeatureVector where
+ FeatureVector a == FeatureVector b = strip a == strip b
+
+instance Show FeatureVector where
+ showsPrec d (FeatureVector bs) = showParen (d > 10) $
+ showString "parse " . showsPrec 11 bs
+
+instance NFData FeatureVector where
+ rnf (FeatureVector bs) = rnf bs
+
+-- | Parse a feature vector from its wire bytes. Every byte string is a
+-- valid feature vector.
--
--- Fix by adding the dependency:
+-- >>> test_bit 9 (parse "\STX\NUL")
+-- True
+parse :: ByteString -> FeatureVector
+parse = FeatureVector
+{-# INLINE parse #-}
+
+-- | The wire bytes of a feature vector: the original bytes of a vector
+-- produced by 'parse', and the minimal encoding of any other.
--
--- >>> let Just ps = featureByName "payment_secret"
--- >>> let fv' = setFeature ps Optional (setFeature mpp Optional empty)
--- >>> validateLocal Init fv'
--- Right ()
+-- >>> render (parse "\NUL\STX")
+-- "\NUL\STX"
+-- >>> render (union (parse "\NUL\STX") empty)
+-- "\STX"
+render :: FeatureVector -> ByteString
+render (FeatureVector bs) = bs
+{-# INLINE render #-}
+
+-- | The empty feature vector.
--
--- == Bit Numbering
+-- >>> render empty
+-- ""
+empty :: FeatureVector
+empty = FeatureVector BS.empty
+
+-- | The bitwise OR of two feature vectors.
--
--- Features use paired bits: even bits (0, 2, 4, ...) indicate required
--- support, while odd bits (1, 3, 5, ...) indicate optional support.
--- For example, @basic_mpp@ uses bit 16 (required) and 17 (optional).
+-- BOLT #1 requires the receiver of an @init@ message to combine its
+-- @globalfeatures@ and @features@ fields this way.
--
--- A node setting bit 16 requires all peers to support @basic_mpp@.
--- A node setting bit 17 indicates optional support (peers without it
--- may still connect).
+-- >>> set_bits (union (parse "\STX") (parse "\SOH\NUL"))
+-- [1,8]
+union :: FeatureVector -> FeatureVector -> FeatureVector
+union (FeatureVector a) (FeatureVector b) =
+ FeatureVector (combine (B..|.) a b)
-module Lightning.Protocol.BOLT9 (
- -- * Context
- -- | Contexts specify where feature flags appear in the protocol.
- Context(..)
- , isChannelContext
- , channelParity
-
- -- * Bit indices
- -- | Low-level bit index types for direct bit manipulation.
- , BitIndex
- , unBitIndex
- , bitIndex
-
- -- * Required/optional level
- -- | Whether a feature is set as required or optional.
- , FeatureLevel(..)
+-- bits ----------------------------------------------------------------------
- -- * Required/optional bits
- -- | Type-safe wrappers ensuring correct parity.
- , RequiredBit
- , unRequiredBit
- , requiredBit
- , requiredFromBitIndex
-
- , OptionalBit
- , unOptionalBit
- , optionalBit
- , optionalFromBitIndex
-
- -- * Feature vectors
- -- | The core feature vector type and basic operations.
- , FeatureVector
- , unFeatureVector
- , FV.empty
- , fromByteString
- , set
- , clear
- , member
-
- -- * Known features
- -- | The BOLT #9 feature table and lookup functions.
- , Feature(..)
- , KnownFeature(..)
- , knownFeatureByBit
- , knownFeatureByName
- , featureByBit
- , featureByName
- , knownFeatures
-
- -- * Parsing and rendering
- -- | Wire format conversion.
- , parse
- , render
+-- | Set the bit at the given index. Negative indices are ignored.
+--
+-- >>> render (set_bit 9 empty)
+-- "\STX\NUL"
+set_bit :: Int -> FeatureVector -> FeatureVector
+set_bit !i (FeatureVector bs)
+ | i < 0 = FeatureVector (strip bs)
+ | otherwise = FeatureVector (combine (B..|.) bs (single i))
- -- * Low-level bit operations
- -- | Direct bit manipulation by index.
- , Codec.setBit
- , Codec.clearBit
- , Codec.testBit
-
- -- * Feature operations
- -- | High-level operations using 'Feature' values.
- , setFeature
- , setFeatureWithDeps
- , hasFeature
- , isFeatureSet
- , listFeatures
-
- -- * Validation
- -- | Validate feature vectors for correctness.
- , ValidationError(..)
- , validateLocal
- , validateRemote
- , setFeatureForContext
- , validateNoBothBits
- , highestSetBit
- , Validate.setBits
- ) where
+-- | Clear the bit at the given index. Negative indices are ignored.
+--
+-- >>> render (clear_bit 9 (parse "\STX\SOH"))
+-- "\SOH"
+clear_bit :: Int -> FeatureVector -> FeatureVector
+clear_bit !i (FeatureVector bs)
+ | i < 0 || i `quot` 8 >= BS.length s = FeatureVector s
+ | otherwise = FeatureVector (combine clr s (single i))
+ where
+ s = strip bs
+ clr x y = x B..&. B.complement y
+
+-- | Test the bit at the given index. Negative indices are never set.
+--
+-- >>> test_bit 9 (parse "\STX\NUL")
+-- True
+-- >>> test_bit 8 (parse "\STX\NUL")
+-- False
+test_bit :: Int -> FeatureVector -> Bool
+test_bit !i (FeatureVector bs)
+ | i < 0 || q >= len = False
+ | otherwise = B.testBit (BS.index bs (len - 1 - q)) r
+ where
+ len = BS.length bs
+ (q, r) = i `quotRem` 8
+
+-- | The indices of all set bits, in ascending order.
+--
+-- >>> set_bits (parse "\STX\NUL\SOH")
+-- [0,17]
+set_bits :: FeatureVector -> [Int]
+set_bits (FeatureVector bs) = go 0
+ where
+ !len = BS.length bs
+ go !q
+ | q >= len = []
+ | otherwise =
+ let !w = BS.index bs (len - 1 - q)
+ in [q * 8 + r | r <- [0 .. 7], B.testBit w r] ++ go (q + 1)
-import Lightning.Protocol.BOLT9.Codec as Codec
-import Lightning.Protocol.BOLT9.Features
-import Lightning.Protocol.BOLT9.Types as FV
-import Lightning.Protocol.BOLT9.Validate as Validate
+-- Drop leading zero bytes.
+strip :: ByteString -> ByteString
+strip = BS.dropWhile (== 0)
+{-# INLINE strip #-}
+
+-- The minimal encoding of a vector with only bit i set (i >= 0).
+single :: Int -> ByteString
+single i = BS.cons (B.bit r) (BS.replicate q 0)
+ where
+ (q, r) = i `quotRem` 8
+
+-- Combine two encodings bytewise, aligned at their last bytes (the
+-- shorter one padded with leading zeros), and strip the result.
+combine
+ :: (Word8 -> Word8 -> Word8) -> ByteString -> ByteString -> ByteString
+combine f a b = strip (fst (BS.unfoldrN n step 0))
+ where
+ !la = BS.length a
+ !lb = BS.length b
+ !n = max la lb
+ byte s ls k
+ | k < n - ls = 0
+ | otherwise = BS.index s (k - n + ls)
+ step !k = Just (f (byte a la k) (byte b lb k), k + 1)
+
+-- known features ------------------------------------------------------------
+
+-- | The features assigned in the BOLT #9 table.
+data Feature
+ = OptionDataLossProtect -- ^ 0/1 @option_data_loss_protect@
+ | OptionUpfrontShutdownScript -- ^ 4/5 @option_upfront_shutdown_script@
+ | GossipQueries -- ^ 6/7 @gossip_queries@
+ | VarOnionOptin -- ^ 8/9 @var_onion_optin@
+ | GossipQueriesEx -- ^ 10/11 @gossip_queries_ex@
+ | OptionStaticRemotekey -- ^ 12/13 @option_static_remotekey@
+ | PaymentSecret -- ^ 14/15 @payment_secret@
+ | BasicMpp -- ^ 16/17 @basic_mpp@
+ | OptionSupportLargeChannel -- ^ 18/19 @option_support_large_channel@
+ | OptionAnchors -- ^ 22/23 @option_anchors@
+ | OptionRouteBlinding -- ^ 24/25 @option_route_blinding@
+ | OptionShutdownAnysegwit -- ^ 26/27 @option_shutdown_anysegwit@
+ | OptionDualFund -- ^ 28/29 @option_dual_fund@
+ | OptionQuiesce -- ^ 34/35 @option_quiesce@
+ | OptionAttributionData -- ^ 36/37 @option_attribution_data@
+ | OptionOnionMessages -- ^ 38/39 @option_onion_messages@
+ | ZeroFeeCommitments -- ^ 40/41 @zero_fee_commitments@
+ | OptionProvideStorage -- ^ 42/43 @option_provide_storage@
+ | OptionChannelType -- ^ 44/45 @option_channel_type@
+ | OptionScidAlias -- ^ 46/47 @option_scid_alias@
+ | OptionPaymentMetadata -- ^ 48/49 @option_payment_metadata@
+ | OptionZeroconf -- ^ 50/51 @option_zeroconf@
+ | OptionSimpleClose -- ^ 60/61 @option_simple_close@
+ | OptionSplice -- ^ 62/63 @option_splice@
+ | OptionOnionMessagesOnlyChannels
+ -- ^ 66/67 @option_onion_messages_only_channels@
+ deriving (Eq, Ord, Show, Generic)
+
+instance NFData Feature
+
+-- | All known features, in bit order.
+--
+-- >>> length known_features
+-- 25
+known_features :: [Feature]
+known_features = [
+ OptionDataLossProtect
+ , OptionUpfrontShutdownScript
+ , GossipQueries
+ , VarOnionOptin
+ , GossipQueriesEx
+ , OptionStaticRemotekey
+ , PaymentSecret
+ , BasicMpp
+ , OptionSupportLargeChannel
+ , OptionAnchors
+ , OptionRouteBlinding
+ , OptionShutdownAnysegwit
+ , OptionDualFund
+ , OptionQuiesce
+ , OptionAttributionData
+ , OptionOnionMessages
+ , ZeroFeeCommitments
+ , OptionProvideStorage
+ , OptionChannelType
+ , OptionScidAlias
+ , OptionPaymentMetadata
+ , OptionZeroconf
+ , OptionSimpleClose
+ , OptionSplice
+ , OptionOnionMessagesOnlyChannels
+ ]
+
+-- A row of the BOLT #9 table.
+data Entry = Entry {
+ e_bit :: !Int
+ , e_name :: !String
+ , e_contexts :: ![Context]
+ , e_deps :: ![Feature]
+ , e_assumed :: !Bool
+ }
+
+entry :: Feature -> Entry
+entry f = case f of
+ OptionDataLossProtect ->
+ Entry 0 "option_data_loss_protect" [] [] True
+ OptionUpfrontShutdownScript ->
+ Entry 4 "option_upfront_shutdown_script" _IN [] False
+ GossipQueries ->
+ Entry 6 "gossip_queries" [] [] False
+ VarOnionOptin ->
+ Entry 8 "var_onion_optin" [] [] True
+ GossipQueriesEx ->
+ Entry 10 "gossip_queries_ex" _IN [] False
+ OptionStaticRemotekey ->
+ Entry 12 "option_static_remotekey" [] [] True
+ PaymentSecret ->
+ Entry 14 "payment_secret" [] [] True
+ BasicMpp ->
+ Entry 16 "basic_mpp" _IN9 [PaymentSecret] False
+ OptionSupportLargeChannel ->
+ Entry 18 "option_support_large_channel" _IN [] False
+ OptionAnchors ->
+ Entry 22 "option_anchors" _INT [] False
+ OptionRouteBlinding ->
+ Entry 24 "option_route_blinding" _IN9 [] False
+ OptionShutdownAnysegwit ->
+ Entry 26 "option_shutdown_anysegwit" _IN [] False
+ OptionDualFund ->
+ Entry 28 "option_dual_fund" _IN [] False
+ OptionQuiesce ->
+ Entry 34 "option_quiesce" _IN [] False
+ OptionAttributionData ->
+ Entry 36 "option_attribution_data" _IN9 [] False
+ OptionOnionMessages ->
+ Entry 38 "option_onion_messages" _IN [] False
+ ZeroFeeCommitments ->
+ Entry 40 "zero_fee_commitments" _IN [OptionChannelType] False
+ OptionProvideStorage ->
+ Entry 42 "option_provide_storage" _IN [] False
+ OptionChannelType ->
+ Entry 44 "option_channel_type" [] [] True
+ OptionScidAlias ->
+ Entry 46 "option_scid_alias" _INT [] False
+ OptionPaymentMetadata ->
+ Entry 48 "option_payment_metadata" [InvoiceContext] [] False
+ OptionZeroconf ->
+ Entry 50 "option_zeroconf" _INT [OptionScidAlias] False
+ OptionSimpleClose ->
+ Entry 60 "option_simple_close" _IN [OptionShutdownAnysegwit] False
+ OptionSplice ->
+ Entry 62 "option_splice" _IN [] False
+ OptionOnionMessagesOnlyChannels ->
+ Entry 66 "option_onion_messages_only_channels" _IN
+ [OptionOnionMessages] False
+ where
+ _IN = [InitContext, NodeContext]
+ _IN9 = [InitContext, NodeContext, InvoiceContext]
+ _INT = [InitContext, NodeContext, ChannelTypeContext]
+
+-- | The feature that a bit (even or odd) belongs to, if any.
+--
+-- >>> feature_by_bit 16
+-- Just BasicMpp
+-- >>> feature_by_bit 17
+-- Just BasicMpp
+-- >>> feature_by_bit 20
+-- Nothing
+feature_by_bit :: Int -> Maybe Feature
+feature_by_bit !i
+ | i < 0 || i > max_known_bit = Nothing
+ | otherwise = find ((== base) . feature_bit) known_features
+ where
+ base = i - i `rem` 2
+
+-- The highest bit assigned to any known feature.
+max_known_bit :: Int
+max_known_bit = foldr (max . (+ 1) . feature_bit) 0 known_features
+
+-- | A feature's even (required) bit. Its odd (optional) bit is the
+-- next one up.
+--
+-- >>> feature_bit BasicMpp
+-- 16
+feature_bit :: Feature -> Int
+feature_bit = e_bit . entry
+
+-- | A feature's name in the BOLT #9 table.
+--
+-- >>> feature_name BasicMpp
+-- "basic_mpp"
+feature_name :: Feature -> String
+feature_name = e_name . entry
+
+-- | The contexts the BOLT #9 table lists for a feature, in table order.
+-- The list is empty for ASSUMED features and for 'GossipQueries'.
+--
+-- >>> feature_contexts BasicMpp
+-- [InitContext,NodeContext,InvoiceContext]
+-- >>> feature_contexts PaymentSecret
+-- []
+feature_contexts :: Feature -> [Context]
+feature_contexts = e_contexts . entry
+
+-- | A feature's direct dependencies.
+--
+-- >>> feature_dependencies OptionZeroconf
+-- [OptionScidAlias]
+feature_dependencies :: Feature -> [Feature]
+feature_dependencies = e_deps . entry
+
+-- | Whether BOLT #9 marks a feature ASSUMED, i.e. supported by all
+-- nodes.
+--
+-- >>> feature_assumed PaymentSecret
+-- True
+feature_assumed :: Feature -> Bool
+feature_assumed = e_assumed . entry
+
+-- feature operations --------------------------------------------------------
+
+-- | The level at which a feature is set.
+data FeatureLevel
+ = Required -- ^ the even bit is set
+ | Optional -- ^ the odd bit is set
+ deriving (Eq, Ord, Show, Generic)
+
+instance NFData FeatureLevel
+
+level_bit :: Feature -> FeatureLevel -> Int
+level_bit f Required = feature_bit f
+level_bit f Optional = feature_bit f + 1
+{-# INLINE level_bit #-}
+
+-- | Set a feature at the given level, clearing the other bit of its
+-- pair.
+--
+-- >>> set_bits (set_feature BasicMpp Optional empty)
+-- [17]
+-- >>> set_bits (set_feature BasicMpp Required (set_bit 17 empty))
+-- [16]
+set_feature :: Feature -> FeatureLevel -> FeatureVector -> FeatureVector
+set_feature f l = set_bit (level_bit f l) . clear_bit (level_bit f other)
+ where
+ other = case l of
+ Required -> Optional
+ Optional -> Required
+
+-- | Set a feature at the given level, together with its transitive
+-- dependencies (ASSUMED ones included). Dependencies that are not
+-- yet set are set at the same level; those already set keep theirs.
+--
+-- >>> list_features (set_feature_with_deps BasicMpp Optional empty)
+-- [(PaymentSecret,Optional),(BasicMpp,Optional)]
+set_feature_with_deps
+ :: Feature -> FeatureLevel -> FeatureVector -> FeatureVector
+set_feature_with_deps f l fv =
+ foldr ensure (set_feature f l fv) (feature_dependencies f)
+ where
+ ensure d acc =
+ let acc' = case test_feature d acc of
+ Just _ -> acc
+ Nothing -> set_feature d l acc
+ in foldr ensure acc' (feature_dependencies d)
+
+-- | Clear both bits of a feature.
+--
+-- >>> clear_feature BasicMpp (set_feature BasicMpp Optional empty)
+-- parse ""
+clear_feature :: Feature -> FeatureVector -> FeatureVector
+clear_feature f =
+ clear_bit (level_bit f Required) . clear_bit (level_bit f Optional)
+
+-- | The level at which a feature is set, if it is.
+--
+-- A feature with both bits set is 'Required', as BOLT #9 directs the
+-- receiver to treat it.
+--
+-- >>> test_feature BasicMpp (set_bit 17 empty)
+-- Just Optional
+-- >>> test_feature BasicMpp (set_bit 16 (set_bit 17 empty))
+-- Just Required
+-- >>> test_feature BasicMpp empty
+-- Nothing
+test_feature :: Feature -> FeatureVector -> Maybe FeatureLevel
+test_feature f fv
+ | test_bit (level_bit f Required) fv = Just Required
+ | test_bit (level_bit f Optional) fv = Just Optional
+ | otherwise = Nothing
+
+-- | The known features set in a vector, in bit order.
+--
+-- >>> list_features (parse "\SOH\128\NUL")
+-- [(PaymentSecret,Optional),(BasicMpp,Required)]
+list_features :: FeatureVector -> [(Feature, FeatureLevel)]
+list_features fv =
+ [(f, l) | f <- known_features, Just l <- [test_feature f fv]]
+
+-- validation ----------------------------------------------------------------
+
+-- | A field in which feature bits are presented: the values of the
+-- Context column of the BOLT #9 table.
+--
+-- The table's @C-@ and @C+@ are not further contexts. They mark a
+-- feature presented in @channel_announcement@ as always optional or
+-- always required. No feature at the implemented spec revision is
+-- presented in @channel_announcement@ in any form.
+data Context
+ = InitContext -- ^ @I@: the @init@ message
+ | NodeContext -- ^ @N@: @node_announcement@
+ | ChannelContext -- ^ @C@: @channel_announcement@
+ | InvoiceContext -- ^ @9@: BOLT #11 invoices
+ | BlindedContext -- ^ @B@: @allowed_features@ of a blinded path
+ | ChannelTypeContext -- ^ @T@: the @channel_type@ field
+ deriving (Eq, Ord, Show, Generic)
+
+instance NFData Context
+
+-- | A rule a feature vector breaks.
+data ValidationError
+ = UnknownBit {-# UNPACK #-} !Int
+ -- ^ a bit belonging to no known feature is set
+ | BothBitsSet !Feature
+ -- ^ both bits of a feature are set
+ | ContextNotAllowed !Feature !Context
+ -- ^ a feature is set in a context that doesn't present it
+ | MissingDependency !Feature !Feature
+ -- ^ a set feature (first) lacks a dependency (second)
+ | InvalidChannelType
+ -- ^ a @channel_type@ is not a type that BOLT #2 defines
+ deriving (Eq, Show, Generic)
+
+instance NFData ValidationError
+
+-- | Validate a feature vector that we're about to send in the given
+-- context, per the origin requirements of BOLT #9 and BOLT #1.
+--
+-- For 'ChannelTypeContext', the vector must be a channel type that
+-- BOLT #2 defines (see 'channel_type'). For every other context,
+-- checks that:
+--
+-- * no bit outside the known features is set;
+-- * no feature has both bits set;
+-- * each set feature is presented in the context. A feature with an
+-- empty Context column (the ASSUMED features and 'GossipQueries')
+-- is accepted in 'InitContext', 'NodeContext' and
+-- 'InvoiceContext', where deployed nodes still present it;
+-- * each set feature's dependencies are set. A dependency on an
+-- ASSUMED feature counts as met even when its bits are clear.
+--
+-- Errors are reported in that order. No known feature is presented
+-- in 'ChannelContext' or 'BlindedContext', so only the empty vector
+-- passes there (as BOLT #4 requires of @allowed_features@).
+--
+-- >>> validate_local InitContext (set_feature OptionZeroconf Optional empty)
+-- Left (MissingDependency OptionZeroconf OptionScidAlias :| [])
+-- >>> validate_local InitContext (set_feature BasicMpp Optional empty)
+-- Right ()
+-- >>> validate_local InitContext (set_bit 101 empty)
+-- Left (UnknownBit 101 :| [])
+validate_local
+ :: Context -> FeatureVector -> Either (NonEmpty ValidationError) ()
+validate_local ctx fv = to_either $ case ctx of
+ ChannelTypeContext -> channel_type_errors fv
+ _ -> unknown_bits (const True) fv
+ ++ both_bits_errors fv
+ ++ context_errors ctx fv
+ ++ dependency_errors fv
+
+-- | Validate a feature vector received in the given context, per the
+-- receiver requirements for that context:
+--
+-- * 'InitContext' (BOLT #1) and 'InvoiceContext' (BOLT #11): no
+-- unknown even bit is set, and each set feature's dependencies are
+-- set (ASSUMED dependencies count as met).
+-- * 'NodeContext' and 'ChannelContext' (BOLT #7): no unknown even
+-- bit is set. A failure here means the node or channel must not be
+-- routed through; the announcement itself is still valid.
+-- * 'BlindedContext' (BOLT #4): no unknown bit is set, odd or even.
+-- * 'ChannelTypeContext' (BOLT #2): the vector is a defined channel
+-- type (see 'channel_type').
+--
+-- Unknown odd bits are otherwise ignored. A feature with both bits
+-- set is not an error; it counts as 'Required' (see 'test_feature').
+-- Nor is a known feature outside its listed contexts, since that
+-- rule binds only the sender.
+--
+-- >>> validate_remote InitContext (set_bit 101 empty)
+-- Right ()
+-- >>> validate_remote InitContext (set_bit 100 empty)
+-- Left (UnknownBit 100 :| [])
+-- >>> validate_remote BlindedContext (set_bit 101 empty)
+-- Left (UnknownBit 101 :| [])
+validate_remote
+ :: Context -> FeatureVector -> Either (NonEmpty ValidationError) ()
+validate_remote ctx fv = to_either $ case ctx of
+ InitContext -> unknown_even ++ dependency_errors fv
+ NodeContext -> unknown_even
+ ChannelContext -> unknown_even
+ InvoiceContext -> unknown_even ++ dependency_errors fv
+ BlindedContext -> unknown_bits (const True) fv
+ ChannelTypeContext -> channel_type_errors fv
+ where
+ unknown_even = unknown_bits even fv
+
+to_either :: [e] -> Either (NonEmpty e) ()
+to_either [] = Right ()
+to_either (e : es) = Left (e :| es)
+
+-- Unknown set bits satisfying the predicate.
+unknown_bits :: (Int -> Bool) -> FeatureVector -> [ValidationError]
+unknown_bits p fv =
+ [ UnknownBit i
+ | i <- set_bits fv, p i, isNothing (feature_by_bit i) ]
+
+both_bits_errors :: FeatureVector -> [ValidationError]
+both_bits_errors fv =
+ [ BothBitsSet f
+ | f <- known_features
+ , test_bit (level_bit f Required) fv
+ , test_bit (level_bit f Optional) fv ]
+
+context_errors :: Context -> FeatureVector -> [ValidationError]
+context_errors ctx fv =
+ [ ContextNotAllowed f ctx
+ | (f, _) <- list_features fv, not (presented f) ]
+ where
+ presented f = case feature_contexts f of
+ [] -> ctx `elem` [InitContext, NodeContext, InvoiceContext]
+ cs -> ctx `elem` cs
+
+dependency_errors :: FeatureVector -> [ValidationError]
+dependency_errors fv =
+ [ MissingDependency f d
+ | (f, _) <- list_features fv
+ , d <- feature_dependencies f
+ , not (feature_assumed d)
+ , isNothing (test_feature d fv) ]
+
+channel_type_errors :: FeatureVector -> [ValidationError]
+channel_type_errors fv = case channel_type fv of
+ Nothing -> [InvalidChannelType]
+ Just _ -> []
+
+-- channel types -------------------------------------------------------------
+
+-- | The basic channel types of BOLT #2.
+data BasicChannelType
+ = BasicStaticRemotekey
+ -- ^ 'OptionStaticRemotekey' (bit 12)
+ | BasicAnchors
+ -- ^ 'OptionAnchors' and 'OptionStaticRemotekey' (bits 22 and 12)
+ | BasicZeroFeeCommitments
+ -- ^ 'ZeroFeeCommitments' (bit 40)
+ deriving (Eq, Ord, Show, Generic)
+
+instance NFData BasicChannelType
+
+-- | A channel type, per BOLT #2: a basic type plus any of the
+-- 'OptionScidAlias' and 'OptionZeroconf' variations.
+--
+-- Channel types are an enumeration that reuses even feature bits;
+-- they aren't subject to the dependency or context rules for
+-- feature vectors. BOLT #2 also forbids 'OptionScidAlias' in the
+-- channel type of a channel to be announced, which needs the
+-- @announce_channel@ flag to check.
+data ChannelType = ChannelType {
+ ct_basic :: !BasicChannelType
+ , ct_scid_alias :: !Bool
+ , ct_zeroconf :: !Bool
+ }
+ deriving (Eq, Show, Generic)
+
+instance NFData ChannelType
+
+-- | The channel type that a @channel_type@ vector encodes, if it is a
+-- defined one. Leading zero bytes are ignored.
+--
+-- >>> let zeroconf = ChannelType BasicStaticRemotekey False True
+-- >>> channel_type (parse "\EOT\NUL\NUL\NUL\NUL\DLE\NUL") == Just zeroconf
+-- True
+-- >>> channel_type (set_bit 13 empty)
+-- Nothing
+channel_type :: FeatureVector -> Maybe ChannelType
+channel_type fv = find ((== fv) . channel_type_features) channel_types
+
+-- All defined channel types.
+channel_types :: [ChannelType]
+channel_types =
+ [ ChannelType b s z
+ | b <- [BasicStaticRemotekey, BasicAnchors, BasicZeroFeeCommitments]
+ , s <- [False, True]
+ , z <- [False, True] ]
+
+-- | The @channel_type@ vector for a channel type.
+--
+-- >>> let anchors = ChannelType BasicAnchors False False
+-- >>> render (channel_type_features anchors)
+-- "@\DLE\NUL"
+channel_type_features :: ChannelType -> FeatureVector
+channel_type_features (ChannelType b s z) =
+ foldr (\f -> set_feature f Required) empty
+ (basic b ++ [OptionScidAlias | s] ++ [OptionZeroconf | z])
+ where
+ basic BasicStaticRemotekey = [OptionStaticRemotekey]
+ basic BasicAnchors = [OptionAnchors, OptionStaticRemotekey]
+ basic BasicZeroFeeCommitments = [ZeroFeeCommitments]
diff --git a/lib/Lightning/Protocol/BOLT9/Codec.hs b/lib/Lightning/Protocol/BOLT9/Codec.hs
@@ -1,193 +0,0 @@
-{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
-
--- |
--- Module: Lightning.Protocol.BOLT9.Codec
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Parsing and rendering for BOLT #9 feature vectors.
-
-module Lightning.Protocol.BOLT9.Codec (
- -- * Parsing and rendering
- parse
- , render
-
- -- * Bit operations
- , setBit
- , clearBit
- , testBit
-
- -- * Feature operations
- , setFeature
- , setFeatureWithDeps
- , hasFeature
- , isFeatureSet
- , listFeatures
- ) where
-
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
-import Data.Word (Word16)
-import Lightning.Protocol.BOLT9.Features
-import Lightning.Protocol.BOLT9.Types
- ( FeatureLevel(..)
- , FeatureVector
- , bitIndex
- , clear
- , fromByteString
- , member
- , set
- , unFeatureVector
- )
-
--- Parsing and rendering ------------------------------------------------------
-
--- | Parse a ByteString into a FeatureVector.
---
--- Alias for 'fromByteString'.
-parse :: ByteString -> FeatureVector
-parse = fromByteString
-{-# INLINE parse #-}
-
--- | Render a FeatureVector to a ByteString, trimming leading zero bytes
--- for compact encoding.
-render :: FeatureVector -> ByteString
-render = BS.dropWhile (== 0) . unFeatureVector
-{-# INLINE render #-}
-
--- Bit operations -------------------------------------------------------------
-
--- | Set a bit by raw index.
---
--- >>> setBit 17 empty
--- FeatureVector {unFeatureVector = "\STX"}
-setBit :: Word16 -> FeatureVector -> FeatureVector
-setBit !idx = set (bitIndex idx)
-{-# INLINE setBit #-}
-
--- | Clear a bit by raw index.
---
--- >>> clearBit 17 (setBit 17 empty)
--- FeatureVector {unFeatureVector = ""}
-clearBit :: Word16 -> FeatureVector -> FeatureVector
-clearBit !idx = clear (bitIndex idx)
-{-# INLINE clearBit #-}
-
--- | Test if a bit is set.
---
--- >>> testBit 17 (setBit 17 empty)
--- True
--- >>> testBit 16 (setBit 17 empty)
--- False
-testBit :: Word16 -> FeatureVector -> Bool
-testBit !idx = member (bitIndex idx)
-{-# INLINE testBit #-}
-
--- Feature operations ---------------------------------------------------------
-
--- | Set a feature's bit at the given level.
---
--- 'Required' sets the even bit, 'Optional' sets the odd bit. The
--- other bit of the pair is cleared, so both are never set.
---
--- >>> import Data.Maybe (fromJust)
--- >>> let mpp = fromJust (featureByName "basic_mpp")
--- >>> setFeature mpp Optional empty -- set optional bit (17)
--- FeatureVector {unFeatureVector = "\STX"}
--- >>> setFeature mpp Required empty -- set required bit (16)
--- FeatureVector {unFeatureVector = "\SOH"}
-setFeature :: Feature -> FeatureLevel -> FeatureVector -> FeatureVector
-setFeature !f !level = case level of
- Required -> setBit baseBit . clearBit (baseBit + 1)
- Optional -> setBit (baseBit + 1) . clearBit baseBit
- where
- !baseBit = featureBaseBit f
-{-# INLINE setFeature #-}
-
--- | Set a feature and all its transitive dependencies.
---
--- Dependencies that are not yet set are set at the same level as
--- the feature itself; dependencies already set keep their level.
--- Unknown dependencies (not in the known features table) are
--- silently skipped.
---
--- >>> import Data.Maybe (fromJust)
--- >>> let mpp = fromJust (featureByName "basic_mpp")
--- >>> let fv = setFeatureWithDeps mpp Optional empty
--- >>> isFeatureSet mpp fv
--- True
--- >>> let Just ps = featureByName "payment_secret"
--- >>> isFeatureSet ps fv -- dependency auto-set
--- True
-setFeatureWithDeps
- :: Feature -> FeatureLevel -> FeatureVector -> FeatureVector
-setFeatureWithDeps !f !level !fv =
- let !fv' = setFeature f level fv
- in foldr setDep fv' (featureDependencies f)
- where
- setDep !depName !acc = case featureByName depName of
- Nothing -> acc
- Just dep
- | isFeatureSet dep acc ->
- foldr setDep acc (featureDependencies dep)
- | otherwise ->
- setFeatureWithDeps dep level acc
-
--- | Check if a feature is set in the vector.
---
--- Returns:
---
--- * @Just Required@ if the required (even) bit is set
--- * @Just Optional@ if the optional (odd) bit is set (and required is not)
--- * @Nothing@ if neither bit is set
---
--- >>> import Data.Maybe (fromJust)
--- >>> let mpp = fromJust (featureByName "basic_mpp")
--- >>> hasFeature mpp (setFeature mpp Optional empty)
--- Just Optional
--- >>> hasFeature mpp (setFeature mpp Required empty)
--- Just Required
--- >>> hasFeature mpp empty
--- Nothing
-hasFeature :: Feature -> FeatureVector -> Maybe FeatureLevel
-hasFeature !f !fv
- | testBit baseBit fv = Just Required
- | testBit (baseBit + 1) fv = Just Optional
- | otherwise = Nothing
- where
- !baseBit = featureBaseBit f
-{-# INLINE hasFeature #-}
-
--- | Check if either bit of a feature is set in the vector.
---
--- >>> import Data.Maybe (fromJust)
--- >>> let mpp = fromJust (featureByName "basic_mpp")
--- >>> isFeatureSet mpp (setFeature mpp Optional empty)
--- True
--- >>> isFeatureSet mpp empty
--- False
-isFeatureSet :: Feature -> FeatureVector -> Bool
-isFeatureSet !f !fv =
- let !baseBit = featureBaseBit f
- in testBit baseBit fv || testBit (baseBit + 1) fv
-{-# INLINE isFeatureSet #-}
-
--- | List all known features that are set in the vector.
---
--- Returns pairs of (Feature, FeatureLevel) indicating whether each
--- feature is set as required or optional.
---
--- >>> import Data.Maybe (fromJust)
--- >>> let mpp = fromJust (featureByName "basic_mpp")
--- >>> let ps = fromJust (featureByName "payment_secret")
--- >>> let fv = setFeature mpp Optional (setFeature ps Required empty)
--- >>> map (\(f, l) -> (featureName f, l)) (listFeatures fv)
--- [("payment_secret",Required),("basic_mpp",Optional)]
-listFeatures :: FeatureVector -> [(Feature, FeatureLevel)]
-listFeatures !fv = foldr check [] knownFeatures
- where
- check !f !acc = case hasFeature f fv of
- Just level -> (f, level) : acc
- Nothing -> acc
diff --git a/lib/Lightning/Protocol/BOLT9/Features.hs b/lib/Lightning/Protocol/BOLT9/Features.hs
@@ -1,161 +0,0 @@
-{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
-
--- |
--- Module: Lightning.Protocol.BOLT9.Features
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Known feature table for the Lightning Network, per
--- [BOLT #9](https://github.com/lightning/bolts/blob/master/09-features.md).
-
-module Lightning.Protocol.BOLT9.Features (
- -- * Feature
- Feature(..)
-
- -- * Known feature
- , KnownFeature(..)
- , knownFeatureByBit
- , knownFeatureByName
-
- -- * Lookup
- , featureByBit
- , featureByName
-
- -- * Known features table
- , knownFeatures
- ) where
-
-import Control.DeepSeq (NFData)
-import Data.IntMap.Strict (IntMap)
-import qualified Data.IntMap.Strict as IM
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as M
-import Data.Word (Word16)
-import GHC.Generics (Generic)
-import Lightning.Protocol.BOLT9.Types (Context(..))
-
--- | A known feature from the BOLT #9 specification.
-data Feature = Feature {
- featureName :: !String
- -- ^ The canonical name of the feature.
- , featureBaseBit :: {-# UNPACK #-} !Word16
- -- ^ The even (compulsory) bit number; the odd (optional) bit is
- -- @baseBit + 1@.
- , featureContexts :: ![Context]
- -- ^ Contexts in which this feature may be presented.
- , featureDependencies :: ![String]
- -- ^ Names of features this feature depends on.
- , featureAssumed :: !Bool
- -- ^ Whether this feature is assumed to be universally supported.
- }
- deriving (Eq, Show, Generic)
-
-instance NFData Feature
-
--- | A feature that is known to be in the BOLT #9 specification.
---
--- Constructed via 'knownFeatureByBit' or 'knownFeatureByName',
--- which validate that the feature exists in the known table.
-newtype KnownFeature = KnownFeature {
- unKnownFeature :: Feature
- -- ^ Extract the underlying 'Feature'.
- }
- deriving (Eq, Show, Generic)
-
-instance NFData KnownFeature
-
--- | Look up a known feature by bit number.
---
--- Accepts either the even (compulsory) or odd (optional) bit.
---
--- >>> fmap (featureName . unKnownFeature) (knownFeatureByBit 16)
--- Just "basic_mpp"
--- >>> knownFeatureByBit 999
--- Nothing
-knownFeatureByBit :: Word16 -> Maybe KnownFeature
-knownFeatureByBit !bit = fmap KnownFeature (featureByBit bit)
-{-# INLINE knownFeatureByBit #-}
-
--- | Look up a known feature by its canonical name.
---
--- >>> fmap (featureName . unKnownFeature)
--- ... (knownFeatureByName "basic_mpp")
--- Just "basic_mpp"
--- >>> knownFeatureByName "nonexistent"
--- Nothing
-knownFeatureByName :: String -> Maybe KnownFeature
-knownFeatureByName !name =
- fmap KnownFeature (featureByName name)
-{-# INLINE knownFeatureByName #-}
-
--- | The complete table of known features from BOLT #9.
-knownFeatures :: [Feature]
-knownFeatures = [
- Feature "option_data_loss_protect" 0 [] [] True
- , Feature "option_upfront_shutdown_script" 4 [Init, NodeAnn] [] False
- , Feature "gossip_queries" 6 [] [] False
- , Feature "var_onion_optin" 8 [] [] True
- , Feature "gossip_queries_ex" 10 [Init, NodeAnn] [] False
- , Feature "option_static_remotekey" 12 [] [] True
- , Feature "payment_secret" 14 [] [] True
- , Feature "basic_mpp" 16 [Init, NodeAnn, Invoice]
- ["payment_secret"] False
- , Feature "option_support_large_channel" 18 [Init, NodeAnn] [] False
- , Feature "option_anchors" 22 [Init, NodeAnn, ChanType] [] False
- , Feature "option_route_blinding" 24 [Init, NodeAnn, Invoice] [] False
- , Feature "option_shutdown_anysegwit" 26 [Init, NodeAnn] [] False
- , Feature "option_dual_fund" 28 [Init, NodeAnn] [] False
- , Feature "option_quiesce" 34 [Init, NodeAnn] [] False
- , Feature "option_attribution_data" 36 [Init, NodeAnn, Invoice]
- [] False
- , Feature "option_onion_messages" 38 [Init, NodeAnn] [] False
- , Feature "option_provide_storage" 42 [Init, NodeAnn] [] False
- , Feature "option_channel_type" 44 [] [] True
- , Feature "option_scid_alias" 46 [Init, NodeAnn, ChanType] [] False
- , Feature "option_payment_metadata" 48 [Invoice] [] False
- , Feature "option_zeroconf" 50 [Init, NodeAnn, ChanType]
- ["option_scid_alias"] False
- , Feature "option_simple_close" 60 [Init, NodeAnn]
- ["option_shutdown_anysegwit"] False
- ]
-
--- | Look up a feature by bit number.
---
--- Accepts either the even (compulsory) or odd (optional) bit of the pair.
---
--- >>> fmap featureName (featureByBit 16)
--- Just "basic_mpp"
--- >>> fmap featureName (featureByBit 17) -- odd bit also works
--- Just "basic_mpp"
--- >>> featureByBit 999
--- Nothing
-featureByBit :: Word16 -> Maybe Feature
-featureByBit !bit =
- let !baseBit = fromIntegral bit - (fromIntegral bit `mod` 2)
- in IM.lookup baseBit featuresByBit
-{-# INLINE featureByBit #-}
-
--- | Look up a feature by its canonical name.
---
--- >>> fmap featureBaseBit (featureByName "basic_mpp")
--- Just 16
--- >>> featureByName "nonexistent"
--- Nothing
-featureByName :: String -> Maybe Feature
-featureByName !name = M.lookup name featuresByName
-{-# INLINE featureByName #-}
-
--- Lookup tables -------------------------------------------------------------
-
--- | Features indexed by base bit (even bit number).
-featuresByBit :: IntMap Feature
-featuresByBit = IM.fromList
- [(fromIntegral (featureBaseBit f), f) | f <- knownFeatures]
-
--- | Features indexed by canonical name.
-featuresByName :: Map String Feature
-featuresByName = M.fromList
- [(featureName f, f) | f <- knownFeatures]
diff --git a/lib/Lightning/Protocol/BOLT9/Types.hs b/lib/Lightning/Protocol/BOLT9/Types.hs
@@ -1,282 +0,0 @@
-{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
-
--- |
--- Module: Lightning.Protocol.BOLT9.Types
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Baseline types for BOLT #9 feature flags.
-
-module Lightning.Protocol.BOLT9.Types (
- -- * Context
- Context(..)
- , isChannelContext
- , channelParity
-
- -- * Bit indices
- , BitIndex
- , unBitIndex
- , bitIndex
-
- -- * Required/optional level
- , FeatureLevel(..)
-
- -- * Required/optional bits
- , RequiredBit
- , unRequiredBit
- , requiredBit
- , requiredFromBitIndex
-
- , OptionalBit
- , unOptionalBit
- , optionalBit
- , optionalFromBitIndex
-
- -- * Feature vectors
- , FeatureVector
- , unFeatureVector
- , empty
- , fromByteString
- , set
- , clear
- , member
- ) where
-
-import Control.DeepSeq (NFData)
-import qualified Data.Bits as B
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
-import Data.Word (Word8, Word16)
-import GHC.Generics (Generic)
-
--- Context ------------------------------------------------------------------
-
--- | Presentation context for feature flags.
---
--- Per BOLT #9, features are presented in different message contexts:
---
--- * 'Init' - the @init@ message
--- * 'NodeAnn' - @node_announcement@ messages
--- * 'ChanAnn' - @channel_announcement@ messages (normal)
--- * 'ChanAnnOdd' - @channel_announcement@, always odd (optional)
--- * 'ChanAnnEven' - @channel_announcement@, always even (required)
--- * 'Invoice' - BOLT 11 invoices
--- * 'Blinded' - @allowed_features@ field of a blinded path
--- * 'ChanType' - @channel_type@ field when opening channels
-data Context
- = Init -- ^ I: presented in the @init@ message
- | NodeAnn -- ^ N: presented in @node_announcement@ messages
- | ChanAnn -- ^ C: presented in @channel_announcement@ message
- | ChanAnnOdd -- ^ C-: @channel_announcement@, always odd (optional)
- | ChanAnnEven -- ^ C+: @channel_announcement@, always even (required)
- | Invoice -- ^ 9: presented in BOLT 11 invoices
- | Blinded -- ^ B: @allowed_features@ field of a blinded path
- | ChanType -- ^ T: @channel_type@ field when opening channels
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData Context
-
--- | Check if a context is a channel announcement context (C, C-, or C+).
-isChannelContext :: Context -> Bool
-isChannelContext ChanAnn = True
-isChannelContext ChanAnnOdd = True
-isChannelContext ChanAnnEven = True
-isChannelContext _ = False
-{-# INLINE isChannelContext #-}
-
--- | For channel contexts with forced parity, return 'Just' the required
--- parity: 'True' for even (C+), 'False' for odd (C-). Returns 'Nothing'
--- for contexts without forced parity.
-channelParity :: Context -> Maybe Bool
-channelParity ChanAnnOdd = Just False -- odd
-channelParity ChanAnnEven = Just True -- even
-channelParity _ = Nothing
-{-# INLINE channelParity #-}
-
--- FeatureLevel -------------------------------------------------------------
-
--- | Whether a feature is set as required or optional.
---
--- Per BOLT #9, each feature has a pair of bits: the even bit indicates
--- required (compulsory) support, the odd bit indicates optional support.
-data FeatureLevel
- = Required -- ^ The feature is required (even bit set)
- | Optional -- ^ The feature is optional (odd bit set)
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData FeatureLevel
-
--- BitIndex -----------------------------------------------------------------
-
--- | A bit index into a feature vector. Bit 0 is the least significant bit.
---
--- Valid range: 0-65535 (sufficient for any practical feature flag).
-newtype BitIndex = BitIndex { unBitIndex :: Word16 }
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData BitIndex
-
--- | Smart constructor for 'BitIndex'. Always succeeds since all Word16
--- values are valid.
-bitIndex :: Word16 -> BitIndex
-bitIndex = BitIndex
-{-# INLINE bitIndex #-}
-
--- RequiredBit --------------------------------------------------------------
-
--- | A required (compulsory) feature bit. Required bits are always even.
-newtype RequiredBit = RequiredBit { unRequiredBit :: Word16 }
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData RequiredBit
-
--- | Smart constructor for 'RequiredBit'. Returns 'Nothing' if the bit
--- index is odd.
---
--- >>> requiredBit 16
--- Just (RequiredBit {unRequiredBit = 16})
--- >>> requiredBit 17
--- Nothing
-requiredBit :: Word16 -> Maybe RequiredBit
-requiredBit !w
- | w B..&. 1 == 0 = Just (RequiredBit w)
- | otherwise = Nothing
-{-# INLINE requiredBit #-}
-
--- | Convert a 'BitIndex' to a 'RequiredBit'. Returns 'Nothing' if odd.
-requiredFromBitIndex :: BitIndex -> Maybe RequiredBit
-requiredFromBitIndex (BitIndex w) = requiredBit w
-{-# INLINE requiredFromBitIndex #-}
-
--- OptionalBit --------------------------------------------------------------
-
--- | An optional feature bit. Optional bits are always odd.
-newtype OptionalBit = OptionalBit { unOptionalBit :: Word16 }
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData OptionalBit
-
--- | Smart constructor for 'OptionalBit'. Returns 'Nothing' if the bit
--- index is even.
---
--- >>> optionalBit 17
--- Just (OptionalBit {unOptionalBit = 17})
--- >>> optionalBit 16
--- Nothing
-optionalBit :: Word16 -> Maybe OptionalBit
-optionalBit !w
- | w B..&. 1 == 1 = Just (OptionalBit w)
- | otherwise = Nothing
-{-# INLINE optionalBit #-}
-
--- | Convert a 'BitIndex' to an 'OptionalBit'. Returns 'Nothing' if even.
-optionalFromBitIndex :: BitIndex -> Maybe OptionalBit
-optionalFromBitIndex (BitIndex w) = optionalBit w
-{-# INLINE optionalFromBitIndex #-}
-
--- FeatureVector ------------------------------------------------------------
-
--- | A feature vector represented as a strict ByteString.
---
--- The vector is stored in big-endian byte order (most significant byte
--- first), with bits numbered from the least significant bit of the last
--- byte. Bit 0 is at position 0 of the last byte.
-newtype FeatureVector = FeatureVector { unFeatureVector :: ByteString }
- deriving (Eq, Ord, Show, Generic)
-
-instance NFData FeatureVector
-
--- | The empty feature vector (no features set).
---
--- >>> empty
--- FeatureVector {unFeatureVector = ""}
-empty :: FeatureVector
-empty = FeatureVector BS.empty
-{-# INLINE empty #-}
-
--- | Wrap a ByteString as a FeatureVector.
-fromByteString :: ByteString -> FeatureVector
-fromByteString = FeatureVector
-{-# INLINE fromByteString #-}
-
--- | Set a bit in the feature vector.
---
--- >>> set (bitIndex 0) empty
--- FeatureVector {unFeatureVector = "\SOH"}
--- >>> set (bitIndex 8) empty
--- FeatureVector {unFeatureVector = "\SOH\NUL"}
-set :: BitIndex -> FeatureVector -> FeatureVector
-set (BitIndex idx) (FeatureVector bs) =
- let byteIdx = fromIntegral idx `div` 8
- bitOffset = fromIntegral idx `mod` 8
- len = BS.length bs
- -- Number of bytes needed to hold this bit
- needed = byteIdx + 1
- -- Pad with zeros if necessary (prepend to maintain big-endian)
- bs' = if needed > len
- then BS.replicate (needed - len) 0 <> bs
- else bs
- len' = BS.length bs'
- -- Index from the end (big-endian: last byte has lowest bits)
- realIdx = len' - 1 - byteIdx
- oldByte = BS.index bs' realIdx
- newByte = oldByte B..|. B.shiftL 1 bitOffset
- in FeatureVector (updateByteAt realIdx newByte bs')
-{-# INLINE set #-}
-
--- | Clear a bit in the feature vector.
-clear :: BitIndex -> FeatureVector -> FeatureVector
-clear (BitIndex idx) (FeatureVector bs)
- | BS.null bs = FeatureVector bs
- | otherwise =
- let byteIdx = fromIntegral idx `div` 8
- bitOffset = fromIntegral idx `mod` 8
- len = BS.length bs
- in if byteIdx >= len
- then FeatureVector bs -- bit not in range, already clear
- else
- let realIdx = len - 1 - byteIdx
- oldByte = BS.index bs realIdx
- newByte = oldByte B..&. B.complement (B.shiftL 1 bitOffset)
- in FeatureVector (stripLeadingZeros (updateByteAt realIdx newByte bs))
-{-# INLINE clear #-}
-
--- | Test if a bit is set in the feature vector.
---
--- >>> member (bitIndex 0) (set (bitIndex 0) empty)
--- True
--- >>> member (bitIndex 1) (set (bitIndex 0) empty)
--- False
-member :: BitIndex -> FeatureVector -> Bool
-member (BitIndex idx) (FeatureVector bs)
- | BS.null bs = False
- | otherwise =
- let byteIdx = fromIntegral idx `div` 8
- bitOffset = fromIntegral idx `mod` 8
- len = BS.length bs
- in if byteIdx >= len
- then False
- else
- let realIdx = len - 1 - byteIdx
- byte = BS.index bs realIdx
- in byte B..&. B.shiftL 1 bitOffset /= 0
-{-# INLINE member #-}
-
--- Internal helpers ---------------------------------------------------------
-
--- | Update a single byte at the given index.
-updateByteAt :: Int -> Word8 -> ByteString -> ByteString
-updateByteAt !i !w !bs =
- let (before, after) = BS.splitAt i bs
- in case BS.uncons after of
- Nothing -> bs -- shouldn't happen if i is valid
- Just (_, rest) -> before <> BS.singleton w <> rest
-{-# INLINE updateByteAt #-}
-
--- | Remove leading zero bytes from a ByteString.
-stripLeadingZeros :: ByteString -> ByteString
-stripLeadingZeros = BS.dropWhile (== 0)
-{-# INLINE stripLeadingZeros #-}
diff --git a/lib/Lightning/Protocol/BOLT9/Validate.hs b/lib/Lightning/Protocol/BOLT9/Validate.hs
@@ -1,308 +0,0 @@
-{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
-
--- |
--- Module: Lightning.Protocol.BOLT9.Validate
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Validation for BOLT #9 feature vectors.
-
-module Lightning.Protocol.BOLT9.Validate (
- -- * Error types
- ValidationError(..)
-
- -- * Local validation
- , validateLocal
-
- -- * Remote validation
- , validateRemote
-
- -- * Validated construction
- , setFeatureForContext
- , validateNoBothBits
-
- -- * Helpers
- , highestSetBit
- , setBits
- ) where
-
-import Control.DeepSeq (NFData)
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as BS
-import qualified Data.Bits as B
-import Data.Word (Word16)
-import GHC.Generics (Generic)
-import Lightning.Protocol.BOLT9.Codec
- (isFeatureSet, setFeature, testBit)
-import Lightning.Protocol.BOLT9.Features
-import Lightning.Protocol.BOLT9.Types
-
--- | Validation errors for feature vectors.
-data ValidationError
- = BothBitsSet {-# UNPACK #-} !Word16 !String
- -- ^ Both optional and required bits are set for a feature.
- -- Arguments: base bit index, feature name.
- | MissingDependency !String !String
- -- ^ A feature's dependency is not set.
- -- Arguments: feature name, missing dependency name.
- | ContextNotAllowed !String !Context
- -- ^ A feature is not allowed in the given context.
- -- Arguments: feature name, context.
- | UnknownRequiredBit {-# UNPACK #-} !Int
- -- ^ An unknown required (even) bit is set (remote validation only).
- -- Argument: bit index.
- | InvalidParity {-# UNPACK #-} !Int !Context
- -- ^ A bit has invalid parity for a channel context.
- -- Arguments: bit index, context (ChanAnnOdd or ChanAnnEven).
- deriving (Eq, Show, Generic)
-
-instance NFData ValidationError
-
--- Local validation -----------------------------------------------------------
-
--- | Validate a feature vector for local use (vectors we create/send).
---
--- Checks:
---
--- * No feature has both optional and required bits set
--- * All set features are valid for the given context
--- * All dependencies of set features are also set
--- * C- context forces odd bits only, C+ forces even bits only
---
--- >>> import Data.Maybe (fromJust)
--- >>> import Lightning.Protocol.BOLT9.Codec (setFeature)
--- >>> let mpp = fromJust (featureByName "basic_mpp")
--- >>> let ps = fromJust (featureByName "payment_secret")
--- >>> validateLocal Init (setFeature mpp False empty)
--- Left [MissingDependency "basic_mpp" "payment_secret"]
--- >>> validateLocal Init (setFeature mpp False (setFeature ps False empty))
--- Right ()
-validateLocal :: Context -> FeatureVector -> Either [ValidationError] ()
-validateLocal !ctx !fv =
- let errs = bothBitsErrors fv
- ++ contextErrors ctx fv
- ++ dependencyErrors fv
- ++ parityErrors ctx fv
- in if null errs
- then Right ()
- else Left errs
-
--- | Check for features with both bits set.
-bothBitsErrors :: FeatureVector -> [ValidationError]
-bothBitsErrors !fv = foldr check [] knownFeatures
- where
- check !f !acc =
- let !baseBit = featureBaseBit f
- in if testBit baseBit fv && testBit (baseBit + 1) fv
- then BothBitsSet baseBit (featureName f) : acc
- else acc
-
--- | Check for features not allowed in the given context.
-contextErrors :: Context -> FeatureVector -> [ValidationError]
-contextErrors !ctx !fv = foldr check [] knownFeatures
- where
- check !f !acc =
- let !contexts = featureContexts f
- in if isFeatureSet f fv
- && not (null contexts)
- && not (contextAllowed ctx contexts)
- then ContextNotAllowed (featureName f) ctx : acc
- else acc
-
--- | Check if a context is allowed given a list of allowed contexts.
-contextAllowed :: Context -> [Context] -> Bool
-contextAllowed !ctx !allowed = ctx `elem` allowed || channelMatch
- where
- channelMatch = isChannelContext ctx && any isChannelContext allowed
-
--- | Check for missing dependencies.
-dependencyErrors :: FeatureVector -> [ValidationError]
-dependencyErrors !fv = foldr check [] knownFeatures
- where
- check !f !acc =
- if isFeatureSet f fv
- then checkDeps f (featureDependencies f) ++ acc
- else acc
-
- checkDeps !f = foldr (checkOneDep f) []
-
- checkOneDep !f !depName !acc =
- case featureByName depName of
- Nothing -> acc -- unknown dep, skip
- Just !dep ->
- if isFeatureSet dep fv
- then acc
- else MissingDependency (featureName f) depName : acc
-
--- | Check for parity errors in C- and C+ contexts.
-parityErrors :: Context -> FeatureVector -> [ValidationError]
-parityErrors !ctx !fv = case channelParity ctx of
- Nothing -> []
- Just wantEven -> foldr (checkParity wantEven) [] (setBits fv)
- where
- checkParity !wantEven !bit !acc =
- let isEven = bit `mod` 2 == 0
- in if isEven /= wantEven
- then InvalidParity bit ctx : acc
- else acc
-
--- Validated construction -------------------------------------------------------
-
--- | Set a feature in a vector, validating that the feature is
--- allowed in the given context and has correct parity.
---
--- Checks:
---
--- * The feature's context list includes the given context
--- (or is empty, meaning all contexts are allowed)
--- * For 'ChanAnnOdd', only 'Optional' (odd bit) is allowed
--- * For 'ChanAnnEven', only 'Required' (even bit) is allowed
---
--- >>> import Data.Maybe (fromJust)
--- >>> let pm = fromJust (featureByName "option_payment_metadata")
--- >>> setFeatureForContext Invoice pm Optional empty
--- Right ...
--- >>> setFeatureForContext Init pm Optional empty
--- Left (ContextNotAllowed "option_payment_metadata" Init)
-setFeatureForContext
- :: Context
- -> Feature
- -> FeatureLevel
- -> FeatureVector
- -> Either ValidationError FeatureVector
-setFeatureForContext !ctx !f !level !fv
- | not (null contexts)
- , not (contextAllowed ctx contexts)
- = Left (ContextNotAllowed (featureName f) ctx)
- | otherwise
- = case channelParity ctx of
- Just True | level == Optional ->
- Left (InvalidParity (fromIntegral targetBit) ctx)
- Just False | level == Required ->
- Left (InvalidParity (fromIntegral targetBit) ctx)
- _ -> Right (setFeature f level fv)
- where
- !contexts = featureContexts f
- !baseBit = featureBaseBit f
- !targetBit = case level of
- Required -> baseBit
- Optional -> baseBit + 1
-
--- | Validate that no feature has both its required and optional
--- bits set simultaneously.
---
--- Returns the input vector unchanged on success.
---
--- >>> validateNoBothBits empty
--- Right ...
-validateNoBothBits
- :: FeatureVector -> Either ValidationError FeatureVector
-validateNoBothBits !fv = go knownFeatures
- where
- go [] = Right fv
- go (f:fs) =
- let !baseBit = featureBaseBit f
- in if testBit baseBit fv
- && testBit (baseBit + 1) fv
- then Left (BothBitsSet baseBit (featureName f))
- else go fs
-
--- Remote validation ----------------------------------------------------------
-
--- | Validate a feature vector received from a remote peer.
---
--- Checks:
---
--- * Unknown odd (optional) bits are acceptable (ignored)
--- * Unknown even (required) bits are errors
--- * If both bits of a pair are set, treat as required (not an error)
--- * Context restrictions still apply for known features
--- * All dependencies of set features are also set
---
--- >>> import Lightning.Protocol.BOLT9.Codec (setBit)
--- >>> validateRemote Init (setBit 999 empty) -- unknown odd bit: ok
--- Right ()
--- >>> validateRemote Init (setBit 998 empty) -- unknown even bit: error
--- Left [UnknownRequiredBit 998]
-validateRemote :: Context -> FeatureVector -> Either [ValidationError] ()
-validateRemote !ctx !fv =
- let errs = unknownRequiredErrors fv
- ++ contextErrors ctx fv
- ++ dependencyErrors fv
- ++ parityErrors ctx fv
- in if null errs
- then Right ()
- else Left errs
-
--- | Check for unknown required bits.
-unknownRequiredErrors :: FeatureVector -> [ValidationError]
-unknownRequiredErrors !fv = foldr check [] (setBits fv)
- where
- check !bit !acc
- | bit `mod` 2 == 1 = acc -- odd bit, optional, ignore
- | bit > fromIntegral (maxBound :: Word16) =
- UnknownRequiredBit bit : acc
- | otherwise = case featureByBit (fromIntegral bit) of
- Just _ -> acc -- known feature
- Nothing -> UnknownRequiredBit bit : acc
-
--- Helpers --------------------------------------------------------------------
-
--- | Find the highest set bit in a feature vector.
---
--- Returns 'Nothing' if the vector is empty or has no bits set.
-highestSetBit :: FeatureVector -> Maybe Int
-highestSetBit !fv =
- let !bs = unFeatureVector fv
- in if BS.null bs
- then Nothing
- else findHighestBit bs
-
--- | Find the highest set bit in a non-empty ByteString.
-findHighestBit :: ByteString -> Maybe Int
-findHighestBit !bs = go 0
- where
- !len = BS.length bs
-
- go !i
- | i >= len = Nothing
- | otherwise =
- let !byte = BS.index bs i
- in if byte == 0
- then go (i + 1)
- else
- let !bytePos = len - 1 - i
- !highBit = 7 - B.countLeadingZeros byte
- !bitIdx = bytePos * 8 + highBit
- in Just bitIdx
-
--- | Collect all set bits in a feature vector.
---
--- Returns a list of bit indices in ascending order.
-setBits :: FeatureVector -> [Int]
-setBits !fv =
- let !bs = unFeatureVector fv
- !len = BS.length bs
- in collectBits bs len 0 []
-
--- | Collect bits from a ByteString into a list.
-collectBits :: ByteString -> Int -> Int -> [Int] -> [Int]
-collectBits !bs !len !i !acc
- | i >= len = acc
- | otherwise =
- let !byte = BS.index bs (len - 1 - i)
- !baseIdx = i * 8
- !acc' = collectByteBits byte baseIdx acc
- in collectBits bs len (i + 1) acc'
-
--- | Collect set bits from a single byte.
-collectByteBits :: B.Bits a => a -> Int -> [Int] -> [Int]
-collectByteBits !byte !baseIdx = go 7
- where
- go !bit !acc
- | bit < 0 = acc
- | B.testBit byte bit = go (bit - 1) ((baseIdx + bit) : acc)
- | otherwise = go (bit - 1) acc
diff --git a/ppad-bolt9.cabal b/ppad-bolt9.cabal
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: ppad-bolt9
-version: 0.0.1
+version: 0.1.0
synopsis: Feature flags per BOLT #9
license: MIT
license-file: LICENSE
@@ -8,11 +8,15 @@ 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:
- Feature flags, per
+ Lightning Network feature flags, per
[BOLT #9](https://github.com/lightning/bolts/blob/master/09-features.md).
+ Provides an abstract feature vector type that preserves its wire
+ bytes, the table of known features with their contexts and
+ dependencies, sender- and receiver-side validation for each context,
+ and BOLT #2 channel types.
source-repository head
type: git
@@ -25,14 +29,9 @@ library
-Wall
exposed-modules:
Lightning.Protocol.BOLT9
- Lightning.Protocol.BOLT9.Codec
- Lightning.Protocol.BOLT9.Features
- Lightning.Protocol.BOLT9.Types
- Lightning.Protocol.BOLT9.Validate
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
- , containers >= 0.6 && < 0.9
, deepseq >= 1.4 && < 1.6
test-suite bolt9-tests
@@ -42,7 +41,7 @@ test-suite bolt9-tests
main-is: Main.hs
ghc-options:
- -rtsopts -Wall -O2
+ -rtsopts -Wall
build-depends:
base
@@ -60,7 +59,7 @@ benchmark bolt9-bench
other-modules: Fixtures
ghc-options:
- -rtsopts -O2 -Wall -fno-warn-orphans
+ -rtsopts -O2 -Wall
build-depends:
base
@@ -77,7 +76,7 @@ benchmark bolt9-weigh
other-modules: Fixtures
ghc-options:
- -rtsopts -O2 -Wall -fno-warn-orphans
+ -rtsopts -O2 -Wall
build-depends:
base
diff --git a/test/Main.hs b/test/Main.hs
@@ -1,638 +1,564 @@
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
module Main where
+import qualified Data.Bits as B
+import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
-import Data.Either (isLeft, isRight)
-import Data.Maybe (isJust, isNothing)
-import Data.Word (Word8, Word16)
+import Data.List (elemIndex, subsequences)
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Word (Word8)
import Lightning.Protocol.BOLT9
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
main :: IO ()
-main = defaultMain tests
-
-tests :: TestTree
-tests = testGroup "ppad-bolt9" [
- featureTableTests
- , bitParityTests
- , featureVectorTests
- , validationTests
- , knownFeatureTests
- , setFeatureWithDepsTests
- , setFeatureForContextTests
- , validateNoBothBitsTests
- , remoteDependencyTests
- , longVectorTests
- , oppositeBitTests
- , propertyTests
+main = defaultMain $ testGroup "ppad-bolt9" [
+ table_tests
+ , vector_tests
+ , feature_tests
+ , local_tests
+ , remote_tests
+ , invoice_tests
+ , blinded_tests
+ , channel_type_tests
+ , properties
]
--- Feature table tests ---------------------------------------------------------
-
-featureTableTests :: TestTree
-featureTableTests = testGroup "Feature table" [
- testCase "all features have even baseBit" $
- all (even . featureBaseBit) knownFeatures @?= True
-
- , testCase "featureByBit works for even bit" $
- case featureByBit 14 of
- Nothing -> assertFailure "expected to find payment_secret"
- Just f -> featureName f @?= "payment_secret"
-
- , testCase "featureByBit works for odd bit" $
- case featureByBit 15 of
- Nothing -> assertFailure "expected to find payment_secret"
- Just f -> featureName f @?= "payment_secret"
-
- , testCase "featureByBit returns Nothing for unknown bit" $
- featureByBit 100 @?= Nothing
-
- , testCase "featureByName finds known features" $ do
- isJust (featureByName "var_onion_optin") @?= True
- isJust (featureByName "payment_secret") @?= True
- isJust (featureByName "basic_mpp") @?= True
-
- , testCase "featureByName returns Nothing for unknown names" $
- featureByName "nonexistent_feature" @?= Nothing
-
- , testCase "assumed features are present" $ do
- let assumedNames = [ "option_data_loss_protect"
- , "var_onion_optin"
- , "option_static_remotekey"
- , "payment_secret"
- , "option_channel_type"
- ]
- mapM_ (\n -> isJust (featureByName n) @?
- ("assumed feature missing: " ++ n)) assumedNames
-
- , testCase "assumed features are marked as assumed" $ do
- let checkAssumed n = case featureByName n of
- Nothing -> assertFailure $ "feature not found: " ++ n
- Just f -> featureAssumed f @?= True
- mapM_ checkAssumed [ "option_data_loss_protect"
- , "var_onion_optin"
- , "option_static_remotekey"
- , "payment_secret"
- , "option_channel_type"
- ]
+-- feature table -------------------------------------------------------------
+
+-- | The BOLT #9 table at lightning/bolts@1aadb719: bits, name, whether
+-- it is ASSUMED, the Context column, and the dependency names.
+spec_table :: [(Int, String, Bool, String, [String])]
+spec_table = [
+ (0, "option_data_loss_protect", True, "", [])
+ , (4, "option_upfront_shutdown_script", False, "IN", [])
+ , (6, "gossip_queries", False, "", [])
+ , (8, "var_onion_optin", True, "", [])
+ , (10, "gossip_queries_ex", False, "IN", [])
+ , (12, "option_static_remotekey", True, "", [])
+ , (14, "payment_secret", True, "", [])
+ , (16, "basic_mpp", False, "IN9", ["payment_secret"])
+ , (18, "option_support_large_channel", False, "IN", [])
+ , (22, "option_anchors", False, "INT", [])
+ , (24, "option_route_blinding", False, "IN9", [])
+ , (26, "option_shutdown_anysegwit", False, "IN", [])
+ , (28, "option_dual_fund", False, "IN", [])
+ , (34, "option_quiesce", False, "IN", [])
+ , (36, "option_attribution_data", False, "IN9", [])
+ , (38, "option_onion_messages", False, "IN", [])
+ , (40, "zero_fee_commitments", False, "IN", ["option_channel_type"])
+ , (42, "option_provide_storage", False, "IN", [])
+ , (44, "option_channel_type", True, "", [])
+ , (46, "option_scid_alias", False, "INT", [])
+ , (48, "option_payment_metadata", False, "9", [])
+ , (50, "option_zeroconf", False, "INT", ["option_scid_alias"])
+ , (60, "option_simple_close", False, "IN"
+ , ["option_shutdown_anysegwit"])
+ , (62, "option_splice", False, "IN", [])
+ , (66, "option_onion_messages_only_channels", False, "IN"
+ , ["option_onion_messages"])
]
--- Bit parity tests ------------------------------------------------------------
-
-bitParityTests :: TestTree
-bitParityTests = testGroup "Bit parity" [
- testCase "requiredBit accepts even numbers" $ do
- isJust (requiredBit 0) @?= True
- isJust (requiredBit 2) @?= True
- isJust (requiredBit 100) @?= True
-
- , testCase "requiredBit rejects odd numbers" $ do
- isNothing (requiredBit 1) @?= True
- isNothing (requiredBit 3) @?= True
- isNothing (requiredBit 101) @?= True
-
- , testCase "optionalBit accepts odd numbers" $ do
- isJust (optionalBit 1) @?= True
- isJust (optionalBit 3) @?= True
- isJust (optionalBit 101) @?= True
-
- , testCase "optionalBit rejects even numbers" $ do
- isNothing (optionalBit 0) @?= True
- isNothing (optionalBit 2) @?= True
- isNothing (optionalBit 100) @?= True
-
- , testCase "requiredBit smart constructor preserves value" $
- case requiredBit 42 of
- Nothing -> assertFailure "expected Just"
- Just rb -> unRequiredBit rb @?= 42
-
- , testCase "optionalBit smart constructor preserves value" $
- case optionalBit 43 of
- Nothing -> assertFailure "expected Just"
- Just ob -> unOptionalBit ob @?= 43
+table_row :: Feature -> (Int, String, Bool, String, [String])
+table_row f =
+ ( feature_bit f
+ , feature_name f
+ , feature_assumed f
+ , concatMap letter (feature_contexts f)
+ , fmap feature_name (feature_dependencies f) )
+ where
+ letter c = case c of
+ InitContext -> "I"
+ NodeContext -> "N"
+ ChannelContext -> "C"
+ InvoiceContext -> "9"
+ BlindedContext -> "B"
+ ChannelTypeContext -> "T"
+
+table_tests :: TestTree
+table_tests = testGroup "feature table" [
+ testCase "matches the spec table" $
+ fmap table_row known_features @?= spec_table
+
+ , testCase "feature_by_bit maps both bits to the feature" $
+ mapM_ (\f -> do
+ feature_by_bit (feature_bit f) @?= Just f
+ feature_by_bit (feature_bit f + 1) @?= Just f)
+ known_features
+
+ , testCase "feature_by_bit rejects unassigned bits" $ do
+ let assigned = concatMap (\f -> [feature_bit f, feature_bit f + 1])
+ known_features
+ free = filter (`notElem` assigned) [0 .. 600]
+ mapM_ (\i -> feature_by_bit i @?= Nothing) free
+ feature_by_bit (-1) @?= Nothing
+ feature_by_bit (-2) @?= Nothing
]
--- FeatureVector tests ---------------------------------------------------------
-
-featureVectorTests :: TestTree
-featureVectorTests = testGroup "FeatureVector" [
- testCase "empty has no bits set" $ do
- unFeatureVector empty @?= BS.empty
- member (bitIndex 0) empty @?= False
- member (bitIndex 100) empty @?= False
-
- , testCase "set adds a bit" $ do
- let fv = set (bitIndex 0) empty
- member (bitIndex 0) fv @?= True
-
- , testCase "set multiple bits" $ do
- let fv = set (bitIndex 8) (set (bitIndex 0) empty)
- member (bitIndex 0) fv @?= True
- member (bitIndex 8) fv @?= True
- member (bitIndex 1) fv @?= False
-
- , testCase "clear removes a bit" $ do
- let fv = set (bitIndex 5) empty
- fv' = clear (bitIndex 5) fv
- member (bitIndex 5) fv @?= True
- member (bitIndex 5) fv' @?= False
-
- , testCase "clear on unset bit is no-op" $ do
- let fv = clear (bitIndex 10) empty
- unFeatureVector fv @?= BS.empty
-
- , testCase "member returns False for unset bits" $ do
- let fv = set (bitIndex 4) empty
- member (bitIndex 0) fv @?= False
- member (bitIndex 1) fv @?= False
- member (bitIndex 5) fv @?= False
-
- , testCase "render strips leading zeros" $ do
- let fv = set (bitIndex 0) empty
- render fv @?= BS.pack [0x01]
-
- , testCase "render handles high bits correctly" $ do
- let fv = set (bitIndex 15) empty
- render fv @?= BS.pack [0x80, 0x00]
-
- , testCase "render of empty is empty" $
- render empty @?= BS.empty
- ]
+-- feature vectors -----------------------------------------------------------
--- Validation tests ------------------------------------------------------------
-
-validationTests :: TestTree
-validationTests = testGroup "Validation" [
- testCase "BothBitsSet error when both bits of a pair are set" $ do
- let baseBit = 14 -- payment_secret
- fv = setBit (baseBit + 1) (setBit baseBit empty)
- case validateLocal Init fv of
- Right () -> assertFailure "expected BothBitsSet error"
- Left errs -> any isBothBitsSet errs @?= True
-
- , testCase "MissingDependency error when dep not set" $ do
- -- basic_mpp (16) depends on payment_secret (14)
- case featureByName "basic_mpp" of
- Nothing -> assertFailure "basic_mpp not found"
- Just f -> do
- let fv = setBit (featureBaseBit f) empty
- case validateLocal Init fv of
- Right () -> assertFailure "expected MissingDependency error"
- Left errs -> any isMissingDependency errs @?= True
-
- , testCase "ContextNotAllowed error for wrong context" $ do
- -- option_payment_metadata (48) is only allowed in Invoice context
- case featureByName "option_payment_metadata" of
- Nothing -> assertFailure "option_payment_metadata not found"
- Just f -> do
- let fv = setBit (featureBaseBit f) empty
- case validateLocal Init fv of
- Right () -> assertFailure "expected ContextNotAllowed error"
- Left errs -> any isContextNotAllowed errs @?= True
-
- , testCase "Remote validation accepts unknown optional bits" $ do
- -- bit 201 is unknown and odd (optional)
- let fv = setBit 201 empty
- validateRemote Init fv @?= Right ()
-
- , testCase "Remote validation rejects unknown required bits" $ do
- -- bit 200 is unknown and even (required)
- let fv = setBit 200 empty
- case validateRemote Init fv of
- Right () -> assertFailure "expected UnknownRequiredBit error"
- Left errs -> any isUnknownRequiredBit errs @?= True
-
- , testCase "Valid local vector passes validation" $ do
- -- payment_secret (14) with its required bit set
- case featureByName "payment_secret" of
- Nothing -> assertFailure "payment_secret not found"
- Just f -> do
- let fv = setBit (featureBaseBit f) empty
- validateLocal Init fv @?= Right ()
-
- , testCase "Valid feature with dependency passes" $ do
- -- basic_mpp (16) with payment_secret (14) dependency set
- case (featureByName "basic_mpp", featureByName "payment_secret") of
- (Just mpp, Just ps) -> do
- let fv = setBit (featureBaseBit mpp)
- $ setBit (featureBaseBit ps) empty
- validateLocal Init fv @?= Right ()
- _ -> assertFailure "features not found"
+-- | A vector of (n + 1) bytes whose most significant byte is b.
+long_vector :: Int -> Word8 -> FeatureVector
+long_vector n b = parse (BS.cons b (BS.replicate n 0))
+
+vector_tests :: TestTree
+vector_tests = testGroup "feature vectors" [
+ testCase "empty" $ do
+ render empty @?= ""
+ set_bits empty @?= []
+
+ , testCase "render returns parsed bytes exactly" $ do
+ render (parse "\NUL\NUL\STX") @?= "\NUL\NUL\STX"
+ render (parse "\NUL") @?= "\NUL"
+
+ , testCase "equality ignores leading zero bytes" $ do
+ parse "\NUL\STX" @?= parse "\STX"
+ parse "\NUL\NUL" @?= empty
+ assertBool "distinct" (parse "\STX" /= parse "\SOH")
+ assertBool "distinct" (parse "\SOH\NUL" /= parse "\SOH")
+
+ , testCase "show" $
+ show (parse "\NUL\STX") @?= "parse \"\\NUL\\STX\""
+
+ , testCase "bit numbering" $ do
+ render (set_bit 0 empty) @?= "\SOH"
+ render (set_bit 7 empty) @?= "\128"
+ render (set_bit 8 empty) @?= "\SOH\NUL"
+ render (set_bit 17 empty) @?= "\STX\NUL\NUL"
+ set_bits (parse "\128\NUL\SOH") @?= [0, 23]
+
+ , testCase "operations encode minimally" $ do
+ render (set_bit 1 (parse "\NUL\NUL\SOH")) @?= "\ETX"
+ render (clear_bit 0 (parse "\NUL\SOH\SOH")) @?= "\SOH\NUL"
+ render (clear_bit 8 (parse "\SOH\SOH")) @?= "\SOH"
+ render (union (parse "\NUL\NUL") empty) @?= ""
+
+ , testCase "union" $ do
+ union (parse "\SOH\NUL") (parse "\STX") @?= parse "\SOH\STX"
+ union (parse "\STX") empty @?= parse "\STX"
+ set_bits (union (parse "\SOH\SOH") (parse "\128\SOH")) @?= [0, 8, 15]
+
+ , testCase "negative indices are ignored" $ do
+ set_bit (-1) (parse "\STX") @?= parse "\STX"
+ clear_bit (-1) (parse "\STX") @?= parse "\STX"
+ test_bit (-1) (parse "\255") @?= False
+
+ , testCase "clearing a bit beyond the vector is a no-op" $
+ render (clear_bit 1000 (parse "\STX")) @?= "\STX"
+
+ , testCase "bit 65536 does not wrap" $ do
+ let fv = long_vector 8192 0x01
+ set_bits fv @?= [65536]
+ test_bit 65536 fv @?= True
+ test_bit 0 fv @?= False
+
+ , testCase "bits of a maximum-length vector" $ do
+ let fv = long_vector 65534 0x80
+ BS.length (render fv) @?= 65535
+ set_bits fv @?= [524279]
+ set_bit 524279 empty @?= fv
+ clear_bit 524279 fv @?= empty
]
-isBothBitsSet :: ValidationError -> Bool
-isBothBitsSet (BothBitsSet _ _) = True
-isBothBitsSet _ = False
-
-isMissingDependency :: ValidationError -> Bool
-isMissingDependency (MissingDependency _ _) = True
-isMissingDependency _ = False
-
-isContextNotAllowed :: ValidationError -> Bool
-isContextNotAllowed (ContextNotAllowed _ _) = True
-isContextNotAllowed _ = False
-
-isUnknownRequiredBit :: ValidationError -> Bool
-isUnknownRequiredBit (UnknownRequiredBit _) = True
-isUnknownRequiredBit _ = False
-
--- KnownFeature tests -----------------------------------------------------------
-
-knownFeatureTests :: TestTree
-knownFeatureTests = testGroup "KnownFeature" [
- testCase "knownFeatureByBit finds known feature" $
- case knownFeatureByBit 16 of
- Nothing -> assertFailure "expected basic_mpp"
- Just kf ->
- featureName (unKnownFeature kf) @?= "basic_mpp"
-
- , testCase "knownFeatureByBit works for odd bit" $
- case knownFeatureByBit 17 of
- Nothing -> assertFailure "expected basic_mpp"
- Just kf ->
- featureName (unKnownFeature kf) @?= "basic_mpp"
-
- , testCase "knownFeatureByBit returns Nothing for unknown" $
- knownFeatureByBit 999 @?= Nothing
-
- , testCase "knownFeatureByName finds known feature" $
- case knownFeatureByName "payment_secret" of
- Nothing -> assertFailure "expected payment_secret"
- Just kf ->
- featureBaseBit (unKnownFeature kf) @?= 14
-
- , testCase "knownFeatureByName returns Nothing for unknown" $
- knownFeatureByName "nonexistent" @?= Nothing
+-- feature operations --------------------------------------------------------
+
+feature_tests :: TestTree
+feature_tests = testGroup "feature operations" [
+ testCase "set_feature sets the bit for its level" $ do
+ set_bits (set_feature BasicMpp Required empty) @?= [16]
+ set_bits (set_feature BasicMpp Optional empty) @?= [17]
+
+ , testCase "set_feature clears the other bit" $ do
+ set_bits (set_feature PaymentSecret Optional (set_bit 14 empty))
+ @?= [15]
+ set_bits (set_feature PaymentSecret Required (set_bit 15 empty))
+ @?= [14]
+
+ , testCase "set_feature leaves other features alone" $
+ set_bits (set_feature BasicMpp Optional (parse "\STX\NUL"))
+ @?= [9, 17]
+
+ , testCase "clear_feature clears both bits" $ do
+ clear_feature BasicMpp (set_bit 16 (set_bit 17 empty)) @?= empty
+ clear_feature BasicMpp (set_bit 9 (set_bit 17 empty))
+ @?= set_bit 9 empty
+
+ , testCase "test_feature" $ do
+ test_feature BasicMpp (set_bit 16 empty) @?= Just Required
+ test_feature BasicMpp (set_bit 17 empty) @?= Just Optional
+ test_feature BasicMpp (set_bit 16 (set_bit 17 empty))
+ @?= Just Required
+ test_feature BasicMpp (set_bit 18 empty) @?= Nothing
+
+ , testCase "list_features is in bit order and skips unknown bits" $
+ list_features (set_bit 100 (set_bit 51 (set_bit 46 (set_bit 15 empty))))
+ @?= [ (PaymentSecret, Optional), (OptionScidAlias, Required)
+ , (OptionZeroconf, Optional) ]
+
+ , testCase "set_feature_with_deps sets dependencies" $ do
+ list_features (set_feature_with_deps OptionZeroconf Required empty)
+ @?= [(OptionScidAlias, Required), (OptionZeroconf, Required)]
+ list_features (set_feature_with_deps ZeroFeeCommitments Optional empty)
+ @?= [(ZeroFeeCommitments, Optional), (OptionChannelType, Optional)]
+
+ , testCase "set_feature_with_deps keeps a set dependency's level" $
+ list_features
+ (set_feature_with_deps OptionSimpleClose Optional
+ (set_feature OptionShutdownAnysegwit Required empty))
+ @?= [ (OptionShutdownAnysegwit, Required)
+ , (OptionSimpleClose, Optional) ]
]
--- setFeatureWithDeps tests -----------------------------------------------------
-
-setFeatureWithDepsTests :: TestTree
-setFeatureWithDepsTests = testGroup "setFeatureWithDeps" [
- testCase "sets feature and its dependency" $ do
- case featureByName "basic_mpp" of
- Nothing -> assertFailure "basic_mpp not found"
- Just mpp -> do
- let fv = setFeatureWithDeps mpp Optional empty
- isFeatureSet mpp fv @?= True
- -- payment_secret should also be set
- case featureByName "payment_secret" of
- Nothing ->
- assertFailure "payment_secret not found"
- Just ps -> isFeatureSet ps fv @?= True
-
- , testCase "sets transitive dependencies" $ do
- -- option_zeroconf depends on option_scid_alias
- case featureByName "option_zeroconf" of
- Nothing ->
- assertFailure "option_zeroconf not found"
- Just zc -> do
- let fv = setFeatureWithDeps zc Required empty
- isFeatureSet zc fv @?= True
- case featureByName "option_scid_alias" of
- Nothing ->
- assertFailure "option_scid_alias not found"
- Just sa -> isFeatureSet sa fv @?= True
-
- , testCase "feature without deps sets only itself" $ do
- case featureByName "payment_secret" of
- Nothing ->
- assertFailure "payment_secret not found"
- Just ps -> do
- let fv = setFeatureWithDeps ps Optional empty
- isFeatureSet ps fv @?= True
- -- no other features should be set
- let others = filter
- (\(f, _) -> featureName f /= "payment_secret")
- (listFeatures fv)
- null others @?= True
-
- , testCase "passes validateLocal after setFeatureWithDeps" $ do
- case featureByName "basic_mpp" of
- Nothing -> assertFailure "basic_mpp not found"
- Just mpp -> do
- let fv = setFeatureWithDeps mpp Optional empty
- validateLocal Init fv @?= Right ()
+-- local validation ----------------------------------------------------------
+
+-- | A vector with the given bits set.
+bits :: [Int] -> FeatureVector
+bits = foldr set_bit empty
+
+contexts :: [Context]
+contexts =
+ [ InitContext, NodeContext, ChannelContext, InvoiceContext
+ , BlindedContext, ChannelTypeContext ]
+
+local_tests :: TestTree
+local_tests = testGroup "validate_local" [
+ testCase "empty is valid in every context but channel_type" $ do
+ mapM_ (\c -> validate_local c empty @?= Right ())
+ (filter (/= ChannelTypeContext) contexts)
+ validate_local ChannelTypeContext empty
+ @?= Left (InvalidChannelType :| [])
+
+ , testCase "rejects unknown bits, odd or even" $ do
+ validate_local InitContext (bits [20, 101])
+ @?= Left (UnknownBit 20 :| [UnknownBit 101])
+ validate_local NodeContext (bits [200]) @?= Left (UnknownBit 200 :| [])
+
+ , testCase "rejects both bits set" $
+ validate_local InitContext (bits [46, 47])
+ @?= Left (BothBitsSet OptionScidAlias :| [])
+
+ , testCase "rejects features outside their contexts" $ do
+ validate_local InitContext (bits [49])
+ @?= Left (ContextNotAllowed OptionPaymentMetadata InitContext :| [])
+ validate_local InvoiceContext (bits [23])
+ @?= Left (ContextNotAllowed OptionAnchors InvoiceContext :| [])
+ validate_local ChannelContext (bits [17, 15])
+ @?= Left (ContextNotAllowed PaymentSecret ChannelContext
+ :| [ContextNotAllowed BasicMpp ChannelContext])
+
+ , testCase "accepts features in their contexts" $ do
+ validate_local InvoiceContext (bits [49]) @?= Right ()
+ validate_local NodeContext (bits [23, 47]) @?= Right ()
+ validate_local InitContext (bits [63, 67, 39]) @?= Right ()
+
+ , testCase "empty-context features: accepted in I, N and 9 only" $ do
+ let fv = bits [1, 7, 9, 13, 15, 45]
+ mapM_ (\c -> validate_local c fv @?= Right ())
+ [InitContext, NodeContext, InvoiceContext]
+ validate_local ChannelContext (bits [9])
+ @?= Left (ContextNotAllowed VarOnionOptin ChannelContext :| [])
+ validate_local BlindedContext (bits [15])
+ @?= Left (ContextNotAllowed PaymentSecret BlindedContext :| [])
+
+ , testCase "allowed_features must be empty" $
+ validate_local BlindedContext (bits [17])
+ @?= Left (ContextNotAllowed BasicMpp BlindedContext :| [])
+
+ , testCase "rejects missing dependencies" $ do
+ validate_local InitContext (bits [51])
+ @?= Left (MissingDependency OptionZeroconf OptionScidAlias :| [])
+ validate_local InitContext (bits [61])
+ @?= Left (MissingDependency OptionSimpleClose
+ OptionShutdownAnysegwit :| [])
+ validate_local NodeContext (bits [67])
+ @?= Left (MissingDependency OptionOnionMessagesOnlyChannels
+ OptionOnionMessages :| [])
+
+ , testCase "dependencies on ASSUMED features count as met" $ do
+ validate_local InitContext (bits [17]) @?= Right ()
+ validate_local InvoiceContext (bits [16]) @?= Right ()
+ validate_local InitContext (bits [41]) @?= Right ()
+
+ , testCase "reports errors in rule order" $
+ validate_local InitContext (bits [20, 22, 23, 48, 61])
+ @?= Left (UnknownBit 20 :|
+ [ BothBitsSet OptionAnchors
+ , ContextNotAllowed OptionPaymentMetadata InitContext
+ , MissingDependency OptionSimpleClose
+ OptionShutdownAnysegwit ])
+
+ , testCase "channel_type follows BOLT #2, not the generic rules" $ do
+ validate_local ChannelTypeContext (bits [12, 50]) @?= Right ()
+ validate_local ChannelTypeContext (bits [12, 23])
+ @?= Left (InvalidChannelType :| [])
]
--- setFeatureForContext tests ---------------------------------------------------
-
-setFeatureForContextTests :: TestTree
-setFeatureForContextTests = testGroup "setFeatureForContext" [
- testCase "allows feature in valid context" $ do
- case featureByName "option_payment_metadata" of
- Nothing ->
- assertFailure "option_payment_metadata not found"
- Just pm ->
- isRight
- (setFeatureForContext Invoice pm Optional empty)
- @?= True
-
- , testCase "rejects feature in wrong context" $ do
- case featureByName "option_payment_metadata" of
- Nothing ->
- assertFailure "option_payment_metadata not found"
- Just pm ->
- case setFeatureForContext Init pm Optional empty of
- Right _ -> assertFailure "expected error"
- Left err -> isContextNotAllowed err @?= True
-
- , testCase "allows feature with empty context list" $ do
- -- payment_secret has empty context list (all allowed)
- case featureByName "payment_secret" of
- Nothing ->
- assertFailure "payment_secret not found"
- Just ps ->
- isRight
- (setFeatureForContext Init ps Optional empty)
- @?= True
-
- , testCase "rejects Required in ChanAnnOdd context" $ do
- case featureByName "payment_secret" of
- Nothing ->
- assertFailure "payment_secret not found"
- Just ps ->
- case setFeatureForContext
- ChanAnnOdd ps Required empty of
- Right _ -> assertFailure "expected parity error"
- Left err -> isInvalidParity err @?= True
-
- , testCase "allows Optional in ChanAnnOdd context" $ do
- case featureByName "payment_secret" of
- Nothing ->
- assertFailure "payment_secret not found"
- Just ps ->
- isRight
- (setFeatureForContext
- ChanAnnOdd ps Optional empty)
- @?= True
-
- , testCase "rejects Optional in ChanAnnEven context" $ do
- case featureByName "payment_secret" of
- Nothing ->
- assertFailure "payment_secret not found"
- Just ps ->
- case setFeatureForContext
- ChanAnnEven ps Optional empty of
- Right _ -> assertFailure "expected parity error"
- Left err -> isInvalidParity err @?= True
-
- , testCase "allows Required in ChanAnnEven context" $ do
- case featureByName "payment_secret" of
- Nothing ->
- assertFailure "payment_secret not found"
- Just ps ->
- isRight
- (setFeatureForContext
- ChanAnnEven ps Required empty)
- @?= True
+-- remote validation ---------------------------------------------------------
+
+remote_tests :: TestTree
+remote_tests = testGroup "validate_remote" [
+ testCase "init: unknown odd bits are ignored" $
+ validate_remote InitContext (bits [101, 201]) @?= Right ()
+
+ , testCase "init: unknown even bits are rejected" $
+ validate_remote InitContext (bits [20, 100, 101])
+ @?= Left (UnknownBit 20 :| [UnknownBit 100])
+
+ , testCase "init: missing dependencies are rejected" $ do
+ validate_remote InitContext (bits [51])
+ @?= Left (MissingDependency OptionZeroconf OptionScidAlias :| [])
+ validate_remote InitContext (bits [60])
+ @?= Left (MissingDependency OptionSimpleClose
+ OptionShutdownAnysegwit :| [])
+ validate_remote InitContext (bits [51, 47]) @?= Right ()
+
+ , testCase "init: ASSUMED dependencies count as met" $ do
+ validate_remote InitContext (bits [17]) @?= Right ()
+ validate_remote InitContext (bits [40]) @?= Right ()
+
+ , testCase "init: both bits set is not an error" $
+ validate_remote InitContext (bits [46, 47]) @?= Right ()
+
+ , testCase "init: known features outside their contexts pass" $
+ validate_remote InitContext (bits [49]) @?= Right ()
+
+ , testCase "node and channel announcements: unknown even bits" $ do
+ validate_remote NodeContext (bits [100])
+ @?= Left (UnknownBit 100 :| [])
+ validate_remote ChannelContext (bits [100])
+ @?= Left (UnknownBit 100 :| [])
+ validate_remote NodeContext (bits [101]) @?= Right ()
+ validate_remote ChannelContext (bits [101]) @?= Right ()
+
+ , testCase "node and channel announcements: no dependency rule" $ do
+ validate_remote NodeContext (bits [51]) @?= Right ()
+ validate_remote ChannelContext (bits [51]) @?= Right ()
+
+ , testCase "invoice: unknown even bits and dependencies" $ do
+ validate_remote InvoiceContext (bits [100])
+ @?= Left (UnknownBit 100 :| [])
+ validate_remote InvoiceContext (bits [51])
+ @?= Left (MissingDependency OptionZeroconf OptionScidAlias :| [])
+ validate_remote InvoiceContext (bits [101, 17]) @?= Right ()
+
+ , testCase "blinded path: any unknown bit is rejected" $ do
+ validate_remote BlindedContext (bits [101])
+ @?= Left (UnknownBit 101 :| [])
+ validate_remote BlindedContext (bits [100])
+ @?= Left (UnknownBit 100 :| [])
+ validate_remote BlindedContext (bits [15, 17]) @?= Right ()
+ validate_remote BlindedContext empty @?= Right ()
+
+ , testCase "channel_type: must be a defined type" $ do
+ validate_remote ChannelTypeContext (bits [12, 22]) @?= Right ()
+ validate_remote ChannelTypeContext (bits [22])
+ @?= Left (InvalidChannelType :| [])
+
+ , testCase "bits above 65535 do not wrap" $ do
+ validate_remote InitContext (long_vector 8192 0x01)
+ @?= Left (UnknownBit 65536 :| [])
+ validate_remote InitContext (long_vector 8192 0x04)
+ @?= Left (UnknownBit 65538 :| [])
+ validate_remote InitContext (long_vector 8194 0x01)
+ @?= Left (UnknownBit 65552 :| [])
+
+ , testCase "maximum-length vectors" $ do
+ validate_remote InitContext (long_vector 65534 0x80) @?= Right ()
+ validate_remote InitContext (long_vector 65534 0x40)
+ @?= Left (UnknownBit 524278 :| [])
]
--- validateNoBothBits tests -----------------------------------------------------
-
-validateNoBothBitsTests :: TestTree
-validateNoBothBitsTests = testGroup "validateNoBothBits" [
- testCase "passes for empty vector" $
- isRight (validateNoBothBits empty) @?= True
-
- , testCase "passes when only one bit of pair is set" $ do
- case featureByName "payment_secret" of
- Nothing ->
- assertFailure "payment_secret not found"
- Just ps -> do
- let fv = setFeature ps Optional empty
- isRight (validateNoBothBits fv) @?= True
-
- , testCase "fails when both bits of pair are set" $ do
- let fv = setBit 15 (setBit 14 empty)
- case validateNoBothBits fv of
- Right _ -> assertFailure "expected BothBitsSet"
- Left err -> isBothBitsSet err @?= True
-
- , testCase "returns first error found" $ do
- -- set both bits for two features
- let fv = setBit 15 (setBit 14
- (setBit 17 (setBit 16 empty)))
- isLeft (validateNoBothBits fv) @?= True
+-- BOLT #11 vectors ----------------------------------------------------------
+
+-- | The feature vector carried by a BOLT #11 @9@ field, given the
+-- field's data as bech32 characters.
+invoice_features :: String -> Maybe FeatureVector
+invoice_features cs = do
+ vs <- traverse (`elemIndex` charset) cs
+ let n = length vs
+ pure $ bits
+ [ (n - 1 - k) * 5 + j
+ | (k, v) <- zip [0 ..] vs, j <- [0 .. 4], B.testBit v j ]
+ where
+ charset = "qpzry9x8gf2tvdw0s3jn54khce6mua7l"
+
+invoice_case
+ :: String -> String -> [Int]
+ -> Either (NonEmpty ValidationError) () -> TestTree
+invoice_case name dat expected result = testCase name $
+ case invoice_features dat of
+ Nothing -> assertFailure "invalid bech32 data"
+ Just fv -> do
+ set_bits fv @?= expected
+ validate_remote InvoiceContext fv @?= result
+
+invoice_tests :: TestTree
+invoice_tests = testGroup "BOLT #11 invoice features" [
+ invoice_case "features 8, 14 and 99" "sqqqqqqqqqqqqqqqqsgq"
+ [8, 14, 99] (Right ())
+ , invoice_case "payment metadata (8, 14, 48)" "gqqqqqqsgq"
+ [8, 14, 48] (Right ())
+ , invoice_case "high-S signature example (8, 14)" "sgq"
+ [8, 14] (Right ())
+ , invoice_case "invalid unknown feature 100" "psqqqqqqqqqqqqqqqqsgq"
+ [8, 14, 99, 100] (Left (UnknownBit 100 :| []))
+ , testCase "a writer may set 8, 14 and 48" $
+ validate_local InvoiceContext (bits [8, 14, 48]) @?= Right ()
]
--- Remote dependency tests -----------------------------------------------------
-
-remoteDependencyTests :: TestTree
-remoteDependencyTests = testGroup "validateRemote dependencies" [
- testCase "rejects option_zeroconf without option_scid_alias" $
- validateRemote Init (setBit 51 empty) @?=
- Left [MissingDependency "option_zeroconf" "option_scid_alias"]
-
- , testCase "rejects basic_mpp without payment_secret (init)" $
- validateRemote Init (setBit 17 empty) @?=
- Left [MissingDependency "basic_mpp" "payment_secret"]
+-- BOLT #4 vectors -----------------------------------------------------------
- , testCase "rejects basic_mpp without payment_secret (invoice)" $
- validateRemote Invoice (setBit 17 empty) @?=
- Left [MissingDependency "basic_mpp" "payment_secret"]
+-- | allowed_features from bolt04/route-blinding-test.json.
+blinded_tests :: TestTree
+blinded_tests = testGroup "BOLT #4 allowed_features" [
+ testCase "features [] (Bob, Carol, Dave)" $ do
+ set_bits (parse "") @?= []
+ validate_remote BlindedContext (parse "") @?= Right ()
- , testCase "rejects option_simple_close without anysegwit" $
- validateRemote Init (setBit 60 empty) @?=
- Left [ MissingDependency
- "option_simple_close" "option_shutdown_anysegwit" ]
-
- , testCase "accepts features with dependencies set" $ do
- validateRemote Init (setBit 51 (setBit 47 empty)) @?= Right ()
- validateRemote Invoice (setBit 17 (setBit 14 empty)) @?= Right ()
+ , testCase "features [113] (Eve)" $ do
+ let fv = parse (BS.pack (0x02 : replicate 14 0))
+ set_bits fv @?= [113]
+ validate_remote BlindedContext fv @?= Left (UnknownBit 113 :| [])
+ validate_local BlindedContext fv @?= Left (UnknownBit 113 :| [])
]
--- Long vector tests -----------------------------------------------------------
-
--- | A vector of (n + 1) bytes whose most significant byte is b.
-longVector :: Int -> Word8 -> FeatureVector
-longVector n b = parse (BS.cons b (BS.replicate n 0))
-
-longVectorTests :: TestTree
-longVectorTests = testGroup "Long vectors" [
- testCase "bit 65536 is reported without wrapping" $ do
- let fv = longVector 8192 0x01
- setBits fv @?= [65536]
- highestSetBit fv @?= Just 65536
- validateRemote Init fv @?= Left [UnknownRequiredBit 65536]
-
- , testCase "bit 65538 is reported as itself" $
- validateRemote Init (longVector 8192 0x04) @?=
- Left [UnknownRequiredBit 65538]
-
- , testCase "bit 65552 does not alias basic_mpp" $
- validateRemote Init (longVector 8194 0x01) @?=
- Left [UnknownRequiredBit 65552]
-
- , testCase "max-length vector, top odd bit accepted" $ do
- let fv = longVector 65534 0x80
- setBits fv @?= [524279]
- highestSetBit fv @?= Just 524279
- validateRemote Init fv @?= Right ()
-
- , testCase "max-length vector, top even bit rejected" $
- validateRemote Init (longVector 65534 0x40) @?=
- Left [UnknownRequiredBit 524278]
+-- channel types -------------------------------------------------------------
+
+all_channel_types :: [ChannelType]
+all_channel_types =
+ [ ChannelType b s z
+ | b <- [BasicStaticRemotekey, BasicAnchors, BasicZeroFeeCommitments]
+ , s <- [False, True]
+ , z <- [False, True] ]
+
+channel_type_tests :: TestTree
+channel_type_tests = testGroup "channel types" [
+ testCase "every defined type round-trips" $
+ mapM_ (\ct -> channel_type (channel_type_features ct) @?= Just ct)
+ all_channel_types
+
+ , testCase "encodings" $ do
+ let enc b s z = render (channel_type_features (ChannelType b s z))
+ enc BasicStaticRemotekey False False @?= BS.pack [0x10, 0x00]
+ enc BasicAnchors False False @?= BS.pack [0x40, 0x10, 0x00]
+ enc BasicZeroFeeCommitments False False
+ @?= BS.pack [0x01, 0, 0, 0, 0, 0]
+ enc BasicAnchors True True
+ @?= BS.pack [0x04, 0x40, 0, 0, 0x40, 0x10, 0x00]
+
+ , testCase "exactly the twelve defined types decode" $ do
+ let candidates = [12, 13, 14, 22, 23, 40, 46, 47, 50, 51, 52]
+ decoded = [ ct | s <- subsequences candidates
+ , Just ct <- [channel_type (bits s)] ]
+ length decoded @?= 12
+ mapM_ (\ct -> assertBool (show ct) (ct `elem` all_channel_types))
+ decoded
+
+ , testCase "rejects undefined types" $
+ mapM_ (\s -> channel_type (bits s) @?= Nothing)
+ [ [], [13], [22], [23, 13], [12, 40], [12, 14], [46], [50]
+ , [12, 47], [12, 51], [12, 52], [40, 44] ]
+
+ , testCase "variations need no dependency closure" $
+ channel_type (bits [12, 50])
+ @?= Just (ChannelType BasicStaticRemotekey False True)
+
+ , testCase "leading zero bytes are ignored" $
+ channel_type (parse "\NUL\NUL\DLE\NUL")
+ @?= Just (ChannelType BasicStaticRemotekey False False)
]
--- Opposite bit tests ----------------------------------------------------------
-
--- | Look up a known feature by name, failing the test if absent.
-knownFeature :: String -> IO Feature
-knownFeature n = case featureByName n of
- Nothing -> assertFailure ("feature not found: " ++ n)
- Just f -> pure f
-
-oppositeBitTests :: TestTree
-oppositeBitTests = testGroup "Opposite bit" [
- testCase "setFeature Optional clears the required bit" $ do
- ps <- knownFeature "payment_secret"
- let fv = setFeature ps Optional (setFeature ps Required empty)
- setBits fv @?= [15]
- hasFeature ps fv @?= Just Optional
-
- , testCase "setFeature Required clears the optional bit" $ do
- ps <- knownFeature "payment_secret"
- let fv = setFeature ps Required (setBit 15 empty)
- setBits fv @?= [14]
- hasFeature ps fv @?= Just Required
-
- , testCase "setFeatureWithDeps keeps a set dependency's level" $ do
- ps <- knownFeature "payment_secret"
- mpp <- knownFeature "basic_mpp"
- let fv = setFeatureWithDeps mpp Optional
- (setFeature ps Required empty)
- hasFeature ps fv @?= Just Required
- hasFeature mpp fv @?= Just Optional
- validateLocal Init fv @?= Right ()
-
- , testCase "setFeatureForContext clears the opposite bit" $ do
- anc <- knownFeature "option_anchors"
- let start = setFeature anc Required empty
- case setFeatureForContext Init anc Optional start of
- Left e -> assertFailure (show e)
- Right fv -> do
- hasFeature anc fv @?= Just Optional
- validateNoBothBits fv @?= Right fv
-
- , testProperty "setFeature never sets both bits (any start)" $
- forAll genFeatureAndLevel $ \(f, lvl) bs ->
- let fv = setFeature f lvl (parse (BS.pack bs))
- b = featureBaseBit f
- in not (testBit b fv && testBit (b + 1) fv)
- && hasFeature f fv == Just lvl
-
- , testProperty "setFeature leaves other bits alone" $
- forAll genFeatureAndLevel $ \(f, lvl) bs ->
- let fv0 = parse (BS.pack bs)
- fv = setFeature f lvl fv0
- b = fromIntegral (featureBaseBit f)
+-- properties ----------------------------------------------------------------
+
+gen_bytes :: Gen ByteString
+gen_bytes = BS.pack <$> arbitrary
+
+gen_vector :: Gen FeatureVector
+gen_vector = parse <$> gen_bytes
+
+gen_feature :: Gen Feature
+gen_feature = elements known_features
+
+gen_level :: Gen FeatureLevel
+gen_level = elements [Required, Optional]
+
+-- | A bit index somewhat beyond the end of a vector.
+gen_index :: FeatureVector -> Gen Int
+gen_index fv = choose (0, 8 * BS.length (render fv) + 16)
+
+has_leading_zero :: FeatureVector -> Bool
+has_leading_zero fv = BS.take 1 (render fv) == BS.singleton 0
+
+properties :: TestTree
+properties = testGroup "properties" [
+ testProperty "render . parse == id" $
+ forAll gen_bytes $ \bs -> render (parse bs) === bs
+
+ , testProperty "equality ignores leading zero bytes" $
+ forAll gen_bytes $ \bs (Small k) ->
+ parse (BS.replicate k 0 <> bs) === parse bs
+
+ , testProperty "equality agrees with set_bits" $
+ forAll gen_vector $ \a -> forAll gen_vector $ \b ->
+ (a == b) === (set_bits a == set_bits b)
+
+ , testProperty "set_bits lists exactly the set bits, ascending" $
+ forAll gen_vector $ \fv ->
+ set_bits fv
+ === filter (`test_bit` fv) [0 .. 8 * BS.length (render fv) - 1]
+
+ , testProperty "set_bit sets only its bit" $
+ forAll gen_vector $ \fv -> forAll (gen_index fv) $ \i ->
+ let fv' = set_bit i fv
+ in test_bit i fv'
+ .&&. filter (/= i) (set_bits fv')
+ === filter (/= i) (set_bits fv)
+
+ , testProperty "clear_bit clears only its bit" $
+ forAll gen_vector $ \fv -> forAll (gen_index fv) $ \i ->
+ let fv' = clear_bit i fv
+ in not (test_bit i fv')
+ .&&. set_bits fv' === filter (/= i) (set_bits fv)
+
+ , testProperty "union is bitwise OR" $
+ forAll gen_vector $ \a -> forAll gen_vector $ \b ->
+ let u = union a b
+ n = 8 * max (BS.length (render a)) (BS.length (render b))
+ in fmap (`test_bit` u) [0 .. n - 1]
+ === fmap (\i -> test_bit i a || test_bit i b) [0 .. n - 1]
+
+ , testProperty "operations encode minimally" $
+ forAll gen_vector $ \a -> forAll gen_vector $ \b ->
+ forAll (gen_index a) $ \i ->
+ not (any has_leading_zero
+ [union a b, set_bit i a, clear_bit i a])
+
+ , testProperty "set_feature sets exactly one bit of the pair" $
+ forAll gen_vector $ \fv -> forAll gen_feature $ \f ->
+ forAll gen_level $ \l ->
+ let fv' = set_feature f l fv
+ b = feature_bit f
other = filter (\i -> i /= b && i /= b + 1)
- in other (setBits fv) === other (setBits fv0)
- ]
-
-isInvalidParity :: ValidationError -> Bool
-isInvalidParity (InvalidParity _ _) = True
-isInvalidParity _ = False
-
--- Property tests --------------------------------------------------------------
-
-propertyTests :: TestTree
-propertyTests = testGroup "Properties" [
- testProperty "render . parse == id for stripped ByteStrings" $
- \bs -> let stripped = BS.dropWhile (== 0) (BS.pack bs)
- in render (parse stripped) === stripped
-
- , testProperty "set then member returns True" $
- \(Small n) -> let idx = bitIndex (n `mod` 256)
- fv = set idx empty
- in member idx fv === True
-
- , testProperty "clear then member returns False" $
- \(Small n) -> let idx = bitIndex (n `mod` 256)
- fv = set idx empty
- fv' = clear idx fv
- in member idx fv' === False
-
- , testProperty "setBits returns all set bits without duplicates" $
- \bs -> let fv = parse (BS.pack bs)
- bits = setBits fv
- -- Verify no duplicates and length matches unique count
- in length bits === length (removeDups bits)
-
- , testProperty "double set is idempotent" $
- \(Small n) -> let idx = bitIndex (n `mod` 256)
- fv = set idx empty
- fv' = set idx fv
- in unFeatureVector fv === unFeatureVector fv'
-
- , testProperty "set then clear restores original (when was unset)" $
- \(Small n) -> let idx = bitIndex (n `mod` 256)
- fv = set idx empty
- fv' = clear idx fv
- in unFeatureVector fv' === BS.empty
-
- , testProperty "member consistent with setBits" $
- \bs -> let fv = parse (BS.pack bs)
- bits = setBits fv
- in all (\b -> member (bitIndex (fromIntegral b)) fv) bits
- === True
-
- , testProperty "requiredBit only succeeds for even" $
- \(n :: Word16) -> isJust (requiredBit n) === (n `mod` 2 == 0)
-
- , testProperty "optionalBit only succeeds for odd" $
- \(n :: Word16) -> isJust (optionalBit n) === (n `mod` 2 == 1)
-
- , testProperty "setFeature then hasFeature" $
- forAll genFeatureAndLevel $ \(f, lvl) ->
- let fv = setFeature f lvl empty
- in hasFeature f fv == Just lvl
-
- , testProperty
- "setFeatureWithDeps passes validateLocal" $
- forAll genInitFeatureAndLevel $ \(f, lvl) ->
- let fv = setFeatureWithDeps f lvl empty
- in isRight (validateLocal Init fv)
-
- , testProperty "parse . render is identity" $
- \bs ->
- let stripped = BS.dropWhile (== 0) (BS.pack bs)
- fv = parse stripped
- in parse (render fv) == fv
-
- , testProperty
- "setFeature never sets both bits" $
- forAll genFeatureAndLevel $ \(f, lvl) ->
- let fv = setFeature f lvl empty
- in isRight (validateNoBothBits fv)
+ in test_feature f fv' === Just l
+ .&&. test_bit b fv' =/= test_bit (b + 1) fv'
+ .&&. other (set_bits fv') === other (set_bits fv)
+
+ , testProperty "vectors built with set_feature_with_deps validate" $
+ forAll (elements (filter (/= ChannelTypeContext) contexts)) $ \c ->
+ forAll (gen_presented c) $ \fs ->
+ let fv = foldr (\(f, l) -> set_feature_with_deps f l) empty fs
+ in validate_local c fv === Right ()
+ .&&. validate_remote c fv === Right ()
]
--- | Generate a random known feature and level.
-genFeatureAndLevel :: Gen (Feature, FeatureLevel)
-genFeatureAndLevel = do
- f <- elements knownFeatures
- lvl <- elements [Required, Optional]
- pure (f, lvl)
-
--- | Generate a feature valid in Init context with a level.
-genInitFeatureAndLevel :: Gen (Feature, FeatureLevel)
-genInitFeatureAndLevel = do
- f <- elements initFeatures
- lvl <- elements [Required, Optional]
- pure (f, lvl)
+-- | Features presented in a context, each with a level.
+gen_presented :: Context -> Gen [(Feature, FeatureLevel)]
+gen_presented c = do
+ fs <- sublistOf (filter presented known_features)
+ traverse (\f -> (,) f <$> gen_level) fs
where
- initFeatures =
- filter validForInit knownFeatures
- validForInit f =
- null (featureContexts f)
- || Init `elem` featureContexts f
-
--- | Remove duplicates from a list.
-removeDups :: Eq a => [a] -> [a]
-removeDups [] = []
-removeDups (x:xs) = x : removeDups (filter (/= x) xs)
+ presented f = case feature_contexts f of
+ [] -> c `elem` [InitContext, NodeContext, InvoiceContext]
+ cs -> c `elem` cs
