commit e7ef9d53a92063b1c9129d2f811606795a5440cf
parent 6f295dd9af0ea3a78db14f5020744bef902a55a1
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 14:16:27 +0400
test: known answers, TLV handling and round-trips
Replaces the suite for the new API.
* A known-answer test per message (31 in all), each against wire bytes
assembled by hand from the spec's field layout, checked through both
the payload codec and encode_message/decode_message.
* Per-message TLV tests: unknown odd records preserved and re-encoded
exactly, unknown even and unordered records rejected, each known type
decoded into its typed field, malformed known values rejected, and
the 2^64-1 record length rejected.
* Splicing records: shared_input_txid and shared_input_signature are
rejected as unknown even types; my_current_funding_locked is kept.
* Negative tests for truncation, unknown message types, invalid points,
amounts above 21M BTC, the stfu initiator byte, u16 length and count
overflows, known types in _tlvs fields and the message size limit.
* Round-trip properties for every message, and a property that any
decodable edit of a valid encoding re-encodes to the same bytes.
Diffstat:
| M | test/Main.hs | | | 2581 | +++++++++++++++++++++++++++++++++++++++---------------------------------------- |
1 file changed, 1279 insertions(+), 1302 deletions(-)
diff --git a/test/Main.hs b/test/Main.hs
@@ -2,1330 +2,1307 @@
module Main where
+import qualified Bitcoin.Prim.Tx as Tx
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base16 as B16
-import Data.Maybe (fromJust)
-import Data.Word (Word8, Word16, Word32, Word64)
-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)
+import qualified Data.ByteString.Char8 as B8
+import Data.Int (Int64)
+import Data.Word (Word8, Word64)
+import qualified Lightning.Protocol.BOLT1 as BOLT1
+import Lightning.Protocol.BOLT1 (TlvRecord(..), TlvError(..))
import Lightning.Protocol.BOLT2
+import qualified Lightning.Protocol.BOLT9 as BOLT9
import Test.Tasty
import Test.Tasty.HUnit
-import Test.Tasty.QuickCheck
+import Test.Tasty.QuickCheck hiding (witness)
main :: IO ()
main = defaultMain $ testGroup "ppad-bolt2" [
- v1_establishment_tests
- , v2_establishment_tests
- , close_tests
- , normal_operation_tests
- , reestablish_tests
- , error_tests
- , property_tests
+ known_answers
+ , tlv_handling
+ , decoding_failures
+ , encoding_failures
+ , field_types
+ , properties
]
--- Test data helpers -----------------------------------------------------------
-
--- | Create a valid ChannelId (32 bytes).
-testChannelId :: ChannelId
-testChannelId = fromJust $ channelId (BS.replicate 32 0xab)
-
--- | Create a valid ChainHash (32 bytes).
-testChainHash :: ChainHash
-testChainHash = fromJust $ chainHash (BS.replicate 32 0x01)
-
--- | Create a valid Point (33 bytes).
-testPoint :: Point
-testPoint = fromJust $ point (BS.pack $ 0x02 : replicate 32 0xff)
-
--- | Create a second valid Point (33 bytes).
-testPoint2 :: Point
-testPoint2 = fromJust $ point (BS.pack $ 0x03 : replicate 32 0xee)
-
--- | Create a valid Signature (64 bytes).
-testSignature :: Signature
-testSignature = fromJust $ signature (BS.replicate 64 0xcc)
-
--- | Create a valid TxId (32 bytes).
-testTxId :: TxId
-testTxId = fromJust $ mkTxId (BS.replicate 32 0xdd)
-
--- | Create a valid PaymentHash (32 bytes).
-testPaymentHash :: PaymentHash
-testPaymentHash = fromJust $ paymentHash (BS.replicate 32 0xaa)
-
--- | Create a valid PaymentPreimage (32 bytes).
-testPaymentPreimage :: PaymentPreimage
-testPaymentPreimage = fromJust $ paymentPreimage (BS.replicate 32 0xbb)
-
--- | Create a valid OnionPacket (1366 bytes).
-testOnionPacket :: OnionPacket
-testOnionPacket = fromJust $ onionPacket (BS.replicate 1366 0x00)
-
--- | Create a valid PerCommitmentSecret (32 bytes).
-testSecret :: PerCommitmentSecret
-testSecret = fromJust $
- perCommitmentSecret (BS.replicate 32 0x11)
-
--- | Empty TLV stream for messages.
-emptyTlvs :: TlvStream
-emptyTlvs = unsafeTlvStream []
-
--- V1 Channel Establishment Tests ----------------------------------------------
-
-v1_establishment_tests :: TestTree
-v1_establishment_tests = testGroup "V1 Channel Establishment" [
- testGroup "OpenChannel" [
- testCase "encode/decode roundtrip" $ do
- let msg = OpenChannel
- { openChannelChainHash = testChainHash
- , openChannelTempChannelId = testChannelId
- , openChannelFundingSatoshi = Satoshi 1000000
- , openChannelPushMsat = MilliSatoshi 500000
- , openChannelDustLimitSatoshi = Satoshi 546
- , openChannelMaxHtlcValueInFlight = MilliSatoshi 100000000
- , openChannelChannelReserveSat = Satoshi 10000
- , openChannelHtlcMinimumMsat = MilliSatoshi 1000
- , openChannelFeeratePerKw = 2500
- , openChannelToSelfDelay = 144
- , openChannelMaxAcceptedHtlcs = 483
- , openChannelFundingPubkey = testPoint
- , openChannelRevocationBasepoint = testPoint
- , openChannelPaymentBasepoint = testPoint
- , openChannelDelayedPaymentBase = testPoint
- , openChannelHtlcBasepoint = testPoint
- , openChannelFirstPerCommitPoint = testPoint
- , openChannelChannelFlags = 0x01
- , openChannelTlvs = emptyTlvs
- }
- encoded = encodeOpenChannel msg
- case decodeOpenChannel encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "AcceptChannel" [
- testCase "encode/decode roundtrip" $ do
- let msg = AcceptChannel
- { acceptChannelTempChannelId = testChannelId
- , acceptChannelDustLimitSatoshi = Satoshi 546
- , acceptChannelMaxHtlcValueInFlight = MilliSatoshi 100000000
- , acceptChannelChannelReserveSat = Satoshi 10000
- , acceptChannelHtlcMinimumMsat = MilliSatoshi 1000
- , acceptChannelMinimumDepth = 3
- , acceptChannelToSelfDelay = 144
- , acceptChannelMaxAcceptedHtlcs = 483
- , acceptChannelFundingPubkey = testPoint
- , acceptChannelRevocationBasepoint = testPoint
- , acceptChannelPaymentBasepoint = testPoint
- , acceptChannelDelayedPaymentBase = testPoint
- , acceptChannelHtlcBasepoint = testPoint
- , acceptChannelFirstPerCommitPoint = testPoint
- , acceptChannelTlvs = emptyTlvs
- }
- encoded = encodeAcceptChannel msg
- case decodeAcceptChannel encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "FundingCreated" [
- testCase "encode/decode roundtrip" $ do
- let msg = FundingCreated
- { fundingCreatedTempChannelId = testChannelId
- , fundingCreatedFundingTxid = testTxId
- , fundingCreatedFundingOutIdx = 0
- , fundingCreatedSignature = testSignature
- }
- encoded = encodeFundingCreated msg
- case decodeFundingCreated encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "roundtrip with non-zero output index" $ do
- let msg = FundingCreated
- { fundingCreatedTempChannelId = testChannelId
- , fundingCreatedFundingTxid = testTxId
- , fundingCreatedFundingOutIdx = 42
- , fundingCreatedSignature = testSignature
- }
- encoded = encodeFundingCreated msg
- case decodeFundingCreated encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "FundingSigned" [
- testCase "encode/decode roundtrip" $ do
- let msg = FundingSigned
- { fundingSignedChannelId = testChannelId
- , fundingSignedSignature = testSignature
- }
- encoded = encodeFundingSigned msg
- case decodeFundingSigned encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "ChannelReady" [
- testCase "encode/decode roundtrip" $ do
- let msg = ChannelReady
- { channelReadyChannelId = testChannelId
- , channelReadySecondPerCommitPoint = testPoint
- , channelReadyTlvs = emptyTlvs
- }
- encoded = encodeChannelReady msg
- case decodeChannelReady encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
+-- helpers --------------------------------------------------------------------
+
+rep :: Int -> String -> String
+rep n = concat . replicate n
+
+hx :: String -> Maybe BS.ByteString
+hx = B16.decode . B8.pack
+
+-- decode a hex literal, failing the test if it isn't valid hex
+unhex :: String -> IO BS.ByteString
+unhex s = maybe (assertFailure ("invalid hex literal: " ++ s)) pure (hx s)
+
+-- unwrap a fixture, failing the test if it couldn't be constructed
+just :: String -> Maybe a -> IO a
+just what = maybe (assertFailure ("invalid fixture: " ++ what)) pure
+
+empty :: BOLT1.TlvStream
+empty = BOLT1.empty_tlv_stream
+
+-- the unknown TLV records of a message
+message_tlvs :: Message -> BOLT1.TlvStream
+message_tlvs m = case m of
+ MsgOpenChannel a -> open_channel_tlvs a
+ MsgAcceptChannel a -> accept_channel_tlvs a
+ MsgFundingCreated a -> funding_created_tlvs a
+ MsgFundingSigned a -> funding_signed_tlvs a
+ MsgChannelReady a -> channel_ready_tlvs a
+ MsgOpenChannel2 a -> open_channel2_tlvs a
+ MsgAcceptChannel2 a -> accept_channel2_tlvs a
+ MsgTxAddInput a -> tx_add_input_tlvs a
+ MsgTxAddOutput a -> tx_add_output_tlvs a
+ MsgTxRemoveInput a -> tx_remove_input_tlvs a
+ MsgTxRemoveOutput a -> tx_remove_output_tlvs a
+ MsgTxComplete a -> tx_complete_tlvs a
+ MsgTxSignatures a -> tx_signatures_tlvs a
+ MsgTxInitRbf a -> tx_init_rbf_tlvs a
+ MsgTxAckRbf a -> tx_ack_rbf_tlvs a
+ MsgTxAbort a -> tx_abort_tlvs a
+ MsgStfu a -> stfu_tlvs a
+ MsgShutdown a -> shutdown_tlvs a
+ MsgClosingComplete a -> closing_complete_tlvs a
+ MsgClosingSig a -> closing_sig_tlvs a
+ MsgClosingSigned a -> closing_signed_tlvs a
+ MsgUpdateAddHtlc a -> update_add_htlc_tlvs a
+ MsgUpdateFulfillHtlc a -> update_fulfill_htlc_tlvs a
+ MsgUpdateFailHtlc a -> update_fail_htlc_tlvs a
+ MsgUpdateFailMalformedHtlc a -> update_fail_malformed_htlc_tlvs a
+ MsgCommitmentSigned a -> commitment_signed_tlvs a
+ MsgRevokeAndAck a -> revoke_and_ack_tlvs a
+ MsgUpdateFee a -> update_fee_tlvs a
+ MsgChannelReestablish a -> channel_reestablish_tlvs a
+
+-- field values ---------------------------------------------------------------
+
+-- the bitcoin genesis block hash, in internal byte order
+chain_h :: String
+chain_h = "6fe28c0ab6f1b372c1a6a246ae63f74f931e8365e15a089c68d6190000000000"
+
+cid_h, tcid_h, txid_h, secret_h, preimage_h, phash_h :: String
+cid_h = rep 32 "ab"
+tcid_h = rep 32 "cd"
+txid_h = rep 32 "7e"
+secret_h = rep 32 "5e"
+preimage_h = rep 32 "50"
+phash_h = rep 32 "9a"
+
+p1_h, p2_h, p3_h, p4_h, p5_h, p6_h, p7_h :: String
+p1_h = "02" ++ rep 32 "11"
+p2_h = "03" ++ rep 32 "22"
+p3_h = "02" ++ rep 32 "33"
+p4_h = "03" ++ rep 32 "44"
+p5_h = "02" ++ rep 32 "55"
+p6_h = "03" ++ rep 32 "66"
+p7_h = "02" ++ rep 32 "77"
+
+sig1_h, sig2_h, sig3_h :: String
+sig1_h = rep 64 "a1"
+sig2_h = rep 64 "b2"
+sig3_h = rep 64 "c3"
+
+-- version, ephemeral key, hop payloads, hmac
+onion_h :: String
+onion_h = "00" ++ p3_h ++ rep 1300 "44" ++ rep 32 "55"
+
+-- twenty hold times of 100, then 210 truncated hmacs
+attribution_h :: String
+attribution_h = rep 20 "00000064" ++ rep 210 "0badf00d"
+
+p2wpkh_h, p2wsh_h, p2tr_h :: String
+p2wpkh_h = "0014" ++ rep 20 "88"
+p2wsh_h = "0020" ++ rep 32 "99"
+p2tr_h = "5120" ++ rep 32 "ee"
+
+-- the sha256 of the empty string
+onion_hash_h :: String
+onion_hash_h =
+ "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
+
+f_chain :: Maybe BOLT1.ChainHash
+f_chain = BOLT1.chain_hash =<< hx chain_h
+
+f_cid, f_tcid :: Maybe BOLT1.ChannelId
+f_cid = BOLT1.channel_id =<< hx cid_h
+f_tcid = BOLT1.channel_id =<< hx tcid_h
+
+f_point :: String -> Maybe BOLT1.Point
+f_point h = BOLT1.point =<< hx h
+
+f_sig :: String -> Maybe BOLT1.Signature
+f_sig h = BOLT1.signature =<< hx h
+
+f_txid :: Maybe Tx.TxId
+f_txid = Tx.mkTxId =<< hx txid_h
+
+f_secret :: Maybe BOLT1.PerCommitmentSecret
+f_secret = BOLT1.per_commitment_secret =<< hx secret_h
+
+f_script :: String -> Maybe ScriptPubKey
+f_script h = script_pubkey =<< hx h
+
+f_attribution :: Maybe AttributionData
+f_attribution = attribution_data =<< hx attribution_h
+
+anchors :: BOLT9.FeatureVector
+anchors = BOLT9.channel_type_features
+ (BOLT9.ChannelType BOLT9.BasicAnchors False False)
+
+sat :: Word64 -> Maybe BOLT1.Satoshi
+sat = BOLT1.satoshi
+
+msat :: Word64 -> Maybe BOLT1.MilliSatoshi
+msat = BOLT1.milli_satoshi
+
+-- message layouts ------------------------------------------------------------
+
+-- A message's layout: its type and fixed fields (hex, assembled by hand
+-- from the spec) and its known TLV types, each with a valid value and
+-- some malformed ones.
+data Layout = Layout
+ { lay_name :: String
+ , lay_type :: String
+ , lay_fixed :: [String]
+ , lay_known :: [(Word64, String, [String])]
+ }
+
+open_channel_lay :: Layout
+open_channel_lay = Layout "open_channel" "0020" [
+ chain_h
+ , tcid_h
+ , "00000000000f4240" -- funding_satoshis: 1000000
+ , "00000000000003e8" -- push_msat: 1000
+ , "0000000000000222" -- dust_limit_satoshis: 546
+ , "ffffffffffffffff" -- max_htlc_value_in_flight_msat: u64 max
+ , "0000000000002710" -- channel_reserve_satoshis: 10000
+ , "0000000000000001" -- htlc_minimum_msat: 1
+ , "000000fd" -- feerate_per_kw: 253
+ , "0090" -- to_self_delay: 144
+ , "01e3" -- max_accepted_htlcs: 483
+ , p1_h, p2_h, p3_h, p4_h, p5_h, p6_h
+ , "01" -- channel_flags
+ ] [ (0, p2wpkh_h, []), (1, "401000", []) ]
+
+accept_channel_lay :: Layout
+accept_channel_lay = Layout "accept_channel" "0021" [
+ tcid_h
+ , "0000000000000222" -- dust_limit_satoshis: 546
+ , "0000000005f5e100" -- max_htlc_value_in_flight_msat: 100000000
+ , "0000000000002710" -- channel_reserve_satoshis: 10000
+ , "00000000000003e8" -- htlc_minimum_msat: 1000
+ , "00000003" -- minimum_depth: 3
+ , "0090" -- to_self_delay: 144
+ , "01e3" -- max_accepted_htlcs: 483
+ , p1_h, p2_h, p3_h, p4_h, p5_h, p6_h
+ ] [ (0, "", []), (1, "401000", []) ]
+
+funding_created_lay :: Layout
+funding_created_lay = Layout "funding_created" "0022" [
+ tcid_h
+ , txid_h
+ , "0001" -- funding_output_index: 1
+ , sig1_h
+ ] []
+
+funding_signed_lay :: Layout
+funding_signed_lay = Layout "funding_signed" "0023" [ cid_h, sig1_h ] []
+
+channel_ready_lay :: Layout
+channel_ready_lay = Layout "channel_ready" "0024" [ cid_h, p1_h ]
+ [ (1, "083a8400034d0001", ["083a8400034d00", "083a8400034d000100"]) ]
+
+open_channel2_lay :: Layout
+open_channel2_lay = Layout "open_channel2" "0040" [
+ chain_h
+ , tcid_h
+ , "00000fa0" -- funding_feerate_perkw: 4000
+ , "000000fd" -- commitment_feerate_perkw: 253
+ , "0000000000030d40" -- funding_satoshis: 200000
+ , "0000000000000162" -- dust_limit_satoshis: 354
+ , "ffffffffffffffff" -- max_htlc_value_in_flight_msat: u64 max
+ , "0000000000000001" -- htlc_minimum_msat: 1
+ , "0090" -- to_self_delay: 144
+ , "01e3" -- max_accepted_htlcs: 483
+ , "000c3500" -- locktime: 800000
+ , p1_h, p2_h, p3_h, p4_h, p5_h, p6_h, p7_h
+ , "00" -- channel_flags
+ ] [ (0, p2wpkh_h, []), (1, "401000", []), (2, "", ["00", "01"]) ]
+
+accept_channel2_lay :: Layout
+accept_channel2_lay = Layout "accept_channel2" "0041" [
+ tcid_h
+ , "0000000000000000" -- funding_satoshis: 0
+ , "0000000000000162" -- dust_limit_satoshis: 354
+ , "0000000005f5e100" -- max_htlc_value_in_flight_msat: 100000000
+ , "00000000000003e8" -- htlc_minimum_msat: 1000
+ , "00000006" -- minimum_depth: 6
+ , "0090" -- to_self_delay: 144
+ , "001e" -- max_accepted_htlcs: 30
+ , p1_h, p2_h, p3_h, p4_h, p5_h, p6_h, p7_h
+ ] [ (0, p2wsh_h, []), (1, "401000", []), (2, "", ["00"]) ]
+
+tx_add_input_lay :: Layout
+tx_add_input_lay = Layout "tx_add_input" "0042" [
+ cid_h
+ , "0000000000000002" -- serial_id: 2
+ , "0005", "0102030405" -- prevtx
+ , "00000001" -- prevtx_vout: 1
+ , "fffffffd" -- sequence
+ ] []
+
+tx_add_output_lay :: Layout
+tx_add_output_lay = Layout "tx_add_output" "0043" [
+ cid_h
+ , "0000000000000004" -- serial_id: 4
+ , "0000000000030d40" -- sats: 200000
+ , "0022", p2wsh_h -- script
+ ] []
+
+tx_remove_input_lay :: Layout
+tx_remove_input_lay = Layout "tx_remove_input" "0044"
+ [ cid_h, "0000000000000002" ] []
+
+tx_remove_output_lay :: Layout
+tx_remove_output_lay = Layout "tx_remove_output" "0045"
+ [ cid_h, "0000000000000005" ] []
+
+tx_complete_lay :: Layout
+tx_complete_lay = Layout "tx_complete" "0046" [ cid_h ] []
+
+tx_signatures_lay :: Layout
+tx_signatures_lay = Layout "tx_signatures" "0047" [
+ cid_h
+ , txid_h
+ , "0002" -- num_witnesses
+ , "0006", "0202aaaa01bb" -- two stack items
+ , "0003", "0101cc" -- one stack item
+ ] []
+
+tx_init_rbf_lay :: Layout
+tx_init_rbf_lay = Layout "tx_init_rbf" "0048" [
+ cid_h
+ , "000c3500" -- locktime: 800000
+ , "00001046" -- feerate: 4166
+ ] [ (0, "0000000000030d40", ["00030d40", "000000000000030d40"])
+ , (2, "", ["00"]) ]
+
+tx_ack_rbf_lay :: Layout
+tx_ack_rbf_lay = Layout "tx_ack_rbf" "0049" [ cid_h ]
+ [ (0, "fffffffffffe7960", ["ff"]), (2, "", ["2a2a"]) ]
+
+tx_abort_lay :: Layout
+tx_abort_lay = Layout "tx_abort" "004a" [
+ cid_h
+ , "000c", "6661696c656420636865636b" -- "failed check"
+ ] []
+
+stfu_lay :: Layout
+stfu_lay = Layout "stfu" "0002" [ cid_h, "01" ] []
+
+shutdown_lay :: Layout
+shutdown_lay = Layout "shutdown" "0026" [ cid_h, "0016", p2wpkh_h ] []
+
+closing_complete_lay :: Layout
+closing_complete_lay = Layout "closing_complete" "0028" [
+ cid_h
+ , "0016", p2wpkh_h -- closer_scriptpubkey
+ , "0022", p2tr_h -- closee_scriptpubkey
+ , "00000000000001f4" -- fee_satoshis: 500
+ , "00000000" -- locktime: 0
+ ] [ (t, sig1_h, [rep 63 "a1", rep 65 "a1"]) | t <- [1, 2, 3] ]
+
+closing_sig_lay :: Layout
+closing_sig_lay = Layout "closing_sig" "0029" [
+ cid_h
+ , "0016", p2wpkh_h -- closer_scriptpubkey
+ , "0022", p2tr_h -- closee_scriptpubkey
+ , "00000000000001f4" -- fee_satoshis: 500
+ , "000c3500" -- locktime: 800000
+ ] [ (t, sig3_h, [rep 63 "c3", ""]) | t <- [1, 2, 3] ]
+
+closing_signed_lay :: Layout
+closing_signed_lay = Layout "closing_signed" "0027" [
+ cid_h
+ , "00000000000001f4" -- fee_satoshis: 500
+ , sig1_h
+ ] [ (1, "000000000000006400000000000003e8", [
+ "000000000000006400000000000003"
+ , "000000000000006400000000000003e800"
+ , "0000000000000064ffffffffffffffff" -- max fee above 21M BTC
+ ]) ]
+
+update_add_htlc_lay :: Layout
+update_add_htlc_lay = Layout "update_add_htlc" "0080" [
+ cid_h
+ , "0000000000000000" -- id: 0
+ , "00000000000186a0" -- amount_msat: 100000
+ , phash_h
+ , "000c3550" -- cltv_expiry: 800080
+ , onion_h
+ ] [ (0, p2_h, [ rep 32 "22", p2_h ++ "00", "04" ++ rep 32 "22" ]) ]
+
+update_fulfill_htlc_lay :: Layout
+update_fulfill_htlc_lay = Layout "update_fulfill_htlc" "0082" [
+ cid_h
+ , "0000000000000007" -- id: 7
+ , preimage_h
+ ] [ (1, attribution_h, [ drop 2 attribution_h, attribution_h ++ "00" ])
+ , (3, "deadbeef", []) ]
+
+update_fail_htlc_lay :: Layout
+update_fail_htlc_lay = Layout "update_fail_htlc" "0083" [
+ cid_h
+ , "0000000000000007" -- id: 7
+ , "0004", "01020304" -- reason
+ ] [ (1, attribution_h, [ "" ]) ]
+
+update_fail_malformed_htlc_lay :: Layout
+update_fail_malformed_htlc_lay =
+ Layout "update_fail_malformed_htlc" "0087" [
+ cid_h
+ , "0000000000000003" -- id: 3
+ , onion_hash_h
+ , "c005" -- failure_code: BADONION | PERM | 5
+ ] []
+
+commitment_signed_lay :: Layout
+commitment_signed_lay = Layout "commitment_signed" "0084" [
+ cid_h
+ , sig1_h
+ , "0002" -- num_htlcs
+ , sig2_h, sig3_h
+ ] [ (1, txid_h, [ rep 31 "7e", rep 33 "7e" ]) ]
+
+revoke_and_ack_lay :: Layout
+revoke_and_ack_lay = Layout "revoke_and_ack" "0085"
+ [ cid_h, secret_h, p1_h ] []
+
+update_fee_lay :: Layout
+update_fee_lay = Layout "update_fee" "0086"
+ [ cid_h, "000009c4" ] [] -- feerate_per_kw: 2500
+
+channel_reestablish_lay :: Layout
+channel_reestablish_lay = Layout "channel_reestablish" "0088" [
+ cid_h
+ , "0000000000000005" -- next_commitment_number: 5
+ , "0000000000000004" -- next_revocation_number: 4
+ , secret_h
+ , p1_h
+ ] [ (1, txid_h ++ "01", [ txid_h, txid_h ++ "0100" ]) ]
+
+layouts :: [Layout]
+layouts = [
+ open_channel_lay, accept_channel_lay, funding_created_lay
+ , funding_signed_lay, channel_ready_lay, open_channel2_lay
+ , accept_channel2_lay, tx_add_input_lay, tx_add_output_lay
+ , tx_remove_input_lay, tx_remove_output_lay, tx_complete_lay
+ , tx_signatures_lay, tx_init_rbf_lay, tx_ack_rbf_lay, tx_abort_lay
+ , stfu_lay, shutdown_lay, closing_complete_lay, closing_sig_lay
+ , closing_signed_lay, update_add_htlc_lay, update_fulfill_htlc_lay
+ , update_fail_htlc_lay, update_fail_malformed_htlc_lay
+ , commitment_signed_lay, revoke_and_ack_lay, update_fee_lay
+ , channel_reestablish_lay
]
--- V2 Channel Establishment (Interactive-tx) Tests ----------------------------
-
-v2_establishment_tests :: TestTree
-v2_establishment_tests = testGroup "V2 Channel Establishment" [
- testGroup "OpenChannel2" [
- testCase "encode/decode roundtrip" $ do
- let msg = OpenChannel2
- { openChannel2ChainHash = testChainHash
- , openChannel2TempChannelId = testChannelId
- , openChannel2FundingFeeratePerkw = 2500
- , openChannel2CommitFeeratePerkw = 2000
- , openChannel2FundingSatoshi = Satoshi 1000000
- , openChannel2DustLimitSatoshi = Satoshi 546
- , openChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000
- , openChannel2HtlcMinimumMsat = MilliSatoshi 1000
- , openChannel2ToSelfDelay = 144
- , openChannel2MaxAcceptedHtlcs = 483
- , openChannel2Locktime = 0
- , openChannel2FundingPubkey = testPoint
- , openChannel2RevocationBasepoint = testPoint
- , openChannel2PaymentBasepoint = testPoint
- , openChannel2DelayedPaymentBase = testPoint
- , openChannel2HtlcBasepoint = testPoint
- , openChannel2FirstPerCommitPoint = testPoint
- , openChannel2SecondPerCommitPoint = testPoint2
- , openChannel2ChannelFlags = 0x00
- , openChannel2Tlvs = emptyTlvs
- }
- encoded = encodeOpenChannel2 msg
- case decodeOpenChannel2 encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "AcceptChannel2" [
- testCase "encode/decode roundtrip" $ do
- let msg = AcceptChannel2
- { acceptChannel2TempChannelId = testChannelId
- , acceptChannel2FundingSatoshi = Satoshi 500000
- , acceptChannel2DustLimitSatoshi = Satoshi 546
- , acceptChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000
- , acceptChannel2HtlcMinimumMsat = MilliSatoshi 1000
- , acceptChannel2MinimumDepth = 3
- , acceptChannel2ToSelfDelay = 144
- , acceptChannel2MaxAcceptedHtlcs = 483
- , acceptChannel2FundingPubkey = testPoint
- , acceptChannel2RevocationBasepoint = testPoint
- , acceptChannel2PaymentBasepoint = testPoint
- , acceptChannel2DelayedPaymentBase = testPoint
- , acceptChannel2HtlcBasepoint = testPoint
- , acceptChannel2FirstPerCommitPoint = testPoint
- , acceptChannel2SecondPerCommitPoint = testPoint2
- , acceptChannel2Tlvs = emptyTlvs
- }
- encoded = encodeAcceptChannel2 msg
- case decodeAcceptChannel2 encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxAddInput" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxAddInput
- { txAddInputChannelId = testChannelId
- , txAddInputSerialId = serialId 12345
- , txAddInputPrevTx = BS.pack [0x01, 0x02, 0x03, 0x04]
- , txAddInputPrevVout = 0
- , txAddInputSequence = 0xfffffffe
- }
- case encodeTxAddInput msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeTxAddInput encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "roundtrip with empty prevTx" $ do
- let msg = TxAddInput
- { txAddInputChannelId = testChannelId
- , txAddInputSerialId = serialId 0
- , txAddInputPrevTx = BS.empty
- , txAddInputPrevVout = 0
- , txAddInputSequence = 0
- }
- case encodeTxAddInput msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeTxAddInput encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxAddOutput" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxAddOutput
- { txAddOutputChannelId = testChannelId
- , txAddOutputSerialId = serialId 54321
- , txAddOutputSats = Satoshi 100000
- , txAddOutputScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xaa)
- }
- case encodeTxAddOutput msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeTxAddOutput encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxRemoveInput" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxRemoveInput
- { txRemoveInputChannelId = testChannelId
- , txRemoveInputSerialId = serialId 12345
- }
- encoded = encodeTxRemoveInput msg
- case decodeTxRemoveInput encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxRemoveOutput" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxRemoveOutput
- { txRemoveOutputChannelId = testChannelId
- , txRemoveOutputSerialId = serialId 54321
- }
- encoded = encodeTxRemoveOutput msg
- case decodeTxRemoveOutput encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxComplete" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxComplete { txCompleteChannelId = testChannelId }
- encoded = encodeTxComplete msg
- case decodeTxComplete encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxSignatures" [
- testCase "encode/decode with no witnesses" $ do
- let msg = TxSignatures
- { txSignaturesChannelId = testChannelId
- , txSignaturesTxid = testTxId
- , txSignaturesWitnesses = []
- }
- case encodeTxSignatures msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeTxSignatures encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "encode/decode with multiple witnesses" $ do
- let w1 = Witness (BS.pack [0x30, 0x44] <> BS.replicate 68 0xaa)
- w2 = Witness (BS.pack [0x02] <> BS.replicate 32 0xbb)
- msg = TxSignatures
- { txSignaturesChannelId = testChannelId
- , txSignaturesTxid = testTxId
- , txSignaturesWitnesses = [w1, w2]
- }
- case encodeTxSignatures msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeTxSignatures encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxInitRbf" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxInitRbf
- { txInitRbfChannelId = testChannelId
- , txInitRbfLocktime = 800000
- , txInitRbfFeerate = 3000
- , txInitRbfTlvs = emptyTlvs
- }
- encoded = encodeTxInitRbf msg
- case decodeTxInitRbf encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxAckRbf" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxAckRbf
- { txAckRbfChannelId = testChannelId
- , txAckRbfTlvs = emptyTlvs
- }
- encoded = encodeTxAckRbf msg
- case decodeTxAckRbf encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "TxAbort" [
- testCase "encode/decode roundtrip" $ do
- let msg = TxAbort
- { txAbortChannelId = testChannelId
- , txAbortData = "transaction abort reason"
- }
- case encodeTxAbort msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeTxAbort encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "roundtrip with empty data" $ do
- let msg = TxAbort
- { txAbortChannelId = testChannelId
- , txAbortData = BS.empty
- }
- case encodeTxAbort msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeTxAbort encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
+-- a TLV record, in hex (for types below 253 and values below 65536
+-- bytes)
+tlv_h :: Word64 -> String -> String
+tlv_h t v = hex2 t ++ len ++ v
+ where
+ n = fromIntegral (length v `div` 2) :: Word64
+ len | n < 253 = hex2 n
+ | otherwise = "fd" ++ hex2 (n `div` 256) ++ hex2 (n `mod` 256)
+
+-- a byte, in hex
+hex2 :: Word64 -> String
+hex2 w = [digit (w `div` 16), digit (w `mod` 16)]
+ where
+ digit d = maybe '?' id (lookup d (zip [0 ..] "0123456789abcdef"))
+
+-- known answers --------------------------------------------------------------
+
+-- Check a message against wire bytes assembled by hand: its payload
+-- decodes to the expected value and re-encodes to the same bytes, and
+-- likewise for the full message.
+kat
+ :: (Eq a, Show a)
+ => String
+ -> Layout
+ -> [String] -- TLV records, hex
+ -> (BS.ByteString -> Either DecodeError a)
+ -> (a -> Either EncodeError BS.ByteString)
+ -> (a -> Message)
+ -> Maybe a
+ -> TestTree
+kat name lay recs dec enc wrap expected = testCase name $ do
+ payload <- unhex (concat (lay_fixed lay ++ recs))
+ wire <- unhex (lay_type lay ++ concat (lay_fixed lay ++ recs))
+ m <- just name expected
+ dec payload @?= Right m
+ enc m @?= Right payload
+ decode_message wire @?= Right (wrap m)
+ encode_message (wrap m) @?= Right wire
+
+known_answers :: TestTree
+known_answers = testGroup "known answers" [
+ kat "open_channel" open_channel_lay
+ [ tlv_h 0 p2wpkh_h, tlv_h 1 "401000" ]
+ decode_open_channel encode_open_channel MsgOpenChannel $ do
+ ch <- f_chain
+ tcid <- f_tcid
+ fund <- sat 1000000
+ push <- msat 1000
+ dust <- sat 546
+ res <- sat 10000
+ hmin <- msat 1
+ [a, b, c, d, e, f] <- traverse f_point
+ [p1_h, p2_h, p3_h, p4_h, p5_h, p6_h]
+ spk <- f_script p2wpkh_h
+ pure (OpenChannel ch tcid fund push dust maxBound res hmin 253 144
+ 483 a b c d e f 1 (Just spk) (Just anchors) empty)
+
+ , kat "open_channel (no TLVs)" open_channel_lay []
+ decode_open_channel encode_open_channel MsgOpenChannel $ do
+ ch <- f_chain
+ tcid <- f_tcid
+ fund <- sat 1000000
+ push <- msat 1000
+ dust <- sat 546
+ res <- sat 10000
+ hmin <- msat 1
+ [a, b, c, d, e, f] <- traverse f_point
+ [p1_h, p2_h, p3_h, p4_h, p5_h, p6_h]
+ pure (OpenChannel ch tcid fund push dust maxBound res hmin 253 144
+ 483 a b c d e f 1 Nothing Nothing empty)
+
+ , kat "accept_channel" accept_channel_lay
+ [ tlv_h 0 "", tlv_h 1 "401000" ]
+ decode_accept_channel encode_accept_channel MsgAcceptChannel $ do
+ tcid <- f_tcid
+ dust <- sat 546
+ res <- sat 10000
+ hmin <- msat 1000
+ [a, b, c, d, e, f] <- traverse f_point
+ [p1_h, p2_h, p3_h, p4_h, p5_h, p6_h]
+ spk <- script_pubkey ""
+ pure (AcceptChannel tcid dust 100000000 res hmin 3 144 483
+ a b c d e f (Just spk) (Just anchors) empty)
+
+ , kat "funding_created" funding_created_lay []
+ decode_funding_created (Right . encode_funding_created)
+ MsgFundingCreated $ do
+ tcid <- f_tcid
+ t <- f_txid
+ s <- f_sig sig1_h
+ pure (FundingCreated tcid t 1 s empty)
+
+ , kat "funding_signed" funding_signed_lay []
+ decode_funding_signed (Right . encode_funding_signed)
+ MsgFundingSigned $ do
+ cid <- f_cid
+ s <- f_sig sig1_h
+ pure (FundingSigned cid s empty)
+
+ , kat "channel_ready" channel_ready_lay
+ [ tlv_h 1 "083a8400034d0001" ]
+ decode_channel_ready encode_channel_ready MsgChannelReady $ do
+ cid <- f_cid
+ pcp <- f_point p1_h
+ alias <- BOLT1.short_channel_id 539268 845 1
+ pure (ChannelReady cid pcp (Just alias) empty)
+
+ , kat "open_channel2" open_channel2_lay
+ [ tlv_h 0 p2wpkh_h, tlv_h 1 "401000", tlv_h 2 "" ]
+ decode_open_channel2 encode_open_channel2 MsgOpenChannel2 $ do
+ ch <- f_chain
+ tcid <- f_tcid
+ fund <- sat 200000
+ dust <- sat 354
+ hmin <- msat 1
+ [a, b, c, d, e, f, g] <- traverse f_point
+ [p1_h, p2_h, p3_h, p4_h, p5_h, p6_h, p7_h]
+ spk <- f_script p2wpkh_h
+ pure (OpenChannel2 ch tcid 4000 253 fund dust maxBound hmin 144 483
+ 800000 a b c d e f g 0 (Just spk) (Just anchors) True
+ empty)
+
+ , kat "accept_channel2" accept_channel2_lay
+ [ tlv_h 0 p2wsh_h, tlv_h 1 "401000", tlv_h 2 "" ]
+ decode_accept_channel2 encode_accept_channel2 MsgAcceptChannel2 $ do
+ tcid <- f_tcid
+ fund <- sat 0
+ dust <- sat 354
+ hmin <- msat 1000
+ [a, b, c, d, e, f, g] <- traverse f_point
+ [p1_h, p2_h, p3_h, p4_h, p5_h, p6_h, p7_h]
+ spk <- f_script p2wsh_h
+ pure (AcceptChannel2 tcid fund dust 100000000 hmin 6 144 30
+ a b c d e f g (Just spk) (Just anchors) True empty)
+
+ , kat "tx_add_input" tx_add_input_lay []
+ decode_tx_add_input encode_tx_add_input MsgTxAddInput $ do
+ cid <- f_cid
+ pure (TxAddInput cid (SerialId 2) "\x01\x02\x03\x04\x05" 1
+ 0xfffffffd empty)
+
+ , kat "tx_add_output" tx_add_output_lay []
+ decode_tx_add_output (Right . encode_tx_add_output)
+ MsgTxAddOutput $ do
+ cid <- f_cid
+ amt <- sat 200000
+ spk <- f_script p2wsh_h
+ pure (TxAddOutput cid (SerialId 4) amt spk empty)
+
+ , kat "tx_remove_input" tx_remove_input_lay []
+ decode_tx_remove_input (Right . encode_tx_remove_input)
+ MsgTxRemoveInput $ do
+ cid <- f_cid
+ pure (TxRemoveInput cid (SerialId 2) empty)
+
+ , kat "tx_remove_output" tx_remove_output_lay []
+ decode_tx_remove_output (Right . encode_tx_remove_output)
+ MsgTxRemoveOutput $ do
+ cid <- f_cid
+ pure (TxRemoveOutput cid (SerialId 5) empty)
+
+ , kat "tx_complete" tx_complete_lay []
+ decode_tx_complete (Right . encode_tx_complete) MsgTxComplete $ do
+ cid <- f_cid
+ pure (TxComplete cid empty)
+
+ , kat "tx_signatures" tx_signatures_lay []
+ decode_tx_signatures encode_tx_signatures MsgTxSignatures $ do
+ cid <- f_cid
+ t <- f_txid
+ w1 <- witness "\x02\x02\xaa\xaa\x01\xbb"
+ w2 <- witness "\x01\x01\xcc"
+ pure (TxSignatures cid t [w1, w2] empty)
+
+ , kat "tx_init_rbf" tx_init_rbf_lay
+ [ tlv_h 0 "0000000000030d40", tlv_h 2 "" ]
+ decode_tx_init_rbf encode_tx_init_rbf MsgTxInitRbf $ do
+ cid <- f_cid
+ pure (TxInitRbf cid 800000 4166 (Just 200000) True empty)
+
+ , kat "tx_ack_rbf" tx_ack_rbf_lay
+ [ tlv_h 0 "fffffffffffe7960", tlv_h 2 "" ]
+ decode_tx_ack_rbf encode_tx_ack_rbf MsgTxAckRbf $ do
+ cid <- f_cid
+ pure (TxAckRbf cid (Just (-100000)) True empty)
+
+ , kat "tx_abort" tx_abort_lay []
+ decode_tx_abort encode_tx_abort MsgTxAbort $ do
+ cid <- f_cid
+ pure (TxAbort cid "failed check" empty)
+
+ , kat "stfu" stfu_lay []
+ decode_stfu (Right . encode_stfu) MsgStfu $ do
+ cid <- f_cid
+ pure (Stfu cid True empty)
+
+ , kat "shutdown" shutdown_lay []
+ decode_shutdown (Right . encode_shutdown) MsgShutdown $ do
+ cid <- f_cid
+ spk <- f_script p2wpkh_h
+ pure (Shutdown cid spk empty)
+
+ , kat "closing_complete" closing_complete_lay
+ [ tlv_h 1 sig1_h, tlv_h 3 sig2_h ]
+ decode_closing_complete encode_closing_complete
+ MsgClosingComplete $ do
+ cid <- f_cid
+ closer <- f_script p2wpkh_h
+ closee <- f_script p2tr_h
+ fee <- sat 500
+ s1 <- f_sig sig1_h
+ s2 <- f_sig sig2_h
+ pure (ClosingComplete cid closer closee fee 0 (Just s1) Nothing
+ (Just s2) empty)
+
+ , kat "closing_complete (closee output only)" closing_complete_lay
+ [ tlv_h 2 sig1_h ]
+ decode_closing_complete encode_closing_complete
+ MsgClosingComplete $ do
+ cid <- f_cid
+ closer <- f_script p2wpkh_h
+ closee <- f_script p2tr_h
+ fee <- sat 500
+ s1 <- f_sig sig1_h
+ pure (ClosingComplete cid closer closee fee 0 Nothing (Just s1)
+ Nothing empty)
+
+ , kat "closing_sig" closing_sig_lay [ tlv_h 3 sig3_h ]
+ decode_closing_sig encode_closing_sig MsgClosingSig $ do
+ cid <- f_cid
+ closer <- f_script p2wpkh_h
+ closee <- f_script p2tr_h
+ fee <- sat 500
+ s3 <- f_sig sig3_h
+ pure (ClosingSig cid closer closee fee 800000 Nothing Nothing
+ (Just s3) empty)
+
+ , kat "closing_signed" closing_signed_lay
+ [ tlv_h 1 "000000000000006400000000000003e8" ]
+ decode_closing_signed encode_closing_signed MsgClosingSigned $ do
+ cid <- f_cid
+ fee <- sat 500
+ s <- f_sig sig1_h
+ lo <- sat 100
+ hi <- sat 1000
+ pure (ClosingSigned cid fee s (Just (FeeRange lo hi)) empty)
+
+ , kat "update_add_htlc" update_add_htlc_lay [ tlv_h 0 p2_h ]
+ decode_update_add_htlc encode_update_add_htlc MsgUpdateAddHtlc $ do
+ cid <- f_cid
+ amt <- msat 100000
+ ph <- BOLT1.payment_hash =<< hx phash_h
+ onion <- onion_routing_packet =<< hx onion_h
+ pk <- f_point p2_h
+ pure (UpdateAddHtlc cid (HtlcId 0) amt ph 800080 onion (Just pk)
+ empty)
+
+ , kat "update_fulfill_htlc" update_fulfill_htlc_lay
+ [ tlv_h 1 attribution_h, tlv_h 3 "deadbeef" ]
+ decode_update_fulfill_htlc encode_update_fulfill_htlc
+ MsgUpdateFulfillHtlc $ do
+ cid <- f_cid
+ pre <- BOLT1.payment_preimage =<< hx preimage_h
+ att <- f_attribution
+ pure (UpdateFulfillHtlc cid (HtlcId 7) pre (Just att)
+ (Just "\xde\xad\xbe\xef") empty)
+
+ , kat "update_fail_htlc" update_fail_htlc_lay [ tlv_h 1 attribution_h ]
+ decode_update_fail_htlc encode_update_fail_htlc MsgUpdateFailHtlc $ do
+ cid <- f_cid
+ att <- f_attribution
+ pure (UpdateFailHtlc cid (HtlcId 7) "\x01\x02\x03\x04" (Just att)
+ empty)
+
+ , kat "update_fail_malformed_htlc" update_fail_malformed_htlc_lay []
+ decode_update_fail_malformed_htlc
+ (Right . encode_update_fail_malformed_htlc)
+ MsgUpdateFailMalformedHtlc $ do
+ cid <- f_cid
+ oh <- onion_hash =<< hx onion_hash_h
+ pure (UpdateFailMalformedHtlc cid (HtlcId 3) oh 0xc005 empty)
+
+ , kat "commitment_signed" commitment_signed_lay [ tlv_h 1 txid_h ]
+ decode_commitment_signed encode_commitment_signed
+ MsgCommitmentSigned $ do
+ cid <- f_cid
+ sigs <- traverse f_sig [sig1_h, sig2_h, sig3_h]
+ t <- f_txid
+ case sigs of
+ (s : hs) -> pure (CommitmentSigned cid s hs (Just t) empty)
+ [] -> Nothing
+
+ , kat "revoke_and_ack" revoke_and_ack_lay []
+ decode_revoke_and_ack (Right . encode_revoke_and_ack)
+ MsgRevokeAndAck $ do
+ cid <- f_cid
+ sec <- f_secret
+ pcp <- f_point p1_h
+ pure (RevokeAndAck cid sec pcp empty)
+
+ , kat "update_fee" update_fee_lay []
+ decode_update_fee (Right . encode_update_fee) MsgUpdateFee $ do
+ cid <- f_cid
+ pure (UpdateFee cid 2500 empty)
+
+ , kat "channel_reestablish" channel_reestablish_lay
+ [ tlv_h 1 (txid_h ++ "01") ]
+ decode_channel_reestablish encode_channel_reestablish
+ MsgChannelReestablish $ do
+ cid <- f_cid
+ sec <- f_secret
+ pcp <- f_point p1_h
+ t <- f_txid
+ pure (ChannelReestablish cid 5 4 sec pcp (Just (NextFunding t 1))
+ empty)
]
--- Channel Close Tests ---------------------------------------------------------
-
-close_tests :: TestTree
-close_tests = testGroup "Channel Close" [
- testGroup "Stfu" [
- testCase "encode/decode IsInitiator" $ do
- let msg = Stfu
- { stfuChannelId = testChannelId
- , stfuInitiator = IsInitiator
- }
- encoded = encodeStfu msg
- case decodeStfu encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "encode/decode NotInitiator" $ do
- let msg = Stfu
- { stfuChannelId = testChannelId
- , stfuInitiator = NotInitiator
- }
- encoded = encodeStfu msg
- case decodeStfu encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "Shutdown" [
- testCase "encode/decode with P2WPKH script" $ do
- let script = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xaa)
- msg = Shutdown
- { shutdownChannelId = testChannelId
- , shutdownScriptPubkey = script
- }
- case encodeShutdown msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeShutdown encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "encode/decode with P2WSH script" $ do
- let script = scriptPubKey (BS.pack [0x00, 0x20] <>
- BS.replicate 32 0xbb)
- msg = Shutdown
- { shutdownChannelId = testChannelId
- , shutdownScriptPubkey = script
- }
- case encodeShutdown msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeShutdown encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "ClosingSigned" [
- testCase "encode/decode roundtrip" $ do
- let msg = ClosingSigned
- { closingSignedChannelId = testChannelId
- , closingSignedFeeSatoshi = Satoshi 1000
- , closingSignedSignature = testSignature
- , closingSignedTlvs = emptyTlvs
- }
- encoded = encodeClosingSigned msg
- case decodeClosingSigned encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "ClosingComplete" [
- testCase "encode/decode roundtrip" $ do
- let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xcc)
- closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xdd)
- msg = ClosingComplete
- { closingCompleteChannelId = testChannelId
- , closingCompleteCloserScript = closerScript
- , closingCompleteCloseeScript = closeeScript
- , closingCompleteFeeSatoshi = Satoshi 500
- , closingCompleteLocktime = 0
- , closingCompleteTlvs = emptyTlvs
- }
- case encodeClosingComplete msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeClosingComplete encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "ClosingSig" [
- testCase "encode/decode roundtrip" $ do
- let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xee)
- closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xff)
- msg = ClosingSig
- { closingSigChannelId = testChannelId
- , closingSigCloserScript = closerScript
- , closingSigCloseeScript = closeeScript
- , closingSigFeeSatoshi = Satoshi 500
- , closingSigLocktime = 100
- , closingSigTlvs = emptyTlvs
- }
- case encodeClosingSig msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeClosingSig encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+-- TLV handling ---------------------------------------------------------------
+
+-- decode a message (type, fixed fields and TLV records in hex), check
+-- its unknown records, and check that it re-encodes exactly
+reencodes :: Layout -> [String] -> [TlvRecord] -> Assertion
+reencodes lay recs extra = do
+ wire <- unhex (lay_type lay ++ concat (lay_fixed lay ++ recs))
+ case decode_message wire of
+ Left e -> assertFailure ("decode failed: " ++ show e)
+ Right m -> do
+ BOLT1.un_tlv_stream (message_tlvs m) @?= extra
+ encode_message m @?= Right wire
+
+rejects :: Layout -> [String] -> DecodeError -> Assertion
+rejects lay recs err = do
+ wire <- unhex (lay_type lay ++ concat (lay_fixed lay ++ recs))
+ decode_message wire @?= Left err
+
+-- the smallest even type a message doesn't know
+first_unknown_even :: Layout -> Word64
+first_unknown_even lay = case filter (`notElem` known) [0, 2 ..] of
+ (t:_) -> t
+ [] -> 0
+ where
+ known = [ t | (t, _, _) <- lay_known lay ]
+
+tlv_cases :: Layout -> TestTree
+tlv_cases lay = testGroup (lay_name lay) $ [
+ testCase "unknown odd records are preserved" $
+ reencodes lay (valid ++ [tlv_h 43 "2a", tlv_h 201 ""])
+ [TlvRecord 43 "\x2a", TlvRecord 201 ""]
+ , testCase "unknown even records are rejected" $ do
+ let t = first_unknown_even lay
+ rejects lay [tlv_h t ""] (DecodeTlvError (TlvUnknownEvenType t))
+ rejects lay (valid ++ [tlv_h 42 "00"])
+ (DecodeTlvError (TlvUnknownEvenType 42))
+ , testCase "unordered records are rejected" $
+ rejects lay [tlv_h 45 "", tlv_h 43 ""]
+ (DecodeTlvError TlvNotStrictlyIncreasing)
+ , testCase "a huge record length is rejected" $ do
+ -- the length 2^64 - 1 must not wrap
+ rejects lay ["2bffffffffffffffffff2b"] (DecodeTlvError TlvTruncated)
+ ] ++ [
+ testCase ("type " ++ show t ++ " is typed") $ reencodes lay [tlv_h t v] []
+ | (t, v, _) <- lay_known lay
+ ] ++ [
+ testCase ("malformed type " ++ show t ++ " is rejected") $
+ mapM_ (\b -> rejects lay [tlv_h t b] (DecodeInvalidTlvValue t)) bad
+ | (t, _, bad) <- lay_known lay, not (null bad)
+ ]
+ where
+ valid = [ tlv_h t v | (t, v, _) <- lay_known lay ]
+
+tlv_handling :: TestTree
+tlv_handling = testGroup "TLV handling" $ map tlv_cases layouts ++ [
+ testGroup "splicing records" [
+ testCase "tx_add_input shared_input_txid is rejected" $
+ rejects tx_add_input_lay [tlv_h 0 txid_h]
+ (DecodeTlvError (TlvUnknownEvenType 0))
+ , testCase "tx_signatures shared_input_signature is rejected" $
+ rejects tx_signatures_lay [tlv_h 0 sig1_h]
+ (DecodeTlvError (TlvUnknownEvenType 0))
+ , testCase "channel_reestablish my_current_funding_locked is kept" $ do
+ v <- unhex (txid_h ++ "01")
+ reencodes channel_reestablish_lay
+ [tlv_h 1 (txid_h ++ "00"), tlv_h 5 (txid_h ++ "01")]
+ [TlvRecord 5 v]
]
+ , testCase "a non-minimal type is rejected" $
+ rejects update_fee_lay ["fd002b00"]
+ (DecodeTlvError TlvNonMinimalBigSize)
+ , testCase "a repeated type is rejected" $
+ rejects update_fee_lay [tlv_h 43 "", tlv_h 43 ""]
+ (DecodeTlvError TlvNotStrictlyIncreasing)
+ , testCase "trailing bytes that aren't a TLV record are rejected" $ do
+ rejects update_fee_lay ["fd"] (DecodeTlvError TlvTruncated)
+ rejects update_fee_lay ["2b"] (DecodeTlvError TlvTruncated)
+ rejects update_fee_lay ["2b02aa"] (DecodeTlvError TlvTruncated)
+ , testCase "an empty upfront_shutdown_script is kept" $ do
+ wire <- unhex (concat (lay_fixed open_channel_lay ++ [tlv_h 0 ""]))
+ fmap open_channel_upfront_shutdown_script (decode_open_channel wire)
+ @?= Right (script_pubkey "")
+ , testCase "an oversized upfront_shutdown_script is rejected" $ do
+ fixed <- unhex (concat (lay_fixed open_channel_lay))
+ let big = BS.replicate 65536 0x00
+ rec = "\x00\xfe\x00\x01\x00\x00" <> big
+ decode_open_channel (fixed <> rec) @?= Left (DecodeInvalidTlvValue 0)
+ , testCase "channel_type bytes are kept as received" $ do
+ wire <- unhex (concat (lay_fixed open_channel_lay
+ ++ [tlv_h 1 "00401000"]))
+ case decode_open_channel wire of
+ Left e -> assertFailure (show e)
+ Right m -> do
+ fmap BOLT9.render (open_channel_channel_type m)
+ @?= Just "\x00\x40\x10\x00"
+ (BOLT9.channel_type =<< open_channel_channel_type m)
+ @?= Just (BOLT9.ChannelType BOLT9.BasicAnchors False False)
+ encode_open_channel m @?= Right wire
]
--- Normal Operation Tests ------------------------------------------------------
-
-normal_operation_tests :: TestTree
-normal_operation_tests = testGroup "Normal Operation" [
- testGroup "UpdateAddHtlc" [
- testCase "encode/decode roundtrip" $ do
- let msg = UpdateAddHtlc
- { updateAddHtlcChannelId = testChannelId
- , updateAddHtlcId = htlcId 0
- , updateAddHtlcAmountMsat = MilliSatoshi 10000000
- , updateAddHtlcPaymentHash = testPaymentHash
- , updateAddHtlcCltvExpiry = 800144
- , updateAddHtlcOnionPacket = testOnionPacket
- , updateAddHtlcTlvs = emptyTlvs
- }
- encoded = encodeUpdateAddHtlc msg
- case decodeUpdateAddHtlc encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "UpdateFulfillHtlc" [
- testCase "encode/decode roundtrip" $ do
- let msg = UpdateFulfillHtlc
- { updateFulfillHtlcChannelId = testChannelId
- , updateFulfillHtlcId = htlcId 42
- , updateFulfillHtlcPaymentPreimage = testPaymentPreimage
- , updateFulfillHtlcTlvs = emptyTlvs
- }
- encoded = encodeUpdateFulfillHtlc msg
- case decodeUpdateFulfillHtlc encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "UpdateFailHtlc" [
- testCase "encode/decode roundtrip" $ do
- let msg = UpdateFailHtlc
- { updateFailHtlcChannelId = testChannelId
- , updateFailHtlcId = htlcId 42
- , updateFailHtlcReason = BS.replicate 32 0xaa
- , updateFailHtlcTlvs = emptyTlvs
- }
- case encodeUpdateFailHtlc msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeUpdateFailHtlc encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "roundtrip with empty reason" $ do
- let msg = UpdateFailHtlc
- { updateFailHtlcChannelId = testChannelId
- , updateFailHtlcId = htlcId 0
- , updateFailHtlcReason = BS.empty
- , updateFailHtlcTlvs = emptyTlvs
- }
- case encodeUpdateFailHtlc msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeUpdateFailHtlc encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "UpdateFailMalformedHtlc" [
- testCase "encode/decode roundtrip" $ do
- let msg = UpdateFailMalformedHtlc
- { updateFailMalformedHtlcChannelId = testChannelId
- , updateFailMalformedHtlcId = htlcId 42
- , updateFailMalformedHtlcSha256Onion = testPaymentHash
- , updateFailMalformedHtlcFailureCode = 0x8002
- }
- encoded = encodeUpdateFailMalformedHtlc msg
- case decodeUpdateFailMalformedHtlc encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "CommitmentSigned" [
- testCase "encode/decode with no HTLC signatures" $ do
- let msg = CommitmentSigned
- { commitmentSignedChannelId = testChannelId
- , commitmentSignedSignature = testSignature
- , commitmentSignedHtlcSignatures = []
- }
- case encodeCommitmentSigned msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeCommitmentSigned encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "encode/decode with HTLC signatures" $ do
- let sig2 = fromJust $ signature (BS.replicate 64 0xdd)
- sig3 = fromJust $ signature (BS.replicate 64 0xee)
- msg = CommitmentSigned
- { commitmentSignedChannelId = testChannelId
- , commitmentSignedSignature = testSignature
- , commitmentSignedHtlcSignatures = [sig2, sig3]
- }
- case encodeCommitmentSigned msg of
- Left e -> assertFailure $ "encode failed: " ++ show e
- Right encoded -> case decodeCommitmentSigned encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "RevokeAndAck" [
- testCase "encode/decode roundtrip" $ do
- let msg = RevokeAndAck
- { revokeAndAckChannelId = testChannelId
- , revokeAndAckPerCommitmentSecret = testSecret
- , revokeAndAckNextPerCommitPoint = testPoint
- }
- encoded = encodeRevokeAndAck msg
- case decodeRevokeAndAck encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
- , testGroup "UpdateFee" [
- testCase "encode/decode roundtrip" $ do
- let msg = UpdateFee
- { updateFeeChannelId = testChannelId
- , updateFeeFeeratePerKw = 5000
- }
- encoded = encodeUpdateFee msg
- case decodeUpdateFee encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- ]
+-- decoding failures ----------------------------------------------------------
+
+decoding_failures :: TestTree
+decoding_failures = testGroup "decoding failures" [
+ testGroup "truncated payloads" [
+ testCase (lay_name lay) $ do
+ wire <- unhex (lay_type lay ++ concat (lay_fixed lay))
+ decode_message (BS.take (BS.length wire - 1) wire)
+ @?= Left DecodeInsufficientBytes
+ decode_message (BS.take 2 wire) @?= Left DecodeInsufficientBytes
+ | lay <- layouts ]
+ , testCase "a message without a type" $ do
+ decode_message "" @?= Left DecodeInsufficientBytes
+ decode_message "\x00" @?= Left DecodeInsufficientBytes
+ , testCase "message types BOLT #2 doesn't define" $ do
+ decode_message "\x00\x50" @?= Left (DecodeUnknownEvenType 80)
+ decode_message "\x00\x51" @?= Left (DecodeUnknownOddType 81)
+ decode_message "\x00\x4d" @?= Left (DecodeUnknownOddType 77)
+ decode_message "\x00\x7f" @?= Left (DecodeUnknownOddType 127)
+ decode_message "\x00\x10\x00\x00\x00\x00"
+ @?= Left (DecodeUnknownEvenType 16)
+ , testCase "an invalid point" $ do
+ let bad = "04" ++ rep 32 "11"
+ wire <- unhex (concat (open_channel_fields 11 bad))
+ decode_open_channel wire @?= Left DecodeInvalidPoint
+ wire' <- unhex (cid_h ++ secret_h ++ bad)
+ decode_revoke_and_ack wire' @?= Left DecodeInvalidPoint
+ , testCase "amounts above 21M BTC" $ do
+ -- funding_satoshis of 21M BTC, then one satoshi more
+ ok <- unhex (concat (open_channel_fields 2 "000775f05a074000"))
+ bad <- unhex (concat (open_channel_fields 2 "000775f05a074001"))
+ assertBool "21M BTC" (either (const False) (const True)
+ (decode_open_channel ok))
+ decode_open_channel bad @?= Left DecodeInvalidAmount
+ htlc <- unhex (cid_h ++ "0000000000000000" ++ "1d24b2dfac520001"
+ ++ phash_h ++ "000c3550" ++ onion_h)
+ decode_update_add_htlc htlc @?= Left DecodeInvalidAmount
+ out <- unhex (cid_h ++ "0000000000000004" ++ "ffffffffffffffff"
+ ++ "0000")
+ decode_tx_add_output out @?= Left DecodeInvalidAmount
+ , testCase "stfu initiator byte" $ do
+ off <- unhex (cid_h ++ "00")
+ fmap stfu_initiator (decode_stfu off) @?= Right False
+ bad <- unhex (cid_h ++ "02")
+ decode_stfu bad @?= Left DecodeInvalidInitiator
+ , testCase "a list longer than its payload" $ do
+ wire <- unhex (cid_h ++ sig1_h ++ "0003" ++ sig2_h ++ sig3_h)
+ decode_commitment_signed wire @?= Left DecodeInsufficientBytes
+ wire' <- unhex (cid_h ++ txid_h ++ "0001" ++ "0004" ++ "0101")
+ decode_tx_signatures wire' @?= Left DecodeInsufficientBytes
+ , testCase "a short onion_routing_packet" $ do
+ wire <- unhex (concat (take 5 (lay_fixed update_add_htlc_lay))
+ ++ drop 2 onion_h)
+ decode_update_add_htlc wire @?= Left DecodeInsufficientBytes
+ ]
+ where
+ -- open_channel's fixed fields with field i replaced
+ open_channel_fields :: Int -> String -> [String]
+ open_channel_fields i v =
+ let fs = lay_fixed open_channel_lay
+ in take i fs ++ [v] ++ drop (i + 1) fs
+
+-- encoding failures ----------------------------------------------------------
+
+encoding_failures :: TestTree
+encoding_failures = testGroup "encoding failures" [
+ testCase "u16 length prefixes" $ do
+ cid <- just "cid" f_cid
+ let big = BS.replicate 65536 0x00
+ max_ok = BS.replicate 65535 0x00
+ encode_tx_add_input (TxAddInput cid (SerialId 0) big 0 0 empty)
+ @?= Left EncodeLengthOverflow
+ assertBool "65535-byte prevtx" $ either (const False) (const True)
+ (encode_tx_add_input (TxAddInput cid (SerialId 0) max_ok 0 0 empty))
+ encode_tx_abort (TxAbort cid big empty) @?= Left EncodeLengthOverflow
+ encode_update_fail_htlc
+ (UpdateFailHtlc cid (HtlcId 0) big Nothing empty)
+ @?= Left EncodeLengthOverflow
+ , testCase "u16 counts" $ do
+ cid <- just "cid" f_cid
+ s <- just "sig" (f_sig sig1_h)
+ t <- just "txid" f_txid
+ w <- just "witness" (witness "\x00")
+ encode_commitment_signed
+ (CommitmentSigned cid s (replicate 65536 s) Nothing empty)
+ @?= Left EncodeLengthOverflow
+ encode_tx_signatures (TxSignatures cid t (replicate 65536 w) empty)
+ @?= Left EncodeLengthOverflow
+ , testCase "_tlvs fields can't hold known types" $ do
+ cid <- just "cid" f_cid
+ pcp <- just "point" (f_point p1_h)
+ s <- just "sig" (f_sig sig1_h)
+ spk <- just "script" (f_script p2wpkh_h)
+ fee <- just "fee" (sat 500)
+ one <- just "tlvs" (BOLT1.tlv_stream [TlvRecord 1 "\x00"])
+ two <- just "tlvs" (BOLT1.tlv_stream [TlvRecord 2 ""])
+ odd' <- just "tlvs" (BOLT1.tlv_stream [TlvRecord 43 ""])
+ encode_channel_ready (ChannelReady cid pcp Nothing one)
+ @?= Left EncodeInvalidTlvs
+ encode_closing_complete
+ (ClosingComplete cid spk spk fee 0 (Just s) Nothing Nothing two)
+ @?= Left EncodeInvalidTlvs
+ encode_tx_ack_rbf (TxAckRbf cid Nothing False two)
+ @?= Left EncodeInvalidTlvs
+ assertBool "unknown odd records encode" $
+ either (const False) (const True)
+ (encode_channel_ready (ChannelReady cid pcp Nothing odd'))
+ , testCase "the message size limit" $ do
+ cid <- just "cid" f_cid
+ -- a 65533-byte payload fits; one more byte doesn't
+ let at n = TxAbort cid (BS.replicate n 0x00) empty
+ fmap BS.length (encode_message (MsgTxAbort (at 65499)))
+ @?= Right 65535
+ encode_message (MsgTxAbort (at 65500)) @?= Left EncodeMessageTooLarge
+ fmap BS.length (encode_tx_abort (at 65500)) @?= Right 65534
]
--- Reestablish Tests -----------------------------------------------------------
-
-reestablish_tests :: TestTree
-reestablish_tests = testGroup "Channel Reestablish" [
- testCase "encode/decode roundtrip" $ do
- let sec = fromJust $ perCommitmentSecret (BS.replicate 32 0x22)
- msg = ChannelReestablish
- { channelReestablishChannelId = testChannelId
- , channelReestablishNextCommitNum = 5
- , channelReestablishNextRevocationNum = 4
- , channelReestablishYourLastCommitSecret = sec
- , channelReestablishMyCurrentCommitPoint = testPoint
- , channelReestablishTlvs = emptyTlvs
- }
- encoded = encodeChannelReestablish msg
- case decodeChannelReestablish encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
- , testCase "roundtrip with zero counters" $ do
- let sec = fromJust $ perCommitmentSecret (BS.replicate 32 0x00)
- msg = ChannelReestablish
- { channelReestablishChannelId = testChannelId
- , channelReestablishNextCommitNum = 1
- , channelReestablishNextRevocationNum = 0
- , channelReestablishYourLastCommitSecret = sec
- , channelReestablishMyCurrentCommitPoint = testPoint
- , channelReestablishTlvs = emptyTlvs
- }
- encoded = encodeChannelReestablish msg
- case decodeChannelReestablish encoded of
- Right (decoded, _) -> decoded @?= msg
- Left e -> assertFailure $ "decode failed: " ++ show e
+-- field types ----------------------------------------------------------------
+
+field_types :: TestTree
+field_types = testGroup "field types" [
+ testCase "script_pubkey" $ do
+ fmap un_script_pubkey (script_pubkey (BS.replicate 65535 0x51))
+ @?= Just (BS.replicate 65535 0x51)
+ script_pubkey (BS.replicate 65536 0x51) @?= Nothing
+ , testCase "witness" $ do
+ fmap un_witness (witness "") @?= Just ""
+ witness (BS.replicate 65536 0x00) @?= Nothing
+ , testCase "onion_routing_packet" $ do
+ let bs = BS.replicate 1366 0x00
+ fmap un_onion_routing_packet (onion_routing_packet bs) @?= Just bs
+ onion_routing_packet (BS.take 1365 bs) @?= Nothing
+ onion_routing_packet (BS.cons 0x00 bs) @?= Nothing
+ , testCase "onion_hash" $ do
+ fmap un_onion_hash (onion_hash (BS.replicate 32 0x01))
+ @?= Just (BS.replicate 32 0x01)
+ onion_hash (BS.replicate 33 0x01) @?= Nothing
+ , testCase "attribution_data" $ do
+ let bs = BS.replicate 920 0x00
+ fmap un_attribution_data (attribution_data bs) @?= Just bs
+ attribution_data (BS.take 919 bs) @?= Nothing
+ , testCase "message types" $ do
+ cid <- just "cid" f_cid
+ message_type (MsgStfu (Stfu cid False empty)) @?= 2
+ message_type (MsgUpdateFee (UpdateFee cid 0 empty)) @?= 134
]
--- Error Condition Tests -------------------------------------------------------
-
-error_tests :: TestTree
-error_tests = testGroup "Error Conditions" [
- testGroup "Insufficient Bytes" [
- testCase "decodeOpenChannel empty" $ do
- case decodeOpenChannel BS.empty of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeOpenChannel too short" $ do
- case decodeOpenChannel (BS.replicate 100 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeAcceptChannel too short" $ do
- case decodeAcceptChannel (BS.replicate 10 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeFundingCreated too short" $ do
- case decodeFundingCreated (BS.replicate 50 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeFundingSigned too short" $ do
- case decodeFundingSigned (BS.replicate 30 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeChannelReady too short" $ do
- case decodeChannelReady (BS.replicate 32 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeStfu too short" $ do
- case decodeStfu (BS.replicate 31 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeShutdown too short" $ do
- case decodeShutdown (BS.replicate 32 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeStfu invalid initiator byte" $ do
- -- channel_id (32 bytes) + initiator (1 byte, value 2)
- let encoded = BS.replicate 32 0xab <> BS.singleton 0x02
- case decodeStfu encoded of
- Left DecodeInvalidInitiator -> pure ()
- other -> assertFailure $
- "expected invalid initiator: " ++ show other
- , testCase "decodeUpdateAddHtlc too short" $ do
- case decodeUpdateAddHtlc (BS.replicate 100 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeCommitmentSigned too short" $ do
- case decodeCommitmentSigned (BS.replicate 90 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeRevokeAndAck too short" $ do
- case decodeRevokeAndAck (BS.replicate 60 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeTxSignatures too short" $ do
- case decodeTxSignatures (BS.replicate 60 0x00) of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- ]
- , testGroup "EncodeError - Length Overflow" [
- testCase "encodeShutdown with oversized script" $ do
- let script = scriptPubKey (BS.replicate 70000 0x00)
- msg = Shutdown
- { shutdownChannelId = testChannelId
- , shutdownScriptPubkey = script
- }
- case encodeShutdown msg of
- Left EncodeLengthOverflow -> pure ()
- other -> assertFailure $ "expected overflow: " ++ show other
- , testCase "encodeClosingComplete with oversized closer script" $ do
- let oversizedScript = scriptPubKey (BS.replicate 70000 0x00)
- normalScript = scriptPubKey (BS.replicate 22 0x00)
- msg = ClosingComplete
- { closingCompleteChannelId = testChannelId
- , closingCompleteCloserScript = oversizedScript
- , closingCompleteCloseeScript = normalScript
- , closingCompleteFeeSatoshi = Satoshi 500
- , closingCompleteLocktime = 0
- , closingCompleteTlvs = emptyTlvs
- }
- case encodeClosingComplete msg of
- Left EncodeLengthOverflow -> pure ()
- other -> assertFailure $ "expected overflow: " ++ show other
- , testCase "encodeClosingComplete with oversized closee script" $ do
- let normalScript = scriptPubKey (BS.replicate 22 0x00)
- oversizedScript = scriptPubKey (BS.replicate 70000 0x00)
- msg = ClosingComplete
- { closingCompleteChannelId = testChannelId
- , closingCompleteCloserScript = normalScript
- , closingCompleteCloseeScript = oversizedScript
- , closingCompleteFeeSatoshi = Satoshi 500
- , closingCompleteLocktime = 0
- , closingCompleteTlvs = emptyTlvs
- }
- case encodeClosingComplete msg of
- Left EncodeLengthOverflow -> pure ()
- other -> assertFailure $ "expected overflow: " ++ show other
- , testCase "encodeClosingSig with oversized script" $ do
- let oversizedScript = scriptPubKey (BS.replicate 70000 0x00)
- normalScript = scriptPubKey (BS.replicate 22 0x00)
- msg = ClosingSig
- { closingSigChannelId = testChannelId
- , closingSigCloserScript = oversizedScript
- , closingSigCloseeScript = normalScript
- , closingSigFeeSatoshi = Satoshi 500
- , closingSigLocktime = 0
- , closingSigTlvs = emptyTlvs
- }
- case encodeClosingSig msg of
- Left EncodeLengthOverflow -> pure ()
- other -> assertFailure $ "expected overflow: " ++ show other
- ]
- , testGroup "Invalid Field Length" [
- testCase "decodeShutdown with invalid script length" $ do
- -- channel_id (32 bytes) + script length (2 bytes) claiming more
- let encoded = BS.replicate 32 0xab <>
- BS.pack [0xff, 0xff] <> -- claims 65535 bytes
- BS.replicate 10 0x00 -- only 10 bytes
- case decodeShutdown encoded of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeTxAddInput with invalid prevTx length" $ do
- -- channel_id (32) + serial_id (8) + len (2) claiming more
- let encoded = BS.replicate 32 0xab <>
- BS.replicate 8 0x00 <>
- BS.pack [0xff, 0xff] <> -- claims 65535 bytes
- BS.replicate 10 0x00 -- only 10 bytes
- case decodeTxAddInput encoded of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- , testCase "decodeUpdateFailHtlc with invalid reason length" $ do
- -- channel_id (32) + htlc_id (8) + len (2) claiming more
- let encoded = BS.replicate 32 0xab <>
- BS.replicate 8 0x00 <>
- BS.pack [0xff, 0xff] <> -- claims 65535 bytes
- BS.replicate 10 0x00 -- only 10 bytes
- case decodeUpdateFailHtlc encoded of
- Left DecodeInsufficientBytes -> pure ()
- other -> assertFailure $ "expected insufficient: " ++ show other
- ]
+-- generators -----------------------------------------------------------------
+
+gen_bytes :: Int -> Gen BS.ByteString
+gen_bytes n = BS.pack <$> vectorOf n arbitrary
+
+gen_var_bytes :: Int -> Gen BS.ByteString
+gen_var_bytes hi = choose (0, hi) >>= gen_bytes
+
+gen_cid :: Gen BOLT1.ChannelId
+gen_cid = gen_bytes 32 `suchThatMap` BOLT1.channel_id
+
+gen_chain :: Gen BOLT1.ChainHash
+gen_chain = gen_bytes 32 `suchThatMap` BOLT1.chain_hash
+
+gen_point :: Gen BOLT1.Point
+gen_point = do
+ p <- elements [0x02, 0x03]
+ (BS.cons p <$> gen_bytes 32) `suchThatMap` BOLT1.point
+
+gen_sig :: Gen BOLT1.Signature
+gen_sig = gen_bytes 64 `suchThatMap` BOLT1.signature
+
+gen_txid :: Gen Tx.TxId
+gen_txid = gen_bytes 32 `suchThatMap` Tx.mkTxId
+
+gen_secret :: Gen BOLT1.PerCommitmentSecret
+gen_secret = gen_bytes 32 `suchThatMap` BOLT1.per_commitment_secret
+
+gen_sat :: Gen BOLT1.Satoshi
+gen_sat = choose (0, 2100000000000000) `suchThatMap` BOLT1.satoshi
+
+gen_msat :: Gen BOLT1.MilliSatoshi
+gen_msat = choose (0, 2100000000000000000) `suchThatMap` BOLT1.milli_satoshi
+
+gen_script :: Gen ScriptPubKey
+gen_script = gen_var_bytes 40 `suchThatMap` script_pubkey
+
+gen_fv :: Gen BOLT9.FeatureVector
+gen_fv = BOLT9.parse <$> gen_var_bytes 8
+
+gen_maybe :: Gen a -> Gen (Maybe a)
+gen_maybe g = oneof [pure Nothing, Just <$> g]
+
+-- unknown odd records, avoiding a message's known types
+gen_tlvs :: [Word64] -> Gen BOLT1.TlvStream
+gen_tlvs known = do
+ ts <- sublistOf (filter (`notElem` known) candidates)
+ rs <- traverse (\t -> TlvRecord t <$> gen_var_bytes 12) ts
+ pure (maybe empty id (BOLT1.tlv_stream rs))
+ where
+ candidates = [1, 3, 5, 7, 43, 201, 253, 65537, 4294967297]
+
+gen_open_channel :: Gen OpenChannel
+gen_open_channel = OpenChannel <$> gen_chain <*> gen_cid <*> gen_sat
+ <*> gen_msat <*> gen_sat <*> arbitrary <*> gen_sat <*> gen_msat
+ <*> arbitrary <*> arbitrary <*> arbitrary <*> gen_point <*> gen_point
+ <*> gen_point <*> gen_point <*> gen_point <*> gen_point <*> arbitrary
+ <*> gen_maybe gen_script <*> gen_maybe gen_fv <*> gen_tlvs [0, 1]
+
+gen_accept_channel :: Gen AcceptChannel
+gen_accept_channel = AcceptChannel <$> gen_cid <*> gen_sat <*> arbitrary
+ <*> gen_sat <*> gen_msat <*> arbitrary <*> arbitrary <*> arbitrary
+ <*> gen_point <*> gen_point <*> gen_point <*> gen_point <*> gen_point
+ <*> gen_point <*> gen_maybe gen_script <*> gen_maybe gen_fv
+ <*> gen_tlvs [0, 1]
+
+gen_funding_created :: Gen FundingCreated
+gen_funding_created = FundingCreated <$> gen_cid <*> gen_txid <*> arbitrary
+ <*> gen_sig <*> gen_tlvs []
+
+gen_funding_signed :: Gen FundingSigned
+gen_funding_signed = FundingSigned <$> gen_cid <*> gen_sig <*> gen_tlvs []
+
+gen_channel_ready :: Gen ChannelReady
+gen_channel_ready = ChannelReady <$> gen_cid <*> gen_point
+ <*> gen_maybe (BOLT1.ShortChannelId <$> arbitrary) <*> gen_tlvs [1]
+
+gen_open_channel2 :: Gen OpenChannel2
+gen_open_channel2 = OpenChannel2 <$> gen_chain <*> gen_cid <*> arbitrary
+ <*> arbitrary <*> gen_sat <*> gen_sat <*> arbitrary <*> gen_msat
+ <*> arbitrary <*> arbitrary <*> arbitrary <*> gen_point <*> gen_point
+ <*> gen_point <*> gen_point <*> gen_point <*> gen_point <*> gen_point
+ <*> arbitrary <*> gen_maybe gen_script <*> gen_maybe gen_fv
+ <*> arbitrary <*> gen_tlvs [0, 1, 2]
+
+gen_accept_channel2 :: Gen AcceptChannel2
+gen_accept_channel2 = AcceptChannel2 <$> gen_cid <*> gen_sat <*> gen_sat
+ <*> arbitrary <*> gen_msat <*> arbitrary <*> arbitrary <*> arbitrary
+ <*> gen_point <*> gen_point <*> gen_point <*> gen_point <*> gen_point
+ <*> gen_point <*> gen_point <*> gen_maybe gen_script
+ <*> gen_maybe gen_fv <*> arbitrary <*> gen_tlvs [0, 1, 2]
+
+gen_tx_add_input :: Gen TxAddInput
+gen_tx_add_input = TxAddInput <$> gen_cid <*> (SerialId <$> arbitrary)
+ <*> gen_var_bytes 64 <*> arbitrary <*> arbitrary <*> gen_tlvs []
+
+gen_tx_add_output :: Gen TxAddOutput
+gen_tx_add_output = TxAddOutput <$> gen_cid <*> (SerialId <$> arbitrary)
+ <*> gen_sat <*> gen_script <*> gen_tlvs []
+
+gen_tx_remove_input :: Gen TxRemoveInput
+gen_tx_remove_input = TxRemoveInput <$> gen_cid <*> (SerialId <$> arbitrary)
+ <*> gen_tlvs []
+
+gen_tx_remove_output :: Gen TxRemoveOutput
+gen_tx_remove_output = TxRemoveOutput <$> gen_cid
+ <*> (SerialId <$> arbitrary) <*> gen_tlvs []
+
+gen_tx_complete :: Gen TxComplete
+gen_tx_complete = TxComplete <$> gen_cid <*> gen_tlvs []
+
+gen_tx_signatures :: Gen TxSignatures
+gen_tx_signatures = TxSignatures <$> gen_cid <*> gen_txid
+ <*> listOf (gen_var_bytes 32 `suchThatMap` witness) <*> gen_tlvs []
+
+gen_tx_init_rbf :: Gen TxInitRbf
+gen_tx_init_rbf = TxInitRbf <$> gen_cid <*> arbitrary <*> arbitrary
+ <*> gen_maybe (arbitrary :: Gen Int64) <*> arbitrary <*> gen_tlvs [0, 2]
+
+gen_tx_ack_rbf :: Gen TxAckRbf
+gen_tx_ack_rbf = TxAckRbf <$> gen_cid <*> gen_maybe arbitrary <*> arbitrary
+ <*> gen_tlvs [0, 2]
+
+gen_tx_abort :: Gen TxAbort
+gen_tx_abort = TxAbort <$> gen_cid <*> gen_var_bytes 64 <*> gen_tlvs []
+
+gen_stfu :: Gen Stfu
+gen_stfu = Stfu <$> gen_cid <*> arbitrary <*> gen_tlvs []
+
+gen_shutdown :: Gen Shutdown
+gen_shutdown = Shutdown <$> gen_cid <*> gen_script <*> gen_tlvs []
+
+gen_closing_complete :: Gen ClosingComplete
+gen_closing_complete = ClosingComplete <$> gen_cid <*> gen_script
+ <*> gen_script <*> gen_sat <*> arbitrary <*> gen_maybe gen_sig
+ <*> gen_maybe gen_sig <*> gen_maybe gen_sig <*> gen_tlvs [1, 2, 3]
+
+gen_closing_sig :: Gen ClosingSig
+gen_closing_sig = ClosingSig <$> gen_cid <*> gen_script <*> gen_script
+ <*> gen_sat <*> arbitrary <*> gen_maybe gen_sig <*> gen_maybe gen_sig
+ <*> gen_maybe gen_sig <*> gen_tlvs [1, 2, 3]
+
+gen_closing_signed :: Gen ClosingSigned
+gen_closing_signed = ClosingSigned <$> gen_cid <*> gen_sat <*> gen_sig
+ <*> gen_maybe (FeeRange <$> gen_sat <*> gen_sat) <*> gen_tlvs [1]
+
+gen_update_add_htlc :: Gen UpdateAddHtlc
+gen_update_add_htlc = UpdateAddHtlc <$> gen_cid <*> (HtlcId <$> arbitrary)
+ <*> gen_msat
+ <*> (gen_bytes 32 `suchThatMap` BOLT1.payment_hash)
+ <*> arbitrary
+ <*> (gen_bytes 1366 `suchThatMap` onion_routing_packet)
+ <*> gen_maybe gen_point <*> gen_tlvs [0]
+
+gen_update_fulfill_htlc :: Gen UpdateFulfillHtlc
+gen_update_fulfill_htlc = UpdateFulfillHtlc <$> gen_cid
+ <*> (HtlcId <$> arbitrary)
+ <*> (gen_bytes 32 `suchThatMap` BOLT1.payment_preimage)
+ <*> gen_maybe (gen_bytes 920 `suchThatMap` attribution_data)
+ <*> gen_maybe (gen_var_bytes 64) <*> gen_tlvs [1, 3]
+
+gen_update_fail_htlc :: Gen UpdateFailHtlc
+gen_update_fail_htlc = UpdateFailHtlc <$> gen_cid <*> (HtlcId <$> arbitrary)
+ <*> gen_var_bytes 300
+ <*> gen_maybe (gen_bytes 920 `suchThatMap` attribution_data)
+ <*> gen_tlvs [1]
+
+gen_update_fail_malformed_htlc :: Gen UpdateFailMalformedHtlc
+gen_update_fail_malformed_htlc = UpdateFailMalformedHtlc <$> gen_cid
+ <*> (HtlcId <$> arbitrary)
+ <*> (gen_bytes 32 `suchThatMap` onion_hash)
+ <*> arbitrary <*> gen_tlvs []
+
+gen_commitment_signed :: Gen CommitmentSigned
+gen_commitment_signed = CommitmentSigned <$> gen_cid <*> gen_sig
+ <*> listOf gen_sig <*> gen_maybe gen_txid <*> gen_tlvs [1]
+
+gen_revoke_and_ack :: Gen RevokeAndAck
+gen_revoke_and_ack = RevokeAndAck <$> gen_cid <*> gen_secret <*> gen_point
+ <*> gen_tlvs []
+
+gen_update_fee :: Gen UpdateFee
+gen_update_fee = UpdateFee <$> gen_cid <*> arbitrary <*> gen_tlvs []
+
+gen_channel_reestablish :: Gen ChannelReestablish
+gen_channel_reestablish = ChannelReestablish <$> gen_cid <*> arbitrary
+ <*> arbitrary <*> gen_secret <*> gen_point
+ <*> gen_maybe (NextFunding <$> gen_txid <*> arbitrary) <*> gen_tlvs [1]
+
+gen_message :: Gen Message
+gen_message = oneof [
+ MsgOpenChannel <$> gen_open_channel
+ , MsgAcceptChannel <$> gen_accept_channel
+ , MsgFundingCreated <$> gen_funding_created
+ , MsgFundingSigned <$> gen_funding_signed
+ , MsgChannelReady <$> gen_channel_ready
+ , MsgOpenChannel2 <$> gen_open_channel2
+ , MsgAcceptChannel2 <$> gen_accept_channel2
+ , MsgTxAddInput <$> gen_tx_add_input
+ , MsgTxAddOutput <$> gen_tx_add_output
+ , MsgTxRemoveInput <$> gen_tx_remove_input
+ , MsgTxRemoveOutput <$> gen_tx_remove_output
+ , MsgTxComplete <$> gen_tx_complete
+ , MsgTxSignatures <$> gen_tx_signatures
+ , MsgTxInitRbf <$> gen_tx_init_rbf
+ , MsgTxAckRbf <$> gen_tx_ack_rbf
+ , MsgTxAbort <$> gen_tx_abort
+ , MsgStfu <$> gen_stfu
+ , MsgShutdown <$> gen_shutdown
+ , MsgClosingComplete <$> gen_closing_complete
+ , MsgClosingSig <$> gen_closing_sig
+ , MsgClosingSigned <$> gen_closing_signed
+ , MsgUpdateAddHtlc <$> gen_update_add_htlc
+ , MsgUpdateFulfillHtlc <$> gen_update_fulfill_htlc
+ , MsgUpdateFailHtlc <$> gen_update_fail_htlc
+ , MsgUpdateFailMalformedHtlc <$> gen_update_fail_malformed_htlc
+ , MsgCommitmentSigned <$> gen_commitment_signed
+ , MsgRevokeAndAck <$> gen_revoke_and_ack
+ , MsgUpdateFee <$> gen_update_fee
+ , MsgChannelReestablish <$> gen_channel_reestablish
]
--- Property Tests --------------------------------------------------------------
-
-property_tests :: TestTree
-property_tests = testGroup "Properties" [
- testProperty "OpenChannel roundtrip" propOpenChannelRoundtrip
- , testProperty "AcceptChannel roundtrip" propAcceptChannelRoundtrip
- , testProperty "FundingCreated roundtrip" propFundingCreatedRoundtrip
- , testProperty "FundingSigned roundtrip" propFundingSignedRoundtrip
- , testProperty "ChannelReady roundtrip" propChannelReadyRoundtrip
- , testProperty "OpenChannel2 roundtrip" propOpenChannel2Roundtrip
- , testProperty "AcceptChannel2 roundtrip" propAcceptChannel2Roundtrip
- , testProperty "TxAddInput roundtrip" propTxAddInputRoundtrip
- , testProperty "TxAddOutput roundtrip" propTxAddOutputRoundtrip
- , testProperty "TxRemoveInput roundtrip" propTxRemoveInputRoundtrip
- , testProperty "TxRemoveOutput roundtrip" propTxRemoveOutputRoundtrip
- , testProperty "TxComplete roundtrip" propTxCompleteRoundtrip
- , testProperty "TxSignatures roundtrip" propTxSignaturesRoundtrip
- , testProperty "TxInitRbf roundtrip" propTxInitRbfRoundtrip
- , testProperty "TxAckRbf roundtrip" propTxAckRbfRoundtrip
- , testProperty "TxAbort roundtrip" propTxAbortRoundtrip
- , testProperty "Stfu roundtrip" propStfuRoundtrip
- , testProperty "Shutdown roundtrip" propShutdownRoundtrip
- , testProperty "ClosingSigned roundtrip" propClosingSignedRoundtrip
- , testProperty "ClosingComplete roundtrip" propClosingCompleteRoundtrip
- , testProperty "ClosingSig roundtrip" propClosingSigRoundtrip
- , testProperty "UpdateAddHtlc roundtrip" propUpdateAddHtlcRoundtrip
- , testProperty "UpdateFulfillHtlc roundtrip" propUpdateFulfillHtlcRoundtrip
- , testProperty "UpdateFailHtlc roundtrip" propUpdateFailHtlcRoundtrip
- , testProperty "UpdateFailMalformedHtlc roundtrip"
- propUpdateFailMalformedHtlcRoundtrip
- , testProperty "CommitmentSigned roundtrip" propCommitmentSignedRoundtrip
- , testProperty "RevokeAndAck roundtrip" propRevokeAndAckRoundtrip
- , testProperty "UpdateFee roundtrip" propUpdateFeeRoundtrip
- , testProperty "ChannelReestablish roundtrip" propChannelReestablishRoundtrip
- , testProperty "HtlcId wrap/unwrap" propHtlcIdRoundtrip
- , testProperty "SerialId wrap/unwrap" propSerialIdRoundtrip
- , testProperty "OnionPacket validates length" propOnionPacketLength
- , testProperty "TxId validates length" propTxIdLength
+-- properties -----------------------------------------------------------------
+
+-- decoding an encoded payload gives back the value
+roundtrip
+ :: (Eq a, Show a)
+ => String
+ -> Gen a
+ -> (a -> Either EncodeError BS.ByteString)
+ -> (BS.ByteString -> Either DecodeError a)
+ -> TestTree
+roundtrip name gen enc dec = testProperty name $ forAll gen $ \m ->
+ case enc m of
+ Left e -> counterexample ("encode failed: " ++ show e) False
+ Right w -> dec w === Right m
+
+-- byte strings derived from a valid encoding
+data Edit = Replace !Int !Word8 | Truncate !Int | Append !BS.ByteString
+ deriving Show
+
+gen_edit :: Gen Edit
+gen_edit = oneof [
+ Replace <$> arbitrary <*> arbitrary
+ , Truncate <$> arbitrary
+ , Append <$> gen_var_bytes 8
]
--- Property: OpenChannel roundtrip
-propOpenChannelRoundtrip :: Property
-propOpenChannelRoundtrip = property $ do
- let msg = OpenChannel
- { openChannelChainHash = testChainHash
- , openChannelTempChannelId = testChannelId
- , openChannelFundingSatoshi = Satoshi 1000000
- , openChannelPushMsat = MilliSatoshi 500000
- , openChannelDustLimitSatoshi = Satoshi 546
- , openChannelMaxHtlcValueInFlight = MilliSatoshi 100000000
- , openChannelChannelReserveSat = Satoshi 10000
- , openChannelHtlcMinimumMsat = MilliSatoshi 1000
- , openChannelFeeratePerKw = 2500
- , openChannelToSelfDelay = 144
- , openChannelMaxAcceptedHtlcs = 483
- , openChannelFundingPubkey = testPoint
- , openChannelRevocationBasepoint = testPoint
- , openChannelPaymentBasepoint = testPoint
- , openChannelDelayedPaymentBase = testPoint
- , openChannelHtlcBasepoint = testPoint
- , openChannelFirstPerCommitPoint = testPoint
- , openChannelChannelFlags = 0x01
- , openChannelTlvs = emptyTlvs
- }
- encoded = encodeOpenChannel msg
- case decodeOpenChannel encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: AcceptChannel roundtrip
-propAcceptChannelRoundtrip :: Property
-propAcceptChannelRoundtrip = property $ do
- let msg = AcceptChannel
- { acceptChannelTempChannelId = testChannelId
- , acceptChannelDustLimitSatoshi = Satoshi 546
- , acceptChannelMaxHtlcValueInFlight = MilliSatoshi 100000000
- , acceptChannelChannelReserveSat = Satoshi 10000
- , acceptChannelHtlcMinimumMsat = MilliSatoshi 1000
- , acceptChannelMinimumDepth = 3
- , acceptChannelToSelfDelay = 144
- , acceptChannelMaxAcceptedHtlcs = 483
- , acceptChannelFundingPubkey = testPoint
- , acceptChannelRevocationBasepoint = testPoint
- , acceptChannelPaymentBasepoint = testPoint
- , acceptChannelDelayedPaymentBase = testPoint
- , acceptChannelHtlcBasepoint = testPoint
- , acceptChannelFirstPerCommitPoint = testPoint
- , acceptChannelTlvs = emptyTlvs
- }
- encoded = encodeAcceptChannel msg
- case decodeAcceptChannel encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: FundingCreated roundtrip
-propFundingCreatedRoundtrip :: Word16 -> Property
-propFundingCreatedRoundtrip outIdx = property $ do
- let msg = FundingCreated
- { fundingCreatedTempChannelId = testChannelId
- , fundingCreatedFundingTxid = testTxId
- , fundingCreatedFundingOutIdx = outIdx
- , fundingCreatedSignature = testSignature
- }
- encoded = encodeFundingCreated msg
- case decodeFundingCreated encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: FundingSigned roundtrip
-propFundingSignedRoundtrip :: Property
-propFundingSignedRoundtrip = property $ do
- let msg = FundingSigned
- { fundingSignedChannelId = testChannelId
- , fundingSignedSignature = testSignature
- }
- encoded = encodeFundingSigned msg
- case decodeFundingSigned encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: ChannelReady roundtrip
-propChannelReadyRoundtrip :: Property
-propChannelReadyRoundtrip = property $ do
- let msg = ChannelReady
- { channelReadyChannelId = testChannelId
- , channelReadySecondPerCommitPoint = testPoint
- , channelReadyTlvs = emptyTlvs
- }
- encoded = encodeChannelReady msg
- case decodeChannelReady encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: OpenChannel2 roundtrip
-propOpenChannel2Roundtrip :: Property
-propOpenChannel2Roundtrip = property $ do
- let msg = OpenChannel2
- { openChannel2ChainHash = testChainHash
- , openChannel2TempChannelId = testChannelId
- , openChannel2FundingFeeratePerkw = 2500
- , openChannel2CommitFeeratePerkw = 2000
- , openChannel2FundingSatoshi = Satoshi 1000000
- , openChannel2DustLimitSatoshi = Satoshi 546
- , openChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000
- , openChannel2HtlcMinimumMsat = MilliSatoshi 1000
- , openChannel2ToSelfDelay = 144
- , openChannel2MaxAcceptedHtlcs = 483
- , openChannel2Locktime = 0
- , openChannel2FundingPubkey = testPoint
- , openChannel2RevocationBasepoint = testPoint
- , openChannel2PaymentBasepoint = testPoint
- , openChannel2DelayedPaymentBase = testPoint
- , openChannel2HtlcBasepoint = testPoint
- , openChannel2FirstPerCommitPoint = testPoint
- , openChannel2SecondPerCommitPoint = testPoint2
- , openChannel2ChannelFlags = 0x00
- , openChannel2Tlvs = emptyTlvs
- }
- encoded = encodeOpenChannel2 msg
- case decodeOpenChannel2 encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: AcceptChannel2 roundtrip
-propAcceptChannel2Roundtrip :: Property
-propAcceptChannel2Roundtrip = property $ do
- let msg = AcceptChannel2
- { acceptChannel2TempChannelId = testChannelId
- , acceptChannel2FundingSatoshi = Satoshi 500000
- , acceptChannel2DustLimitSatoshi = Satoshi 546
- , acceptChannel2MaxHtlcValueInFlight = MilliSatoshi 100000000
- , acceptChannel2HtlcMinimumMsat = MilliSatoshi 1000
- , acceptChannel2MinimumDepth = 3
- , acceptChannel2ToSelfDelay = 144
- , acceptChannel2MaxAcceptedHtlcs = 483
- , acceptChannel2FundingPubkey = testPoint
- , acceptChannel2RevocationBasepoint = testPoint
- , acceptChannel2PaymentBasepoint = testPoint
- , acceptChannel2DelayedPaymentBase = testPoint
- , acceptChannel2HtlcBasepoint = testPoint
- , acceptChannel2FirstPerCommitPoint = testPoint
- , acceptChannel2SecondPerCommitPoint = testPoint2
- , acceptChannel2Tlvs = emptyTlvs
- }
- encoded = encodeAcceptChannel2 msg
- case decodeAcceptChannel2 encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxAddInput roundtrip with varying data
-propTxAddInputRoundtrip :: [Word8] -> Word32 -> Word32 -> Property
-propTxAddInputRoundtrip prevTxBytes vout seqNum = property $ do
- let prevTx = BS.pack (take 1000 prevTxBytes) -- limit size
- msg = TxAddInput
- { txAddInputChannelId = testChannelId
- , txAddInputSerialId = serialId 12345
- , txAddInputPrevTx = prevTx
- , txAddInputPrevVout = vout
- , txAddInputSequence = seqNum
- }
- case encodeTxAddInput msg of
- Left _ -> False
- Right encoded -> case decodeTxAddInput encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxAddOutput roundtrip
-propTxAddOutputRoundtrip :: Word64 -> [Word8] -> Property
-propTxAddOutputRoundtrip sats scriptBytes = property $ do
- let script = scriptPubKey (BS.pack (take 100 scriptBytes))
- msg = TxAddOutput
- { txAddOutputChannelId = testChannelId
- , txAddOutputSerialId = serialId 54321
- , txAddOutputSats = Satoshi sats
- , txAddOutputScript = script
- }
- case encodeTxAddOutput msg of
- Left _ -> False
- Right encoded -> case decodeTxAddOutput encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxRemoveInput roundtrip
-propTxRemoveInputRoundtrip :: Word64 -> Property
-propTxRemoveInputRoundtrip sid = property $ do
- let msg = TxRemoveInput
- { txRemoveInputChannelId = testChannelId
- , txRemoveInputSerialId = serialId sid
- }
- encoded = encodeTxRemoveInput msg
- case decodeTxRemoveInput encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxRemoveOutput roundtrip
-propTxRemoveOutputRoundtrip :: Word64 -> Property
-propTxRemoveOutputRoundtrip sid = property $ do
- let msg = TxRemoveOutput
- { txRemoveOutputChannelId = testChannelId
- , txRemoveOutputSerialId = serialId sid
- }
- encoded = encodeTxRemoveOutput msg
- case decodeTxRemoveOutput encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxComplete roundtrip
-propTxCompleteRoundtrip :: Property
-propTxCompleteRoundtrip = property $ do
- let msg = TxComplete { txCompleteChannelId = testChannelId }
- encoded = encodeTxComplete msg
- case decodeTxComplete encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxSignatures roundtrip with varying witnesses
-propTxSignaturesRoundtrip :: [[Word8]] -> Property
-propTxSignaturesRoundtrip witnessList = property $ do
- let wits = map (Witness . BS.pack . take 200) (take 10 witnessList)
- msg = TxSignatures
- { txSignaturesChannelId = testChannelId
- , txSignaturesTxid = testTxId
- , txSignaturesWitnesses = wits
- }
- case encodeTxSignatures msg of
- Left _ -> False
- Right encoded -> case decodeTxSignatures encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxInitRbf roundtrip
-propTxInitRbfRoundtrip :: Word32 -> Word32 -> Property
-propTxInitRbfRoundtrip locktime feerate = property $ do
- let msg = TxInitRbf
- { txInitRbfChannelId = testChannelId
- , txInitRbfLocktime = locktime
- , txInitRbfFeerate = feerate
- , txInitRbfTlvs = emptyTlvs
- }
- encoded = encodeTxInitRbf msg
- case decodeTxInitRbf encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxAckRbf roundtrip
-propTxAckRbfRoundtrip :: Property
-propTxAckRbfRoundtrip = property $ do
- let msg = TxAckRbf
- { txAckRbfChannelId = testChannelId
- , txAckRbfTlvs = emptyTlvs
- }
- encoded = encodeTxAckRbf msg
- case decodeTxAckRbf encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: TxAbort roundtrip
-propTxAbortRoundtrip :: [Word8] -> Property
-propTxAbortRoundtrip dataBytes = property $ do
- let abortData = BS.pack (take 1000 dataBytes)
- msg = TxAbort
- { txAbortChannelId = testChannelId
- , txAbortData = abortData
- }
- case encodeTxAbort msg of
- Left _ -> False
- Right encoded -> case decodeTxAbort encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: Stfu roundtrip
-propStfuRoundtrip :: Bool -> Property
-propStfuRoundtrip isInit = property $ do
- let ini = if isInit then IsInitiator else NotInitiator
- msg = Stfu
- { stfuChannelId = testChannelId
- , stfuInitiator = ini
- }
- encoded = encodeStfu msg
- case decodeStfu encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: Shutdown roundtrip
-propShutdownRoundtrip :: [Word8] -> Property
-propShutdownRoundtrip scriptBytes = property $ do
- let script = scriptPubKey (BS.pack (take 100 scriptBytes))
- msg = Shutdown
- { shutdownChannelId = testChannelId
- , shutdownScriptPubkey = script
- }
- case encodeShutdown msg of
- Left _ -> False
- Right encoded -> case decodeShutdown encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: ClosingSigned roundtrip
-propClosingSignedRoundtrip :: Word64 -> Property
-propClosingSignedRoundtrip feeSats = property $ do
- let msg = ClosingSigned
- { closingSignedChannelId = testChannelId
- , closingSignedFeeSatoshi = Satoshi feeSats
- , closingSignedSignature = testSignature
- , closingSignedTlvs = emptyTlvs
- }
- encoded = encodeClosingSigned msg
- case decodeClosingSigned encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: ClosingComplete roundtrip
-propClosingCompleteRoundtrip :: Word64 -> Word32 -> Property
-propClosingCompleteRoundtrip feeSats locktime = property $ do
- let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xcc)
- closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xdd)
- msg = ClosingComplete
- { closingCompleteChannelId = testChannelId
- , closingCompleteCloserScript = closerScript
- , closingCompleteCloseeScript = closeeScript
- , closingCompleteFeeSatoshi = Satoshi feeSats
- , closingCompleteLocktime = locktime
- , closingCompleteTlvs = emptyTlvs
- }
- case encodeClosingComplete msg of
- Left _ -> False
- Right encoded -> case decodeClosingComplete encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: ClosingSig roundtrip
-propClosingSigRoundtrip :: Word64 -> Word32 -> Property
-propClosingSigRoundtrip feeSats locktime = property $ do
- let closerScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xee)
- closeeScript = scriptPubKey (BS.pack [0x00, 0x14] <>
- BS.replicate 20 0xff)
- msg = ClosingSig
- { closingSigChannelId = testChannelId
- , closingSigCloserScript = closerScript
- , closingSigCloseeScript = closeeScript
- , closingSigFeeSatoshi = Satoshi feeSats
- , closingSigLocktime = locktime
- , closingSigTlvs = emptyTlvs
- }
- case encodeClosingSig msg of
- Left _ -> False
- Right encoded -> case decodeClosingSig encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: UpdateAddHtlc roundtrip
-propUpdateAddHtlcRoundtrip :: Word64 -> Word64 -> Word32 -> Property
-propUpdateAddHtlcRoundtrip hid amountMsat cltvExpiry = property $ do
- let msg = UpdateAddHtlc
- { updateAddHtlcChannelId = testChannelId
- , updateAddHtlcId = htlcId hid
- , updateAddHtlcAmountMsat = MilliSatoshi amountMsat
- , updateAddHtlcPaymentHash = testPaymentHash
- , updateAddHtlcCltvExpiry = cltvExpiry
- , updateAddHtlcOnionPacket = testOnionPacket
- , updateAddHtlcTlvs = emptyTlvs
- }
- encoded = encodeUpdateAddHtlc msg
- case decodeUpdateAddHtlc encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: UpdateFulfillHtlc roundtrip
-propUpdateFulfillHtlcRoundtrip :: Word64 -> Property
-propUpdateFulfillHtlcRoundtrip hid = property $ do
- let msg = UpdateFulfillHtlc
- { updateFulfillHtlcChannelId = testChannelId
- , updateFulfillHtlcId = htlcId hid
- , updateFulfillHtlcPaymentPreimage = testPaymentPreimage
- , updateFulfillHtlcTlvs = emptyTlvs
- }
- encoded = encodeUpdateFulfillHtlc msg
- case decodeUpdateFulfillHtlc encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: UpdateFailHtlc roundtrip
-propUpdateFailHtlcRoundtrip :: Word64 -> [Word8] -> Property
-propUpdateFailHtlcRoundtrip hid reasonBytes = property $ do
- let failReason = BS.pack (take 1000 reasonBytes)
- msg = UpdateFailHtlc
- { updateFailHtlcChannelId = testChannelId
- , updateFailHtlcId = htlcId hid
- , updateFailHtlcReason = failReason
- , updateFailHtlcTlvs = emptyTlvs
- }
- case encodeUpdateFailHtlc msg of
- Left _ -> False
- Right encoded -> case decodeUpdateFailHtlc encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: UpdateFailMalformedHtlc roundtrip
-propUpdateFailMalformedHtlcRoundtrip :: Word64 -> Word16 -> Property
-propUpdateFailMalformedHtlcRoundtrip hid failCode = property $ do
- let msg = UpdateFailMalformedHtlc
- { updateFailMalformedHtlcChannelId = testChannelId
- , updateFailMalformedHtlcId = htlcId hid
- , updateFailMalformedHtlcSha256Onion = testPaymentHash
- , updateFailMalformedHtlcFailureCode = failCode
- }
- encoded = encodeUpdateFailMalformedHtlc msg
- case decodeUpdateFailMalformedHtlc encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: CommitmentSigned roundtrip with varying HTLC count
-propCommitmentSignedRoundtrip :: NonNegative Int -> Property
-propCommitmentSignedRoundtrip (NonNegative n) = property $ do
- let numHtlcs = n `mod` 10 -- limit to 10 HTLCs for test speed
- htlcSigs = replicate numHtlcs testSignature
- msg = CommitmentSigned
- { commitmentSignedChannelId = testChannelId
- , commitmentSignedSignature = testSignature
- , commitmentSignedHtlcSignatures = htlcSigs
- }
- case encodeCommitmentSigned msg of
- Left _ -> False
- Right encoded -> case decodeCommitmentSigned encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: RevokeAndAck roundtrip
-propRevokeAndAckRoundtrip :: Property
-propRevokeAndAckRoundtrip = property $ do
- let msg = RevokeAndAck
- { revokeAndAckChannelId = testChannelId
- , revokeAndAckPerCommitmentSecret = testSecret
- , revokeAndAckNextPerCommitPoint = testPoint
- }
- encoded = encodeRevokeAndAck msg
- case decodeRevokeAndAck encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: UpdateFee roundtrip
-propUpdateFeeRoundtrip :: Word32 -> Property
-propUpdateFeeRoundtrip feerate = property $ do
- let msg = UpdateFee
- { updateFeeChannelId = testChannelId
- , updateFeeFeeratePerKw = feerate
- }
- encoded = encodeUpdateFee msg
- case decodeUpdateFee encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: ChannelReestablish roundtrip
-propChannelReestablishRoundtrip :: Word64 -> Word64 -> Property
-propChannelReestablishRoundtrip nextCommit nextRevoke = property $ do
- let sec = fromJust $ perCommitmentSecret (BS.replicate 32 0x22)
- msg = ChannelReestablish
- { channelReestablishChannelId = testChannelId
- , channelReestablishNextCommitNum = nextCommit
- , channelReestablishNextRevocationNum = nextRevoke
- , channelReestablishYourLastCommitSecret = sec
- , channelReestablishMyCurrentCommitPoint = testPoint
- , channelReestablishTlvs = emptyTlvs
- }
- encoded = encodeChannelReestablish msg
- case decodeChannelReestablish encoded of
- Right (decoded, _) -> decoded == msg
- Left _ -> False
-
--- Property: HtlcId wrap/unwrap
-propHtlcIdRoundtrip :: Word64 -> Property
-propHtlcIdRoundtrip w = property $ unHtlcId (htlcId w) == w
-
--- Property: SerialId wrap/unwrap
-propSerialIdRoundtrip :: Word64 -> Property
-propSerialIdRoundtrip w = property $ unSerialId (serialId w) == w
-
--- Property: OnionPacket validates length (1366 only)
-propOnionPacketLength :: NonNegative Int -> Property
-propOnionPacketLength (NonNegative n) = property $
- let len = n `mod` 2000
- bs = BS.replicate len 0x00
- in case onionPacket bs of
- Just _ -> len == onionPacketLen
- Nothing -> len /= onionPacketLen
-
--- Property: TxId validates length (32 only)
-propTxIdLength :: NonNegative Int -> Property
-propTxIdLength (NonNegative n) = property $
- let len = n `mod` 100
- bs = BS.replicate len 0x00
- in case mkTxId bs of
- Just _ -> len == 32
- Nothing -> len /= 32
-
--- Helpers ---------------------------------------------------------------------
-
--- | Decode hex string. Returns Nothing on invalid hex.
-unhex :: BS.ByteString -> Maybe BS.ByteString
-unhex = B16.decode
+apply_edit :: Edit -> BS.ByteString -> BS.ByteString
+apply_edit e bs = case e of
+ Replace i b
+ | BS.null bs -> bs
+ | otherwise ->
+ let j = i `mod` BS.length bs
+ in BS.take j bs <> BS.singleton b <> BS.drop (j + 1) bs
+ Truncate i
+ | BS.null bs -> bs
+ | otherwise -> BS.take (i `mod` BS.length bs) bs
+ Append x -> bs <> x
+
+properties :: TestTree
+properties = testGroup "properties" [
+ testGroup "payloads round-trip" [
+ roundtrip "open_channel" gen_open_channel
+ encode_open_channel decode_open_channel
+ , roundtrip "accept_channel" gen_accept_channel
+ encode_accept_channel decode_accept_channel
+ , roundtrip "funding_created" gen_funding_created
+ (Right . encode_funding_created) decode_funding_created
+ , roundtrip "funding_signed" gen_funding_signed
+ (Right . encode_funding_signed) decode_funding_signed
+ , roundtrip "channel_ready" gen_channel_ready
+ encode_channel_ready decode_channel_ready
+ , roundtrip "open_channel2" gen_open_channel2
+ encode_open_channel2 decode_open_channel2
+ , roundtrip "accept_channel2" gen_accept_channel2
+ encode_accept_channel2 decode_accept_channel2
+ , roundtrip "tx_add_input" gen_tx_add_input
+ encode_tx_add_input decode_tx_add_input
+ , roundtrip "tx_add_output" gen_tx_add_output
+ (Right . encode_tx_add_output) decode_tx_add_output
+ , roundtrip "tx_remove_input" gen_tx_remove_input
+ (Right . encode_tx_remove_input) decode_tx_remove_input
+ , roundtrip "tx_remove_output" gen_tx_remove_output
+ (Right . encode_tx_remove_output) decode_tx_remove_output
+ , roundtrip "tx_complete" gen_tx_complete
+ (Right . encode_tx_complete) decode_tx_complete
+ , roundtrip "tx_signatures" gen_tx_signatures
+ encode_tx_signatures decode_tx_signatures
+ , roundtrip "tx_init_rbf" gen_tx_init_rbf
+ encode_tx_init_rbf decode_tx_init_rbf
+ , roundtrip "tx_ack_rbf" gen_tx_ack_rbf
+ encode_tx_ack_rbf decode_tx_ack_rbf
+ , roundtrip "tx_abort" gen_tx_abort encode_tx_abort decode_tx_abort
+ , roundtrip "stfu" gen_stfu (Right . encode_stfu) decode_stfu
+ , roundtrip "shutdown" gen_shutdown
+ (Right . encode_shutdown) decode_shutdown
+ , roundtrip "closing_complete" gen_closing_complete
+ encode_closing_complete decode_closing_complete
+ , roundtrip "closing_sig" gen_closing_sig
+ encode_closing_sig decode_closing_sig
+ , roundtrip "closing_signed" gen_closing_signed
+ encode_closing_signed decode_closing_signed
+ , roundtrip "update_add_htlc" gen_update_add_htlc
+ encode_update_add_htlc decode_update_add_htlc
+ , roundtrip "update_fulfill_htlc" gen_update_fulfill_htlc
+ encode_update_fulfill_htlc decode_update_fulfill_htlc
+ , roundtrip "update_fail_htlc" gen_update_fail_htlc
+ encode_update_fail_htlc decode_update_fail_htlc
+ , roundtrip "update_fail_malformed_htlc" gen_update_fail_malformed_htlc
+ (Right . encode_update_fail_malformed_htlc)
+ decode_update_fail_malformed_htlc
+ , roundtrip "commitment_signed" gen_commitment_signed
+ encode_commitment_signed decode_commitment_signed
+ , roundtrip "revoke_and_ack" gen_revoke_and_ack
+ (Right . encode_revoke_and_ack) decode_revoke_and_ack
+ , roundtrip "update_fee" gen_update_fee
+ (Right . encode_update_fee) decode_update_fee
+ , roundtrip "channel_reestablish" gen_channel_reestablish
+ encode_channel_reestablish decode_channel_reestablish
+ ]
+ , roundtrip "messages round-trip" gen_message encode_message decode_message
+ , testProperty "decoded messages re-encode exactly" $
+ withMaxSuccess 2000 $
+ forAll gen_message $ \m -> forAll gen_edit $ \e ->
+ case encode_message m of
+ Left err -> counterexample ("encode failed: " ++ show err) False
+ Right w ->
+ let w' = apply_edit e w
+ in case decode_message w' of
+ Left _ -> property True
+ Right m' -> encode_message m' === Right w'
+ ]
