bolt9

Lightning feature flags, per BOLT #9 (docs.ppad.tech/bolt9).
git clone git://git.ppad.tech/bolt9.git
Log | Files | Refs | README | LICENSE

Codec.hs (4815B)

      1 {-# OPTIONS_HADDOCK prune #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 
      4 -- |
      5 -- Module: Lightning.Protocol.BOLT9.Codec
      6 -- Copyright: (c) 2025 Jared Tobin
      7 -- License: MIT
      8 -- Maintainer: Jared Tobin <jared@ppad.tech>
      9 --
     10 -- Parsing and rendering for BOLT #9 feature vectors.
     11 
     12 module Lightning.Protocol.BOLT9.Codec (
     13     -- * Parsing and rendering
     14     parse
     15   , render
     16 
     17     -- * Bit operations
     18   , setBit
     19   , clearBit
     20   , testBit
     21 
     22     -- * Feature operations
     23   , setFeature
     24   , hasFeature
     25   , isFeatureSet
     26   , listFeatures
     27   ) where
     28 
     29 import Data.ByteString (ByteString)
     30 import qualified Data.ByteString as BS
     31 import Data.Word (Word16)
     32 import Lightning.Protocol.BOLT9.Features
     33 import Lightning.Protocol.BOLT9.Types
     34   ( FeatureLevel(..)
     35   , FeatureVector
     36   , bitIndex
     37   , clear
     38   , fromByteString
     39   , member
     40   , set
     41   , unFeatureVector
     42   )
     43 
     44 -- Parsing and rendering ------------------------------------------------------
     45 
     46 -- | Parse a ByteString into a FeatureVector.
     47 --
     48 --   Alias for 'fromByteString'.
     49 parse :: ByteString -> FeatureVector
     50 parse = fromByteString
     51 {-# INLINE parse #-}
     52 
     53 -- | Render a FeatureVector to a ByteString, trimming leading zero bytes
     54 --   for compact encoding.
     55 render :: FeatureVector -> ByteString
     56 render = BS.dropWhile (== 0) . unFeatureVector
     57 {-# INLINE render #-}
     58 
     59 -- Bit operations -------------------------------------------------------------
     60 
     61 -- | Set a bit by raw index.
     62 --
     63 --   >>> setBit 17 empty
     64 --   FeatureVector {unFeatureVector = "\STX"}
     65 setBit :: Word16 -> FeatureVector -> FeatureVector
     66 setBit !idx = set (bitIndex idx)
     67 {-# INLINE setBit #-}
     68 
     69 -- | Clear a bit by raw index.
     70 --
     71 --   >>> clearBit 17 (setBit 17 empty)
     72 --   FeatureVector {unFeatureVector = ""}
     73 clearBit :: Word16 -> FeatureVector -> FeatureVector
     74 clearBit !idx = clear (bitIndex idx)
     75 {-# INLINE clearBit #-}
     76 
     77 -- | Test if a bit is set.
     78 --
     79 --   >>> testBit 17 (setBit 17 empty)
     80 --   True
     81 --   >>> testBit 16 (setBit 17 empty)
     82 --   False
     83 testBit :: Word16 -> FeatureVector -> Bool
     84 testBit !idx = member (bitIndex idx)
     85 {-# INLINE testBit #-}
     86 
     87 -- Feature operations ---------------------------------------------------------
     88 
     89 -- | Set a feature's bit at the given level.
     90 --
     91 --   'Required' sets the even bit, 'Optional' sets the odd bit.
     92 --
     93 --   >>> import Data.Maybe (fromJust)
     94 --   >>> let mpp = fromJust (featureByName "basic_mpp")
     95 --   >>> setFeature mpp Optional empty  -- set optional bit (17)
     96 --   FeatureVector {unFeatureVector = "\STX"}
     97 --   >>> setFeature mpp Required empty  -- set required bit (16)
     98 --   FeatureVector {unFeatureVector = "\SOH"}
     99 setFeature :: Feature -> FeatureLevel -> FeatureVector -> FeatureVector
    100 setFeature !f !level = setBit targetBit
    101   where
    102     !baseBit   = featureBaseBit f
    103     !targetBit = case level of
    104       Required -> baseBit
    105       Optional -> baseBit + 1
    106 {-# INLINE setFeature #-}
    107 
    108 -- | Check if a feature is set in the vector.
    109 --
    110 --   Returns:
    111 --
    112 --   * @Just Required@ if the required (even) bit is set
    113 --   * @Just Optional@ if the optional (odd) bit is set (and required is not)
    114 --   * @Nothing@ if neither bit is set
    115 --
    116 --   >>> import Data.Maybe (fromJust)
    117 --   >>> let mpp = fromJust (featureByName "basic_mpp")
    118 --   >>> hasFeature mpp (setFeature mpp Optional empty)
    119 --   Just Optional
    120 --   >>> hasFeature mpp (setFeature mpp Required empty)
    121 --   Just Required
    122 --   >>> hasFeature mpp empty
    123 --   Nothing
    124 hasFeature :: Feature -> FeatureVector -> Maybe FeatureLevel
    125 hasFeature !f !fv
    126   | testBit baseBit fv       = Just Required
    127   | testBit (baseBit + 1) fv = Just Optional
    128   | otherwise                = Nothing
    129   where
    130     !baseBit = featureBaseBit f
    131 {-# INLINE hasFeature #-}
    132 
    133 -- | Check if either bit of a feature is set in the vector.
    134 --
    135 --   >>> import Data.Maybe (fromJust)
    136 --   >>> let mpp = fromJust (featureByName "basic_mpp")
    137 --   >>> isFeatureSet mpp (setFeature mpp Optional empty)
    138 --   True
    139 --   >>> isFeatureSet mpp empty
    140 --   False
    141 isFeatureSet :: Feature -> FeatureVector -> Bool
    142 isFeatureSet !f !fv =
    143   let !baseBit = featureBaseBit f
    144   in  testBit baseBit fv || testBit (baseBit + 1) fv
    145 {-# INLINE isFeatureSet #-}
    146 
    147 -- | List all known features that are set in the vector.
    148 --
    149 --   Returns pairs of (Feature, FeatureLevel) indicating whether each
    150 --   feature is set as required or optional.
    151 --
    152 --   >>> import Data.Maybe (fromJust)
    153 --   >>> let mpp = fromJust (featureByName "basic_mpp")
    154 --   >>> let ps = fromJust (featureByName "payment_secret")
    155 --   >>> let fv = setFeature mpp Optional (setFeature ps Required empty)
    156 --   >>> map (\(f, l) -> (featureName f, l)) (listFeatures fv)
    157 --   [("payment_secret",Required),("basic_mpp",Optional)]
    158 listFeatures :: FeatureVector -> [(Feature, FeatureLevel)]
    159 listFeatures !fv = foldr check [] knownFeatures
    160   where
    161     check !f !acc = case hasFeature f fv of
    162       Just level -> (f, level) : acc
    163       Nothing    -> acc