{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
module Lightning.Protocol.BOLT9.Codec (
parse
, render
, setBit
, clearBit
, testBit
, 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
)
parse :: ByteString -> FeatureVector
parse :: ByteString -> FeatureVector
parse = ByteString -> FeatureVector
fromByteString
{-# INLINE parse #-}
render :: FeatureVector -> ByteString
render :: FeatureVector -> ByteString
render = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0) (ByteString -> ByteString)
-> (FeatureVector -> ByteString) -> FeatureVector -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FeatureVector -> ByteString
unFeatureVector
{-# INLINE render #-}
setBit :: Word16 -> FeatureVector -> FeatureVector
setBit :: Word16 -> FeatureVector -> FeatureVector
setBit !Word16
idx = BitIndex -> FeatureVector -> FeatureVector
set (Word16 -> BitIndex
bitIndex Word16
idx)
{-# INLINE setBit #-}
clearBit :: Word16 -> FeatureVector -> FeatureVector
clearBit :: Word16 -> FeatureVector -> FeatureVector
clearBit !Word16
idx = BitIndex -> FeatureVector -> FeatureVector
clear (Word16 -> BitIndex
bitIndex Word16
idx)
{-# INLINE clearBit #-}
testBit :: Word16 -> FeatureVector -> Bool
testBit :: Word16 -> FeatureVector -> Bool
testBit !Word16
idx = BitIndex -> FeatureVector -> Bool
member (Word16 -> BitIndex
bitIndex Word16
idx)
{-# INLINE testBit #-}
setFeature :: Feature -> FeatureLevel -> FeatureVector -> FeatureVector
setFeature :: Feature -> FeatureLevel -> FeatureVector -> FeatureVector
setFeature !Feature
f !FeatureLevel
level = Word16 -> FeatureVector -> FeatureVector
setBit Word16
targetBit
where
!baseBit :: Word16
baseBit = Feature -> Word16
featureBaseBit Feature
f
!targetBit :: Word16
targetBit = case FeatureLevel
level of
FeatureLevel
Required -> Word16
baseBit
FeatureLevel
Optional -> Word16
baseBit Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1
{-# INLINE setFeature #-}
hasFeature :: Feature -> FeatureVector -> Maybe FeatureLevel
hasFeature :: Feature -> FeatureVector -> Maybe FeatureLevel
hasFeature !Feature
f !FeatureVector
fv
| Word16 -> FeatureVector -> Bool
testBit Word16
baseBit FeatureVector
fv = FeatureLevel -> Maybe FeatureLevel
forall a. a -> Maybe a
Just FeatureLevel
Required
| Word16 -> FeatureVector -> Bool
testBit (Word16
baseBit Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1) FeatureVector
fv = FeatureLevel -> Maybe FeatureLevel
forall a. a -> Maybe a
Just FeatureLevel
Optional
| Bool
otherwise = Maybe FeatureLevel
forall a. Maybe a
Nothing
where
!baseBit :: Word16
baseBit = Feature -> Word16
featureBaseBit Feature
f
{-# INLINE hasFeature #-}
isFeatureSet :: Feature -> FeatureVector -> Bool
isFeatureSet :: Feature -> FeatureVector -> Bool
isFeatureSet !Feature
f !FeatureVector
fv =
let !baseBit :: Word16
baseBit = Feature -> Word16
featureBaseBit Feature
f
in Word16 -> FeatureVector -> Bool
testBit Word16
baseBit FeatureVector
fv Bool -> Bool -> Bool
|| Word16 -> FeatureVector -> Bool
testBit (Word16
baseBit Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
1) FeatureVector
fv
{-# INLINE isFeatureSet #-}
listFeatures :: FeatureVector -> [(Feature, FeatureLevel)]
listFeatures :: FeatureVector -> [(Feature, FeatureLevel)]
listFeatures !FeatureVector
fv = (Feature -> [(Feature, FeatureLevel)] -> [(Feature, FeatureLevel)])
-> [(Feature, FeatureLevel)]
-> [Feature]
-> [(Feature, FeatureLevel)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [(Feature, FeatureLevel)] -> [(Feature, FeatureLevel)]
check [] [Feature]
knownFeatures
where
check :: Feature -> [(Feature, FeatureLevel)] -> [(Feature, FeatureLevel)]
check !Feature
f ![(Feature, FeatureLevel)]
acc = case Feature -> FeatureVector -> Maybe FeatureLevel
hasFeature Feature
f FeatureVector
fv of
Just FeatureLevel
level -> (Feature
f, FeatureLevel
level) (Feature, FeatureLevel)
-> [(Feature, FeatureLevel)] -> [(Feature, FeatureLevel)]
forall a. a -> [a] -> [a]
: [(Feature, FeatureLevel)]
acc
Maybe FeatureLevel
Nothing -> [(Feature, FeatureLevel)]
acc