{-# 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 (ValidationError -> ValidationError -> Bool
(ValidationError -> ValidationError -> Bool)
-> (ValidationError -> ValidationError -> Bool)
-> Eq ValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidationError -> ValidationError -> Bool
== :: ValidationError -> ValidationError -> Bool
$c/= :: ValidationError -> ValidationError -> Bool
/= :: ValidationError -> ValidationError -> Bool
Eq, Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> String
(Int -> ValidationError -> ShowS)
-> (ValidationError -> String)
-> ([ValidationError] -> ShowS)
-> Show ValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidationError -> ShowS
showsPrec :: Int -> ValidationError -> ShowS
$cshow :: ValidationError -> String
show :: ValidationError -> String
$cshowList :: [ValidationError] -> ShowS
showList :: [ValidationError] -> ShowS
Show, (forall x. ValidationError -> Rep ValidationError x)
-> (forall x. Rep ValidationError x -> ValidationError)
-> Generic ValidationError
forall x. Rep ValidationError x -> ValidationError
forall x. ValidationError -> Rep ValidationError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ValidationError -> Rep ValidationError x
from :: forall x. ValidationError -> Rep ValidationError x
$cto :: forall x. Rep ValidationError x -> ValidationError
to :: forall x. Rep ValidationError x -> ValidationError
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 :: Context -> FeatureVector -> Either [ValidationError] ()
validateLocal !Context
ctx !FeatureVector
fv =
  let errs :: [ValidationError]
errs = FeatureVector -> [ValidationError]
bothBitsErrors FeatureVector
fv
          [ValidationError] -> [ValidationError] -> [ValidationError]
forall a. [a] -> [a] -> [a]
++ Context -> FeatureVector -> [ValidationError]
contextErrors Context
ctx FeatureVector
fv
          [ValidationError] -> [ValidationError] -> [ValidationError]
forall a. [a] -> [a] -> [a]
++ FeatureVector -> [ValidationError]
dependencyErrors FeatureVector
fv
          [ValidationError] -> [ValidationError] -> [ValidationError]
forall a. [a] -> [a] -> [a]
++ Context -> FeatureVector -> [ValidationError]
parityErrors Context
ctx FeatureVector
fv
  in  if [ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ValidationError]
errs
      then () -> Either [ValidationError] ()
forall a b. b -> Either a b
Right ()
      else [ValidationError] -> Either [ValidationError] ()
forall a b. a -> Either a b
Left [ValidationError]
errs

-- | Check for features with both bits set.
bothBitsErrors :: FeatureVector -> [ValidationError]
bothBitsErrors :: FeatureVector -> [ValidationError]
bothBitsErrors !FeatureVector
fv = (Feature -> [ValidationError] -> [ValidationError])
-> [ValidationError] -> [Feature] -> [ValidationError]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [ValidationError] -> [ValidationError]
check [] [Feature]
knownFeatures
  where
    check :: Feature -> [ValidationError] -> [ValidationError]
check !Feature
f ![ValidationError]
acc =
      let !baseBit :: Word16
baseBit = Feature -> Word16
featureBaseBit Feature
f
      in  if 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
          then Word16 -> String -> ValidationError
BothBitsSet Word16
baseBit (Feature -> String
featureName Feature
f) ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
acc
          else [ValidationError]
acc

-- | Check for features not allowed in the given context.
contextErrors :: Context -> FeatureVector -> [ValidationError]
contextErrors :: Context -> FeatureVector -> [ValidationError]
contextErrors !Context
ctx !FeatureVector
fv = (Feature -> [ValidationError] -> [ValidationError])
-> [ValidationError] -> [Feature] -> [ValidationError]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [ValidationError] -> [ValidationError]
check [] [Feature]
knownFeatures
  where
    check :: Feature -> [ValidationError] -> [ValidationError]
check !Feature
f ![ValidationError]
acc =
      let !contexts :: [Context]
contexts = Feature -> [Context]
featureContexts Feature
f
      in  if   Feature -> FeatureVector -> Bool
isFeatureSet Feature
f FeatureVector
fv
            Bool -> Bool -> Bool
&& Bool -> Bool
not ([Context] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Context]
contexts)
            Bool -> Bool -> Bool
&& Bool -> Bool
not (Context -> [Context] -> Bool
contextAllowed Context
ctx [Context]
contexts)
          then String -> Context -> ValidationError
ContextNotAllowed (Feature -> String
featureName Feature
f) Context
ctx ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
acc
          else [ValidationError]
acc

-- | Check if a context is allowed given a list of allowed contexts.
contextAllowed :: Context -> [Context] -> Bool
contextAllowed :: Context -> [Context] -> Bool
contextAllowed !Context
ctx ![Context]
allowed = Context
ctx Context -> [Context] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Context]
allowed Bool -> Bool -> Bool
|| Bool
channelMatch
  where
    channelMatch :: Bool
channelMatch = Context -> Bool
isChannelContext Context
ctx Bool -> Bool -> Bool
&& (Context -> Bool) -> [Context] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Context -> Bool
isChannelContext [Context]
allowed

-- | Check for missing dependencies.
dependencyErrors :: FeatureVector -> [ValidationError]
dependencyErrors :: FeatureVector -> [ValidationError]
dependencyErrors !FeatureVector
fv = (Feature -> [ValidationError] -> [ValidationError])
-> [ValidationError] -> [Feature] -> [ValidationError]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Feature -> [ValidationError] -> [ValidationError]
check [] [Feature]
knownFeatures
  where
    check :: Feature -> [ValidationError] -> [ValidationError]
check !Feature
f ![ValidationError]
acc =
      if   Feature -> FeatureVector -> Bool
isFeatureSet Feature
f FeatureVector
fv
      then Feature -> [String] -> [ValidationError]
forall {t :: * -> *}.
Foldable t =>
Feature -> t String -> [ValidationError]
checkDeps Feature
f (Feature -> [String]
featureDependencies Feature
f) [ValidationError] -> [ValidationError] -> [ValidationError]
forall a. [a] -> [a] -> [a]
++ [ValidationError]
acc
      else [ValidationError]
acc

    checkDeps :: Feature -> t String -> [ValidationError]
checkDeps !Feature
f = (String -> [ValidationError] -> [ValidationError])
-> [ValidationError] -> t String -> [ValidationError]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Feature -> String -> [ValidationError] -> [ValidationError]
checkOneDep Feature
f) []

    checkOneDep :: Feature -> String -> [ValidationError] -> [ValidationError]
checkOneDep !Feature
f !String
depName ![ValidationError]
acc =
      case String -> Maybe Feature
featureByName String
depName of
        Maybe Feature
Nothing   -> [ValidationError]
acc  -- unknown dep, skip
        Just !Feature
dep ->
          if   Feature -> FeatureVector -> Bool
isFeatureSet Feature
dep FeatureVector
fv
          then [ValidationError]
acc
          else String -> String -> ValidationError
MissingDependency (Feature -> String
featureName Feature
f) String
depName ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
acc

-- | Check for parity errors in C- and C+ contexts.
parityErrors :: Context -> FeatureVector -> [ValidationError]
parityErrors :: Context -> FeatureVector -> [ValidationError]
parityErrors !Context
ctx !FeatureVector
fv = case Context -> Maybe Bool
channelParity Context
ctx of
  Maybe Bool
Nothing       -> []
  Just Bool
wantEven -> (Word16 -> [ValidationError] -> [ValidationError])
-> [ValidationError] -> [Word16] -> [ValidationError]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Word16 -> [ValidationError] -> [ValidationError]
checkParity Bool
wantEven) [] (FeatureVector -> [Word16]
setBits FeatureVector
fv)
  where
    checkParity :: Bool -> Word16 -> [ValidationError] -> [ValidationError]
checkParity !Bool
wantEven !Word16
bit ![ValidationError]
acc =
      let isEven :: Bool
isEven = Word16
bit Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`mod` Word16
2 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
0
      in  if Bool
isEven Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
wantEven
          then Word16 -> Context -> ValidationError
InvalidParity Word16
bit Context
ctx ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
acc
          else [ValidationError]
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 :: Context -> FeatureVector -> Either [ValidationError] ()
validateRemote !Context
ctx !FeatureVector
fv =
  let errs :: [ValidationError]
errs = FeatureVector -> [ValidationError]
unknownRequiredErrors FeatureVector
fv
          [ValidationError] -> [ValidationError] -> [ValidationError]
forall a. [a] -> [a] -> [a]
++ Context -> FeatureVector -> [ValidationError]
contextErrors Context
ctx FeatureVector
fv
          [ValidationError] -> [ValidationError] -> [ValidationError]
forall a. [a] -> [a] -> [a]
++ Context -> FeatureVector -> [ValidationError]
parityErrors Context
ctx FeatureVector
fv
  in  if [ValidationError] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ValidationError]
errs
      then () -> Either [ValidationError] ()
forall a b. b -> Either a b
Right ()
      else [ValidationError] -> Either [ValidationError] ()
forall a b. a -> Either a b
Left [ValidationError]
errs

-- | Check for unknown required bits.
unknownRequiredErrors :: FeatureVector -> [ValidationError]
unknownRequiredErrors :: FeatureVector -> [ValidationError]
unknownRequiredErrors !FeatureVector
fv = (Word16 -> [ValidationError] -> [ValidationError])
-> [ValidationError] -> [Word16] -> [ValidationError]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word16 -> [ValidationError] -> [ValidationError]
check [] (FeatureVector -> [Word16]
setBits FeatureVector
fv)
  where
    check :: Word16 -> [ValidationError] -> [ValidationError]
check !Word16
bit ![ValidationError]
acc
      | Word16
bit Word16 -> Word16 -> Word16
forall a. Integral a => a -> a -> a
`mod` Word16
2 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
1 = [ValidationError]
acc  -- odd bit, optional, ignore
      | Bool
otherwise = case Word16 -> Maybe Feature
featureByBit Word16
bit of
          Just Feature
_  -> [ValidationError]
acc  -- known feature
          Maybe Feature
Nothing -> Word16 -> ValidationError
UnknownRequiredBit Word16
bit ValidationError -> [ValidationError] -> [ValidationError]
forall a. a -> [a] -> [a]
: [ValidationError]
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 :: FeatureVector -> Maybe Word16
highestSetBit !FeatureVector
fv =
  let !bs :: ByteString
bs = FeatureVector -> ByteString
unFeatureVector FeatureVector
fv
  in  if ByteString -> Bool
BS.null ByteString
bs
      then Maybe Word16
forall a. Maybe a
Nothing
      else ByteString -> Maybe Word16
findHighestBit ByteString
bs

-- | Find the highest set bit in a non-empty ByteString.
findHighestBit :: ByteString -> Maybe Word16
findHighestBit :: ByteString -> Maybe Word16
findHighestBit !ByteString
bs = Int -> Maybe Word16
forall {a}. Num a => Int -> Maybe a
go Int
0
  where
    !len :: Int
len = ByteString -> Int
BS.length ByteString
bs

    go :: Int -> Maybe a
go !Int
i
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = Maybe a
forall a. Maybe a
Nothing
      | Bool
otherwise =
          let !byte :: Word8
byte = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs Int
i
          in  if Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
              then Int -> Maybe a
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
              else
                let !bytePos :: Int
bytePos = Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
                    !highBit :: Int
highBit = Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall b. FiniteBits b => b -> Int
B.countLeadingZeros Word8
byte
                    !bitIdx :: a
bitIdx  = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bytePos a -> a -> a
forall a. Num a => a -> a -> a
* a
8 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
highBit
                in  a -> Maybe a
forall a. a -> Maybe a
Just a
bitIdx

-- | Collect all set bits in a feature vector.
--
--   Returns a list of bit indices in ascending order.
setBits :: FeatureVector -> [Word16]
setBits :: FeatureVector -> [Word16]
setBits !FeatureVector
fv =
  let !bs :: ByteString
bs  = FeatureVector -> ByteString
unFeatureVector FeatureVector
fv
      !len :: Int
len = ByteString -> Int
BS.length ByteString
bs
  in  ByteString -> Int -> Int -> [Word16] -> [Word16]
collectBits ByteString
bs Int
len Int
0 []

-- | Collect bits from a ByteString into a list.
collectBits :: ByteString -> Int -> Int -> [Word16] -> [Word16]
collectBits :: ByteString -> Int -> Int -> [Word16] -> [Word16]
collectBits !ByteString
bs !Int
len !Int
i ![Word16]
acc
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len  = [Word16]
acc
  | Bool
otherwise =
      let !byte :: Word8
byte    = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index ByteString
bs (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i)
          !baseIdx :: Word16
baseIdx = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
8
          !acc' :: [Word16]
acc'    = Word8 -> Word16 -> [Word16] -> [Word16]
forall a. Bits a => a -> Word16 -> [Word16] -> [Word16]
collectByteBits Word8
byte Word16
baseIdx [Word16]
acc
      in  ByteString -> Int -> Int -> [Word16] -> [Word16]
collectBits ByteString
bs Int
len (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) [Word16]
acc'

-- | Collect set bits from a single byte.
collectByteBits :: B.Bits a => a -> Word16 -> [Word16] -> [Word16]
collectByteBits :: forall a. Bits a => a -> Word16 -> [Word16] -> [Word16]
collectByteBits !a
byte !Word16
baseIdx = Int -> [Word16] -> [Word16]
go Int
7
  where
    go :: Int -> [Word16] -> [Word16]
go !Int
bit ![Word16]
acc
      | Int
bit Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0        = [Word16]
acc
      | a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
B.testBit a
byte Int
bit = Int -> [Word16] -> [Word16]
go (Int
bit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ((Word16
baseIdx Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
bit) Word16 -> [Word16] -> [Word16]
forall a. a -> [a] -> [a]
: [Word16]
acc)
      | Bool
otherwise          = Int -> [Word16] -> [Word16]
go (Int
bit Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Word16]
acc