commit 5c2e239fdd5d5ccce99572aad742bef4cdd3e70f
parent 39e9cd5da9db0cc676d1c55fb3aa78de779d7c7c
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 13:28:20 +0400
lib: redesign around a closed feature enum and spec contexts
Collapses the library into the single exposed module
Lightning.Protocol.BOLT9 with a snake_case API.
- FeatureVector is abstract. parse keeps the received bytes and render
returns them unchanged; every other operation encodes minimally.
Equality ignores leading zero bytes. Adds union.
- Bit indices are Int throughout; negative indices are ignored.
- Feature is a closed enumeration of the BOLT #9 table at
lightning/bolts@1aadb719, adding zero_fee_commitments,
option_splice and option_onion_messages_only_channels. Dependencies
are Features, not names. Drops the containers dependency.
- Context has one constructor per spec context (I, N, C, 9, B, T).
C- and C+ are not contexts.
- validate_local rejects unknown bits, both bits set, features outside
their contexts and missing dependencies. validate_remote applies
each context's receiver rules, including BOLT #4's rejection of any
unknown bit in allowed_features. A dependency on an ASSUMED feature
counts as met.
- ChannelType models BOLT #2 channel types; the channel_type context
is validated against them rather than the generic rules.
- Removes RequiredBit, OptionalBit, BitIndex, KnownFeature, the
name-based lookups, the duplicate bit operations and the aliases.
Diffstat:
6 files changed, 695 insertions(+), 1067 deletions(-)
diff --git a/lib/Lightning/Protocol/BOLT9.hs b/lib/Lightning/Protocol/BOLT9.hs
@@ -11,132 +11,705 @@
-- 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
+ deriving Generic
+
+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
+
+-- | 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.
+--
+-- >>> 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
