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