Main.hs (30472B)
1 {-# LANGUAGE OverloadedStrings #-} 2 3 module Main where 4 5 import qualified Data.ByteString as BS 6 import Data.Maybe (fromJust) 7 import Data.Word (Word16, Word32) 8 import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream) 9 import Lightning.Protocol.BOLT7 10 import Lightning.Protocol.BOLT7.CRC32C (crc32c) 11 import Test.Tasty 12 import Test.Tasty.HUnit 13 import Test.Tasty.QuickCheck 14 15 main :: IO () 16 main = defaultMain $ testGroup "ppad-bolt7" [ 17 type_tests 18 , channel_announcement_tests 19 , node_announcement_tests 20 , channel_update_tests 21 , announcement_signatures_tests 22 , query_tests 23 , scid_list_tests 24 , hash_tests 25 , validation_tests 26 , error_tests 27 , property_tests 28 ] 29 30 -- Test data helpers ----------------------------------------------------------- 31 32 -- | Create a valid ChainHash (32 bytes). 33 testChainHash :: ChainHash 34 testChainHash = fromJust $ chainHash (BS.replicate 32 0x01) 35 36 -- | Create a valid ShortChannelId (8 bytes). 37 testShortChannelId :: ShortChannelId 38 testShortChannelId = fromJust $ shortChannelId (BS.replicate 8 0xab) 39 40 -- | Create a valid ChannelId (32 bytes). 41 testChannelId :: ChannelId 42 testChannelId = fromJust $ channelId (BS.replicate 32 0xcd) 43 44 -- | Create a valid Signature (64 bytes). 45 testSignature :: Signature 46 testSignature = fromJust $ signature (BS.replicate 64 0xee) 47 48 -- | Create a valid Point (33 bytes). 49 testPoint :: Point 50 testPoint = fromJust $ point (BS.pack $ 0x02 : replicate 32 0xff) 51 52 -- | Create a valid NodeId (33 bytes). 53 testNodeId :: NodeId 54 testNodeId = fromJust $ nodeId (BS.pack $ 0x03 : replicate 32 0xaa) 55 56 -- | Create a second valid NodeId (33 bytes). 57 testNodeId2 :: NodeId 58 testNodeId2 = fromJust $ nodeId (BS.pack $ 0x02 : replicate 32 0xbb) 59 60 -- | Create a valid RgbColor (3 bytes). 61 testRgbColor :: RgbColor 62 testRgbColor = fromJust $ rgbColor (BS.pack [0xff, 0x00, 0x00]) 63 64 -- | Create a valid Alias (32 bytes). 65 testAlias :: Alias 66 testAlias = fromJust $ alias (BS.pack $ replicate 32 0x00) 67 68 -- | Empty TLV stream for messages. 69 emptyTlvs :: TlvStream 70 emptyTlvs = unsafeTlvStream [] 71 72 -- | Empty feature bits. 73 emptyFeatures :: FeatureBits 74 emptyFeatures = featureBits BS.empty 75 76 -- Type Tests ------------------------------------------------------------------ 77 78 type_tests :: TestTree 79 type_tests = testGroup "Types" [ 80 testGroup "ShortChannelId" [ 81 testCase "scidBlockHeight" $ do 82 -- 8 bytes: block=0x123456, tx=0x789abc, output=0xdef0 83 let scid = fromJust $ shortChannelId (BS.pack 84 [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0]) 85 scidBlockHeight scid @?= 0x123456 86 , testCase "scidTxIndex" $ do 87 let scid = fromJust $ shortChannelId (BS.pack 88 [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0]) 89 scidTxIndex scid @?= 0x789abc 90 , testCase "scidOutputIndex" $ do 91 let scid = fromJust $ shortChannelId (BS.pack 92 [0x12, 0x34, 0x56, 0x78, 0x9a, 0xbc, 0xde, 0xf0]) 93 scidOutputIndex scid @?= 0xdef0 94 , testCase "mkShortChannelId roundtrip" $ do 95 let scid = mkShortChannelId 539268 845 1 96 scidBlockHeight scid @?= 539268 97 scidTxIndex scid @?= 845 98 scidOutputIndex scid @?= 1 99 , testCase "formatScid" $ do 100 let scid = mkShortChannelId 539268 845 1 101 formatScid scid @?= "539268x845x1" 102 , testCase "formatScid zero values" $ do 103 let scid = mkShortChannelId 0 0 0 104 formatScid scid @?= "0x0x0" 105 ] 106 , testGroup "Smart constructors" [ 107 testCase "chainHash rejects wrong length" $ do 108 chainHash (BS.replicate 31 0x00) @?= Nothing 109 chainHash (BS.replicate 33 0x00) @?= Nothing 110 , testCase "shortChannelId rejects wrong length" $ do 111 shortChannelId (BS.replicate 7 0x00) @?= Nothing 112 shortChannelId (BS.replicate 9 0x00) @?= Nothing 113 , testCase "signature rejects wrong length" $ do 114 signature (BS.replicate 63 0x00) @?= Nothing 115 signature (BS.replicate 65 0x00) @?= Nothing 116 , testCase "point rejects wrong length" $ do 117 point (BS.replicate 32 0x00) @?= Nothing 118 point (BS.replicate 34 0x00) @?= Nothing 119 ] 120 , testGroup "Constants" [ 121 testCase "mainnetChainHash has correct length" $ do 122 BS.length (getChainHash mainnetChainHash) @?= 32 123 ] 124 , testGroup "NodeId ordering" [ 125 testCase "NodeId Ord is lexicographic" $ do 126 let n1 = fromJust $ nodeId (BS.pack $ 0x02 : replicate 32 0x00) 127 n2 = fromJust $ nodeId (BS.pack $ 0x03 : replicate 32 0x00) 128 n1 < n2 @?= True 129 n2 < n1 @?= False 130 ] 131 ] 132 133 -- Channel Announcement Tests -------------------------------------------------- 134 135 channel_announcement_tests :: TestTree 136 channel_announcement_tests = testGroup "ChannelAnnouncement" [ 137 testCase "encode/decode roundtrip" $ do 138 let msg = ChannelAnnouncement 139 { channelAnnNodeSig1 = testSignature 140 , channelAnnNodeSig2 = testSignature 141 , channelAnnBitcoinSig1 = testSignature 142 , channelAnnBitcoinSig2 = testSignature 143 , channelAnnFeatures = emptyFeatures 144 , channelAnnChainHash = testChainHash 145 , channelAnnShortChanId = testShortChannelId 146 , channelAnnNodeId1 = testNodeId 147 , channelAnnNodeId2 = testNodeId2 148 , channelAnnBitcoinKey1 = testPoint 149 , channelAnnBitcoinKey2 = testPoint 150 } 151 encoded = encodeChannelAnnouncement msg 152 case decodeChannelAnnouncement encoded of 153 Right (decoded, _) -> decoded @?= msg 154 Left e -> assertFailure $ "decode failed: " ++ show e 155 ] 156 157 -- Node Announcement Tests ----------------------------------------------------- 158 159 node_announcement_tests :: TestTree 160 node_announcement_tests = testGroup "NodeAnnouncement" [ 161 testCase "encode/decode roundtrip with no addresses" $ do 162 let msg = NodeAnnouncement 163 { nodeAnnSignature = testSignature 164 , nodeAnnFeatures = emptyFeatures 165 , nodeAnnTimestamp = 1234567890 166 , nodeAnnNodeId = testNodeId 167 , nodeAnnRgbColor = testRgbColor 168 , nodeAnnAlias = testAlias 169 , nodeAnnAddresses = [] 170 } 171 case encodeNodeAnnouncement msg of 172 Left e -> assertFailure $ "encode failed: " ++ show e 173 Right encoded -> case decodeNodeAnnouncement encoded of 174 Right (decoded, _) -> decoded @?= msg 175 Left e -> assertFailure $ "decode failed: " ++ show e 176 , testCase "encode/decode roundtrip with IPv4 address" $ do 177 let ipv4 = fromJust $ ipv4Addr (BS.pack [127, 0, 0, 1]) 178 msg = NodeAnnouncement 179 { nodeAnnSignature = testSignature 180 , nodeAnnFeatures = emptyFeatures 181 , nodeAnnTimestamp = 1234567890 182 , nodeAnnNodeId = testNodeId 183 , nodeAnnRgbColor = testRgbColor 184 , nodeAnnAlias = testAlias 185 , nodeAnnAddresses = [AddrIPv4 ipv4 9735] 186 } 187 case encodeNodeAnnouncement msg of 188 Left e -> assertFailure $ "encode failed: " ++ show e 189 Right encoded -> case decodeNodeAnnouncement encoded of 190 Right (decoded, _) -> decoded @?= msg 191 Left e -> assertFailure $ "decode failed: " ++ show e 192 ] 193 194 -- Channel Update Tests -------------------------------------------------------- 195 196 channel_update_tests :: TestTree 197 channel_update_tests = testGroup "ChannelUpdate" [ 198 testCase "encode/decode roundtrip without htlc_maximum_msat" $ do 199 let msg = ChannelUpdate 200 { chanUpdateSignature = testSignature 201 , chanUpdateChainHash = testChainHash 202 , chanUpdateShortChanId = testShortChannelId 203 , chanUpdateTimestamp = 1234567890 204 , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } 205 , chanUpdateChanFlags = ChannelFlags 206 { cfDirection = True, cfDisabled = False } 207 , chanUpdateCltvExpDelta = CltvExpiryDelta 144 208 , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 209 , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 210 , chanUpdateFeeProportional = FeeProportionalMillionths 100 211 , chanUpdateHtlcMaxMsat = Nothing 212 } 213 encoded = encodeChannelUpdate msg 214 case decodeChannelUpdate encoded of 215 Right (decoded, _) -> decoded @?= msg 216 Left e -> assertFailure $ "decode failed: " ++ show e 217 , testCase "encode/decode roundtrip with htlc_maximum_msat" $ do 218 let msg = ChannelUpdate 219 { chanUpdateSignature = testSignature 220 , chanUpdateChainHash = testChainHash 221 , chanUpdateShortChanId = testShortChannelId 222 , chanUpdateTimestamp = 1234567890 223 , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = True } 224 , chanUpdateChanFlags = ChannelFlags 225 { cfDirection = False, cfDisabled = False } 226 , chanUpdateCltvExpDelta = CltvExpiryDelta 40 227 , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 228 , chanUpdateFeeBaseMsat = FeeBaseMsat 500 229 , chanUpdateFeeProportional = FeeProportionalMillionths 50 230 , chanUpdateHtlcMaxMsat = Just (HtlcMaximumMsat 1000000000) 231 } 232 encoded = encodeChannelUpdate msg 233 case decodeChannelUpdate encoded of 234 Right (decoded, _) -> decoded @?= msg 235 Left e -> assertFailure $ "decode failed: " ++ show e 236 ] 237 238 -- Announcement Signatures Tests ----------------------------------------------- 239 240 announcement_signatures_tests :: TestTree 241 announcement_signatures_tests = testGroup "AnnouncementSignatures" [ 242 testCase "encode/decode roundtrip" $ do 243 let msg = AnnouncementSignatures 244 { annSigChannelId = testChannelId 245 , annSigShortChanId = testShortChannelId 246 , annSigNodeSig = testSignature 247 , annSigBitcoinSig = testSignature 248 } 249 encoded = encodeAnnouncementSignatures msg 250 case decodeAnnouncementSignatures encoded of 251 Right (decoded, _) -> decoded @?= msg 252 Left e -> assertFailure $ "decode failed: " ++ show e 253 ] 254 255 -- Query Tests ----------------------------------------------------------------- 256 257 query_tests :: TestTree 258 query_tests = testGroup "Query Messages" [ 259 testGroup "QueryShortChannelIds" [ 260 testCase "encode/decode roundtrip" $ do 261 let msg = QueryShortChannelIds 262 { queryScidsChainHash = testChainHash 263 , queryScidsData = BS.replicate 24 0xab -- 3 SCIDs 264 , queryScidsTlvs = emptyTlvs 265 } 266 case encodeQueryShortChannelIds msg of 267 Left e -> assertFailure $ "encode failed: " ++ show e 268 Right encoded -> case decodeQueryShortChannelIds encoded of 269 Right (decoded, _) -> do 270 queryScidsChainHash decoded @?= queryScidsChainHash msg 271 queryScidsData decoded @?= queryScidsData msg 272 Left e -> assertFailure $ "decode failed: " ++ show e 273 ] 274 , testGroup "ReplyShortChannelIdsEnd" [ 275 testCase "encode/decode roundtrip" $ do 276 let msg = ReplyShortChannelIdsEnd 277 { replyScidsChainHash = testChainHash 278 , replyScidsFullInfo = 1 279 } 280 encoded = encodeReplyShortChannelIdsEnd msg 281 case decodeReplyShortChannelIdsEnd encoded of 282 Right (decoded, _) -> decoded @?= msg 283 Left e -> assertFailure $ "decode failed: " ++ show e 284 ] 285 , testGroup "QueryChannelRange" [ 286 testCase "encode/decode roundtrip" $ do 287 let msg = QueryChannelRange 288 { queryRangeChainHash = testChainHash 289 , queryRangeFirstBlock = 600000 290 , queryRangeNumBlocks = 10000 291 , queryRangeTlvs = emptyTlvs 292 } 293 encoded = encodeQueryChannelRange msg 294 case decodeQueryChannelRange encoded of 295 Right (decoded, _) -> do 296 queryRangeChainHash decoded @?= queryRangeChainHash msg 297 queryRangeFirstBlock decoded @?= queryRangeFirstBlock msg 298 queryRangeNumBlocks decoded @?= queryRangeNumBlocks msg 299 Left e -> assertFailure $ "decode failed: " ++ show e 300 ] 301 , testGroup "ReplyChannelRange" [ 302 testCase "encode/decode roundtrip" $ do 303 let msg = ReplyChannelRange 304 { replyRangeChainHash = testChainHash 305 , replyRangeFirstBlock = 600000 306 , replyRangeNumBlocks = 10000 307 , replyRangeSyncComplete = 1 308 , replyRangeData = BS.replicate 16 0xcd 309 , replyRangeTlvs = emptyTlvs 310 } 311 case encodeReplyChannelRange msg of 312 Left e -> assertFailure $ "encode failed: " ++ show e 313 Right encoded -> case decodeReplyChannelRange encoded of 314 Right (decoded, _) -> do 315 replyRangeChainHash decoded @?= replyRangeChainHash msg 316 replyRangeFirstBlock decoded @?= replyRangeFirstBlock msg 317 replyRangeNumBlocks decoded @?= replyRangeNumBlocks msg 318 replyRangeSyncComplete decoded @?= replyRangeSyncComplete msg 319 replyRangeData decoded @?= replyRangeData msg 320 Left e -> assertFailure $ "decode failed: " ++ show e 321 ] 322 , testGroup "GossipTimestampFilter" [ 323 testCase "encode/decode roundtrip" $ do 324 let msg = GossipTimestampFilter 325 { gossipFilterChainHash = testChainHash 326 , gossipFilterFirstTimestamp = 1609459200 327 , gossipFilterTimestampRange = 86400 328 } 329 encoded = encodeGossipTimestampFilter msg 330 case decodeGossipTimestampFilter encoded of 331 Right (decoded, _) -> decoded @?= msg 332 Left e -> assertFailure $ "decode failed: " ++ show e 333 ] 334 ] 335 336 -- SCID List Tests ------------------------------------------------------------ 337 338 scid_list_tests :: TestTree 339 scid_list_tests = testGroup "SCID List Encoding" [ 340 testCase "encode/decode roundtrip empty list" $ do 341 let encoded = encodeShortChannelIdList [] 342 case decodeShortChannelIdList encoded of 343 Right decoded -> decoded @?= [] 344 Left e -> assertFailure $ "decode failed: " ++ show e 345 , testCase "encode/decode roundtrip single SCID" $ do 346 let scids = [mkShortChannelId 539268 845 1] 347 encoded = encodeShortChannelIdList scids 348 case decodeShortChannelIdList encoded of 349 Right decoded -> decoded @?= scids 350 Left e -> assertFailure $ "decode failed: " ++ show e 351 , testCase "encode/decode roundtrip multiple SCIDs" $ do 352 let scids = [ mkShortChannelId 100000 1 0 353 , mkShortChannelId 200000 2 1 354 , mkShortChannelId 300000 3 2 355 ] 356 encoded = encodeShortChannelIdList scids 357 case decodeShortChannelIdList encoded of 358 Right decoded -> decoded @?= scids 359 Left e -> assertFailure $ "decode failed: " ++ show e 360 , testCase "encoding has correct format" $ do 361 let scids = [mkShortChannelId 1 2 3] 362 encoded = encodeShortChannelIdList scids 363 -- First byte should be 0 (encoding type) 364 BS.index encoded 0 @?= 0 365 -- Total length: 1 (type) + 8 (SCID) = 9 366 BS.length encoded @?= 9 367 , testCase "decode rejects unknown encoding type" $ do 368 -- Encoding type 1 (zlib compressed) is not supported 369 let badEncoded = BS.cons 1 (getShortChannelId testShortChannelId) 370 case decodeShortChannelIdList badEncoded of 371 Left _ -> pure () 372 Right _ -> assertFailure "should reject encoding type 1" 373 ] 374 375 -- Hash Tests ----------------------------------------------------------------- 376 377 hash_tests :: TestTree 378 hash_tests = testGroup "Hash Functions" [ 379 testGroup "CRC32C" [ 380 testCase "known test vector '123456789'" $ do 381 -- Standard CRC-32C test vector 382 crc32c "123456789" @?= 0xe3069283 383 , testCase "empty string" $ do 384 crc32c "" @?= 0x00000000 385 ] 386 , testGroup "Signature Hashes" [ 387 testCase "channelAnnouncementHash produces 32 bytes" $ do 388 -- Create a minimal valid encoded message 389 let msg = encodeChannelAnnouncement ChannelAnnouncement 390 { channelAnnNodeSig1 = testSignature 391 , channelAnnNodeSig2 = testSignature 392 , channelAnnBitcoinSig1 = testSignature 393 , channelAnnBitcoinSig2 = testSignature 394 , channelAnnFeatures = emptyFeatures 395 , channelAnnChainHash = testChainHash 396 , channelAnnShortChanId = testShortChannelId 397 , channelAnnNodeId1 = testNodeId 398 , channelAnnNodeId2 = testNodeId2 399 , channelAnnBitcoinKey1 = testPoint 400 , channelAnnBitcoinKey2 = testPoint 401 } 402 hashVal = channelAnnouncementHash msg 403 BS.length hashVal @?= 32 404 , testCase "nodeAnnouncementHash produces 32 bytes" $ do 405 case encodeNodeAnnouncement NodeAnnouncement 406 { nodeAnnSignature = testSignature 407 , nodeAnnFeatures = emptyFeatures 408 , nodeAnnTimestamp = 1234567890 409 , nodeAnnNodeId = testNodeId 410 , nodeAnnRgbColor = testRgbColor 411 , nodeAnnAlias = testAlias 412 , nodeAnnAddresses = [] 413 } of 414 Left e -> assertFailure $ "encode failed: " ++ show e 415 Right msg -> do 416 let hashVal = nodeAnnouncementHash msg 417 BS.length hashVal @?= 32 418 , testCase "channelUpdateHash produces 32 bytes" $ do 419 let msg = encodeChannelUpdate ChannelUpdate 420 { chanUpdateSignature = testSignature 421 , chanUpdateChainHash = testChainHash 422 , chanUpdateShortChanId = testShortChannelId 423 , chanUpdateTimestamp = 1234567890 424 , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } 425 , chanUpdateChanFlags = ChannelFlags 426 { cfDirection = False, cfDisabled = False } 427 , chanUpdateCltvExpDelta = CltvExpiryDelta 144 428 , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 429 , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 430 , chanUpdateFeeProportional = FeeProportionalMillionths 100 431 , chanUpdateHtlcMaxMsat = Nothing 432 } 433 hashVal = channelUpdateHash msg 434 BS.length hashVal @?= 32 435 ] 436 , testGroup "Checksum" [ 437 testCase "channelUpdateChecksum produces consistent result" $ do 438 -- The checksum should be deterministic 439 let msg = encodeChannelUpdate ChannelUpdate 440 { chanUpdateSignature = testSignature 441 , chanUpdateChainHash = testChainHash 442 , chanUpdateShortChanId = testShortChannelId 443 , chanUpdateTimestamp = 1234567890 444 , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } 445 , chanUpdateChanFlags = ChannelFlags 446 { cfDirection = False, cfDisabled = False } 447 , chanUpdateCltvExpDelta = CltvExpiryDelta 144 448 , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 449 , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 450 , chanUpdateFeeProportional = FeeProportionalMillionths 100 451 , chanUpdateHtlcMaxMsat = Nothing 452 } 453 cs1 = channelUpdateChecksum msg 454 cs2 = channelUpdateChecksum msg 455 cs1 @?= cs2 456 , testCase "different timestamps produce same checksum" $ do 457 -- Checksum excludes timestamp field 458 let msg1 = encodeChannelUpdate ChannelUpdate 459 { chanUpdateSignature = testSignature 460 , chanUpdateChainHash = testChainHash 461 , chanUpdateShortChanId = testShortChannelId 462 , chanUpdateTimestamp = 1000000000 463 , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } 464 , chanUpdateChanFlags = ChannelFlags 465 { cfDirection = False, cfDisabled = False } 466 , chanUpdateCltvExpDelta = CltvExpiryDelta 144 467 , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 468 , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 469 , chanUpdateFeeProportional = FeeProportionalMillionths 100 470 , chanUpdateHtlcMaxMsat = Nothing 471 } 472 msg2 = encodeChannelUpdate ChannelUpdate 473 { chanUpdateSignature = testSignature 474 , chanUpdateChainHash = testChainHash 475 , chanUpdateShortChanId = testShortChannelId 476 , chanUpdateTimestamp = 2000000000 477 , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } 478 , chanUpdateChanFlags = ChannelFlags 479 { cfDirection = False, cfDisabled = False } 480 , chanUpdateCltvExpDelta = CltvExpiryDelta 144 481 , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 482 , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 483 , chanUpdateFeeProportional = FeeProportionalMillionths 100 484 , chanUpdateHtlcMaxMsat = Nothing 485 } 486 channelUpdateChecksum msg1 @?= channelUpdateChecksum msg2 487 ] 488 ] 489 490 -- Validation Tests ----------------------------------------------------------- 491 492 validation_tests :: TestTree 493 validation_tests = testGroup "Validation" [ 494 testGroup "ChannelAnnouncement" [ 495 testCase "valid announcement passes" $ do 496 let msg = ChannelAnnouncement 497 { channelAnnNodeSig1 = testSignature 498 , channelAnnNodeSig2 = testSignature 499 , channelAnnBitcoinSig1 = testSignature 500 , channelAnnBitcoinSig2 = testSignature 501 , channelAnnFeatures = emptyFeatures 502 , channelAnnChainHash = testChainHash 503 , channelAnnShortChanId = testShortChannelId 504 , channelAnnNodeId1 = testNodeId2 -- 0x02... < 0x03... 505 , channelAnnNodeId2 = testNodeId -- 0x03... 506 , channelAnnBitcoinKey1 = testPoint 507 , channelAnnBitcoinKey2 = testPoint 508 } 509 validateChannelAnnouncement msg @?= Right () 510 , testCase "rejects wrong node_id order" $ do 511 let msg = ChannelAnnouncement 512 { channelAnnNodeSig1 = testSignature 513 , channelAnnNodeSig2 = testSignature 514 , channelAnnBitcoinSig1 = testSignature 515 , channelAnnBitcoinSig2 = testSignature 516 , channelAnnFeatures = emptyFeatures 517 , channelAnnChainHash = testChainHash 518 , channelAnnShortChanId = testShortChannelId 519 , channelAnnNodeId1 = testNodeId -- 0x03... > 0x02... 520 , channelAnnNodeId2 = testNodeId2 -- 0x02... 521 , channelAnnBitcoinKey1 = testPoint 522 , channelAnnBitcoinKey2 = testPoint 523 } 524 validateChannelAnnouncement msg @?= Left ValidateNodeIdOrdering 525 ] 526 , testGroup "ChannelUpdate" [ 527 testCase "valid update passes" $ do 528 let msg = ChannelUpdate 529 { chanUpdateSignature = testSignature 530 , chanUpdateChainHash = testChainHash 531 , chanUpdateShortChanId = testShortChannelId 532 , chanUpdateTimestamp = 1234567890 533 , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = True } 534 , chanUpdateChanFlags = ChannelFlags 535 { cfDirection = False, cfDisabled = False } 536 , chanUpdateCltvExpDelta = CltvExpiryDelta 144 537 , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 538 , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 539 , chanUpdateFeeProportional = FeeProportionalMillionths 100 540 , chanUpdateHtlcMaxMsat = Just (HtlcMaximumMsat 1000000000) 541 } 542 validateChannelUpdate msg @?= Right () 543 , testCase "rejects htlc_min > htlc_max" $ do 544 let msg = ChannelUpdate 545 { chanUpdateSignature = testSignature 546 , chanUpdateChainHash = testChainHash 547 , chanUpdateShortChanId = testShortChannelId 548 , chanUpdateTimestamp = 1234567890 549 , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = True } 550 , chanUpdateChanFlags = ChannelFlags 551 { cfDirection = False, cfDisabled = False } 552 , chanUpdateCltvExpDelta = CltvExpiryDelta 144 553 , chanUpdateHtlcMinMsat = HtlcMinimumMsat 2000000000 -- > htlcMax 554 , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 555 , chanUpdateFeeProportional = FeeProportionalMillionths 100 556 , chanUpdateHtlcMaxMsat = Just (HtlcMaximumMsat 1000000000) 557 } 558 validateChannelUpdate msg @?= Left ValidateHtlcAmounts 559 ] 560 , testGroup "QueryChannelRange" [ 561 testCase "valid range passes" $ do 562 let msg = QueryChannelRange 563 { queryRangeChainHash = testChainHash 564 , queryRangeFirstBlock = 600000 565 , queryRangeNumBlocks = 10000 566 , queryRangeTlvs = emptyTlvs 567 } 568 validateQueryChannelRange msg @?= Right () 569 , testCase "rejects overflow" $ do 570 let msg = QueryChannelRange 571 { queryRangeChainHash = testChainHash 572 , queryRangeFirstBlock = maxBound -- 0xFFFFFFFF 573 , queryRangeNumBlocks = 10 574 , queryRangeTlvs = emptyTlvs 575 } 576 validateQueryChannelRange msg @?= Left ValidateBlockOverflow 577 ] 578 ] 579 580 -- Error Tests ----------------------------------------------------------------- 581 582 error_tests :: TestTree 583 error_tests = testGroup "Error Conditions" [ 584 testGroup "Insufficient Bytes" [ 585 testCase "decodeChannelAnnouncement empty" $ do 586 case decodeChannelAnnouncement BS.empty of 587 Left DecodeInsufficientBytes -> pure () 588 other -> assertFailure $ "expected insufficient: " ++ show other 589 , testCase "decodeChannelUpdate too short" $ do 590 case decodeChannelUpdate (BS.replicate 50 0x00) of 591 Left DecodeInsufficientBytes -> pure () 592 other -> assertFailure $ "expected insufficient: " ++ show other 593 , testCase "decodeAnnouncementSignatures too short" $ do 594 case decodeAnnouncementSignatures (BS.replicate 50 0x00) of 595 Left DecodeInsufficientBytes -> pure () 596 other -> assertFailure $ "expected insufficient: " ++ show other 597 , testCase "decodeGossipTimestampFilter too short" $ do 598 case decodeGossipTimestampFilter (BS.replicate 30 0x00) of 599 Left DecodeInsufficientBytes -> pure () 600 other -> assertFailure $ "expected insufficient: " ++ show other 601 ] 602 ] 603 604 -- Property Tests -------------------------------------------------------------- 605 606 property_tests :: TestTree 607 property_tests = testGroup "Properties" [ 608 testProperty "ChannelAnnouncement roundtrip" propChannelAnnouncementRoundtrip 609 , testProperty "ChannelUpdate roundtrip" propChannelUpdateRoundtrip 610 , testProperty "AnnouncementSignatures roundtrip" 611 propAnnouncementSignaturesRoundtrip 612 , testProperty "GossipTimestampFilter roundtrip" 613 propGossipTimestampFilterRoundtrip 614 ] 615 616 -- Property: ChannelAnnouncement roundtrip 617 propChannelAnnouncementRoundtrip :: Property 618 propChannelAnnouncementRoundtrip = property $ do 619 let msg = ChannelAnnouncement 620 { channelAnnNodeSig1 = testSignature 621 , channelAnnNodeSig2 = testSignature 622 , channelAnnBitcoinSig1 = testSignature 623 , channelAnnBitcoinSig2 = testSignature 624 , channelAnnFeatures = emptyFeatures 625 , channelAnnChainHash = testChainHash 626 , channelAnnShortChanId = testShortChannelId 627 , channelAnnNodeId1 = testNodeId 628 , channelAnnNodeId2 = testNodeId2 629 , channelAnnBitcoinKey1 = testPoint 630 , channelAnnBitcoinKey2 = testPoint 631 } 632 encoded = encodeChannelAnnouncement msg 633 case decodeChannelAnnouncement encoded of 634 Right (decoded, _) -> decoded == msg 635 Left _ -> False 636 637 -- Property: ChannelUpdate roundtrip 638 propChannelUpdateRoundtrip :: Word32 -> Word16 -> Property 639 propChannelUpdateRoundtrip timestamp cltvDelta = property $ do 640 let msg = ChannelUpdate 641 { chanUpdateSignature = testSignature 642 , chanUpdateChainHash = testChainHash 643 , chanUpdateShortChanId = testShortChannelId 644 , chanUpdateTimestamp = timestamp 645 , chanUpdateMsgFlags = MessageFlags { mfHtlcMaxPresent = False } 646 , chanUpdateChanFlags = ChannelFlags 647 { cfDirection = False, cfDisabled = False } 648 , chanUpdateCltvExpDelta = CltvExpiryDelta cltvDelta 649 , chanUpdateHtlcMinMsat = HtlcMinimumMsat 1000 650 , chanUpdateFeeBaseMsat = FeeBaseMsat 1000 651 , chanUpdateFeeProportional = FeeProportionalMillionths 100 652 , chanUpdateHtlcMaxMsat = Nothing 653 } 654 encoded = encodeChannelUpdate msg 655 case decodeChannelUpdate encoded of 656 Right (decoded, _) -> decoded == msg 657 Left _ -> False 658 659 -- Property: AnnouncementSignatures roundtrip 660 propAnnouncementSignaturesRoundtrip :: Property 661 propAnnouncementSignaturesRoundtrip = property $ do 662 let msg = AnnouncementSignatures 663 { annSigChannelId = testChannelId 664 , annSigShortChanId = testShortChannelId 665 , annSigNodeSig = testSignature 666 , annSigBitcoinSig = testSignature 667 } 668 encoded = encodeAnnouncementSignatures msg 669 case decodeAnnouncementSignatures encoded of 670 Right (decoded, _) -> decoded == msg 671 Left _ -> False 672 673 -- Property: GossipTimestampFilter roundtrip 674 propGossipTimestampFilterRoundtrip :: Word32 -> Word32 -> Property 675 propGossipTimestampFilterRoundtrip firstTs tsRange = property $ do 676 let msg = GossipTimestampFilter 677 { gossipFilterChainHash = testChainHash 678 , gossipFilterFirstTimestamp = firstTs 679 , gossipFilterTimestampRange = tsRange 680 } 681 encoded = encodeGossipTimestampFilter msg 682 case decodeGossipTimestampFilter encoded of 683 Right (decoded, _) -> decoded == msg 684 Left _ -> False