{-# OPTIONS_HADDOCK prune #-}

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}

-- |
-- Module: Lightning.Protocol.BOLT7.Validate
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Validation functions for BOLT #7 gossip messages.
--
-- These functions check message invariants as specified in BOLT #7.
-- They do NOT verify cryptographic signatures; that requires the
-- actual public keys and is left to the caller.

module Lightning.Protocol.BOLT7.Validate (
  -- * Error types
    ValidationError(..)

  -- * Validation functions
  , validateChannelAnnouncement
  , validateNodeAnnouncement
  , validateChannelUpdate
  , validateQueryChannelRange
  , validateReplyChannelRange
  ) where

import Control.DeepSeq (NFData)
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Lightning.Protocol.BOLT7.Codec (decodeShortChannelIdList)
import Lightning.Protocol.BOLT7.Messages
import Lightning.Protocol.BOLT7.Types

-- | Validation errors.
data ValidationError
  = ValidateNodeIdOrdering        -- ^ node_id_1 must be < node_id_2
  | ValidateUnknownEvenFeature    -- ^ Unknown even feature bit set
  | ValidateHtlcAmounts           -- ^ htlc_minimum_msat > htlc_maximum_msat
  | ValidateBlockOverflow         -- ^ first_blocknum + number_of_blocks overflow
  | ValidateScidNotAscending      -- ^ short_channel_ids not in ascending order
  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

-- | Validate channel_announcement message.
--
-- Checks:
--
-- * node_id_1 < node_id_2 (lexicographic ordering)
-- * Feature bits do not contain unknown even bits
validateChannelAnnouncement :: ChannelAnnouncement
                            -> Either ValidationError ()
validateChannelAnnouncement :: ChannelAnnouncement -> Either ValidationError ()
validateChannelAnnouncement ChannelAnnouncement
msg = do
  -- Check node_id ordering
  let nid1 :: NodeId
nid1 = ChannelAnnouncement -> NodeId
channelAnnNodeId1 ChannelAnnouncement
msg
      nid2 :: NodeId
nid2 = ChannelAnnouncement -> NodeId
channelAnnNodeId2 ChannelAnnouncement
msg
  if NodeId
nid1 NodeId -> NodeId -> Bool
forall a. Ord a => a -> a -> Bool
>= NodeId
nid2
    then ValidationError -> Either ValidationError ()
forall a b. a -> Either a b
Left ValidationError
ValidateNodeIdOrdering
    else () -> Either ValidationError ()
forall a b. b -> Either a b
Right ()
  -- Check feature bits
  FeatureBits -> Either ValidationError ()
validateFeatureBits (ChannelAnnouncement -> FeatureBits
channelAnnFeatures ChannelAnnouncement
msg)

-- | Validate node_announcement message.
--
-- Checks:
--
-- * Feature bits do not contain unknown even bits
--
-- Note: Address list validation (duplicate DNS entries) and alias
-- UTF-8 validation are not enforced; the spec allows non-UTF-8 aliases.
validateNodeAnnouncement :: NodeAnnouncement -> Either ValidationError ()
validateNodeAnnouncement :: NodeAnnouncement -> Either ValidationError ()
validateNodeAnnouncement NodeAnnouncement
msg = do
  FeatureBits -> Either ValidationError ()
validateFeatureBits (NodeAnnouncement -> FeatureBits
nodeAnnFeatures NodeAnnouncement
msg)

-- | Validate channel_update message.
--
-- Checks:
--
-- * htlc_minimum_msat <= htlc_maximum_msat (if htlc_maximum_msat present)
--
-- Note: The spec says message_flags bit 0 MUST be set if htlc_maximum_msat
-- is advertised. We don't enforce this at validation time since the codec
-- already handles the conditional field based on the flag.
validateChannelUpdate :: ChannelUpdate -> Either ValidationError ()
validateChannelUpdate :: ChannelUpdate -> Either ValidationError ()
validateChannelUpdate ChannelUpdate
msg = do
  case ChannelUpdate -> Maybe HtlcMaximumMsat
chanUpdateHtlcMaxMsat ChannelUpdate
msg of
    Maybe HtlcMaximumMsat
Nothing -> () -> Either ValidationError ()
forall a b. b -> Either a b
Right ()
    Just HtlcMaximumMsat
htlcMax ->
      let htlcMin :: HtlcMinimumMsat
htlcMin = ChannelUpdate -> HtlcMinimumMsat
chanUpdateHtlcMinMsat ChannelUpdate
msg
      in  if HtlcMinimumMsat -> Word64
getHtlcMinimumMsat HtlcMinimumMsat
htlcMin Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> HtlcMaximumMsat -> Word64
getHtlcMaximumMsat HtlcMaximumMsat
htlcMax
          then ValidationError -> Either ValidationError ()
forall a b. a -> Either a b
Left ValidationError
ValidateHtlcAmounts
          else () -> Either ValidationError ()
forall a b. b -> Either a b
Right ()

-- | Validate query_channel_range message.
--
-- Checks:
--
-- * first_blocknum + number_of_blocks does not overflow
validateQueryChannelRange :: QueryChannelRange -> Either ValidationError ()
validateQueryChannelRange :: QueryChannelRange -> Either ValidationError ()
validateQueryChannelRange QueryChannelRange
msg = do
  let first :: Word64
first = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (QueryChannelRange -> Word32
queryRangeFirstBlock QueryChannelRange
msg) :: Word64
      num :: Word64
num   = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (QueryChannelRange -> Word32
queryRangeNumBlocks QueryChannelRange
msg) :: Word64
  if Word64
first Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
num Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
forall a. Bounded a => a
maxBound :: Word32)
    then ValidationError -> Either ValidationError ()
forall a b. a -> Either a b
Left ValidationError
ValidateBlockOverflow
    else () -> Either ValidationError ()
forall a b. b -> Either a b
Right ()

-- | Validate reply_channel_range message.
--
-- Checks:
--
-- * Encoded short_channel_ids are in ascending order
validateReplyChannelRange :: ReplyChannelRange -> Either ValidationError ()
validateReplyChannelRange :: ReplyChannelRange -> Either ValidationError ()
validateReplyChannelRange ReplyChannelRange
msg =
  case ByteString -> Either DecodeError [ShortChannelId]
decodeShortChannelIdList (ReplyChannelRange -> ByteString
replyRangeData ReplyChannelRange
msg) of
    Left DecodeError
_ -> () -> Either ValidationError ()
forall a b. b -> Either a b
Right ()  -- Can't decode, skip validation
    Right [ShortChannelId]
scids -> [ShortChannelId] -> Either ValidationError ()
checkAscending [ShortChannelId]
scids
  where
    checkAscending :: [ShortChannelId] -> Either ValidationError ()
checkAscending [] = () -> Either ValidationError ()
forall a b. b -> Either a b
Right ()
    checkAscending [ShortChannelId
_] = () -> Either ValidationError ()
forall a b. b -> Either a b
Right ()
    checkAscending (ShortChannelId
a:ShortChannelId
b:[ShortChannelId]
rest)
      | ShortChannelId -> ByteString
getShortChannelId ShortChannelId
a ByteString -> ByteString -> Bool
forall a. Ord a => a -> a -> Bool
< ShortChannelId -> ByteString
getShortChannelId ShortChannelId
b = [ShortChannelId] -> Either ValidationError ()
checkAscending (ShortChannelId
bShortChannelId -> [ShortChannelId] -> [ShortChannelId]
forall a. a -> [a] -> [a]
:[ShortChannelId]
rest)
      | Bool
otherwise = ValidationError -> Either ValidationError ()
forall a b. a -> Either a b
Left ValidationError
ValidateScidNotAscending

-- Internal helpers -----------------------------------------------------------

-- | Validate feature bits - reject unknown even bits.
--
-- Per BOLT #9, even feature bits are "required" and odd bits are
-- "optional". A node MUST fail if an unknown even bit is set.
--
-- For this library, we consider all feature bits as "known" (since we
-- don't implement feature negotiation). The caller should validate
-- against their own set of supported features.
validateFeatureBits :: FeatureBits -> Either ValidationError ()
validateFeatureBits :: FeatureBits -> Either ValidationError ()
validateFeatureBits FeatureBits
_features = () -> Either ValidationError ()
forall a b. b -> Either a b
Right ()
-- Note: Full feature validation requires knowing which features are
-- supported by the implementation. For now we accept all features.
-- The caller should implement their own feature bit validation.