Validate.hs (4964B)
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 present) 83 -- 84 -- Note: message_flags consistency is enforced at the type 85 -- level -- the flag is derived from the presence of 86 -- 'chanUpdateHtlcMaxMsat'. 87 validateChannelUpdate :: ChannelUpdate 88 -> Either ValidationError () 89 validateChannelUpdate msg = do 90 case chanUpdateHtlcMaxMsat msg of 91 Nothing -> Right () 92 Just htlcMax -> 93 let htlcMin = chanUpdateHtlcMinMsat msg 94 in if getHtlcMinimumMsat htlcMin > getHtlcMaximumMsat htlcMax 95 then Left ValidateHtlcAmounts 96 else Right () 97 98 -- | Validate query_channel_range message. 99 -- 100 -- Checks: 101 -- 102 -- * first_blocknum + number_of_blocks does not overflow 103 validateQueryChannelRange :: QueryChannelRange 104 -> Either ValidationError () 105 validateQueryChannelRange msg = do 106 let first = fromIntegral 107 (getBlockHeight (queryRangeFirstBlock msg)) 108 :: Word64 109 num = fromIntegral 110 (getBlockCount (queryRangeNumBlocks msg)) 111 :: Word64 112 if first + num > fromIntegral (maxBound :: Word32) 113 then Left ValidateBlockOverflow 114 else Right () 115 116 -- | Validate reply_channel_range message. 117 -- 118 -- Checks: 119 -- 120 -- * Encoded short_channel_ids are in ascending order 121 validateReplyChannelRange :: ReplyChannelRange -> Either ValidationError () 122 validateReplyChannelRange msg = 123 case decodeShortChannelIdList (replyRangeData msg) of 124 Left _ -> Right () -- Can't decode, skip validation 125 Right scids -> checkAscending scids 126 where 127 checkAscending [] = Right () 128 checkAscending [_] = Right () 129 checkAscending (a:b:rest) 130 | a < b = checkAscending (b:rest) 131 | otherwise = Left ValidateScidNotAscending 132 133 -- Internal helpers ----------------------------------------------------------- 134 135 -- | Validate feature bits - reject unknown even bits. 136 -- 137 -- Per BOLT #9, even feature bits are "required" and odd bits are 138 -- "optional". A node MUST fail if an unknown even bit is set. 139 -- 140 -- For this library, we consider all feature bits as "known" (since we 141 -- don't implement feature negotiation). The caller should validate 142 -- against their own set of supported features. 143 validateFeatureBits :: FeatureBits -> Either ValidationError () 144 validateFeatureBits _features = Right () 145 -- Note: Full feature validation requires knowing which features are 146 -- supported by the implementation. For now we accept all features. 147 -- The caller should implement their own feature bit validation.