ppad-bolt9 0.0.1 → 0.1.0

raw patch · 11 files changed

+1281/−1218 lines, 11 filesdep −containersPVP ok

version bump matches the API change (PVP)

Dependencies removed: containers

API changes (from Hackage documentation)

Files

• CHANGELOG +28/−1
• bench/Fixtures.hs +25/−46
• bench/Main.hs +31/−25
• bench/Weight.hs +11/−14
• lib/Lightning/Protocol/BOLT9.hs +679/−98
• lib/Lightning/Protocol/BOLT9/Codec.hs +0/−163
• lib/Lightning/Protocol/BOLT9/Features.hs +0/−120
• lib/Lightning/Protocol/BOLT9/Types.hs +0/−282
• lib/Lightning/Protocol/BOLT9/Validate.hs +0/−238
• ppad-bolt9.cabal +10/−11
• test/Main.hs +497/−220

@@ -1,4 +1,31 @@ # Changelog -- 0.0.1 (unreleased)+- 0.1.0 (2026-10-10)+  * 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.

@@ -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

@@ -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       ]   ]

@@ -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

@@ -11,126 +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. ----- Validate a feature vector for a specific context:+--   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. ----- >>> validateLocal Init fv--- Left [MissingDependency "basic_mpp" "payment_secret"]+--   Equality ignores leading zero bytes. ----- Fix by adding the dependency:+--   >>> 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. ----- >>> let Just ps = featureByName "payment_secret"--- >>> let fv' = setFeature ps Optional (setFeature mpp Optional empty)--- >>> validateLocal Init fv'--- Right ()+--   >>> 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. ----- == Bit Numbering+--   >>> 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. ----- 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).+--   >>> render empty+--   ""+empty :: FeatureVector+empty = FeatureVector BS.empty++-- | The bitwise OR of two feature vectors. ----- 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).+--   BOLT #1 requires the receiver of an @init@ message to combine its+--   @globalfeatures@ and @features@ fields this way.+--+--   >>> 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+-- bits ---------------------------------------------------------------------- -    -- * Bit indices-    -- | Low-level bit index types for direct bit manipulation.-  , BitIndex-  , unBitIndex-  , bitIndex+-- | 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)) -    -- * Required/optional level-    -- | Whether a feature is set as required or optional.-  , FeatureLevel(..)+-- | 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 -    -- * Required/optional bits-    -- | Type-safe wrappers ensuring correct parity.-  , RequiredBit-  , unRequiredBit-  , requiredBit-  , requiredFromBitIndex+-- | 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 -  , OptionalBit-  , unOptionalBit-  , optionalBit-  , optionalFromBitIndex+-- | 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) -    -- * Feature vectors-    -- | The core feature vector type and basic operations.-  , FeatureVector-  , unFeatureVector-  , FV.empty-  , fromByteString-  , set-  , clear-  , member+-- Drop leading zero bytes.+strip :: ByteString -> ByteString+strip = BS.dropWhile (== 0)+{-# INLINE strip #-} -    -- * Known features-    -- | The BOLT #9 feature table and lookup functions.-  , Feature(..)-  , featureByBit-  , featureByName-  , knownFeatures+-- 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 -    -- * Parsing and rendering-    -- | Wire format conversion.-  , parse-  , render+-- 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) -    -- * Low-level bit operations-    -- | Direct bit manipulation by index.-  , Codec.setBit-  , Codec.clearBit-  , Codec.testBit+-- known features ------------------------------------------------------------ -    -- * Feature operations-    -- | High-level operations using 'Feature' values.-  , setFeature-  , hasFeature-  , isFeatureSet-  , listFeatures+-- | 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) -    -- * Validation-    -- | Validate feature vectors for correctness.-  , ValidationError(..)-  , validateLocal-  , validateRemote-  , highestSetBit-  , Validate.setBits-  ) where+instance NFData Feature -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+-- | 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]

@@ -1,163 +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-  , 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.------   >>> 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 = setBit targetBit-  where-    !baseBit   = featureBaseBit f-    !targetBit = case level of-      Required -> baseBit-      Optional -> baseBit + 1-{-# INLINE setFeature #-}---- | 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

@@ -1,120 +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(..)--    -- * 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---- | 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]

@@ -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 #-}

@@ -1,238 +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--    -- * 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, 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 #-} !Word16-    -- ^ An unknown required (even) bit is set (remote validation only).-    --   Argument: bit index.-  | InvalidParity {-# UNPACK #-} !Word16 !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---- 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------   >>> 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-          ++ 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-      | otherwise = case featureByBit 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 Word16-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 Word16-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  = fromIntegral bytePos * 8 + fromIntegral highBit-                in  Just bitIdx---- | Collect all set bits in a feature vector.------   Returns a list of bit indices in ascending order.-setBits :: FeatureVector -> [Word16]-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 -> [Word16] -> [Word16]-collectBits !bs !len !i !acc-  | i >= len  = acc-  | otherwise =-      let !byte    = BS.index bs (len - 1 - i)-          !baseIdx = fromIntegral 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 -> Word16 -> [Word16] -> [Word16]-collectByteBits !byte !baseIdx = go 7-  where-    go !bit !acc-      | bit < 0        = acc-      | B.testBit byte bit = go (bit - 1) ((baseIdx + fromIntegral bit) : acc)-      | otherwise          = go (bit - 1) acc

@@ -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 @@ 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 @@       -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 @@   main-is:             Main.hs    ghc-options:-    -rtsopts -Wall -O2+    -rtsopts -Wall    build-depends:       base@@ -60,7 +59,7 @@   other-modules:       Fixtures    ghc-options:-    -rtsopts -O2 -Wall -fno-warn-orphans+    -rtsopts -O2 -Wall    build-depends:       base@@ -77,7 +76,7 @@   other-modules:       Fixtures    ghc-options:-    -rtsopts -O2 -Wall -fno-warn-orphans+    -rtsopts -O2 -Wall    build-depends:       base

@@ -1,287 +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.Maybe (isJust, isNothing)-import Data.Word (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+main = defaultMain $ testGroup "ppad-bolt9" [+    table_tests+  , vector_tests+  , feature_tests+  , local_tests+  , remote_tests+  , invoice_tests+  , blinded_tests+  , channel_type_tests+  , properties+  ] -tests :: TestTree-tests = testGroup "ppad-bolt9" [-    featureTableTests-  , bitParityTests-  , featureVectorTests-  , validationTests-  , propertyTests+-- 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"])   ] --- Feature table tests ---------------------------------------------------------+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" -featureTableTests :: TestTree-featureTableTests = testGroup "Feature table" [-    testCase "all features have even baseBit" $-      all (even . featureBaseBit) knownFeatures @?= True+table_tests :: TestTree+table_tests = testGroup "feature table" [+    testCase "matches the spec table" $+      fmap table_row known_features @?= spec_table -  , testCase "featureByBit works for even bit" $-      case featureByBit 14 of-        Nothing -> assertFailure "expected to find payment_secret"-        Just f  -> featureName f @?= "payment_secret"+  , 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 "featureByBit works for odd bit" $-      case featureByBit 15 of-        Nothing -> assertFailure "expected to find payment_secret"-        Just f  -> featureName f @?= "payment_secret"+  , 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+  ] -  , testCase "featureByBit returns Nothing for unknown bit" $-      featureByBit 100 @?= Nothing+-- feature vectors ----------------------------------------------------------- -  , testCase "featureByName finds known features" $ do-      isJust (featureByName "var_onion_optin") @?= True-      isJust (featureByName "payment_secret") @?= True-      isJust (featureByName "basic_mpp") @?= True+-- | 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)) -  , testCase "featureByName returns Nothing for unknown names" $-      featureByName "nonexistent_feature" @?= Nothing+vector_tests :: TestTree+vector_tests = testGroup "feature vectors" [+    testCase "empty" $ do+      render empty @?= ""+      set_bits empty @?= [] -  , 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 "render returns parsed bytes exactly" $ do+      render (parse "\NUL\NUL\STX") @?= "\NUL\NUL\STX"+      render (parse "\NUL") @?= "\NUL" -  , 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"-                         ]+  , 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   ] --- Bit parity tests ------------------------------------------------------------+-- feature operations -------------------------------------------------------- -bitParityTests :: TestTree-bitParityTests = testGroup "Bit parity" [-    testCase "requiredBit accepts even numbers" $ do-      isJust (requiredBit 0) @?= True-      isJust (requiredBit 2) @?= True-      isJust (requiredBit 100) @?= True+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 "requiredBit rejects odd numbers" $ do-      isNothing (requiredBit 1) @?= True-      isNothing (requiredBit 3) @?= True-      isNothing (requiredBit 101) @?= True+  , 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 "optionalBit accepts odd numbers" $ do-      isJust (optionalBit 1) @?= True-      isJust (optionalBit 3) @?= True-      isJust (optionalBit 101) @?= True+  , testCase "set_feature leaves other features alone" $+      set_bits (set_feature BasicMpp Optional (parse "\STX\NUL"))+        @?= [9, 17] -  , testCase "optionalBit rejects even numbers" $ do-      isNothing (optionalBit 0) @?= True-      isNothing (optionalBit 2) @?= True-      isNothing (optionalBit 100) @?= True+  , 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 "requiredBit smart constructor preserves value" $-      case requiredBit 42 of-        Nothing -> assertFailure "expected Just"-        Just rb -> unRequiredBit rb @?= 42+  , 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 "optionalBit smart constructor preserves value" $-      case optionalBit 43 of-        Nothing -> assertFailure "expected Just"-        Just ob -> unOptionalBit ob @?= 43+  , 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) ]   ] --- FeatureVector tests ---------------------------------------------------------+-- local validation ---------------------------------------------------------- -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+-- | A vector with the given bits set.+bits :: [Int] -> FeatureVector+bits = foldr set_bit empty -  , testCase "set adds a bit" $ do-      let fv = set (bitIndex 0) empty-      member (bitIndex 0) fv @?= True+contexts :: [Context]+contexts =+  [ InitContext, NodeContext, ChannelContext, InvoiceContext+  , BlindedContext, ChannelTypeContext ] -  , 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+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 "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 "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 "clear on unset bit is no-op" $ do-      let fv = clear (bitIndex 10) empty-      unFeatureVector fv @?= BS.empty+  , testCase "rejects both bits set" $+      validate_local InitContext (bits [46, 47])+        @?= Left (BothBitsSet OptionScidAlias :| []) -  , 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 "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 "render strips leading zeros" $ do-      let fv = set (bitIndex 0) empty-      render fv @?= BS.pack [0x01]+  , 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 "render handles high bits correctly" $ do-      let fv = set (bitIndex 15) empty-      render fv @?= BS.pack [0x80, 0x00]+  , 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 "render of empty is empty" $-      render empty @?= BS.empty+  , 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 :| [])   ] --- Validation tests ------------------------------------------------------------+-- remote validation --------------------------------------------------------- -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+remote_tests :: TestTree+remote_tests = testGroup "validate_remote" [+    testCase "init: unknown odd bits are ignored" $+      validate_remote InitContext (bits [101, 201]) @?= Right () -  , 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 "init: unknown even bits are rejected" $+      validate_remote InitContext (bits [20, 100, 101])+        @?= Left (UnknownBit 20 :| [UnknownBit 100]) -  , 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 "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 "Remote validation accepts unknown optional bits" $ do-      -- bit 201 is unknown and odd (optional)-      let fv = setBit 201 empty-      validateRemote Init fv @?= Right ()+  , testCase "init: ASSUMED dependencies count as met" $ do+      validate_remote InitContext (bits [17]) @?= Right ()+      validate_remote InitContext (bits [40]) @?= 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 "init: both bits set is not an error" $+      validate_remote InitContext (bits [46, 47]) @?= Right () -  , 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 "init: known features outside their contexts pass" $+      validate_remote InitContext (bits [49]) @?= 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"+  , 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 :| [])   ] -isBothBitsSet :: ValidationError -> Bool-isBothBitsSet (BothBitsSet _ _) = True-isBothBitsSet _ = False+-- BOLT #11 vectors ---------------------------------------------------------- -isMissingDependency :: ValidationError -> Bool-isMissingDependency (MissingDependency _ _) = True-isMissingDependency _ = False+-- | 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" -isContextNotAllowed :: ValidationError -> Bool-isContextNotAllowed (ContextNotAllowed _ _) = True-isContextNotAllowed _ = False+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 -isUnknownRequiredBit :: ValidationError -> Bool-isUnknownRequiredBit (UnknownRequiredBit _) = True-isUnknownRequiredBit _ = False+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 ()+  ] --- Property tests --------------------------------------------------------------+-- BOLT #4 vectors ----------------------------------------------------------- -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+-- | 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 () -  , testProperty "set then member returns True" $-      \(Small n) -> let idx = bitIndex (n `mod` 256)-                        fv  = set idx empty-                    in  member idx fv === True+  , 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 :| [])+  ] -  , 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+-- channel types ------------------------------------------------------------- -  , 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)+all_channel_types :: [ChannelType]+all_channel_types =+  [ ChannelType b s z+  | b <- [BasicStaticRemotekey, BasicAnchors, BasicZeroFeeCommitments]+  , s <- [False, True]+  , z <- [False, True] ] -  , 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'+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 -  , 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+  , 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] -  , testProperty "member consistent with setBits" $-      \bs -> let fv   = parse (BS.pack bs)-                 bits = setBits fv-             in  all (\b -> member (bitIndex b) fv) bits === True+  , 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 -  , testProperty "requiredBit only succeeds for even" $-      \(n :: Word16) -> isJust (requiredBit n) === (n `mod` 2 == 0)+  , 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] ] -  , testProperty "optionalBit only succeeds for odd" $-      \(n :: Word16) -> isJust (optionalBit n) === (n `mod` 2 == 1)+  , 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)   ] --- | Remove duplicates from a list.-removeDups :: Eq a => [a] -> [a]-removeDups [] = []-removeDups (x:xs) = x : removeDups (filter (/= x) xs)+-- 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  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 ()+  ]++-- | 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+    presented f = case feature_contexts f of+      [] -> c `elem` [InitContext, NodeContext, InvoiceContext]+      cs -> c `elem` cs