Types.hs (9370B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 {-# LANGUAGE DeriveGeneric #-} 4 5 -- | 6 -- Module: Lightning.Protocol.BOLT9.Types 7 -- Copyright: (c) 2025 Jared Tobin 8 -- License: MIT 9 -- Maintainer: Jared Tobin <jared@ppad.tech> 10 -- 11 -- Baseline types for BOLT #9 feature flags. 12 13 module Lightning.Protocol.BOLT9.Types ( 14 -- * Context 15 Context(..) 16 , isChannelContext 17 , channelParity 18 19 -- * Bit indices 20 , BitIndex 21 , unBitIndex 22 , bitIndex 23 24 -- * Required/optional level 25 , FeatureLevel(..) 26 27 -- * Required/optional bits 28 , RequiredBit 29 , unRequiredBit 30 , requiredBit 31 , requiredFromBitIndex 32 33 , OptionalBit 34 , unOptionalBit 35 , optionalBit 36 , optionalFromBitIndex 37 38 -- * Feature vectors 39 , FeatureVector 40 , unFeatureVector 41 , empty 42 , fromByteString 43 , set 44 , clear 45 , member 46 ) where 47 48 import Control.DeepSeq (NFData) 49 import qualified Data.Bits as B 50 import Data.ByteString (ByteString) 51 import qualified Data.ByteString as BS 52 import Data.Word (Word8, Word16) 53 import GHC.Generics (Generic) 54 55 -- Context ------------------------------------------------------------------ 56 57 -- | Presentation context for feature flags. 58 -- 59 -- Per BOLT #9, features are presented in different message contexts: 60 -- 61 -- * 'Init' - the @init@ message 62 -- * 'NodeAnn' - @node_announcement@ messages 63 -- * 'ChanAnn' - @channel_announcement@ messages (normal) 64 -- * 'ChanAnnOdd' - @channel_announcement@, always odd (optional) 65 -- * 'ChanAnnEven' - @channel_announcement@, always even (required) 66 -- * 'Invoice' - BOLT 11 invoices 67 -- * 'Blinded' - @allowed_features@ field of a blinded path 68 -- * 'ChanType' - @channel_type@ field when opening channels 69 data Context 70 = Init -- ^ I: presented in the @init@ message 71 | NodeAnn -- ^ N: presented in @node_announcement@ messages 72 | ChanAnn -- ^ C: presented in @channel_announcement@ message 73 | ChanAnnOdd -- ^ C-: @channel_announcement@, always odd (optional) 74 | ChanAnnEven -- ^ C+: @channel_announcement@, always even (required) 75 | Invoice -- ^ 9: presented in BOLT 11 invoices 76 | Blinded -- ^ B: @allowed_features@ field of a blinded path 77 | ChanType -- ^ T: @channel_type@ field when opening channels 78 deriving (Eq, Ord, Show, Generic) 79 80 instance NFData Context 81 82 -- | Check if a context is a channel announcement context (C, C-, or C+). 83 isChannelContext :: Context -> Bool 84 isChannelContext ChanAnn = True 85 isChannelContext ChanAnnOdd = True 86 isChannelContext ChanAnnEven = True 87 isChannelContext _ = False 88 {-# INLINE isChannelContext #-} 89 90 -- | For channel contexts with forced parity, return 'Just' the required 91 -- parity: 'True' for even (C+), 'False' for odd (C-). Returns 'Nothing' 92 -- for contexts without forced parity. 93 channelParity :: Context -> Maybe Bool 94 channelParity ChanAnnOdd = Just False -- odd 95 channelParity ChanAnnEven = Just True -- even 96 channelParity _ = Nothing 97 {-# INLINE channelParity #-} 98 99 -- FeatureLevel ------------------------------------------------------------- 100 101 -- | Whether a feature is set as required or optional. 102 -- 103 -- Per BOLT #9, each feature has a pair of bits: the even bit indicates 104 -- required (compulsory) support, the odd bit indicates optional support. 105 data FeatureLevel 106 = Required -- ^ The feature is required (even bit set) 107 | Optional -- ^ The feature is optional (odd bit set) 108 deriving (Eq, Ord, Show, Generic) 109 110 instance NFData FeatureLevel 111 112 -- BitIndex ----------------------------------------------------------------- 113 114 -- | A bit index into a feature vector. Bit 0 is the least significant bit. 115 -- 116 -- Valid range: 0-65535 (sufficient for any practical feature flag). 117 newtype BitIndex = BitIndex { unBitIndex :: Word16 } 118 deriving (Eq, Ord, Show, Generic) 119 120 instance NFData BitIndex 121 122 -- | Smart constructor for 'BitIndex'. Always succeeds since all Word16 123 -- values are valid. 124 bitIndex :: Word16 -> BitIndex 125 bitIndex = BitIndex 126 {-# INLINE bitIndex #-} 127 128 -- RequiredBit -------------------------------------------------------------- 129 130 -- | A required (compulsory) feature bit. Required bits are always even. 131 newtype RequiredBit = RequiredBit { unRequiredBit :: Word16 } 132 deriving (Eq, Ord, Show, Generic) 133 134 instance NFData RequiredBit 135 136 -- | Smart constructor for 'RequiredBit'. Returns 'Nothing' if the bit 137 -- index is odd. 138 -- 139 -- >>> requiredBit 16 140 -- Just (RequiredBit {unRequiredBit = 16}) 141 -- >>> requiredBit 17 142 -- Nothing 143 requiredBit :: Word16 -> Maybe RequiredBit 144 requiredBit !w 145 | w B..&. 1 == 0 = Just (RequiredBit w) 146 | otherwise = Nothing 147 {-# INLINE requiredBit #-} 148 149 -- | Convert a 'BitIndex' to a 'RequiredBit'. Returns 'Nothing' if odd. 150 requiredFromBitIndex :: BitIndex -> Maybe RequiredBit 151 requiredFromBitIndex (BitIndex w) = requiredBit w 152 {-# INLINE requiredFromBitIndex #-} 153 154 -- OptionalBit -------------------------------------------------------------- 155 156 -- | An optional feature bit. Optional bits are always odd. 157 newtype OptionalBit = OptionalBit { unOptionalBit :: Word16 } 158 deriving (Eq, Ord, Show, Generic) 159 160 instance NFData OptionalBit 161 162 -- | Smart constructor for 'OptionalBit'. Returns 'Nothing' if the bit 163 -- index is even. 164 -- 165 -- >>> optionalBit 17 166 -- Just (OptionalBit {unOptionalBit = 17}) 167 -- >>> optionalBit 16 168 -- Nothing 169 optionalBit :: Word16 -> Maybe OptionalBit 170 optionalBit !w 171 | w B..&. 1 == 1 = Just (OptionalBit w) 172 | otherwise = Nothing 173 {-# INLINE optionalBit #-} 174 175 -- | Convert a 'BitIndex' to an 'OptionalBit'. Returns 'Nothing' if even. 176 optionalFromBitIndex :: BitIndex -> Maybe OptionalBit 177 optionalFromBitIndex (BitIndex w) = optionalBit w 178 {-# INLINE optionalFromBitIndex #-} 179 180 -- FeatureVector ------------------------------------------------------------ 181 182 -- | A feature vector represented as a strict ByteString. 183 -- 184 -- The vector is stored in big-endian byte order (most significant byte 185 -- first), with bits numbered from the least significant bit of the last 186 -- byte. Bit 0 is at position 0 of the last byte. 187 newtype FeatureVector = FeatureVector { unFeatureVector :: ByteString } 188 deriving (Eq, Ord, Show, Generic) 189 190 instance NFData FeatureVector 191 192 -- | The empty feature vector (no features set). 193 -- 194 -- >>> empty 195 -- FeatureVector {unFeatureVector = ""} 196 empty :: FeatureVector 197 empty = FeatureVector BS.empty 198 {-# INLINE empty #-} 199 200 -- | Wrap a ByteString as a FeatureVector. 201 fromByteString :: ByteString -> FeatureVector 202 fromByteString = FeatureVector 203 {-# INLINE fromByteString #-} 204 205 -- | Set a bit in the feature vector. 206 -- 207 -- >>> set (bitIndex 0) empty 208 -- FeatureVector {unFeatureVector = "\SOH"} 209 -- >>> set (bitIndex 8) empty 210 -- FeatureVector {unFeatureVector = "\SOH\NUL"} 211 set :: BitIndex -> FeatureVector -> FeatureVector 212 set (BitIndex idx) (FeatureVector bs) = 213 let byteIdx = fromIntegral idx `div` 8 214 bitOffset = fromIntegral idx `mod` 8 215 len = BS.length bs 216 -- Number of bytes needed to hold this bit 217 needed = byteIdx + 1 218 -- Pad with zeros if necessary (prepend to maintain big-endian) 219 bs' = if needed > len 220 then BS.replicate (needed - len) 0 <> bs 221 else bs 222 len' = BS.length bs' 223 -- Index from the end (big-endian: last byte has lowest bits) 224 realIdx = len' - 1 - byteIdx 225 oldByte = BS.index bs' realIdx 226 newByte = oldByte B..|. B.shiftL 1 bitOffset 227 in FeatureVector (updateByteAt realIdx newByte bs') 228 {-# INLINE set #-} 229 230 -- | Clear a bit in the feature vector. 231 clear :: BitIndex -> FeatureVector -> FeatureVector 232 clear (BitIndex idx) (FeatureVector bs) 233 | BS.null bs = FeatureVector bs 234 | otherwise = 235 let byteIdx = fromIntegral idx `div` 8 236 bitOffset = fromIntegral idx `mod` 8 237 len = BS.length bs 238 in if byteIdx >= len 239 then FeatureVector bs -- bit not in range, already clear 240 else 241 let realIdx = len - 1 - byteIdx 242 oldByte = BS.index bs realIdx 243 newByte = oldByte B..&. B.complement (B.shiftL 1 bitOffset) 244 in FeatureVector (stripLeadingZeros (updateByteAt realIdx newByte bs)) 245 {-# INLINE clear #-} 246 247 -- | Test if a bit is set in the feature vector. 248 -- 249 -- >>> member (bitIndex 0) (set (bitIndex 0) empty) 250 -- True 251 -- >>> member (bitIndex 1) (set (bitIndex 0) empty) 252 -- False 253 member :: BitIndex -> FeatureVector -> Bool 254 member (BitIndex idx) (FeatureVector bs) 255 | BS.null bs = False 256 | otherwise = 257 let byteIdx = fromIntegral idx `div` 8 258 bitOffset = fromIntegral idx `mod` 8 259 len = BS.length bs 260 in if byteIdx >= len 261 then False 262 else 263 let realIdx = len - 1 - byteIdx 264 byte = BS.index bs realIdx 265 in byte B..&. B.shiftL 1 bitOffset /= 0 266 {-# INLINE member #-} 267 268 -- Internal helpers --------------------------------------------------------- 269 270 -- | Update a single byte at the given index. 271 updateByteAt :: Int -> Word8 -> ByteString -> ByteString 272 updateByteAt !i !w !bs = 273 let (before, after) = BS.splitAt i bs 274 in case BS.uncons after of 275 Nothing -> bs -- shouldn't happen if i is valid 276 Just (_, rest) -> before <> BS.singleton w <> rest 277 {-# INLINE updateByteAt #-} 278 279 -- | Remove leading zero bytes from a ByteString. 280 stripLeadingZeros :: ByteString -> ByteString 281 stripLeadingZeros = BS.dropWhile (== 0) 282 {-# INLINE stripLeadingZeros #-}