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