commit e0e8c5e5244b6c00162f5739b5a314248415fc3c
parent 564b7b53f6dfc7830c389793758fae9118c78b9f
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 25 Jan 2026 15:52:59 +0400
Add baseline types for BOLT #9 feature flags
Introduces the Types module with:
- Context ADT for message presentation contexts (I, N, C, C-, C+, 9, B, T)
- BitIndex newtype for bit positions in feature vectors
- RequiredBit/OptionalBit newtypes with parity-enforcing smart constructors
- FeatureVector wrapper over strict ByteString with set/clear/member ops
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
Diffstat:
4 files changed, 362 insertions(+), 5 deletions(-)
diff --git a/flake.lock b/flake.lock
@@ -0,0 +1,88 @@
+{
+ "nodes": {
+ "flake-utils": {
+ "inputs": {
+ "systems": "systems"
+ },
+ "locked": {
+ "lastModified": 1731533236,
+ "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
+ "type": "github"
+ },
+ "original": {
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "type": "github"
+ }
+ },
+ "nixpkgs": {
+ "locked": {
+ "lastModified": 1766840161,
+ "narHash": "sha256-Ss/LHpJJsng8vz1Pe33RSGIWUOcqM1fjrehjUkdrWio=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "3edc4a30ed3903fdf6f90c837f961fa6b49582d1",
+ "type": "github"
+ },
+ "original": {
+ "owner": "NixOS",
+ "ref": "nixpkgs-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "ppad-nixpkgs": {
+ "inputs": {
+ "flake-utils": "flake-utils",
+ "nixpkgs": "nixpkgs"
+ },
+ "locked": {
+ "lastModified": 1766932084,
+ "narHash": "sha256-GvVsbTfW+B7IQ9K/QP2xcXJAm1lhBin1jYZWNjOzT+o=",
+ "ref": "master",
+ "rev": "353e61763b959b960a55321a85423501e3e9ed7a",
+ "revCount": 2,
+ "type": "git",
+ "url": "git://git.ppad.tech/nixpkgs.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/nixpkgs.git"
+ }
+ },
+ "root": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": "ppad-nixpkgs"
+ }
+ },
+ "systems": {
+ "locked": {
+ "lastModified": 1681028828,
+ "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+ "owner": "nix-systems",
+ "repo": "default",
+ "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+ "type": "github"
+ },
+ "original": {
+ "owner": "nix-systems",
+ "repo": "default",
+ "type": "github"
+ }
+ }
+ },
+ "root": "root",
+ "version": 7
+}
diff --git a/lib/Lightning/Protocol/BOLT9.hs b/lib/Lightning/Protocol/BOLT9.hs
@@ -12,10 +12,35 @@
-- [BOLT #9](https://github.com/lightning/bolts/blob/master/09-features.md).
module Lightning.Protocol.BOLT9 (
- -- * Feature flags
- -- TODO
- ) where
+ -- * Context
+ Context(..)
+ , isChannelContext
+ , channelParity
+
+ -- * Bit indices
+ , BitIndex
+ , unBitIndex
+ , bitIndex
+
+ -- * Required/optional bits
+ , RequiredBit
+ , unRequiredBit
+ , requiredBit
+ , requiredFromBitIndex
-import Control.DeepSeq (NFData)
-import GHC.Generics (Generic)
+ , OptionalBit
+ , unOptionalBit
+ , optionalBit
+ , optionalFromBitIndex
+
+ -- * Feature vectors
+ , FeatureVector
+ , unFeatureVector
+ , FV.empty
+ , fromByteString
+ , set
+ , clear
+ , member
+ ) where
+import Lightning.Protocol.BOLT9.Types as FV
diff --git a/lib/Lightning/Protocol/BOLT9/Types.hs b/lib/Lightning/Protocol/BOLT9/Types.hs
@@ -0,0 +1,243 @@
+{-# 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 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 #-}
+
+-- 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 :: 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 :: 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
+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 -> 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 -> FeatureVector -> Bool
+member (BitIndex idx) (FeatureVector bs)
+ | BS.null bs = False
+ | otherwise =
+ let byteIdx = fromIntegral idx `div` 8
+ bitOffset = fromIntegral idx `mod` 8
+ len = BS.length bs
+ in if byteIdx >= len
+ then False
+ else
+ let realIdx = len - 1 - byteIdx
+ byte = BS.index bs realIdx
+ in byte B..&. B.shiftL 1 bitOffset /= 0
+{-# INLINE member #-}
+
+-- Internal helpers ---------------------------------------------------------
+
+-- | Update a single byte at the given index.
+updateByteAt :: Int -> Word8 -> ByteString -> ByteString
+updateByteAt !i !w !bs =
+ let (before, after) = BS.splitAt i bs
+ in case BS.uncons after of
+ Nothing -> bs -- shouldn't happen if i is valid
+ Just (_, rest) -> before <> BS.singleton w <> rest
+{-# INLINE updateByteAt #-}
+
+-- | Remove leading zero bytes from a ByteString.
+stripLeadingZeros :: ByteString -> ByteString
+stripLeadingZeros = BS.dropWhile (== 0)
+{-# INLINE stripLeadingZeros #-}
diff --git a/ppad-bolt9.cabal b/ppad-bolt9.cabal
@@ -25,6 +25,7 @@ library
-Wall
exposed-modules:
Lightning.Protocol.BOLT9
+ Lightning.Protocol.BOLT9.Types
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
