Validate.hs (4978B)
1 {-# OPTIONS_HADDOCK prune #-} 2 3 {-# LANGUAGE BangPatterns #-} 4 {-# LANGUAGE DeriveGeneric #-} 5 6 -- | 7 -- Module: Lightning.Protocol.BOLT7.Validate 8 -- Copyright: (c) 2025 Jared Tobin 9 -- License: MIT 10 -- Maintainer: Jared Tobin <jared@ppad.tech> 11 -- 12 -- Validation functions for BOLT #7 gossip messages. 13 -- 14 -- These functions check message invariants as specified in BOLT #7. 15 -- They do NOT verify cryptographic signatures; that requires the 16 -- actual public keys and is left to the caller. 17 18 module Lightning.Protocol.BOLT7.Validate ( 19 -- * Error types 20 ValidationError(..) 21 22 -- * Validation functions 23 , validateChannelAnnouncement 24 , validateNodeAnnouncement 25 , validateChannelUpdate 26 , validateQueryChannelRange 27 , validateReplyChannelRange 28 ) where 29 30 import Control.DeepSeq (NFData) 31 import Data.Word (Word32, Word64) 32 import GHC.Generics (Generic) 33 import Lightning.Protocol.BOLT7.Codec (decodeShortChannelIdList) 34 import Lightning.Protocol.BOLT7.Messages 35 import Lightning.Protocol.BOLT7.Types 36 37 -- | Validation errors. 38 data ValidationError 39 = ValidateNodeIdOrdering -- ^ node_id_1 must be < node_id_2 40 | ValidateUnknownEvenFeature -- ^ Unknown even feature bit set 41 | ValidateHtlcAmounts -- ^ htlc_minimum_msat > htlc_maximum_msat 42 | ValidateBlockOverflow -- ^ first_blocknum + number_of_blocks overflow 43 | ValidateScidNotAscending -- ^ short_channel_ids not in ascending order 44 deriving (Eq, Show, Generic) 45 46 instance NFData ValidationError 47 48 -- | Validate channel_announcement message. 49 -- 50 -- Checks: 51 -- 52 -- * node_id_1 < node_id_2 (lexicographic ordering) 53 -- * Feature bits do not contain unknown even bits 54 validateChannelAnnouncement :: ChannelAnnouncement 55 -> Either ValidationError () 56 validateChannelAnnouncement msg = do 57 -- Check node_id ordering 58 let nid1 = channelAnnNodeId1 msg 59 nid2 = channelAnnNodeId2 msg 60 if nid1 >= nid2 61 then Left ValidateNodeIdOrdering 62 else Right () 63 -- Check feature bits 64 validateFeatureBits (channelAnnFeatures msg) 65 66 -- | Validate node_announcement message. 67 -- 68 -- Checks: 69 -- 70 -- * Feature bits do not contain unknown even bits 71 -- 72 -- Note: Address list validation (duplicate DNS entries) and alias 73 -- UTF-8 validation are not enforced; the spec allows non-UTF-8 aliases. 74 validateNodeAnnouncement :: NodeAnnouncement -> Either ValidationError () 75 validateNodeAnnouncement msg = do 76 validateFeatureBits (nodeAnnFeatures msg) 77 78 -- | Validate channel_update message. 79 -- 80 -- Checks: 81 -- 82 -- * htlc_minimum_msat <= htlc_maximum_msat (if htlc_maximum_msat present) 83 -- 84 -- Note: The spec says message_flags bit 0 MUST be set if htlc_maximum_msat 85 -- is advertised. We don't enforce this at validation time since the codec 86 -- already handles the conditional field based on the flag. 87 validateChannelUpdate :: ChannelUpdate -> Either ValidationError () 88 validateChannelUpdate msg = do 89 case chanUpdateHtlcMaxMsat msg of 90 Nothing -> Right () 91 Just htlcMax -> 92 let htlcMin = chanUpdateHtlcMinMsat msg 93 in if getHtlcMinimumMsat htlcMin > getHtlcMaximumMsat htlcMax 94 then Left ValidateHtlcAmounts 95 else Right () 96 97 -- | Validate query_channel_range message. 98 -- 99 -- Checks: 100 -- 101 -- * first_blocknum + number_of_blocks does not overflow 102 validateQueryChannelRange :: QueryChannelRange -> Either ValidationError () 103 validateQueryChannelRange msg = do 104 let first = fromIntegral (queryRangeFirstBlock msg) :: Word64 105 num = fromIntegral (queryRangeNumBlocks msg) :: Word64 106 if first + num > fromIntegral (maxBound :: Word32) 107 then Left ValidateBlockOverflow 108 else Right () 109 110 -- | Validate reply_channel_range message. 111 -- 112 -- Checks: 113 -- 114 -- * Encoded short_channel_ids are in ascending order 115 validateReplyChannelRange :: ReplyChannelRange -> Either ValidationError () 116 validateReplyChannelRange msg = 117 case decodeShortChannelIdList (replyRangeData msg) of 118 Left _ -> Right () -- Can't decode, skip validation 119 Right scids -> checkAscending scids 120 where 121 checkAscending [] = Right () 122 checkAscending [_] = Right () 123 checkAscending (a:b:rest) 124 | getShortChannelId a < getShortChannelId b = checkAscending (b:rest) 125 | otherwise = Left ValidateScidNotAscending 126 127 -- Internal helpers ----------------------------------------------------------- 128 129 -- | Validate feature bits - reject unknown even bits. 130 -- 131 -- Per BOLT #9, even feature bits are "required" and odd bits are 132 -- "optional". A node MUST fail if an unknown even bit is set. 133 -- 134 -- For this library, we consider all feature bits as "known" (since we 135 -- don't implement feature negotiation). The caller should validate 136 -- against their own set of supported features. 137 validateFeatureBits :: FeatureBits -> Either ValidationError () 138 validateFeatureBits _features = Right () 139 -- Note: Full feature validation requires knowing which features are 140 -- supported by the implementation. For now we accept all features. 141 -- The caller should implement their own feature bit validation.