Main.hs (56899B)
1 {-# LANGUAGE OverloadedStrings #-} 2 3 module Main where 4 5 import qualified Data.ByteString as BS 6 import qualified Data.ByteString.Base16 as B16 7 import Data.Maybe (fromJust) 8 import Data.Word (Word8, Word16, Word32, Word64) 9 import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream) 10 import Lightning.Protocol.BOLT2 11 import Test.Tasty 12 import Test.Tasty.HUnit 13 import Test.Tasty.QuickCheck 14 15 main :: IO () 16 main = defaultMain $ testGroup "ppad-bolt2" [ 17 v1_establishment_tests 18 , v2_establishment_tests 19 , close_tests 20 , normal_operation_tests 21 , reestablish_tests 22 , error_tests 23 , property_tests 24 ] 25 26 -- Test data helpers ----------------------------------------------------------- 27 28 -- | Create a valid ChannelId (32 bytes). 29 testChannelId :: ChannelId 30 testChannelId = fromJust $ channelId (BS.replicate 32 0xab) 31 32 -- | Create a valid ChainHash (32 bytes). 33 testChainHash :: ChainHash 34 testChainHash = fromJust $ chainHash (BS.replicate 32 0x01) 35 36 -- | Create a valid Point (33 bytes). 37 testPoint :: Point 38 testPoint = fromJust $ point (BS.pack $ 0x02 : replicate 32 0xff) 39 40 -- | Create a second valid Point (33 bytes). 41 testPoint2 :: Point 42 testPoint2 = fromJust $ point (BS.pack $ 0x03 : replicate 32 0xee) 43 44 -- | Create a valid Signature (64 bytes). 45 testSignature :: Signature 46 testSignature = fromJust $ signature (BS.replicate 64 0xcc) 47 48 -- | Create a valid TxId (32 bytes). 49 testTxId :: TxId 50 testTxId = fromJust $ mkTxId (BS.replicate 32 0xdd) 51 52 -- | Create a valid PaymentHash (32 bytes). 53 testPaymentHash :: PaymentHash 54 testPaymentHash = fromJust $ paymentHash (BS.replicate 32 0xaa) 55 56 -- | Create a valid PaymentPreimage (32 bytes). 57 testPaymentPreimage :: PaymentPreimage 58 testPaymentPreimage = fromJust $ paymentPreimage (BS.replicate 32 0xbb) 59 60 -- | Create a valid OnionPacket (1366 bytes). 61 testOnionPacket :: OnionPacket 62 testOnionPacket = fromJust $ onionPacket (BS.replicate 1366 0x00) 63 64 -- | Create a valid PerCommitmentSecret (32 bytes). 65 testSecret :: PerCommitmentSecret 66 testSecret = fromJust $ 67 perCommitmentSecret (BS.replicate 32 0x11) 68 69 -- | Empty TLV stream for messages. 70 emptyTlvs :: TlvStream 71 emptyTlvs = unsafeTlvStream [] 72 73 -- V1 Channel Establishment Tests ---------------------------------------------- 74 75 v1_establishment_tests :: TestTree 76 v1_establishment_tests = testGroup "V1 Channel Establishment" [ 77 testGroup "OpenChannel" [ 78 testCase "encode/decode roundtrip" $ do 79 let msg = OpenChannel 80 { openChannelChainHash = testChainHash 81 , openChannelTempChannelId = testChannelId 82 , openChannelFundingSatoshi = Satoshi 1000000 83 , openChannelPushMsat = MilliSatoshi 500000 84 , openChannelDustLimitSatoshi = Satoshi 546 85 , openChannelMaxHtlcValueInFlight = MilliSatoshi 100000000 86 , openChannelChannelReserveSat = Satoshi 10000 87 , openChannelHtlcMinimumMsat = MilliSatoshi 1000 88 , openChannelFeeratePerKw = 2500 89 , openChannelToSelfDelay = 144 90 , openChannelMaxAcceptedHtlcs = 483 91 , openChannelFundingPubkey = testPoint 92 , openChannelRevocationBasepoint = testPoint 93 , openChannelPaymentBasepoint = testPoint 94 , openChannelDelayedPaymentBase = testPoint 95 , openChannelHtlcBasepoint = testPoint 96 , openChannelFirstPerCommitPoint = testPoint 97 , openChannelChannelFlags = 0x01 98 , openChannelTlvs = emptyTlvs 99 } 100 encoded = encodeOpenChannel msg 101 case decodeOpenChannel encoded of 102 Right (decoded, _) -> decoded @?= msg 103 Left e -> assertFailure $ "decode failed: " ++ show e 104 ] 105 , testGroup "AcceptChannel" [ 106 testCase "encode/decode roundtrip" $ do 107 let msg = AcceptChannel 108 { acceptChannelTempChannelId = testChannelId 109 , acceptChannelDustLimitSatoshi = Satoshi 546 110 , acceptChannelMaxHtlcValueInFlight = MilliSatoshi 100000000 111 , acceptChannelChannelReserveSat = Satoshi 10000 112 , acceptChannelHtlcMinimumMsat = MilliSatoshi 1000 113 , acceptChannelMinimumDepth = 3 114 , acceptChannelToSelfDelay = 144 115 , acceptChannelMaxAcceptedHtlcs = 483 116 , acceptChannelFundingPubkey = testPoint 117 , acceptChannelRevocationBasepoint = testPoint 118 , acceptChannelPaymentBasepoint = testPoint 119 , acceptChannelDelayedPaymentBase = testPoint 120 , acceptChannelHtlcBasepoint = testPoint 121 , acceptChannelFirstPerCommitPoint = testPoint 122 , acceptChannelTlvs = emptyTlvs 123 } 124 encoded = encodeAcceptChannel msg 125 case decodeAcceptChannel encoded of 126 Right (decoded, _) -> decoded @?= msg 127 Left e -> assertFailure $ "decode failed: " ++ show e 128 ] 129 , testGroup "FundingCreated" [ 130 testCase "encode/decode roundtrip" $ do 131 let msg = FundingCreated 132 { fundingCreatedTempChannelId = testChannelId 133 , fundingCreatedFundingTxid = testTxId 134 , fundingCreatedFundingOutIdx = 0 135 , fundingCreatedSignature = testSignature 136 } 137 encoded = encodeFundingCreated msg 138 case decodeFundingCreated encoded of 139 Right (decoded, _) -> decoded @?= msg 140 Left e -> assertFailure $ "decode failed: " ++ show e 141 , testCase "roundtrip with non-zero output index" $ do 142 let msg = FundingCreated 143 { fundingCreatedTempChannelId = testChannelId 144 , fundingCreatedFundingTxid = testTxId 145 , fundingCreatedFundingOutIdx = 42 146 , fundingCreatedSignature = testSignature 147 } 148 encoded = encodeFundingCreated msg 149 case decodeFundingCreated encoded of 150 Right (decoded, _) -> decoded @?= msg 151 Left e -> assertFailure $ "decode failed: " ++ show e 152 ] 153 , testGroup "FundingSigned" [ 154 testCase "encode/decode roundtrip" $ do 155 let msg = FundingSigned 156 { fundingSignedChannelId = testChannelId 157 , fundingSignedSignature = testSignature 158 } 159 encoded = encodeFundingSigned msg 160 case decodeFundingSigned encoded of 161 Right (decoded, _) -> decoded @?= msg 162 Left e -> assertFailure $ "decode failed: " ++ show e 163 ] 164 , testGroup "ChannelReady" [ 165 testCase "encode/decode roundtrip" $ do 166 let msg = ChannelReady 167 { channelReadyChannelId = testChannelId 168 , channelReadySecondPerCommitPoint = testPoint 169 , channelReadyTlvs = emptyTlvs 170 } 171 encoded = encodeChannelReady msg 172 case decodeChannelReady encoded of 173 Right (decoded, _) -> decoded @?= msg 174 Left e -> assertFailure $ "decode failed: " ++ show e 175 ] 176 ] 177 178 -- V2 Channel Establishment (Interactive-tx) Tests ---------------------------- 179 180 v2_establishment_tests :: TestTree 181 v2_establishment_tests = testGroup "V2 Channel Establishment" [ 182 testGroup "OpenChannel2" [ 183 testCase "encode/decode roundtrip" $ do 184 let msg = OpenChannel2 185 { openChannel2ChainHash = testChainHash 186 , openChannel2TempChannelId = testChannelId 187 , openChannel2FundingFeeratePerkw = 2500 188 , openChannel2CommitFeeratePerkw = 2000 189 , openChannel2FundingSatoshi = Satoshi 1000000 190 , openChannel2DustLimitSatoshi = Satoshi 546 191 , openChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000 192 , openChannel2HtlcMinimumMsat = MilliSatoshi 1000 193 , openChannel2ToSelfDelay = 144 194 , openChannel2MaxAcceptedHtlcs = 483 195 , openChannel2Locktime = 0 196 , openChannel2FundingPubkey = testPoint 197 , openChannel2RevocationBasepoint = testPoint 198 , openChannel2PaymentBasepoint = testPoint 199 , openChannel2DelayedPaymentBase = testPoint 200 , openChannel2HtlcBasepoint = testPoint 201 , openChannel2FirstPerCommitPoint = testPoint 202 , openChannel2SecondPerCommitPoint = testPoint2 203 , openChannel2ChannelFlags = 0x00 204 , openChannel2Tlvs = emptyTlvs 205 } 206 encoded = encodeOpenChannel2 msg 207 case decodeOpenChannel2 encoded of 208 Right (decoded, _) -> decoded @?= msg 209 Left e -> assertFailure $ "decode failed: " ++ show e 210 ] 211 , testGroup "AcceptChannel2" [ 212 testCase "encode/decode roundtrip" $ do 213 let msg = AcceptChannel2 214 { acceptChannel2TempChannelId = testChannelId 215 , acceptChannel2FundingSatoshi = Satoshi 500000 216 , acceptChannel2DustLimitSatoshi = Satoshi 546 217 , acceptChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000 218 , acceptChannel2HtlcMinimumMsat = MilliSatoshi 1000 219 , acceptChannel2MinimumDepth = 3 220 , acceptChannel2ToSelfDelay = 144 221 , acceptChannel2MaxAcceptedHtlcs = 483 222 , acceptChannel2FundingPubkey = testPoint 223 , acceptChannel2RevocationBasepoint = testPoint 224 , acceptChannel2PaymentBasepoint = testPoint 225 , acceptChannel2DelayedPaymentBase = testPoint 226 , acceptChannel2HtlcBasepoint = testPoint 227 , acceptChannel2FirstPerCommitPoint = testPoint 228 , acceptChannel2SecondPerCommitPoint = testPoint2 229 , acceptChannel2Tlvs = emptyTlvs 230 } 231 encoded = encodeAcceptChannel2 msg 232 case decodeAcceptChannel2 encoded of 233 Right (decoded, _) -> decoded @?= msg 234 Left e -> assertFailure $ "decode failed: " ++ show e 235 ] 236 , testGroup "TxAddInput" [ 237 testCase "encode/decode roundtrip" $ do 238 let msg = TxAddInput 239 { txAddInputChannelId = testChannelId 240 , txAddInputSerialId = serialId 12345 241 , txAddInputPrevTx = BS.pack [0x01, 0x02, 0x03, 0x04] 242 , txAddInputPrevVout = 0 243 , txAddInputSequence = 0xfffffffe 244 } 245 case encodeTxAddInput msg of 246 Left e -> assertFailure $ "encode failed: " ++ show e 247 Right encoded -> case decodeTxAddInput encoded of 248 Right (decoded, _) -> decoded @?= msg 249 Left e -> assertFailure $ "decode failed: " ++ show e 250 , testCase "roundtrip with empty prevTx" $ do 251 let msg = TxAddInput 252 { txAddInputChannelId = testChannelId 253 , txAddInputSerialId = serialId 0 254 , txAddInputPrevTx = BS.empty 255 , txAddInputPrevVout = 0 256 , txAddInputSequence = 0 257 } 258 case encodeTxAddInput msg of 259 Left e -> assertFailure $ "encode failed: " ++ show e 260 Right encoded -> case decodeTxAddInput encoded of 261 Right (decoded, _) -> decoded @?= msg 262 Left e -> assertFailure $ "decode failed: " ++ show e 263 ] 264 , testGroup "TxAddOutput" [ 265 testCase "encode/decode roundtrip" $ do 266 let msg = TxAddOutput 267 { txAddOutputChannelId = testChannelId 268 , txAddOutputSerialId = serialId 54321 269 , txAddOutputSats = Satoshi 100000 270 , txAddOutputScript = scriptPubKey (BS.pack [0x00, 0x14] <> 271 BS.replicate 20 0xaa) 272 } 273 case encodeTxAddOutput msg of 274 Left e -> assertFailure $ "encode failed: " ++ show e 275 Right encoded -> case decodeTxAddOutput encoded of 276 Right (decoded, _) -> decoded @?= msg 277 Left e -> assertFailure $ "decode failed: " ++ show e 278 ] 279 , testGroup "TxRemoveInput" [ 280 testCase "encode/decode roundtrip" $ do 281 let msg = TxRemoveInput 282 { txRemoveInputChannelId = testChannelId 283 , txRemoveInputSerialId = serialId 12345 284 } 285 encoded = encodeTxRemoveInput msg 286 case decodeTxRemoveInput encoded of 287 Right (decoded, _) -> decoded @?= msg 288 Left e -> assertFailure $ "decode failed: " ++ show e 289 ] 290 , testGroup "TxRemoveOutput" [ 291 testCase "encode/decode roundtrip" $ do 292 let msg = TxRemoveOutput 293 { txRemoveOutputChannelId = testChannelId 294 , txRemoveOutputSerialId = serialId 54321 295 } 296 encoded = encodeTxRemoveOutput msg 297 case decodeTxRemoveOutput encoded of 298 Right (decoded, _) -> decoded @?= msg 299 Left e -> assertFailure $ "decode failed: " ++ show e 300 ] 301 , testGroup "TxComplete" [ 302 testCase "encode/decode roundtrip" $ do 303 let msg = TxComplete { txCompleteChannelId = testChannelId } 304 encoded = encodeTxComplete msg 305 case decodeTxComplete encoded of 306 Right (decoded, _) -> decoded @?= msg 307 Left e -> assertFailure $ "decode failed: " ++ show e 308 ] 309 , testGroup "TxSignatures" [ 310 testCase "encode/decode with no witnesses" $ do 311 let msg = TxSignatures 312 { txSignaturesChannelId = testChannelId 313 , txSignaturesTxid = testTxId 314 , txSignaturesWitnesses = [] 315 } 316 case encodeTxSignatures msg of 317 Left e -> assertFailure $ "encode failed: " ++ show e 318 Right encoded -> case decodeTxSignatures encoded of 319 Right (decoded, _) -> decoded @?= msg 320 Left e -> assertFailure $ "decode failed: " ++ show e 321 , testCase "encode/decode with multiple witnesses" $ do 322 let w1 = Witness (BS.pack [0x30, 0x44] <> BS.replicate 68 0xaa) 323 w2 = Witness (BS.pack [0x02] <> BS.replicate 32 0xbb) 324 msg = TxSignatures 325 { txSignaturesChannelId = testChannelId 326 , txSignaturesTxid = testTxId 327 , txSignaturesWitnesses = [w1, w2] 328 } 329 case encodeTxSignatures msg of 330 Left e -> assertFailure $ "encode failed: " ++ show e 331 Right encoded -> case decodeTxSignatures encoded of 332 Right (decoded, _) -> decoded @?= msg 333 Left e -> assertFailure $ "decode failed: " ++ show e 334 ] 335 , testGroup "TxInitRbf" [ 336 testCase "encode/decode roundtrip" $ do 337 let msg = TxInitRbf 338 { txInitRbfChannelId = testChannelId 339 , txInitRbfLocktime = 800000 340 , txInitRbfFeerate = 3000 341 , txInitRbfTlvs = emptyTlvs 342 } 343 encoded = encodeTxInitRbf msg 344 case decodeTxInitRbf encoded of 345 Right (decoded, _) -> decoded @?= msg 346 Left e -> assertFailure $ "decode failed: " ++ show e 347 ] 348 , testGroup "TxAckRbf" [ 349 testCase "encode/decode roundtrip" $ do 350 let msg = TxAckRbf 351 { txAckRbfChannelId = testChannelId 352 , txAckRbfTlvs = emptyTlvs 353 } 354 encoded = encodeTxAckRbf msg 355 case decodeTxAckRbf encoded of 356 Right (decoded, _) -> decoded @?= msg 357 Left e -> assertFailure $ "decode failed: " ++ show e 358 ] 359 , testGroup "TxAbort" [ 360 testCase "encode/decode roundtrip" $ do 361 let msg = TxAbort 362 { txAbortChannelId = testChannelId 363 , txAbortData = "transaction abort reason" 364 } 365 case encodeTxAbort msg of 366 Left e -> assertFailure $ "encode failed: " ++ show e 367 Right encoded -> case decodeTxAbort encoded of 368 Right (decoded, _) -> decoded @?= msg 369 Left e -> assertFailure $ "decode failed: " ++ show e 370 , testCase "roundtrip with empty data" $ do 371 let msg = TxAbort 372 { txAbortChannelId = testChannelId 373 , txAbortData = BS.empty 374 } 375 case encodeTxAbort msg of 376 Left e -> assertFailure $ "encode failed: " ++ show e 377 Right encoded -> case decodeTxAbort encoded of 378 Right (decoded, _) -> decoded @?= msg 379 Left e -> assertFailure $ "decode failed: " ++ show e 380 ] 381 ] 382 383 -- Channel Close Tests --------------------------------------------------------- 384 385 close_tests :: TestTree 386 close_tests = testGroup "Channel Close" [ 387 testGroup "Stfu" [ 388 testCase "encode/decode IsInitiator" $ do 389 let msg = Stfu 390 { stfuChannelId = testChannelId 391 , stfuInitiator = IsInitiator 392 } 393 encoded = encodeStfu msg 394 case decodeStfu encoded of 395 Right (decoded, _) -> decoded @?= msg 396 Left e -> assertFailure $ "decode failed: " ++ show e 397 , testCase "encode/decode NotInitiator" $ do 398 let msg = Stfu 399 { stfuChannelId = testChannelId 400 , stfuInitiator = NotInitiator 401 } 402 encoded = encodeStfu msg 403 case decodeStfu encoded of 404 Right (decoded, _) -> decoded @?= msg 405 Left e -> assertFailure $ "decode failed: " ++ show e 406 ] 407 , testGroup "Shutdown" [ 408 testCase "encode/decode with P2WPKH script" $ do 409 let script = scriptPubKey (BS.pack [0x00, 0x14] <> 410 BS.replicate 20 0xaa) 411 msg = Shutdown 412 { shutdownChannelId = testChannelId 413 , shutdownScriptPubkey = script 414 } 415 case encodeShutdown msg of 416 Left e -> assertFailure $ "encode failed: " ++ show e 417 Right encoded -> case decodeShutdown encoded of 418 Right (decoded, _) -> decoded @?= msg 419 Left e -> assertFailure $ "decode failed: " ++ show e 420 , testCase "encode/decode with P2WSH script" $ do 421 let script = scriptPubKey (BS.pack [0x00, 0x20] <> 422 BS.replicate 32 0xbb) 423 msg = Shutdown 424 { shutdownChannelId = testChannelId 425 , shutdownScriptPubkey = script 426 } 427 case encodeShutdown msg of 428 Left e -> assertFailure $ "encode failed: " ++ show e 429 Right encoded -> case decodeShutdown encoded of 430 Right (decoded, _) -> decoded @?= msg 431 Left e -> assertFailure $ "decode failed: " ++ show e 432 ] 433 , testGroup "ClosingSigned" [ 434 testCase "encode/decode roundtrip" $ do 435 let msg = ClosingSigned 436 { closingSignedChannelId = testChannelId 437 , closingSignedFeeSatoshi = Satoshi 1000 438 , closingSignedSignature = testSignature 439 , closingSignedTlvs = emptyTlvs 440 } 441 encoded = encodeClosingSigned msg 442 case decodeClosingSigned encoded of 443 Right (decoded, _) -> decoded @?= msg 444 Left e -> assertFailure $ "decode failed: " ++ show e 445 ] 446 , testGroup "ClosingComplete" [ 447 testCase "encode/decode roundtrip" $ do 448 let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <> 449 BS.replicate 20 0xcc) 450 closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <> 451 BS.replicate 20 0xdd) 452 msg = ClosingComplete 453 { closingCompleteChannelId = testChannelId 454 , closingCompleteCloserScript = closerScript 455 , closingCompleteCloseeScript = closeeScript 456 , closingCompleteFeeSatoshi = Satoshi 500 457 , closingCompleteLocktime = 0 458 , closingCompleteTlvs = emptyTlvs 459 } 460 case encodeClosingComplete msg of 461 Left e -> assertFailure $ "encode failed: " ++ show e 462 Right encoded -> case decodeClosingComplete encoded of 463 Right (decoded, _) -> decoded @?= msg 464 Left e -> assertFailure $ "decode failed: " ++ show e 465 ] 466 , testGroup "ClosingSig" [ 467 testCase "encode/decode roundtrip" $ do 468 let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <> 469 BS.replicate 20 0xee) 470 closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <> 471 BS.replicate 20 0xff) 472 msg = ClosingSig 473 { closingSigChannelId = testChannelId 474 , closingSigCloserScript = closerScript 475 , closingSigCloseeScript = closeeScript 476 , closingSigFeeSatoshi = Satoshi 500 477 , closingSigLocktime = 100 478 , closingSigTlvs = emptyTlvs 479 } 480 case encodeClosingSig msg of 481 Left e -> assertFailure $ "encode failed: " ++ show e 482 Right encoded -> case decodeClosingSig encoded of 483 Right (decoded, _) -> decoded @?= msg 484 Left e -> assertFailure $ "decode failed: " ++ show e 485 ] 486 ] 487 488 -- Normal Operation Tests ------------------------------------------------------ 489 490 normal_operation_tests :: TestTree 491 normal_operation_tests = testGroup "Normal Operation" [ 492 testGroup "UpdateAddHtlc" [ 493 testCase "encode/decode roundtrip" $ do 494 let msg = UpdateAddHtlc 495 { updateAddHtlcChannelId = testChannelId 496 , updateAddHtlcId = htlcId 0 497 , updateAddHtlcAmountMsat = MilliSatoshi 10000000 498 , updateAddHtlcPaymentHash = testPaymentHash 499 , updateAddHtlcCltvExpiry = 800144 500 , updateAddHtlcOnionPacket = testOnionPacket 501 , updateAddHtlcTlvs = emptyTlvs 502 } 503 encoded = encodeUpdateAddHtlc msg 504 case decodeUpdateAddHtlc encoded of 505 Right (decoded, _) -> decoded @?= msg 506 Left e -> assertFailure $ "decode failed: " ++ show e 507 ] 508 , testGroup "UpdateFulfillHtlc" [ 509 testCase "encode/decode roundtrip" $ do 510 let msg = UpdateFulfillHtlc 511 { updateFulfillHtlcChannelId = testChannelId 512 , updateFulfillHtlcId = htlcId 42 513 , updateFulfillHtlcPaymentPreimage = testPaymentPreimage 514 , updateFulfillHtlcTlvs = emptyTlvs 515 } 516 encoded = encodeUpdateFulfillHtlc msg 517 case decodeUpdateFulfillHtlc encoded of 518 Right (decoded, _) -> decoded @?= msg 519 Left e -> assertFailure $ "decode failed: " ++ show e 520 ] 521 , testGroup "UpdateFailHtlc" [ 522 testCase "encode/decode roundtrip" $ do 523 let msg = UpdateFailHtlc 524 { updateFailHtlcChannelId = testChannelId 525 , updateFailHtlcId = htlcId 42 526 , updateFailHtlcReason = BS.replicate 32 0xaa 527 , updateFailHtlcTlvs = emptyTlvs 528 } 529 case encodeUpdateFailHtlc msg of 530 Left e -> assertFailure $ "encode failed: " ++ show e 531 Right encoded -> case decodeUpdateFailHtlc encoded of 532 Right (decoded, _) -> decoded @?= msg 533 Left e -> assertFailure $ "decode failed: " ++ show e 534 , testCase "roundtrip with empty reason" $ do 535 let msg = UpdateFailHtlc 536 { updateFailHtlcChannelId = testChannelId 537 , updateFailHtlcId = htlcId 0 538 , updateFailHtlcReason = BS.empty 539 , updateFailHtlcTlvs = emptyTlvs 540 } 541 case encodeUpdateFailHtlc msg of 542 Left e -> assertFailure $ "encode failed: " ++ show e 543 Right encoded -> case decodeUpdateFailHtlc encoded of 544 Right (decoded, _) -> decoded @?= msg 545 Left e -> assertFailure $ "decode failed: " ++ show e 546 ] 547 , testGroup "UpdateFailMalformedHtlc" [ 548 testCase "encode/decode roundtrip" $ do 549 let msg = UpdateFailMalformedHtlc 550 { updateFailMalformedHtlcChannelId = testChannelId 551 , updateFailMalformedHtlcId = htlcId 42 552 , updateFailMalformedHtlcSha256Onion = testPaymentHash 553 , updateFailMalformedHtlcFailureCode = 0x8002 554 } 555 encoded = encodeUpdateFailMalformedHtlc msg 556 case decodeUpdateFailMalformedHtlc encoded of 557 Right (decoded, _) -> decoded @?= msg 558 Left e -> assertFailure $ "decode failed: " ++ show e 559 ] 560 , testGroup "CommitmentSigned" [ 561 testCase "encode/decode with no HTLC signatures" $ do 562 let msg = CommitmentSigned 563 { commitmentSignedChannelId = testChannelId 564 , commitmentSignedSignature = testSignature 565 , commitmentSignedHtlcSignatures = [] 566 } 567 case encodeCommitmentSigned msg of 568 Left e -> assertFailure $ "encode failed: " ++ show e 569 Right encoded -> case decodeCommitmentSigned encoded of 570 Right (decoded, _) -> decoded @?= msg 571 Left e -> assertFailure $ "decode failed: " ++ show e 572 , testCase "encode/decode with HTLC signatures" $ do 573 let sig2 = fromJust $ signature (BS.replicate 64 0xdd) 574 sig3 = fromJust $ signature (BS.replicate 64 0xee) 575 msg = CommitmentSigned 576 { commitmentSignedChannelId = testChannelId 577 , commitmentSignedSignature = testSignature 578 , commitmentSignedHtlcSignatures = [sig2, sig3] 579 } 580 case encodeCommitmentSigned msg of 581 Left e -> assertFailure $ "encode failed: " ++ show e 582 Right encoded -> case decodeCommitmentSigned encoded of 583 Right (decoded, _) -> decoded @?= msg 584 Left e -> assertFailure $ "decode failed: " ++ show e 585 ] 586 , testGroup "RevokeAndAck" [ 587 testCase "encode/decode roundtrip" $ do 588 let msg = RevokeAndAck 589 { revokeAndAckChannelId = testChannelId 590 , revokeAndAckPerCommitmentSecret = testSecret 591 , revokeAndAckNextPerCommitPoint = testPoint 592 } 593 encoded = encodeRevokeAndAck msg 594 case decodeRevokeAndAck encoded of 595 Right (decoded, _) -> decoded @?= msg 596 Left e -> assertFailure $ "decode failed: " ++ show e 597 ] 598 , testGroup "UpdateFee" [ 599 testCase "encode/decode roundtrip" $ do 600 let msg = UpdateFee 601 { updateFeeChannelId = testChannelId 602 , updateFeeFeeratePerKw = 5000 603 } 604 encoded = encodeUpdateFee msg 605 case decodeUpdateFee encoded of 606 Right (decoded, _) -> decoded @?= msg 607 Left e -> assertFailure $ "decode failed: " ++ show e 608 ] 609 ] 610 611 -- Reestablish Tests ----------------------------------------------------------- 612 613 reestablish_tests :: TestTree 614 reestablish_tests = testGroup "Channel Reestablish" [ 615 testCase "encode/decode roundtrip" $ do 616 let sec = fromJust $ perCommitmentSecret (BS.replicate 32 0x22) 617 msg = ChannelReestablish 618 { channelReestablishChannelId = testChannelId 619 , channelReestablishNextCommitNum = 5 620 , channelReestablishNextRevocationNum = 4 621 , channelReestablishYourLastCommitSecret = sec 622 , channelReestablishMyCurrentCommitPoint = testPoint 623 , channelReestablishTlvs = emptyTlvs 624 } 625 encoded = encodeChannelReestablish msg 626 case decodeChannelReestablish encoded of 627 Right (decoded, _) -> decoded @?= msg 628 Left e -> assertFailure $ "decode failed: " ++ show e 629 , testCase "roundtrip with zero counters" $ do 630 let sec = fromJust $ perCommitmentSecret (BS.replicate 32 0x00) 631 msg = ChannelReestablish 632 { channelReestablishChannelId = testChannelId 633 , channelReestablishNextCommitNum = 1 634 , channelReestablishNextRevocationNum = 0 635 , channelReestablishYourLastCommitSecret = sec 636 , channelReestablishMyCurrentCommitPoint = testPoint 637 , channelReestablishTlvs = emptyTlvs 638 } 639 encoded = encodeChannelReestablish msg 640 case decodeChannelReestablish encoded of 641 Right (decoded, _) -> decoded @?= msg 642 Left e -> assertFailure $ "decode failed: " ++ show e 643 ] 644 645 -- Error Condition Tests ------------------------------------------------------- 646 647 error_tests :: TestTree 648 error_tests = testGroup "Error Conditions" [ 649 testGroup "Insufficient Bytes" [ 650 testCase "decodeOpenChannel empty" $ do 651 case decodeOpenChannel BS.empty of 652 Left DecodeInsufficientBytes -> pure () 653 other -> assertFailure $ "expected insufficient: " ++ show other 654 , testCase "decodeOpenChannel too short" $ do 655 case decodeOpenChannel (BS.replicate 100 0x00) of 656 Left DecodeInsufficientBytes -> pure () 657 other -> assertFailure $ "expected insufficient: " ++ show other 658 , testCase "decodeAcceptChannel too short" $ do 659 case decodeAcceptChannel (BS.replicate 10 0x00) of 660 Left DecodeInsufficientBytes -> pure () 661 other -> assertFailure $ "expected insufficient: " ++ show other 662 , testCase "decodeFundingCreated too short" $ do 663 case decodeFundingCreated (BS.replicate 50 0x00) of 664 Left DecodeInsufficientBytes -> pure () 665 other -> assertFailure $ "expected insufficient: " ++ show other 666 , testCase "decodeFundingSigned too short" $ do 667 case decodeFundingSigned (BS.replicate 30 0x00) of 668 Left DecodeInsufficientBytes -> pure () 669 other -> assertFailure $ "expected insufficient: " ++ show other 670 , testCase "decodeChannelReady too short" $ do 671 case decodeChannelReady (BS.replicate 32 0x00) of 672 Left DecodeInsufficientBytes -> pure () 673 other -> assertFailure $ "expected insufficient: " ++ show other 674 , testCase "decodeStfu too short" $ do 675 case decodeStfu (BS.replicate 31 0x00) of 676 Left DecodeInsufficientBytes -> pure () 677 other -> assertFailure $ "expected insufficient: " ++ show other 678 , testCase "decodeShutdown too short" $ do 679 case decodeShutdown (BS.replicate 32 0x00) of 680 Left DecodeInsufficientBytes -> pure () 681 other -> assertFailure $ "expected insufficient: " ++ show other 682 , testCase "decodeStfu invalid initiator byte" $ do 683 -- channel_id (32 bytes) + initiator (1 byte, value 2) 684 let encoded = BS.replicate 32 0xab <> BS.singleton 0x02 685 case decodeStfu encoded of 686 Left DecodeInvalidInitiator -> pure () 687 other -> assertFailure $ 688 "expected invalid initiator: " ++ show other 689 , testCase "decodeUpdateAddHtlc too short" $ do 690 case decodeUpdateAddHtlc (BS.replicate 100 0x00) of 691 Left DecodeInsufficientBytes -> pure () 692 other -> assertFailure $ "expected insufficient: " ++ show other 693 , testCase "decodeCommitmentSigned too short" $ do 694 case decodeCommitmentSigned (BS.replicate 90 0x00) of 695 Left DecodeInsufficientBytes -> pure () 696 other -> assertFailure $ "expected insufficient: " ++ show other 697 , testCase "decodeRevokeAndAck too short" $ do 698 case decodeRevokeAndAck (BS.replicate 60 0x00) of 699 Left DecodeInsufficientBytes -> pure () 700 other -> assertFailure $ "expected insufficient: " ++ show other 701 , testCase "decodeTxSignatures too short" $ do 702 case decodeTxSignatures (BS.replicate 60 0x00) of 703 Left DecodeInsufficientBytes -> pure () 704 other -> assertFailure $ "expected insufficient: " ++ show other 705 ] 706 , testGroup "EncodeError - Length Overflow" [ 707 testCase "encodeShutdown with oversized script" $ do 708 let script = scriptPubKey (BS.replicate 70000 0x00) 709 msg = Shutdown 710 { shutdownChannelId = testChannelId 711 , shutdownScriptPubkey = script 712 } 713 case encodeShutdown msg of 714 Left EncodeLengthOverflow -> pure () 715 other -> assertFailure $ "expected overflow: " ++ show other 716 , testCase "encodeClosingComplete with oversized closer script" $ do 717 let oversizedScript = scriptPubKey (BS.replicate 70000 0x00) 718 normalScript = scriptPubKey (BS.replicate 22 0x00) 719 msg = ClosingComplete 720 { closingCompleteChannelId = testChannelId 721 , closingCompleteCloserScript = oversizedScript 722 , closingCompleteCloseeScript = normalScript 723 , closingCompleteFeeSatoshi = Satoshi 500 724 , closingCompleteLocktime = 0 725 , closingCompleteTlvs = emptyTlvs 726 } 727 case encodeClosingComplete msg of 728 Left EncodeLengthOverflow -> pure () 729 other -> assertFailure $ "expected overflow: " ++ show other 730 , testCase "encodeClosingComplete with oversized closee script" $ do 731 let normalScript = scriptPubKey (BS.replicate 22 0x00) 732 oversizedScript = scriptPubKey (BS.replicate 70000 0x00) 733 msg = ClosingComplete 734 { closingCompleteChannelId = testChannelId 735 , closingCompleteCloserScript = normalScript 736 , closingCompleteCloseeScript = oversizedScript 737 , closingCompleteFeeSatoshi = Satoshi 500 738 , closingCompleteLocktime = 0 739 , closingCompleteTlvs = emptyTlvs 740 } 741 case encodeClosingComplete msg of 742 Left EncodeLengthOverflow -> pure () 743 other -> assertFailure $ "expected overflow: " ++ show other 744 , testCase "encodeClosingSig with oversized script" $ do 745 let oversizedScript = scriptPubKey (BS.replicate 70000 0x00) 746 normalScript = scriptPubKey (BS.replicate 22 0x00) 747 msg = ClosingSig 748 { closingSigChannelId = testChannelId 749 , closingSigCloserScript = oversizedScript 750 , closingSigCloseeScript = normalScript 751 , closingSigFeeSatoshi = Satoshi 500 752 , closingSigLocktime = 0 753 , closingSigTlvs = emptyTlvs 754 } 755 case encodeClosingSig msg of 756 Left EncodeLengthOverflow -> pure () 757 other -> assertFailure $ "expected overflow: " ++ show other 758 ] 759 , testGroup "Invalid Field Length" [ 760 testCase "decodeShutdown with invalid script length" $ do 761 -- channel_id (32 bytes) + script length (2 bytes) claiming more 762 let encoded = BS.replicate 32 0xab <> 763 BS.pack [0xff, 0xff] <> -- claims 65535 bytes 764 BS.replicate 10 0x00 -- only 10 bytes 765 case decodeShutdown encoded of 766 Left DecodeInsufficientBytes -> pure () 767 other -> assertFailure $ "expected insufficient: " ++ show other 768 , testCase "decodeTxAddInput with invalid prevTx length" $ do 769 -- channel_id (32) + serial_id (8) + len (2) claiming more 770 let encoded = BS.replicate 32 0xab <> 771 BS.replicate 8 0x00 <> 772 BS.pack [0xff, 0xff] <> -- claims 65535 bytes 773 BS.replicate 10 0x00 -- only 10 bytes 774 case decodeTxAddInput encoded of 775 Left DecodeInsufficientBytes -> pure () 776 other -> assertFailure $ "expected insufficient: " ++ show other 777 , testCase "decodeUpdateFailHtlc with invalid reason length" $ do 778 -- channel_id (32) + htlc_id (8) + len (2) claiming more 779 let encoded = BS.replicate 32 0xab <> 780 BS.replicate 8 0x00 <> 781 BS.pack [0xff, 0xff] <> -- claims 65535 bytes 782 BS.replicate 10 0x00 -- only 10 bytes 783 case decodeUpdateFailHtlc encoded of 784 Left DecodeInsufficientBytes -> pure () 785 other -> assertFailure $ "expected insufficient: " ++ show other 786 ] 787 ] 788 789 -- Property Tests -------------------------------------------------------------- 790 791 property_tests :: TestTree 792 property_tests = testGroup "Properties" [ 793 testProperty "OpenChannel roundtrip" propOpenChannelRoundtrip 794 , testProperty "AcceptChannel roundtrip" propAcceptChannelRoundtrip 795 , testProperty "FundingCreated roundtrip" propFundingCreatedRoundtrip 796 , testProperty "FundingSigned roundtrip" propFundingSignedRoundtrip 797 , testProperty "ChannelReady roundtrip" propChannelReadyRoundtrip 798 , testProperty "OpenChannel2 roundtrip" propOpenChannel2Roundtrip 799 , testProperty "AcceptChannel2 roundtrip" propAcceptChannel2Roundtrip 800 , testProperty "TxAddInput roundtrip" propTxAddInputRoundtrip 801 , testProperty "TxAddOutput roundtrip" propTxAddOutputRoundtrip 802 , testProperty "TxRemoveInput roundtrip" propTxRemoveInputRoundtrip 803 , testProperty "TxRemoveOutput roundtrip" propTxRemoveOutputRoundtrip 804 , testProperty "TxComplete roundtrip" propTxCompleteRoundtrip 805 , testProperty "TxSignatures roundtrip" propTxSignaturesRoundtrip 806 , testProperty "TxInitRbf roundtrip" propTxInitRbfRoundtrip 807 , testProperty "TxAckRbf roundtrip" propTxAckRbfRoundtrip 808 , testProperty "TxAbort roundtrip" propTxAbortRoundtrip 809 , testProperty "Stfu roundtrip" propStfuRoundtrip 810 , testProperty "Shutdown roundtrip" propShutdownRoundtrip 811 , testProperty "ClosingSigned roundtrip" propClosingSignedRoundtrip 812 , testProperty "ClosingComplete roundtrip" propClosingCompleteRoundtrip 813 , testProperty "ClosingSig roundtrip" propClosingSigRoundtrip 814 , testProperty "UpdateAddHtlc roundtrip" propUpdateAddHtlcRoundtrip 815 , testProperty "UpdateFulfillHtlc roundtrip" propUpdateFulfillHtlcRoundtrip 816 , testProperty "UpdateFailHtlc roundtrip" propUpdateFailHtlcRoundtrip 817 , testProperty "UpdateFailMalformedHtlc roundtrip" 818 propUpdateFailMalformedHtlcRoundtrip 819 , testProperty "CommitmentSigned roundtrip" propCommitmentSignedRoundtrip 820 , testProperty "RevokeAndAck roundtrip" propRevokeAndAckRoundtrip 821 , testProperty "UpdateFee roundtrip" propUpdateFeeRoundtrip 822 , testProperty "ChannelReestablish roundtrip" propChannelReestablishRoundtrip 823 , testProperty "HtlcId wrap/unwrap" propHtlcIdRoundtrip 824 , testProperty "SerialId wrap/unwrap" propSerialIdRoundtrip 825 , testProperty "OnionPacket validates length" propOnionPacketLength 826 , testProperty "TxId validates length" propTxIdLength 827 ] 828 829 -- Property: OpenChannel roundtrip 830 propOpenChannelRoundtrip :: Property 831 propOpenChannelRoundtrip = property $ do 832 let msg = OpenChannel 833 { openChannelChainHash = testChainHash 834 , openChannelTempChannelId = testChannelId 835 , openChannelFundingSatoshi = Satoshi 1000000 836 , openChannelPushMsat = MilliSatoshi 500000 837 , openChannelDustLimitSatoshi = Satoshi 546 838 , openChannelMaxHtlcValueInFlight = MilliSatoshi 100000000 839 , openChannelChannelReserveSat = Satoshi 10000 840 , openChannelHtlcMinimumMsat = MilliSatoshi 1000 841 , openChannelFeeratePerKw = 2500 842 , openChannelToSelfDelay = 144 843 , openChannelMaxAcceptedHtlcs = 483 844 , openChannelFundingPubkey = testPoint 845 , openChannelRevocationBasepoint = testPoint 846 , openChannelPaymentBasepoint = testPoint 847 , openChannelDelayedPaymentBase = testPoint 848 , openChannelHtlcBasepoint = testPoint 849 , openChannelFirstPerCommitPoint = testPoint 850 , openChannelChannelFlags = 0x01 851 , openChannelTlvs = emptyTlvs 852 } 853 encoded = encodeOpenChannel msg 854 case decodeOpenChannel encoded of 855 Right (decoded, _) -> decoded == msg 856 Left _ -> False 857 858 -- Property: AcceptChannel roundtrip 859 propAcceptChannelRoundtrip :: Property 860 propAcceptChannelRoundtrip = property $ do 861 let msg = AcceptChannel 862 { acceptChannelTempChannelId = testChannelId 863 , acceptChannelDustLimitSatoshi = Satoshi 546 864 , acceptChannelMaxHtlcValueInFlight = MilliSatoshi 100000000 865 , acceptChannelChannelReserveSat = Satoshi 10000 866 , acceptChannelHtlcMinimumMsat = MilliSatoshi 1000 867 , acceptChannelMinimumDepth = 3 868 , acceptChannelToSelfDelay = 144 869 , acceptChannelMaxAcceptedHtlcs = 483 870 , acceptChannelFundingPubkey = testPoint 871 , acceptChannelRevocationBasepoint = testPoint 872 , acceptChannelPaymentBasepoint = testPoint 873 , acceptChannelDelayedPaymentBase = testPoint 874 , acceptChannelHtlcBasepoint = testPoint 875 , acceptChannelFirstPerCommitPoint = testPoint 876 , acceptChannelTlvs = emptyTlvs 877 } 878 encoded = encodeAcceptChannel msg 879 case decodeAcceptChannel encoded of 880 Right (decoded, _) -> decoded == msg 881 Left _ -> False 882 883 -- Property: FundingCreated roundtrip 884 propFundingCreatedRoundtrip :: Word16 -> Property 885 propFundingCreatedRoundtrip outIdx = property $ do 886 let msg = FundingCreated 887 { fundingCreatedTempChannelId = testChannelId 888 , fundingCreatedFundingTxid = testTxId 889 , fundingCreatedFundingOutIdx = outIdx 890 , fundingCreatedSignature = testSignature 891 } 892 encoded = encodeFundingCreated msg 893 case decodeFundingCreated encoded of 894 Right (decoded, _) -> decoded == msg 895 Left _ -> False 896 897 -- Property: FundingSigned roundtrip 898 propFundingSignedRoundtrip :: Property 899 propFundingSignedRoundtrip = property $ do 900 let msg = FundingSigned 901 { fundingSignedChannelId = testChannelId 902 , fundingSignedSignature = testSignature 903 } 904 encoded = encodeFundingSigned msg 905 case decodeFundingSigned encoded of 906 Right (decoded, _) -> decoded == msg 907 Left _ -> False 908 909 -- Property: ChannelReady roundtrip 910 propChannelReadyRoundtrip :: Property 911 propChannelReadyRoundtrip = property $ do 912 let msg = ChannelReady 913 { channelReadyChannelId = testChannelId 914 , channelReadySecondPerCommitPoint = testPoint 915 , channelReadyTlvs = emptyTlvs 916 } 917 encoded = encodeChannelReady msg 918 case decodeChannelReady encoded of 919 Right (decoded, _) -> decoded == msg 920 Left _ -> False 921 922 -- Property: OpenChannel2 roundtrip 923 propOpenChannel2Roundtrip :: Property 924 propOpenChannel2Roundtrip = property $ do 925 let msg = OpenChannel2 926 { openChannel2ChainHash = testChainHash 927 , openChannel2TempChannelId = testChannelId 928 , openChannel2FundingFeeratePerkw = 2500 929 , openChannel2CommitFeeratePerkw = 2000 930 , openChannel2FundingSatoshi = Satoshi 1000000 931 , openChannel2DustLimitSatoshi = Satoshi 546 932 , openChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000 933 , openChannel2HtlcMinimumMsat = MilliSatoshi 1000 934 , openChannel2ToSelfDelay = 144 935 , openChannel2MaxAcceptedHtlcs = 483 936 , openChannel2Locktime = 0 937 , openChannel2FundingPubkey = testPoint 938 , openChannel2RevocationBasepoint = testPoint 939 , openChannel2PaymentBasepoint = testPoint 940 , openChannel2DelayedPaymentBase = testPoint 941 , openChannel2HtlcBasepoint = testPoint 942 , openChannel2FirstPerCommitPoint = testPoint 943 , openChannel2SecondPerCommitPoint = testPoint2 944 , openChannel2ChannelFlags = 0x00 945 , openChannel2Tlvs = emptyTlvs 946 } 947 encoded = encodeOpenChannel2 msg 948 case decodeOpenChannel2 encoded of 949 Right (decoded, _) -> decoded == msg 950 Left _ -> False 951 952 -- Property: AcceptChannel2 roundtrip 953 propAcceptChannel2Roundtrip :: Property 954 propAcceptChannel2Roundtrip = property $ do 955 let msg = AcceptChannel2 956 { acceptChannel2TempChannelId = testChannelId 957 , acceptChannel2FundingSatoshi = Satoshi 500000 958 , acceptChannel2DustLimitSatoshi = Satoshi 546 959 , acceptChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000 960 , acceptChannel2HtlcMinimumMsat = MilliSatoshi 1000 961 , acceptChannel2MinimumDepth = 3 962 , acceptChannel2ToSelfDelay = 144 963 , acceptChannel2MaxAcceptedHtlcs = 483 964 , acceptChannel2FundingPubkey = testPoint 965 , acceptChannel2RevocationBasepoint = testPoint 966 , acceptChannel2PaymentBasepoint = testPoint 967 , acceptChannel2DelayedPaymentBase = testPoint 968 , acceptChannel2HtlcBasepoint = testPoint 969 , acceptChannel2FirstPerCommitPoint = testPoint 970 , acceptChannel2SecondPerCommitPoint = testPoint2 971 , acceptChannel2Tlvs = emptyTlvs 972 } 973 encoded = encodeAcceptChannel2 msg 974 case decodeAcceptChannel2 encoded of 975 Right (decoded, _) -> decoded == msg 976 Left _ -> False 977 978 -- Property: TxAddInput roundtrip with varying data 979 propTxAddInputRoundtrip :: [Word8] -> Word32 -> Word32 -> Property 980 propTxAddInputRoundtrip prevTxBytes vout seqNum = property $ do 981 let prevTx = BS.pack (take 1000 prevTxBytes) -- limit size 982 msg = TxAddInput 983 { txAddInputChannelId = testChannelId 984 , txAddInputSerialId = serialId 12345 985 , txAddInputPrevTx = prevTx 986 , txAddInputPrevVout = vout 987 , txAddInputSequence = seqNum 988 } 989 case encodeTxAddInput msg of 990 Left _ -> False 991 Right encoded -> case decodeTxAddInput encoded of 992 Right (decoded, _) -> decoded == msg 993 Left _ -> False 994 995 -- Property: TxAddOutput roundtrip 996 propTxAddOutputRoundtrip :: Word64 -> [Word8] -> Property 997 propTxAddOutputRoundtrip sats scriptBytes = property $ do 998 let script = scriptPubKey (BS.pack (take 100 scriptBytes)) 999 msg = TxAddOutput 1000 { txAddOutputChannelId = testChannelId 1001 , txAddOutputSerialId = serialId 54321 1002 , txAddOutputSats = Satoshi sats 1003 , txAddOutputScript = script 1004 } 1005 case encodeTxAddOutput msg of 1006 Left _ -> False 1007 Right encoded -> case decodeTxAddOutput encoded of 1008 Right (decoded, _) -> decoded == msg 1009 Left _ -> False 1010 1011 -- Property: TxRemoveInput roundtrip 1012 propTxRemoveInputRoundtrip :: Word64 -> Property 1013 propTxRemoveInputRoundtrip sid = property $ do 1014 let msg = TxRemoveInput 1015 { txRemoveInputChannelId = testChannelId 1016 , txRemoveInputSerialId = serialId sid 1017 } 1018 encoded = encodeTxRemoveInput msg 1019 case decodeTxRemoveInput encoded of 1020 Right (decoded, _) -> decoded == msg 1021 Left _ -> False 1022 1023 -- Property: TxRemoveOutput roundtrip 1024 propTxRemoveOutputRoundtrip :: Word64 -> Property 1025 propTxRemoveOutputRoundtrip sid = property $ do 1026 let msg = TxRemoveOutput 1027 { txRemoveOutputChannelId = testChannelId 1028 , txRemoveOutputSerialId = serialId sid 1029 } 1030 encoded = encodeTxRemoveOutput msg 1031 case decodeTxRemoveOutput encoded of 1032 Right (decoded, _) -> decoded == msg 1033 Left _ -> False 1034 1035 -- Property: TxComplete roundtrip 1036 propTxCompleteRoundtrip :: Property 1037 propTxCompleteRoundtrip = property $ do 1038 let msg = TxComplete { txCompleteChannelId = testChannelId } 1039 encoded = encodeTxComplete msg 1040 case decodeTxComplete encoded of 1041 Right (decoded, _) -> decoded == msg 1042 Left _ -> False 1043 1044 -- Property: TxSignatures roundtrip with varying witnesses 1045 propTxSignaturesRoundtrip :: [[Word8]] -> Property 1046 propTxSignaturesRoundtrip witnessList = property $ do 1047 let wits = map (Witness . BS.pack . take 200) (take 10 witnessList) 1048 msg = TxSignatures 1049 { txSignaturesChannelId = testChannelId 1050 , txSignaturesTxid = testTxId 1051 , txSignaturesWitnesses = wits 1052 } 1053 case encodeTxSignatures msg of 1054 Left _ -> False 1055 Right encoded -> case decodeTxSignatures encoded of 1056 Right (decoded, _) -> decoded == msg 1057 Left _ -> False 1058 1059 -- Property: TxInitRbf roundtrip 1060 propTxInitRbfRoundtrip :: Word32 -> Word32 -> Property 1061 propTxInitRbfRoundtrip locktime feerate = property $ do 1062 let msg = TxInitRbf 1063 { txInitRbfChannelId = testChannelId 1064 , txInitRbfLocktime = locktime 1065 , txInitRbfFeerate = feerate 1066 , txInitRbfTlvs = emptyTlvs 1067 } 1068 encoded = encodeTxInitRbf msg 1069 case decodeTxInitRbf encoded of 1070 Right (decoded, _) -> decoded == msg 1071 Left _ -> False 1072 1073 -- Property: TxAckRbf roundtrip 1074 propTxAckRbfRoundtrip :: Property 1075 propTxAckRbfRoundtrip = property $ do 1076 let msg = TxAckRbf 1077 { txAckRbfChannelId = testChannelId 1078 , txAckRbfTlvs = emptyTlvs 1079 } 1080 encoded = encodeTxAckRbf msg 1081 case decodeTxAckRbf encoded of 1082 Right (decoded, _) -> decoded == msg 1083 Left _ -> False 1084 1085 -- Property: TxAbort roundtrip 1086 propTxAbortRoundtrip :: [Word8] -> Property 1087 propTxAbortRoundtrip dataBytes = property $ do 1088 let abortData = BS.pack (take 1000 dataBytes) 1089 msg = TxAbort 1090 { txAbortChannelId = testChannelId 1091 , txAbortData = abortData 1092 } 1093 case encodeTxAbort msg of 1094 Left _ -> False 1095 Right encoded -> case decodeTxAbort encoded of 1096 Right (decoded, _) -> decoded == msg 1097 Left _ -> False 1098 1099 -- Property: Stfu roundtrip 1100 propStfuRoundtrip :: Bool -> Property 1101 propStfuRoundtrip isInit = property $ do 1102 let ini = if isInit then IsInitiator else NotInitiator 1103 msg = Stfu 1104 { stfuChannelId = testChannelId 1105 , stfuInitiator = ini 1106 } 1107 encoded = encodeStfu msg 1108 case decodeStfu encoded of 1109 Right (decoded, _) -> decoded == msg 1110 Left _ -> False 1111 1112 -- Property: Shutdown roundtrip 1113 propShutdownRoundtrip :: [Word8] -> Property 1114 propShutdownRoundtrip scriptBytes = property $ do 1115 let script = scriptPubKey (BS.pack (take 100 scriptBytes)) 1116 msg = Shutdown 1117 { shutdownChannelId = testChannelId 1118 , shutdownScriptPubkey = script 1119 } 1120 case encodeShutdown msg of 1121 Left _ -> False 1122 Right encoded -> case decodeShutdown encoded of 1123 Right (decoded, _) -> decoded == msg 1124 Left _ -> False 1125 1126 -- Property: ClosingSigned roundtrip 1127 propClosingSignedRoundtrip :: Word64 -> Property 1128 propClosingSignedRoundtrip feeSats = property $ do 1129 let msg = ClosingSigned 1130 { closingSignedChannelId = testChannelId 1131 , closingSignedFeeSatoshi = Satoshi feeSats 1132 , closingSignedSignature = testSignature 1133 , closingSignedTlvs = emptyTlvs 1134 } 1135 encoded = encodeClosingSigned msg 1136 case decodeClosingSigned encoded of 1137 Right (decoded, _) -> decoded == msg 1138 Left _ -> False 1139 1140 -- Property: ClosingComplete roundtrip 1141 propClosingCompleteRoundtrip :: Word64 -> Word32 -> Property 1142 propClosingCompleteRoundtrip feeSats locktime = property $ do 1143 let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <> 1144 BS.replicate 20 0xcc) 1145 closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <> 1146 BS.replicate 20 0xdd) 1147 msg = ClosingComplete 1148 { closingCompleteChannelId = testChannelId 1149 , closingCompleteCloserScript = closerScript 1150 , closingCompleteCloseeScript = closeeScript 1151 , closingCompleteFeeSatoshi = Satoshi feeSats 1152 , closingCompleteLocktime = locktime 1153 , closingCompleteTlvs = emptyTlvs 1154 } 1155 case encodeClosingComplete msg of 1156 Left _ -> False 1157 Right encoded -> case decodeClosingComplete encoded of 1158 Right (decoded, _) -> decoded == msg 1159 Left _ -> False 1160 1161 -- Property: ClosingSig roundtrip 1162 propClosingSigRoundtrip :: Word64 -> Word32 -> Property 1163 propClosingSigRoundtrip feeSats locktime = property $ do 1164 let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <> 1165 BS.replicate 20 0xee) 1166 closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <> 1167 BS.replicate 20 0xff) 1168 msg = ClosingSig 1169 { closingSigChannelId = testChannelId 1170 , closingSigCloserScript = closerScript 1171 , closingSigCloseeScript = closeeScript 1172 , closingSigFeeSatoshi = Satoshi feeSats 1173 , closingSigLocktime = locktime 1174 , closingSigTlvs = emptyTlvs 1175 } 1176 case encodeClosingSig msg of 1177 Left _ -> False 1178 Right encoded -> case decodeClosingSig encoded of 1179 Right (decoded, _) -> decoded == msg 1180 Left _ -> False 1181 1182 -- Property: UpdateAddHtlc roundtrip 1183 propUpdateAddHtlcRoundtrip :: Word64 -> Word64 -> Word32 -> Property 1184 propUpdateAddHtlcRoundtrip hid amountMsat cltvExpiry = property $ do 1185 let msg = UpdateAddHtlc 1186 { updateAddHtlcChannelId = testChannelId 1187 , updateAddHtlcId = htlcId hid 1188 , updateAddHtlcAmountMsat = MilliSatoshi amountMsat 1189 , updateAddHtlcPaymentHash = testPaymentHash 1190 , updateAddHtlcCltvExpiry = cltvExpiry 1191 , updateAddHtlcOnionPacket = testOnionPacket 1192 , updateAddHtlcTlvs = emptyTlvs 1193 } 1194 encoded = encodeUpdateAddHtlc msg 1195 case decodeUpdateAddHtlc encoded of 1196 Right (decoded, _) -> decoded == msg 1197 Left _ -> False 1198 1199 -- Property: UpdateFulfillHtlc roundtrip 1200 propUpdateFulfillHtlcRoundtrip :: Word64 -> Property 1201 propUpdateFulfillHtlcRoundtrip hid = property $ do 1202 let msg = UpdateFulfillHtlc 1203 { updateFulfillHtlcChannelId = testChannelId 1204 , updateFulfillHtlcId = htlcId hid 1205 , updateFulfillHtlcPaymentPreimage = testPaymentPreimage 1206 , updateFulfillHtlcTlvs = emptyTlvs 1207 } 1208 encoded = encodeUpdateFulfillHtlc msg 1209 case decodeUpdateFulfillHtlc encoded of 1210 Right (decoded, _) -> decoded == msg 1211 Left _ -> False 1212 1213 -- Property: UpdateFailHtlc roundtrip 1214 propUpdateFailHtlcRoundtrip :: Word64 -> [Word8] -> Property 1215 propUpdateFailHtlcRoundtrip hid reasonBytes = property $ do 1216 let failReason = BS.pack (take 1000 reasonBytes) 1217 msg = UpdateFailHtlc 1218 { updateFailHtlcChannelId = testChannelId 1219 , updateFailHtlcId = htlcId hid 1220 , updateFailHtlcReason = failReason 1221 , updateFailHtlcTlvs = emptyTlvs 1222 } 1223 case encodeUpdateFailHtlc msg of 1224 Left _ -> False 1225 Right encoded -> case decodeUpdateFailHtlc encoded of 1226 Right (decoded, _) -> decoded == msg 1227 Left _ -> False 1228 1229 -- Property: UpdateFailMalformedHtlc roundtrip 1230 propUpdateFailMalformedHtlcRoundtrip :: Word64 -> Word16 -> Property 1231 propUpdateFailMalformedHtlcRoundtrip hid failCode = property $ do 1232 let msg = UpdateFailMalformedHtlc 1233 { updateFailMalformedHtlcChannelId = testChannelId 1234 , updateFailMalformedHtlcId = htlcId hid 1235 , updateFailMalformedHtlcSha256Onion = testPaymentHash 1236 , updateFailMalformedHtlcFailureCode = failCode 1237 } 1238 encoded = encodeUpdateFailMalformedHtlc msg 1239 case decodeUpdateFailMalformedHtlc encoded of 1240 Right (decoded, _) -> decoded == msg 1241 Left _ -> False 1242 1243 -- Property: CommitmentSigned roundtrip with varying HTLC count 1244 propCommitmentSignedRoundtrip :: NonNegative Int -> Property 1245 propCommitmentSignedRoundtrip (NonNegative n) = property $ do 1246 let numHtlcs = n `mod` 10 -- limit to 10 HTLCs for test speed 1247 htlcSigs = replicate numHtlcs testSignature 1248 msg = CommitmentSigned 1249 { commitmentSignedChannelId = testChannelId 1250 , commitmentSignedSignature = testSignature 1251 , commitmentSignedHtlcSignatures = htlcSigs 1252 } 1253 case encodeCommitmentSigned msg of 1254 Left _ -> False 1255 Right encoded -> case decodeCommitmentSigned encoded of 1256 Right (decoded, _) -> decoded == msg 1257 Left _ -> False 1258 1259 -- Property: RevokeAndAck roundtrip 1260 propRevokeAndAckRoundtrip :: Property 1261 propRevokeAndAckRoundtrip = property $ do 1262 let msg = RevokeAndAck 1263 { revokeAndAckChannelId = testChannelId 1264 , revokeAndAckPerCommitmentSecret = testSecret 1265 , revokeAndAckNextPerCommitPoint = testPoint 1266 } 1267 encoded = encodeRevokeAndAck msg 1268 case decodeRevokeAndAck encoded of 1269 Right (decoded, _) -> decoded == msg 1270 Left _ -> False 1271 1272 -- Property: UpdateFee roundtrip 1273 propUpdateFeeRoundtrip :: Word32 -> Property 1274 propUpdateFeeRoundtrip feerate = property $ do 1275 let msg = UpdateFee 1276 { updateFeeChannelId = testChannelId 1277 , updateFeeFeeratePerKw = feerate 1278 } 1279 encoded = encodeUpdateFee msg 1280 case decodeUpdateFee encoded of 1281 Right (decoded, _) -> decoded == msg 1282 Left _ -> False 1283 1284 -- Property: ChannelReestablish roundtrip 1285 propChannelReestablishRoundtrip :: Word64 -> Word64 -> Property 1286 propChannelReestablishRoundtrip nextCommit nextRevoke = property $ do 1287 let sec = fromJust $ perCommitmentSecret (BS.replicate 32 0x22) 1288 msg = ChannelReestablish 1289 { channelReestablishChannelId = testChannelId 1290 , channelReestablishNextCommitNum = nextCommit 1291 , channelReestablishNextRevocationNum = nextRevoke 1292 , channelReestablishYourLastCommitSecret = sec 1293 , channelReestablishMyCurrentCommitPoint = testPoint 1294 , channelReestablishTlvs = emptyTlvs 1295 } 1296 encoded = encodeChannelReestablish msg 1297 case decodeChannelReestablish encoded of 1298 Right (decoded, _) -> decoded == msg 1299 Left _ -> False 1300 1301 -- Property: HtlcId wrap/unwrap 1302 propHtlcIdRoundtrip :: Word64 -> Property 1303 propHtlcIdRoundtrip w = property $ unHtlcId (htlcId w) == w 1304 1305 -- Property: SerialId wrap/unwrap 1306 propSerialIdRoundtrip :: Word64 -> Property 1307 propSerialIdRoundtrip w = property $ unSerialId (serialId w) == w 1308 1309 -- Property: OnionPacket validates length (1366 only) 1310 propOnionPacketLength :: NonNegative Int -> Property 1311 propOnionPacketLength (NonNegative n) = property $ 1312 let len = n `mod` 2000 1313 bs = BS.replicate len 0x00 1314 in case onionPacket bs of 1315 Just _ -> len == onionPacketLen 1316 Nothing -> len /= onionPacketLen 1317 1318 -- Property: TxId validates length (32 only) 1319 propTxIdLength :: NonNegative Int -> Property 1320 propTxIdLength (NonNegative n) = property $ 1321 let len = n `mod` 100 1322 bs = BS.replicate len 0x00 1323 in case mkTxId bs of 1324 Just _ -> len == 32 1325 Nothing -> len /= 32 1326 1327 -- Helpers --------------------------------------------------------------------- 1328 1329 -- | Decode hex string. Returns Nothing on invalid hex. 1330 unhex :: BS.ByteString -> Maybe BS.ByteString 1331 unhex = B16.decode