ppad-bolt2 0.0.1 → 0.1.0

raw patch · 10 files changed

+3715/−4263 lines, 10 filesdep +ppad-bolt9dep +ppad-txdep ~deepseqdep ~ppad-bolt1PVP ok

version bump matches the API change (PVP)

Dependencies added: ppad-bolt9, ppad-tx

Dependency ranges changed: deepseq, ppad-bolt1

API changes (from Hackage documentation)

Files

• CHANGELOG +39/−1
• bench/Fixtures.hs +126/−0
• bench/Main.hs +55/−291
• bench/Weight.hs +43/−338
• lib/Lightning/Protocol/BOLT2.hs +168/−109
• lib/Lightning/Protocol/BOLT2/Codec.hs +1388/−1347
• lib/Lightning/Protocol/BOLT2/Messages.hs +429/−429
• lib/Lightning/Protocol/BOLT2/Types.hs +146/−452
• ppad-bolt2.cabal +17/−8
• test/Main.hs +1304/−1288

@@ -1,4 +1,42 @@ # Changelog -- 0.0.1 (2025-01-25)+- 0.1.0 (2026-10-10)+  * A substantial rewrite against ppad-bolt1 0.1.0, with breaking+    changes throughout:++    * The API is exported from Lightning.Protocol.BOLT2 alone, and uses+      snake_case names, with record fields prefixed by their message's+      name (e.g. encode_open_channel, open_channel_funding_satoshis).++    * Payload decoders have type ByteString -> Either DecodeError a and+      consume their whole input; encoders return Either EncodeError+      ByteString only where they can fail. A Message type, with+      message_type, encode_message and decode_message, handles complete+      messages.++    * Every message has a TLV stream. Known TLV records are typed fields+      (channel_type is a ppad-bolt9 feature vector), unknown even records+      are rejected, and unknown odd records are kept, so encoding a+      decoded message reproduces its bytes.++    * Amounts use ppad-bolt1's bounded Satoshi and MilliSatoshi, except+      max_htlc_value_in_flight_msat. Types from ppad-bolt1 and ppad-tx+      are no longer re-exported.++    * OnionPacket is renamed OnionRoutingPacket and checks its length;+      ScriptPubKey and Witness are bounded at 65535 bytes; FeatureBits,+      Initiator and MsgType are removed; OnionHash, AttributionData,+      FeeRange and NextFunding are added.++  * Catches up with BOLT #2 as of lightning/bolts 1aadb719:+    channel_reestablish's next_funding moves to TLV type 1, and+    update_fulfill_htlc (fulfillment_payload), commitment_signed+    (funding_txid), tx_add_input and tx_signatures gain TLV streams.++  * Fixes decoding, which accepted unknown even TLV types, didn't check+    known TLV values, point prefixes or amounts, and ignored trailing+    bytes on some messages; and encoding, which accepted malformed+    field values.++- 0.0.1 (2026-04-18)   * Initial release.

@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}++module Fixtures (+    Fixtures(..)+  , fixtures+  ) where++import qualified Bitcoin.Prim.Tx as Tx+import qualified Data.ByteString as BS+import qualified Lightning.Protocol.BOLT1 as BOLT1+import Lightning.Protocol.BOLT2+import qualified Lightning.Protocol.BOLT9 as BOLT9++-- representative messages, with their encoded payloads+data Fixtures = Fixtures+  { fx_open_channel                :: !OpenChannel+  , fx_open_channel_bytes          :: !BS.ByteString+  , fx_accept_channel2             :: !AcceptChannel2+  , fx_accept_channel2_bytes       :: !BS.ByteString+  , fx_tx_signatures               :: !TxSignatures+  , fx_tx_signatures_bytes         :: !BS.ByteString+  , fx_closing_complete            :: !ClosingComplete+  , fx_closing_complete_bytes      :: !BS.ByteString+  , fx_update_add_htlc             :: !UpdateAddHtlc+  , fx_update_add_htlc_bytes       :: !BS.ByteString+  , fx_update_add_htlc_wire        :: !BS.ByteString+  , fx_update_fulfill_htlc         :: !UpdateFulfillHtlc+  , fx_update_fulfill_htlc_bytes   :: !BS.ByteString+  , fx_commitment_signed           :: !CommitmentSigned+  , fx_commitment_signed_bytes     :: !BS.ByteString+  , fx_commitment_signed_483       :: !CommitmentSigned+  , fx_commitment_signed_483_bytes :: !BS.ByteString+  , fx_revoke_and_ack              :: !RevokeAndAck+  , fx_revoke_and_ack_bytes        :: !BS.ByteString+  , fx_channel_reestablish         :: !ChannelReestablish+  , fx_channel_reestablish_bytes   :: !BS.ByteString+  }++ok :: Either e a -> Maybe a+ok = either (const Nothing) Just++empty :: BOLT1.TlvStream+empty = BOLT1.empty_tlv_stream++fixtures :: Maybe Fixtures+fixtures = do+  ch   <- BOLT1.chain_hash (BS.replicate 32 0x6f)+  cid  <- BOLT1.channel_id (BS.replicate 32 0xab)+  pts  <- traverse (\b -> BOLT1.point (BS.cons 0x02 (BS.replicate 32 b)))+            [0x11, 0x22, 0x33, 0x44, 0x55, 0x66, 0x77]+  sig  <- BOLT1.signature (BS.replicate 64 0xa1)+  txid <- Tx.mk_txid (BS.replicate 32 0x7e)+  spk  <- script_pubkey ("\x00\x14" <> BS.replicate 20 0x88)+  fund <- BOLT1.satoshi 1000000+  dust <- BOLT1.satoshi 546+  res  <- BOLT1.satoshi 10000+  push <- BOLT1.milli_satoshi 0+  hmin <- BOLT1.milli_satoshi 1000+  amt  <- BOLT1.milli_satoshi 100000+  fee  <- BOLT1.satoshi 500+  ph   <- BOLT1.payment_hash (BS.replicate 32 0x9a)+  pre  <- BOLT1.payment_preimage (BS.replicate 32 0x50)+  sec  <- BOLT1.per_commitment_secret (BS.replicate 32 0x5e)+  onion <- onion_routing_packet (BS.replicate 1366 0x44)+  att  <- attribution_data (BS.replicate 920 0x0b)+  ws   <- traverse witness+            [ "\x02\x47" <> BS.replicate 71 0x30 <> "\x21"+                <> BS.replicate 33 0x02+            , "\x01\x40" <> BS.replicate 64 0x01 ]+  ext  <- BOLT1.tlv_stream [BOLT1.TlvRecord 43 (BS.replicate 16 0x2a)]+  (p1, p2, p3, p4, p5, p6, p7) <- case pts of+    [a, b, c, d, e, f, g] -> Just (a, b, c, d, e, f, g)+    _ -> Nothing+  let ctype = BOLT9.channel_type_features+        (BOLT9.ChannelType BOLT9.BasicAnchors False False)++      oc = OpenChannel ch cid fund push dust maxBound res hmin 253 144 483+             p1 p2 p3 p4 p5 p6 1 (Just spk) (Just ctype) empty+      ac2 = AcceptChannel2 cid fund dust maxBound hmin 3 144 483+              p1 p2 p3 p4 p5 p6 p7 (Just spk) (Just ctype) True ext+      txs = TxSignatures cid txid ws empty+      cc = ClosingComplete cid spk spk fee 0 (Just sig) Nothing (Just sig)+             empty+      add = UpdateAddHtlc cid (HtlcId 42) amt ph 800000 onion (Just p1)+              empty+      ful = UpdateFulfillHtlc cid (HtlcId 42) pre (Just att) Nothing empty+      cs0 = CommitmentSigned cid sig [] (Just txid) empty+      cs483 = CommitmentSigned cid sig (replicate 483 sig) (Just txid)+                empty+      raa = RevokeAndAck cid sec p1 empty+      rst = ChannelReestablish cid 5 4 sec p1 (Just (NextFunding txid 1))+              empty++  oc_b   <- ok (encode_open_channel oc)+  ac2_b  <- ok (encode_accept_channel2 ac2)+  txs_b  <- ok (encode_tx_signatures txs)+  cc_b   <- ok (encode_closing_complete cc)+  add_b  <- ok (encode_update_add_htlc add)+  add_w  <- ok (encode_message (MsgUpdateAddHtlc add))+  ful_b  <- ok (encode_update_fulfill_htlc ful)+  cs0_b  <- ok (encode_commitment_signed cs0)+  cs483_b <- ok (encode_commitment_signed cs483)+  rst_b  <- ok (encode_channel_reestablish rst)+  pure Fixtures+    { fx_open_channel                = oc+    , fx_open_channel_bytes          = oc_b+    , fx_accept_channel2             = ac2+    , fx_accept_channel2_bytes       = ac2_b+    , fx_tx_signatures               = txs+    , fx_tx_signatures_bytes         = txs_b+    , fx_closing_complete            = cc+    , fx_closing_complete_bytes      = cc_b+    , fx_update_add_htlc             = add+    , fx_update_add_htlc_bytes       = add_b+    , fx_update_add_htlc_wire        = add_w+    , fx_update_fulfill_htlc         = ful+    , fx_update_fulfill_htlc_bytes   = ful_b+    , fx_commitment_signed           = cs0+    , fx_commitment_signed_bytes     = cs0_b+    , fx_commitment_signed_483       = cs483+    , fx_commitment_signed_483_bytes = cs483_b+    , fx_revoke_and_ack              = raa+    , fx_revoke_and_ack_bytes        = encode_revoke_and_ack raa+    , fx_channel_reestablish         = rst+    , fx_channel_reestablish_bytes   = rst_b+    }

@@ -1,301 +1,65 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}---- |--- Module: Main--- Copyright: (c) 2025 Jared Tobin--- License: MIT--- Maintainer: Jared Tobin <jared@ppad.tech>------ Criterion timing benchmarks for BOLT #2 message codecs.- module Main where  import Criterion.Main-import qualified Data.ByteString as BS-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)+import Fixtures import Lightning.Protocol.BOLT2 --- Test data construction ---------------------------------------------------------- | 32 zero bytes for channel IDs, chain hashes, etc.-zeroBytes32 :: BS.ByteString-zeroBytes32 = BS.replicate 32 0x00-{-# NOINLINE zeroBytes32 #-}---- | 33-byte compressed public key (02 prefix + 32 zero bytes).-testPoint :: Point-testPoint = case point (BS.cons 0x02 zeroBytes32) of-  Just p  -> p-  Nothing -> error "testPoint: invalid"-{-# NOINLINE testPoint #-}---- | 64-byte signature.-testSignature :: Signature-testSignature = case signature (BS.replicate 64 0x01) of-  Just s  -> s-  Nothing -> error "testSignature: invalid"-{-# NOINLINE testSignature #-}---- | 32-byte channel ID.-testChannelId :: ChannelId-testChannelId = case channelId zeroBytes32 of-  Just c  -> c-  Nothing -> error "testChannelId: invalid"-{-# NOINLINE testChannelId #-}---- | 32-byte chain hash.-testChainHash :: ChainHash-testChainHash = case chainHash zeroBytes32 of-  Just h  -> h-  Nothing -> error "testChainHash: invalid"-{-# NOINLINE testChainHash #-}---- | 32-byte txid.-testTxId :: TxId-testTxId = case txId zeroBytes32 of-  Just t  -> t-  Nothing -> error "testTxId: invalid"-{-# NOINLINE testTxId #-}---- | 32-byte payment hash.-testPaymentHash :: PaymentHash-testPaymentHash = case paymentHash zeroBytes32 of-  Just h  -> h-  Nothing -> error "testPaymentHash: invalid"-{-# NOINLINE testPaymentHash #-}---- | 1366-byte onion packet.-testOnionPacket :: OnionPacket-testOnionPacket = case onionPacket (BS.replicate 1366 0x00) of-  Just o  -> o-  Nothing -> error "testOnionPacket: invalid"-{-# NOINLINE testOnionPacket #-}---- | Empty TLV stream.-emptyTlvs :: TlvStream-emptyTlvs = unsafeTlvStream []-{-# NOINLINE emptyTlvs #-}---- V1 messages --------------------------------------------------------------------- | Test OpenChannel message.-testOpenChannel :: OpenChannel-testOpenChannel = OpenChannel-  { openChannelChainHash            = testChainHash-  , openChannelTempChannelId        = testChannelId-  , openChannelFundingSatoshis      = Satoshis 1000000-  , openChannelPushMsat             = MilliSatoshis 0-  , openChannelDustLimitSatoshis    = Satoshis 546-  , openChannelMaxHtlcValueInFlight = MilliSatoshis 1000000000-  , openChannelChannelReserveSat    = Satoshis 10000-  , openChannelHtlcMinimumMsat      = MilliSatoshis 1000-  , openChannelFeeratePerKw         = 250-  , openChannelToSelfDelay          = 144-  , openChannelMaxAcceptedHtlcs     = 30-  , openChannelFundingPubkey        = testPoint-  , openChannelRevocationBasepoint  = testPoint-  , openChannelPaymentBasepoint     = testPoint-  , openChannelDelayedPaymentBase   = testPoint-  , openChannelHtlcBasepoint        = testPoint-  , openChannelFirstPerCommitPoint  = testPoint-  , openChannelChannelFlags         = 0x00-  , openChannelTlvs                 = emptyTlvs-  }-{-# NOINLINE testOpenChannel #-}---- | Encoded OpenChannel for decode benchmarks.-encodedOpenChannel :: BS.ByteString-encodedOpenChannel = encodeOpenChannel testOpenChannel-{-# NOINLINE encodedOpenChannel #-}---- V2 messages --------------------------------------------------------------------- | Test OpenChannel2 message.-testOpenChannel2 :: OpenChannel2-testOpenChannel2 = OpenChannel2-  { openChannel2ChainHash            = testChainHash-  , openChannel2TempChannelId        = testChannelId-  , openChannel2FundingFeeratePerkw  = 2500-  , openChannel2CommitFeeratePerkw   = 250-  , openChannel2FundingSatoshis      = Satoshis 1000000-  , openChannel2DustLimitSatoshis    = Satoshis 546-  , openChannel2MaxHtlcValueInFlight = MilliSatoshis 1000000000-  , openChannel2HtlcMinimumMsat      = MilliSatoshis 1000-  , openChannel2ToSelfDelay          = 144-  , openChannel2MaxAcceptedHtlcs     = 30-  , openChannel2Locktime             = 0-  , openChannel2FundingPubkey        = testPoint-  , openChannel2RevocationBasepoint  = testPoint-  , openChannel2PaymentBasepoint     = testPoint-  , openChannel2DelayedPaymentBase   = testPoint-  , openChannel2HtlcBasepoint        = testPoint-  , openChannel2FirstPerCommitPoint  = testPoint-  , openChannel2SecondPerCommitPoint = testPoint-  , openChannel2ChannelFlags         = 0x00-  , openChannel2Tlvs                 = emptyTlvs-  }-{-# NOINLINE testOpenChannel2 #-}---- | Encoded OpenChannel2 for decode benchmarks.-encodedOpenChannel2 :: BS.ByteString-encodedOpenChannel2 = encodeOpenChannel2 testOpenChannel2-{-# NOINLINE encodedOpenChannel2 #-}---- | Test witness data (simulated P2WPKH signature + pubkey).-testWitness :: Witness-testWitness = Witness (BS.replicate 107 0xab)-{-# NOINLINE testWitness #-}---- | TxSignatures with multiple witnesses.-testTxSignatures :: TxSignatures-testTxSignatures = TxSignatures-  { txSignaturesChannelId = testChannelId-  , txSignaturesTxid      = testTxId-  , txSignaturesWitnesses = replicate 5 testWitness-  }-{-# NOINLINE testTxSignatures #-}---- | Encoded TxSignatures for decode benchmarks.-encodedTxSignatures :: BS.ByteString-encodedTxSignatures = case encodeTxSignatures testTxSignatures of-  Right bs -> bs-  Left e   -> error $ "encodedTxSignatures: " ++ show e-{-# NOINLINE encodedTxSignatures #-}---- Close messages ------------------------------------------------------------------ | Test ClosingSigned message.-testClosingSigned :: ClosingSigned-testClosingSigned = ClosingSigned-  { closingSignedChannelId   = testChannelId-  , closingSignedFeeSatoshis = Satoshis 1000-  , closingSignedSignature   = testSignature-  , closingSignedTlvs        = emptyTlvs-  }-{-# NOINLINE testClosingSigned #-}---- | Encoded ClosingSigned for decode benchmarks.-encodedClosingSigned :: BS.ByteString-encodedClosingSigned = encodeClosingSigned testClosingSigned-{-# NOINLINE encodedClosingSigned #-}---- Normal operation messages ------------------------------------------------------- | Test UpdateAddHtlc message.-testUpdateAddHtlc :: UpdateAddHtlc-testUpdateAddHtlc = UpdateAddHtlc-  { updateAddHtlcChannelId   = testChannelId-  , updateAddHtlcId          = 0-  , updateAddHtlcAmountMsat  = MilliSatoshis 10000000-  , updateAddHtlcPaymentHash = testPaymentHash-  , updateAddHtlcCltvExpiry  = 800000-  , updateAddHtlcOnionPacket = testOnionPacket-  , updateAddHtlcTlvs        = emptyTlvs-  }-{-# NOINLINE testUpdateAddHtlc #-}---- | Encoded UpdateAddHtlc for decode benchmarks.-encodedUpdateAddHtlc :: BS.ByteString-encodedUpdateAddHtlc = encodeUpdateAddHtlc testUpdateAddHtlc-{-# NOINLINE encodedUpdateAddHtlc #-}---- | Test CommitmentSigned message with HTLC signatures (10 sigs).-testCommitmentSigned :: CommitmentSigned-testCommitmentSigned = CommitmentSigned-  { commitmentSignedChannelId      = testChannelId-  , commitmentSignedSignature      = testSignature-  , commitmentSignedHtlcSignatures = replicate 10 testSignature-  }-{-# NOINLINE testCommitmentSigned #-}---- | Encoded CommitmentSigned for decode benchmarks.-encodedCommitmentSigned :: BS.ByteString-encodedCommitmentSigned = case encodeCommitmentSigned testCommitmentSigned of-  Right bs -> bs-  Left e   -> error $ "encodedCommitmentSigned: " ++ show e-{-# NOINLINE encodedCommitmentSigned #-}---- | Test CommitmentSigned with many HTLC signatures (100 sigs).-testCommitmentSignedLarge :: CommitmentSigned-testCommitmentSignedLarge = CommitmentSigned-  { commitmentSignedChannelId      = testChannelId-  , commitmentSignedSignature      = testSignature-  , commitmentSignedHtlcSignatures = replicate 100 testSignature-  }-{-# NOINLINE testCommitmentSignedLarge #-}---- | Encoded large CommitmentSigned for decode benchmarks.-encodedCommitmentSignedLarge :: BS.ByteString-encodedCommitmentSignedLarge =-  case encodeCommitmentSigned testCommitmentSignedLarge of-    Right bs -> bs-    Left e   -> error $ "encodedCommitmentSignedLarge: " ++ show e-{-# NOINLINE encodedCommitmentSignedLarge #-}---- | Test CommitmentSigned with max HTLC signatures (483 sigs).-testCommitmentSignedMax :: CommitmentSigned-testCommitmentSignedMax = CommitmentSigned-  { commitmentSignedChannelId      = testChannelId-  , commitmentSignedSignature      = testSignature-  , commitmentSignedHtlcSignatures = replicate 483 testSignature-  }-{-# NOINLINE testCommitmentSignedMax #-}---- | Encoded max CommitmentSigned for decode benchmarks.-encodedCommitmentSignedMax :: BS.ByteString-encodedCommitmentSignedMax =-  case encodeCommitmentSigned testCommitmentSignedMax of-    Right bs -> bs-    Left e   -> error $ "encodedCommitmentSignedMax: " ++ show e-{-# NOINLINE encodedCommitmentSignedMax #-}---- Benchmark groups ------------------------------------------------------------- main :: IO ()-main = defaultMain-  [ bgroup "v1"-      [ bgroup "open_channel"-          [ bench "encode" $ nf encodeOpenChannel testOpenChannel-          , bench "decode" $ nf decodeOpenChannel encodedOpenChannel-          ]+main = case fixtures of+  Nothing -> fail "invalid fixtures"+  Just fx -> defaultMain [+      bgroup "open_channel" [+        bench "encode" $ nf encode_open_channel (fx_open_channel fx)+      , bench "decode" $ nf decode_open_channel (fx_open_channel_bytes fx)       ]-  , bgroup "v2"-      [ bgroup "open_channel2"-          [ bench "encode" $ nf encodeOpenChannel2 testOpenChannel2-          , bench "decode" $ nf decodeOpenChannel2 encodedOpenChannel2-          ]-      , bgroup "tx_signatures"-          [ bench "encode" $ nf encodeTxSignatures testTxSignatures-          , bench "decode" $ nf decodeTxSignatures encodedTxSignatures-          ]+    , bgroup "accept_channel2" [+        bench "encode" $ nf encode_accept_channel2 (fx_accept_channel2 fx)+      , bench "decode" $+          nf decode_accept_channel2 (fx_accept_channel2_bytes fx)       ]-  , bgroup "close"-      [ bgroup "closing_signed"-          [ bench "encode" $ nf encodeClosingSigned testClosingSigned-          , bench "decode" $ nf decodeClosingSigned encodedClosingSigned-          ]+    , bgroup "tx_signatures" [+        bench "encode" $ nf encode_tx_signatures (fx_tx_signatures fx)+      , bench "decode" $ nf decode_tx_signatures (fx_tx_signatures_bytes fx)       ]-  , bgroup "normal"-      [ bgroup "update_add_htlc"-          [ bench "encode" $ nf encodeUpdateAddHtlc testUpdateAddHtlc-          , bench "decode" $ nf decodeUpdateAddHtlc encodedUpdateAddHtlc-          ]-      , bgroup "commitment_signed"-          [ bench "encode" $ nf encodeCommitmentSigned testCommitmentSigned-          , bench "decode" $ nf decodeCommitmentSigned encodedCommitmentSigned-          ]-      , bgroup "commitment_signed_100"-          [ bench "encode" $-              nf encodeCommitmentSigned testCommitmentSignedLarge-          , bench "decode" $-              nf decodeCommitmentSigned encodedCommitmentSignedLarge-          ]-      , bgroup "commitment_signed_483"-          [ bench "encode" $-              nf encodeCommitmentSigned testCommitmentSignedMax-          , bench "decode" $-              nf decodeCommitmentSigned encodedCommitmentSignedMax-          ]+    , bgroup "closing_complete" [+        bench "encode" $ nf encode_closing_complete (fx_closing_complete fx)+      , bench "decode" $+          nf decode_closing_complete (fx_closing_complete_bytes fx)       ]-  ]+    , bgroup "update_add_htlc" [+        bench "encode" $ nf encode_update_add_htlc (fx_update_add_htlc fx)+      , bench "decode" $+          nf decode_update_add_htlc (fx_update_add_htlc_bytes fx)+      , bench "encode_message" $+          nf encode_message (MsgUpdateAddHtlc (fx_update_add_htlc fx))+      , bench "decode_message" $+          nf decode_message (fx_update_add_htlc_wire fx)+      ]+    , bgroup "update_fulfill_htlc" [+        bench "encode" $+          nf encode_update_fulfill_htlc (fx_update_fulfill_htlc fx)+      , bench "decode" $+          nf decode_update_fulfill_htlc (fx_update_fulfill_htlc_bytes fx)+      ]+    , bgroup "commitment_signed" [+        bench "encode (0 htlcs)" $+          nf encode_commitment_signed (fx_commitment_signed fx)+      , bench "decode (0 htlcs)" $+          nf decode_commitment_signed (fx_commitment_signed_bytes fx)+      , bench "encode (483 htlcs)" $+          nf encode_commitment_signed (fx_commitment_signed_483 fx)+      , bench "decode (483 htlcs)" $+          nf decode_commitment_signed (fx_commitment_signed_483_bytes fx)+      ]+    , bgroup "revoke_and_ack" [+        bench "encode" $ nf encode_revoke_and_ack (fx_revoke_and_ack fx)+      , bench "decode" $+          nf decode_revoke_and_ack (fx_revoke_and_ack_bytes fx)+      ]+    , bgroup "channel_reestablish" [+        bench "encode" $+          nf encode_channel_reestablish (fx_channel_reestablish fx)+      , bench "decode" $+          nf decode_channel_reestablish (fx_channel_reestablish_bytes fx)+      ]+    ]

@@ -1,344 +1,49 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}---- |--- Module: Main--- Copyright: (c) 2025 Jared Tobin--- License: MIT--- Maintainer: Jared Tobin <jared@ppad.tech>------ Weigh allocation benchmarks for BOLT #2 message codecs.- module Main where -import qualified Data.ByteString as BS-import Lightning.Protocol.BOLT1 (TlvStream, unsafeTlvStream)+import Fixtures import Lightning.Protocol.BOLT2 import Weigh --- | Wrapper for encoding functions that return Either.-forceEncode :: Either EncodeError BS.ByteString -> BS.ByteString-forceEncode (Right bs) = bs-forceEncode (Left e)   = error $ "forceEncode: " ++ show e-{-# INLINE forceEncode #-}---- Test data construction ---------------------------------------------------------- | 32 zero bytes for channel IDs, chain hashes, etc.-zeroBytes32 :: BS.ByteString-zeroBytes32 = BS.replicate 32 0x00-{-# NOINLINE zeroBytes32 #-}---- | 33-byte compressed public key (02 prefix + 32 zero bytes).-testPoint :: Point-testPoint = case point (BS.cons 0x02 zeroBytes32) of-  Just p  -> p-  Nothing -> error "testPoint: invalid"-{-# NOINLINE testPoint #-}---- | 64-byte signature.-testSignature :: Signature-testSignature = case signature (BS.replicate 64 0x01) of-  Just s  -> s-  Nothing -> error "testSignature: invalid"-{-# NOINLINE testSignature #-}---- | 32-byte channel ID.-testChannelId :: ChannelId-testChannelId = case channelId zeroBytes32 of-  Just c  -> c-  Nothing -> error "testChannelId: invalid"-{-# NOINLINE testChannelId #-}---- | 32-byte chain hash.-testChainHash :: ChainHash-testChainHash = case chainHash zeroBytes32 of-  Just h  -> h-  Nothing -> error "testChainHash: invalid"-{-# NOINLINE testChainHash #-}---- | 32-byte txid.-testTxId :: TxId-testTxId = case txId zeroBytes32 of-  Just t  -> t-  Nothing -> error "testTxId: invalid"-{-# NOINLINE testTxId #-}---- | 32-byte payment hash.-testPaymentHash :: PaymentHash-testPaymentHash = case paymentHash zeroBytes32 of-  Just h  -> h-  Nothing -> error "testPaymentHash: invalid"-{-# NOINLINE testPaymentHash #-}---- | 1366-byte onion packet.-testOnionPacket :: OnionPacket-testOnionPacket = case onionPacket (BS.replicate 1366 0x00) of-  Just o  -> o-  Nothing -> error "testOnionPacket: invalid"-{-# NOINLINE testOnionPacket #-}---- | Empty TLV stream.-emptyTlvs :: TlvStream-emptyTlvs = unsafeTlvStream []-{-# NOINLINE emptyTlvs #-}---- Message constructors ------------------------------------------------------------ | Construct OpenChannel message.-mkOpenChannel :: ChainHash -> ChannelId -> Point -> TlvStream -> OpenChannel-mkOpenChannel !ch !cid !pt !tlvs = OpenChannel-  { openChannelChainHash            = ch-  , openChannelTempChannelId        = cid-  , openChannelFundingSatoshis      = Satoshis 1000000-  , openChannelPushMsat             = MilliSatoshis 0-  , openChannelDustLimitSatoshis    = Satoshis 546-  , openChannelMaxHtlcValueInFlight = MilliSatoshis 1000000000-  , openChannelChannelReserveSat    = Satoshis 10000-  , openChannelHtlcMinimumMsat      = MilliSatoshis 1000-  , openChannelFeeratePerKw         = 250-  , openChannelToSelfDelay          = 144-  , openChannelMaxAcceptedHtlcs     = 30-  , openChannelFundingPubkey        = pt-  , openChannelRevocationBasepoint  = pt-  , openChannelPaymentBasepoint     = pt-  , openChannelDelayedPaymentBase   = pt-  , openChannelHtlcBasepoint        = pt-  , openChannelFirstPerCommitPoint  = pt-  , openChannelChannelFlags         = 0x00-  , openChannelTlvs                 = tlvs-  }---- | Construct OpenChannel2 message.-mkOpenChannel2 :: ChainHash -> ChannelId -> Point -> TlvStream -> OpenChannel2-mkOpenChannel2 !ch !cid !pt !tlvs = OpenChannel2-  { openChannel2ChainHash            = ch-  , openChannel2TempChannelId        = cid-  , openChannel2FundingFeeratePerkw  = 2500-  , openChannel2CommitFeeratePerkw   = 250-  , openChannel2FundingSatoshis      = Satoshis 1000000-  , openChannel2DustLimitSatoshis    = Satoshis 546-  , openChannel2MaxHtlcValueInFlight = MilliSatoshis 1000000000-  , openChannel2HtlcMinimumMsat      = MilliSatoshis 1000-  , openChannel2ToSelfDelay          = 144-  , openChannel2MaxAcceptedHtlcs     = 30-  , openChannel2Locktime             = 0-  , openChannel2FundingPubkey        = pt-  , openChannel2RevocationBasepoint  = pt-  , openChannel2PaymentBasepoint     = pt-  , openChannel2DelayedPaymentBase   = pt-  , openChannel2HtlcBasepoint        = pt-  , openChannel2FirstPerCommitPoint  = pt-  , openChannel2SecondPerCommitPoint = pt-  , openChannel2ChannelFlags         = 0x00-  , openChannel2Tlvs                 = tlvs-  }---- | Construct TxSignatures message.-mkTxSignatures :: ChannelId -> TxId -> [Witness] -> TxSignatures-mkTxSignatures !cid !tid !ws = TxSignatures-  { txSignaturesChannelId = cid-  , txSignaturesTxid      = tid-  , txSignaturesWitnesses = ws-  }---- | Construct ClosingSigned message.-mkClosingSigned :: ChannelId -> Signature -> TlvStream -> ClosingSigned-mkClosingSigned !cid !sig !tlvs = ClosingSigned-  { closingSignedChannelId   = cid-  , closingSignedFeeSatoshis = Satoshis 1000-  , closingSignedSignature   = sig-  , closingSignedTlvs        = tlvs-  }---- | Construct UpdateAddHtlc message.-mkUpdateAddHtlc-  :: ChannelId -> PaymentHash -> OnionPacket -> TlvStream -> UpdateAddHtlc-mkUpdateAddHtlc !cid !ph !onion !tlvs = UpdateAddHtlc-  { updateAddHtlcChannelId   = cid-  , updateAddHtlcId          = 0-  , updateAddHtlcAmountMsat  = MilliSatoshis 10000000-  , updateAddHtlcPaymentHash = ph-  , updateAddHtlcCltvExpiry  = 800000-  , updateAddHtlcOnionPacket = onion-  , updateAddHtlcTlvs        = tlvs-  }---- | Construct CommitmentSigned message.-mkCommitmentSigned :: ChannelId -> Signature -> [Signature] -> CommitmentSigned-mkCommitmentSigned !cid !sig !htlcSigs = CommitmentSigned-  { commitmentSignedChannelId      = cid-  , commitmentSignedSignature      = sig-  , commitmentSignedHtlcSignatures = htlcSigs-  }---- Pre-constructed messages -------------------------------------------------------- | Test OpenChannel message.-testOpenChannel :: OpenChannel-testOpenChannel =-  mkOpenChannel testChainHash testChannelId testPoint emptyTlvs-{-# NOINLINE testOpenChannel #-}---- | Encoded OpenChannel for decode benchmarks.-encodedOpenChannel :: BS.ByteString-encodedOpenChannel = encodeOpenChannel testOpenChannel-{-# NOINLINE encodedOpenChannel #-}---- | Test OpenChannel2 message.-testOpenChannel2 :: OpenChannel2-testOpenChannel2 =-  mkOpenChannel2 testChainHash testChannelId testPoint emptyTlvs-{-# NOINLINE testOpenChannel2 #-}---- | Encoded OpenChannel2 for decode benchmarks.-encodedOpenChannel2 :: BS.ByteString-encodedOpenChannel2 = encodeOpenChannel2 testOpenChannel2-{-# NOINLINE encodedOpenChannel2 #-}---- | Test witness data.-testWitness :: Witness-testWitness = Witness (BS.replicate 107 0xab)-{-# NOINLINE testWitness #-}---- | Multiple witnesses for TxSignatures.-testWitnesses :: [Witness]-testWitnesses = replicate 5 testWitness-{-# NOINLINE testWitnesses #-}---- | Test TxSignatures message.-testTxSignatures :: TxSignatures-testTxSignatures = mkTxSignatures testChannelId testTxId testWitnesses-{-# NOINLINE testTxSignatures #-}---- | Encoded TxSignatures for decode benchmarks.-encodedTxSignatures :: BS.ByteString-encodedTxSignatures = case encodeTxSignatures testTxSignatures of-  Right bs -> bs-  Left e   -> error $ "encodedTxSignatures: " ++ show e-{-# NOINLINE encodedTxSignatures #-}---- | Test ClosingSigned message.-testClosingSigned :: ClosingSigned-testClosingSigned = mkClosingSigned testChannelId testSignature emptyTlvs-{-# NOINLINE testClosingSigned #-}---- | Encoded ClosingSigned for decode benchmarks.-encodedClosingSigned :: BS.ByteString-encodedClosingSigned = encodeClosingSigned testClosingSigned-{-# NOINLINE encodedClosingSigned #-}---- | Test UpdateAddHtlc message.-testUpdateAddHtlc :: UpdateAddHtlc-testUpdateAddHtlc =-  mkUpdateAddHtlc testChannelId testPaymentHash testOnionPacket emptyTlvs-{-# NOINLINE testUpdateAddHtlc #-}---- | Encoded UpdateAddHtlc for decode benchmarks.-encodedUpdateAddHtlc :: BS.ByteString-encodedUpdateAddHtlc = encodeUpdateAddHtlc testUpdateAddHtlc-{-# NOINLINE encodedUpdateAddHtlc #-}---- | HTLC signatures for CommitmentSigned.-testHtlcSigs :: [Signature]-testHtlcSigs = replicate 10 testSignature-{-# NOINLINE testHtlcSigs #-}---- | Test CommitmentSigned message.-testCommitmentSigned :: CommitmentSigned-testCommitmentSigned =-  mkCommitmentSigned testChannelId testSignature testHtlcSigs-{-# NOINLINE testCommitmentSigned #-}---- | Encoded CommitmentSigned for decode benchmarks.-encodedCommitmentSigned :: BS.ByteString-encodedCommitmentSigned = case encodeCommitmentSigned testCommitmentSigned of-  Right bs -> bs-  Left e   -> error $ "encodedCommitmentSigned: " ++ show e-{-# NOINLINE encodedCommitmentSigned #-}---- | Large HTLC signatures for CommitmentSigned (100).-testHtlcSigsLarge :: [Signature]-testHtlcSigsLarge = replicate 100 testSignature-{-# NOINLINE testHtlcSigsLarge #-}---- | Test CommitmentSigned message (100 sigs).-testCommitmentSignedLarge :: CommitmentSigned-testCommitmentSignedLarge =-  mkCommitmentSigned testChannelId testSignature testHtlcSigsLarge-{-# NOINLINE testCommitmentSignedLarge #-}---- | Encoded large CommitmentSigned for decode benchmarks.-encodedCommitmentSignedLarge :: BS.ByteString-encodedCommitmentSignedLarge =-  case encodeCommitmentSigned testCommitmentSignedLarge of-    Right bs -> bs-    Left e   -> error $ "encodedCommitmentSignedLarge: " ++ show e-{-# NOINLINE encodedCommitmentSignedLarge #-}---- | Max HTLC signatures for CommitmentSigned (483).-testHtlcSigsMax :: [Signature]-testHtlcSigsMax = replicate 483 testSignature-{-# NOINLINE testHtlcSigsMax #-}---- | Test CommitmentSigned message (483 sigs).-testCommitmentSignedMax :: CommitmentSigned-testCommitmentSignedMax =-  mkCommitmentSigned testChannelId testSignature testHtlcSigsMax-{-# NOINLINE testCommitmentSignedMax #-}---- | Encoded max CommitmentSigned for decode benchmarks.-encodedCommitmentSignedMax :: BS.ByteString-encodedCommitmentSignedMax =-  case encodeCommitmentSigned testCommitmentSignedMax of-    Right bs -> bs-    Left e   -> error $ "encodedCommitmentSignedMax: " ++ show e-{-# NOINLINE encodedCommitmentSignedMax #-}---- Weigh benchmarks ------------------------------------------------------------- main :: IO ()-main = mainWith $ do-  -- V1 message construction and encoding-  wgroup "v1/open_channel" $ do-    func "construct" (mkOpenChannel testChainHash testChannelId testPoint)-      emptyTlvs-    func "encode" encodeOpenChannel testOpenChannel-    func "decode" decodeOpenChannel encodedOpenChannel--  -- V2 message construction and encoding-  wgroup "v2/open_channel2" $ do-    func "construct" (mkOpenChannel2 testChainHash testChannelId testPoint)-      emptyTlvs-    func "encode" encodeOpenChannel2 testOpenChannel2-    func "decode" decodeOpenChannel2 encodedOpenChannel2--  wgroup "v2/tx_signatures" $ do-    func "construct" (mkTxSignatures testChannelId testTxId) testWitnesses-    func "encode" (forceEncode . encodeTxSignatures) testTxSignatures-    func "decode" decodeTxSignatures encodedTxSignatures--  -- Close messages-  wgroup "close/closing_signed" $ do-    func "construct" (mkClosingSigned testChannelId testSignature) emptyTlvs-    func "encode" encodeClosingSigned testClosingSigned-    func "decode" decodeClosingSigned encodedClosingSigned--  -- Normal operation (hot paths)-  wgroup "normal/update_add_htlc" $ do-    func "construct"-      (mkUpdateAddHtlc testChannelId testPaymentHash testOnionPacket) emptyTlvs-    func "encode" encodeUpdateAddHtlc testUpdateAddHtlc-    func "decode" decodeUpdateAddHtlc encodedUpdateAddHtlc--  wgroup "normal/commitment_signed" $ do-    func "construct" (mkCommitmentSigned testChannelId testSignature)-      testHtlcSigs-    func "encode" (forceEncode . encodeCommitmentSigned) testCommitmentSigned-    func "decode" decodeCommitmentSigned encodedCommitmentSigned--  wgroup "normal/commitment_signed_100" $ do-    func "decode" decodeCommitmentSigned encodedCommitmentSignedLarge--  wgroup "normal/commitment_signed_483" $ do-    func "decode" decodeCommitmentSigned encodedCommitmentSignedMax+main = case fixtures of+  Nothing -> fail "invalid fixtures"+  Just fx -> mainWith $ do+    func "baseline (weigh overhead)" (+ (1 :: Int)) 1+    wgroup "open_channel" $ do+      func "encode" encode_open_channel (fx_open_channel fx)+      func "decode" decode_open_channel (fx_open_channel_bytes fx)+    wgroup "accept_channel2" $ do+      func "encode" encode_accept_channel2 (fx_accept_channel2 fx)+      func "decode" decode_accept_channel2 (fx_accept_channel2_bytes fx)+    wgroup "tx_signatures" $ do+      func "encode" encode_tx_signatures (fx_tx_signatures fx)+      func "decode" decode_tx_signatures (fx_tx_signatures_bytes fx)+    wgroup "closing_complete" $ do+      func "encode" encode_closing_complete (fx_closing_complete fx)+      func "decode" decode_closing_complete (fx_closing_complete_bytes fx)+    wgroup "update_add_htlc" $ do+      func "encode" encode_update_add_htlc (fx_update_add_htlc fx)+      func "decode" decode_update_add_htlc (fx_update_add_htlc_bytes fx)+      func "encode_message" encode_message+        (MsgUpdateAddHtlc (fx_update_add_htlc fx))+      func "decode_message" decode_message (fx_update_add_htlc_wire fx)+    wgroup "update_fulfill_htlc" $ do+      func "encode" encode_update_fulfill_htlc (fx_update_fulfill_htlc fx)+      func "decode" decode_update_fulfill_htlc+        (fx_update_fulfill_htlc_bytes fx)+    wgroup "commitment_signed" $ do+      func "encode (0 htlcs)" encode_commitment_signed+        (fx_commitment_signed fx)+      func "decode (0 htlcs)" decode_commitment_signed+        (fx_commitment_signed_bytes fx)+      func "encode (483 htlcs)" encode_commitment_signed+        (fx_commitment_signed_483 fx)+      func "decode (483 htlcs)" decode_commitment_signed+        (fx_commitment_signed_483_bytes fx)+    wgroup "revoke_and_ack" $ do+      func "encode" encode_revoke_and_ack (fx_revoke_and_ack fx)+      func "decode" decode_revoke_and_ack (fx_revoke_and_ack_bytes fx)+    wgroup "channel_reestablish" $ do+      func "encode" encode_channel_reestablish (fx_channel_reestablish fx)+      func "decode" decode_channel_reestablish+        (fx_channel_reestablish_bytes fx)

@@ -6,128 +6,187 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Peer protocol for the Lightning Network, per--- [BOLT #2](https://github.com/lightning/bolts/blob/master/02-peer-protocol.md).+-- The peer protocol of the Lightning Network, per+-- [BOLT #2](https://github.com/lightning/bolts/blob/master/02-peer-protocol.md):+-- the messages for channel establishment (v1 and v2), interactive+-- transaction construction, quiescence, channel close, normal operation+-- and message retransmission.+--+-- Fundamental types (channel ids, points, signatures, amounts, TLV+-- streams) come from ppad-bolt1, transaction ids from ppad-tx, and+-- feature vectors from ppad-bolt9.+--+-- Each message has a payload codec, @encode_\<msg\>@ and+-- @decode_\<msg\>@; 'encode_message' and 'decode_message' handle+-- complete messages, including the type. Decoders consume the whole+-- payload: bytes after the fixed fields are the message's TLV stream.+-- Known TLV records are decoded into typed fields, an unknown even+-- record fails the decode, and unknown odd records are kept in the+-- message's @_tlvs@ field, so re-encoding a decoded message reproduces+-- its bytes.+--+-- The examples below assume:+--+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.ByteString as BS+-- >>> import qualified Lightning.Protocol.BOLT1 as BOLT1+-- >>> import Lightning.Protocol.BOLT2+-- >>> let Just cid = BOLT1.channel_id (BS.replicate 32 0xab)+--+-- Encode a message, and decode it again:+--+-- >>> let fee = UpdateFee cid 2500 BOLT1.empty_tlv_stream+-- >>> let Right wire = encode_message (MsgUpdateFee fee)+-- >>> BS.length wire+-- 38+-- >>> decode_message wire == Right (MsgUpdateFee fee)+-- True+--+-- Unknown odd TLV records are preserved, and unknown even ones+-- rejected:+--+-- >>> let payload = encode_update_fee fee+-- >>> fmap update_fee_tlvs (decode_update_fee (payload <> "\x05\x01\x2a"))+-- Right (TlvStream [TlvRecord {tlv_type = 5, tlv_value = "*"}])+-- >>> decode_update_fee (payload <> "\x04\x01\x2a")+-- Left (DecodeTlvError (TlvUnknownEvenType 4))  module Lightning.Protocol.BOLT2 (-  -- * Core types-  -- | Re-exported from "Lightning.Protocol.BOLT2.Types".-    module Lightning.Protocol.BOLT2.Types--  -- * Message types-  -- | Re-exported from "Lightning.Protocol.BOLT2.Messages".-  , module Lightning.Protocol.BOLT2.Messages+  -- * Messages+    Message(..)+  , message_type -  -- * Codec functions-  -- | Re-exported from "Lightning.Protocol.BOLT2.Codec".-  , module Lightning.Protocol.BOLT2.Codec+  -- ** Channel establishment v1+  , OpenChannel(..)+  , AcceptChannel(..)+  , FundingCreated(..)+  , FundingSigned(..)+  , ChannelReady(..) -  -- $messagetypes+  -- ** Channel establishment v2+  , OpenChannel2(..)+  , AcceptChannel2(..) -  -- ** Channel establishment (v1)-  -- $v1establishment+  -- ** Interactive transaction construction+  , TxAddInput(..)+  , TxAddOutput(..)+  , TxRemoveInput(..)+  , TxRemoveOutput(..)+  , TxComplete(..)+  , TxSignatures(..)+  , TxInitRbf(..)+  , TxAckRbf(..)+  , TxAbort(..) -  -- ** Channel establishment (v2)-  -- $v2establishment+  -- ** Channel quiescence+  , Stfu(..)    -- ** Channel close-  -- $close+  , Shutdown(..)+  , ClosingComplete(..)+  , ClosingSig(..)+  , ClosingSigned(..)    -- ** Normal operation-  -- $normal+  , UpdateAddHtlc(..)+  , UpdateFulfillHtlc(..)+  , UpdateFailHtlc(..)+  , UpdateFailMalformedHtlc(..)+  , CommitmentSigned(..)+  , RevokeAndAck(..)+  , UpdateFee(..) -  -- ** Message reestablishment-  -- $reestablish+  -- ** Message retransmission+  , ChannelReestablish(..)++  -- * Field types+  , HtlcId(..)+  , SerialId(..)+  , ScriptPubKey+  , script_pubkey+  , un_script_pubkey+  , Witness+  , witness+  , un_witness+  , OnionRoutingPacket+  , onion_routing_packet+  , un_onion_routing_packet+  , OnionHash+  , onion_hash+  , un_onion_hash+  , AttributionData+  , attribution_data+  , un_attribution_data+  , FeeRange(..)+  , NextFunding(..)++  -- * Encoding and decoding messages+  , encode_message+  , decode_message+  , EncodeError(..)+  , DecodeError(..)++  -- ** Payloads+  , encode_open_channel+  , decode_open_channel+  , encode_accept_channel+  , decode_accept_channel+  , encode_funding_created+  , decode_funding_created+  , encode_funding_signed+  , decode_funding_signed+  , encode_channel_ready+  , decode_channel_ready+  , encode_open_channel2+  , decode_open_channel2+  , encode_accept_channel2+  , decode_accept_channel2+  , encode_tx_add_input+  , decode_tx_add_input+  , encode_tx_add_output+  , decode_tx_add_output+  , encode_tx_remove_input+  , decode_tx_remove_input+  , encode_tx_remove_output+  , decode_tx_remove_output+  , encode_tx_complete+  , decode_tx_complete+  , encode_tx_signatures+  , decode_tx_signatures+  , encode_tx_init_rbf+  , decode_tx_init_rbf+  , encode_tx_ack_rbf+  , decode_tx_ack_rbf+  , encode_tx_abort+  , decode_tx_abort+  , encode_stfu+  , decode_stfu+  , encode_shutdown+  , decode_shutdown+  , encode_closing_complete+  , decode_closing_complete+  , encode_closing_sig+  , decode_closing_sig+  , encode_closing_signed+  , decode_closing_signed+  , encode_update_add_htlc+  , decode_update_add_htlc+  , encode_update_fulfill_htlc+  , decode_update_fulfill_htlc+  , encode_update_fail_htlc+  , decode_update_fail_htlc+  , encode_update_fail_malformed_htlc+  , decode_update_fail_malformed_htlc+  , encode_commitment_signed+  , decode_commitment_signed+  , encode_revoke_and_ack+  , decode_revoke_and_ack+  , encode_update_fee+  , decode_update_fee+  , encode_channel_reestablish+  , decode_channel_reestablish   ) where  import Lightning.Protocol.BOLT2.Codec import Lightning.Protocol.BOLT2.Messages import Lightning.Protocol.BOLT2.Types---- $messagetypes------ BOLT #2 defines the following message types:------ * 2: stfu--- * 32: open_channel--- * 33: accept_channel--- * 34: funding_created--- * 35: funding_signed--- * 36: channel_ready--- * 38: shutdown--- * 39: closing_signed--- * 40: closing_complete--- * 41: closing_sig--- * 64: open_channel2--- * 65: accept_channel2--- * 66: tx_add_input--- * 67: tx_add_output--- * 68: tx_remove_input--- * 69: tx_remove_output--- * 70: tx_complete--- * 71: tx_signatures--- * 72: tx_init_rbf--- * 73: tx_ack_rbf--- * 74: tx_abort--- * 128: update_add_htlc--- * 130: update_fulfill_htlc--- * 131: update_fail_htlc--- * 132: commitment_signed--- * 133: revoke_and_ack--- * 134: update_fee--- * 135: update_fail_malformed_htlc--- * 136: channel_reestablish---- $v1establishment------ Channel establishment v1 messages:------ * open_channel (32)--- * accept_channel (33)--- * funding_created (34)--- * funding_signed (35)--- * channel_ready (36)---- $v2establishment------ Channel establishment v2 (interactive-tx) messages:------ * open_channel2 (64)--- * accept_channel2 (65)--- * tx_add_input (66)--- * tx_add_output (67)--- * tx_remove_input (68)--- * tx_remove_output (69)--- * tx_complete (70)--- * tx_signatures (71)--- * tx_init_rbf (72)--- * tx_ack_rbf (73)--- * tx_abort (74)---- $close------ Channel close messages:------ * stfu (2)--- * shutdown (38)--- * closing_signed (39)--- * closing_complete (40)--- * closing_sig (41)---- $normal------ Normal operation messages:------ * update_add_htlc (128)--- * update_fulfill_htlc (130)--- * update_fail_htlc (131)--- * commitment_signed (132)--- * revoke_and_ack (133)--- * update_fee (134)--- * update_fail_malformed_htlc (135)---- $reestablish------ Message reestablishment:------ * channel_reestablish (136)

@@ -1,1347 +1,1388 @@-{-# OPTIONS_HADDOCK prune #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}---- |--- Module: Lightning.Protocol.BOLT2.Codec--- Copyright: (c) 2025 Jared Tobin--- License: MIT--- Maintainer: Jared Tobin <jared@ppad.tech>------ Encode/decode functions for BOLT #2 messages.--module Lightning.Protocol.BOLT2.Codec (-  -- * Error types-    EncodeError(..)-  , DecodeError(..)--  -- * Channel establishment v1-  , encodeOpenChannel-  , decodeOpenChannel-  , encodeAcceptChannel-  , decodeAcceptChannel-  , encodeFundingCreated-  , decodeFundingCreated-  , encodeFundingSigned-  , decodeFundingSigned-  , encodeChannelReady-  , decodeChannelReady--  -- * Channel establishment v2 (interactive-tx)-  , encodeOpenChannel2-  , decodeOpenChannel2-  , encodeAcceptChannel2-  , decodeAcceptChannel2-  , encodeTxAddInput-  , decodeTxAddInput-  , encodeTxAddOutput-  , decodeTxAddOutput-  , encodeTxRemoveInput-  , decodeTxRemoveInput-  , encodeTxRemoveOutput-  , decodeTxRemoveOutput-  , encodeTxComplete-  , decodeTxComplete-  , encodeTxSignatures-  , decodeTxSignatures-  , encodeTxInitRbf-  , decodeTxInitRbf-  , encodeTxAckRbf-  , decodeTxAckRbf-  , encodeTxAbort-  , decodeTxAbort--  -- * Channel close-  , encodeStfu-  , decodeStfu-  , encodeShutdown-  , decodeShutdown-  , encodeClosingSigned-  , decodeClosingSigned-  , encodeClosingComplete-  , decodeClosingComplete-  , encodeClosingSig-  , decodeClosingSig--  -- * Normal operation-  , encodeUpdateAddHtlc-  , decodeUpdateAddHtlc-  , encodeUpdateFulfillHtlc-  , decodeUpdateFulfillHtlc-  , encodeUpdateFailHtlc-  , decodeUpdateFailHtlc-  , encodeUpdateFailMalformedHtlc-  , decodeUpdateFailMalformedHtlc-  , encodeCommitmentSigned-  , decodeCommitmentSigned-  , encodeRevokeAndAck-  , decodeRevokeAndAck-  , encodeUpdateFee-  , decodeUpdateFee--  -- * Channel reestablishment-  , encodeChannelReestablish-  , decodeChannelReestablish-  ) where--import Control.DeepSeq (NFData)-import Control.Monad (unless)-import qualified Data.ByteString as BS-import Data.Word (Word8, Word16, Word32)-import GHC.Generics (Generic)-import Lightning.Protocol.BOLT1-  ( TlvStream-  , unsafeTlvStream-  , TlvError-  , encodeU16-  , encodeU32-  , encodeU64-  , decodeU16-  , decodeU32-  , decodeU64-  , encodeTlvStream-  , decodeTlvStreamRaw-  )-import Lightning.Protocol.BOLT2.Types-import Lightning.Protocol.BOLT2.Messages---- Error types --------------------------------------------------------------------- | Encoding errors.-data EncodeError-  = EncodeLengthOverflow  -- ^ Payload exceeds u16 max (65535 bytes)-  deriving stock (Eq, Show, Generic)--instance NFData EncodeError---- | Decoding errors.-data DecodeError-  = DecodeInsufficientBytes-  | DecodeInvalidLength-  | DecodeInvalidChannelId-  | DecodeInvalidChainHash-  | DecodeInvalidSignature-  | DecodeInvalidPoint-  | DecodeInvalidTxId-  | DecodeInvalidPaymentHash-  | DecodeInvalidPaymentPreimage-  | DecodeInvalidOnionPacket-  | DecodeInvalidSecret-  | DecodeTlvError !TlvError-  deriving stock (Eq, Show, Generic)--instance NFData DecodeError---- Helpers ------------------------------------------------------------------------- | Decode a single byte.-decodeU8 :: BS.ByteString -> Maybe (Word8, BS.ByteString)-decodeU8 !bs-  | BS.null bs = Nothing-  | otherwise  = Just (BS.index bs 0, BS.drop 1 bs)-{-# INLINE decodeU8 #-}---- | Decode fixed-size bytes.-decodeBytes :: Int -> BS.ByteString -> Maybe (BS.ByteString, BS.ByteString)-decodeBytes !n !bs-  | BS.length bs < n = Nothing-  | otherwise        = Just (BS.take n bs, BS.drop n bs)-{-# INLINE decodeBytes #-}---- | Decode a ChannelId (32 bytes).-decodeChannelIdBytes-  :: BS.ByteString -> Either DecodeError (ChannelId, BS.ByteString)-decodeChannelIdBytes !bs = do-  (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right-                   (decodeBytes channelIdLen bs)-  cid <- maybe (Left DecodeInvalidChannelId) Right (channelId raw)-  Right (cid, rest)-{-# INLINE decodeChannelIdBytes #-}---- | Decode a ChainHash (32 bytes).-decodeChainHashBytes-  :: BS.ByteString -> Either DecodeError (ChainHash, BS.ByteString)-decodeChainHashBytes !bs = do-  (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right-                   (decodeBytes chainHashLen bs)-  ch <- maybe (Left DecodeInvalidChainHash) Right (chainHash raw)-  Right (ch, rest)-{-# INLINE decodeChainHashBytes #-}---- | Decode a Signature (64 bytes).-decodeSignatureBytes-  :: BS.ByteString -> Either DecodeError (Signature, BS.ByteString)-decodeSignatureBytes !bs = do-  (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right-                   (decodeBytes signatureLen bs)-  sig <- maybe (Left DecodeInvalidSignature) Right (signature raw)-  Right (sig, rest)-{-# INLINE decodeSignatureBytes #-}---- | Decode a Point (33 bytes).-decodePointBytes-  :: BS.ByteString -> Either DecodeError (Point, BS.ByteString)-decodePointBytes !bs = do-  (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right-                   (decodeBytes pointLen bs)-  pt <- maybe (Left DecodeInvalidPoint) Right (point raw)-  Right (pt, rest)-{-# INLINE decodePointBytes #-}---- | Decode a TxId (32 bytes).-decodeTxIdBytes-  :: BS.ByteString -> Either DecodeError (TxId, BS.ByteString)-decodeTxIdBytes !bs = do-  (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right-                   (decodeBytes txIdLen bs)-  tid <- maybe (Left DecodeInvalidTxId) Right (txId raw)-  Right (tid, rest)-{-# INLINE decodeTxIdBytes #-}---- | Decode a u16 with error handling.-decodeU16E :: BS.ByteString -> Either DecodeError (Word16, BS.ByteString)-decodeU16E !bs = maybe (Left DecodeInsufficientBytes) Right (decodeU16 bs)-{-# INLINE decodeU16E #-}---- | Decode a u32 with error handling.-decodeU32E :: BS.ByteString -> Either DecodeError (Word32, BS.ByteString)-decodeU32E !bs = maybe (Left DecodeInsufficientBytes) Right (decodeU32 bs)-{-# INLINE decodeU32E #-}---- | Decode a u64 as Satoshis.-decodeSatoshis-  :: BS.ByteString -> Either DecodeError (Satoshis, BS.ByteString)-decodeSatoshis !bs = do-  (val, rest) <- maybe (Left DecodeInsufficientBytes) Right (decodeU64 bs)-  Right (Satoshis val, rest)-{-# INLINE decodeSatoshis #-}---- | Decode a u64 as MilliSatoshis.-decodeMilliSatoshis-  :: BS.ByteString -> Either DecodeError (MilliSatoshis, BS.ByteString)-decodeMilliSatoshis !bs = do-  (val, rest) <- maybe (Left DecodeInsufficientBytes) Right (decodeU64 bs)-  Right (MilliSatoshis val, rest)-{-# INLINE decodeMilliSatoshis #-}---- | Decode optional TLV stream from remaining bytes.-decodeTlvs :: BS.ByteString -> Either DecodeError TlvStream-decodeTlvs !bs-  | BS.null bs = Right (unsafeTlvStream [])-  | otherwise  = either (Left . DecodeTlvError) Right (decodeTlvStreamRaw bs)-{-# INLINE decodeTlvs #-}---- | Decode a length-prefixed script (u16 length prefix).-decodeScriptPubKey-  :: BS.ByteString -> Either DecodeError (ScriptPubKey, BS.ByteString)-decodeScriptPubKey !bs = do-  (len, rest1) <- decodeU16E bs-  let !scriptLen = fromIntegral len-  unless (BS.length rest1 >= scriptLen) $ Left DecodeInsufficientBytes-  let !script = BS.take scriptLen rest1-      !rest2 = BS.drop scriptLen rest1-  Right (scriptPubKey script, rest2)-{-# INLINE decodeScriptPubKey #-}---- | Decode a PaymentHash (32 bytes).-decodePaymentHashBytes-  :: BS.ByteString -> Either DecodeError (PaymentHash, BS.ByteString)-decodePaymentHashBytes !bs = do-  (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right-                   (decodeBytes paymentHashLen bs)-  ph <- maybe (Left DecodeInvalidPaymentHash) Right (paymentHash raw)-  Right (ph, rest)-{-# INLINE decodePaymentHashBytes #-}---- | Decode a PaymentPreimage (32 bytes).-decodePaymentPreimageBytes-  :: BS.ByteString -> Either DecodeError (PaymentPreimage, BS.ByteString)-decodePaymentPreimageBytes !bs = do-  (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right-                   (decodeBytes paymentPreimageLen bs)-  pp <- maybe (Left DecodeInvalidPaymentPreimage) Right (paymentPreimage raw)-  Right (pp, rest)-{-# INLINE decodePaymentPreimageBytes #-}---- | Decode an OnionPacket (1366 bytes).-decodeOnionPacketBytes-  :: BS.ByteString -> Either DecodeError (OnionPacket, BS.ByteString)-decodeOnionPacketBytes !bs = do-  (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right-                   (decodeBytes onionPacketLen bs)-  op <- maybe (Left DecodeInvalidOnionPacket) Right (onionPacket raw)-  Right (op, rest)-{-# INLINE decodeOnionPacketBytes #-}---- | Decode a Secret (32 bytes).-decodeSecretBytes-  :: BS.ByteString -> Either DecodeError (Secret, BS.ByteString)-decodeSecretBytes !bs = do-  (raw, rest) <- maybe (Left DecodeInsufficientBytes) Right-                   (decodeBytes secretLen bs)-  sec <- maybe (Left DecodeInvalidSecret) Right (secret raw)-  Right (sec, rest)-{-# INLINE decodeSecretBytes #-}---- | Encode a u16-prefixed byte string with bounds checking.-encodeU16BytesE :: BS.ByteString -> Either EncodeError BS.ByteString-encodeU16BytesE !bs-  | BS.length bs > 65535 = Left EncodeLengthOverflow-  | otherwise = Right $! encodeU16 (fromIntegral (BS.length bs)) <> bs-{-# INLINE encodeU16BytesE #-}---- | Check that a list count fits in u16.-checkListCountU16 :: Int -> Either EncodeError Word16-checkListCountU16 !n-  | n > 65535 = Left EncodeLengthOverflow-  | otherwise = Right $! fromIntegral n-{-# INLINE checkListCountU16 #-}---- | Decode a u16-prefixed byte string.-decodeU16Bytes-  :: BS.ByteString -> Either DecodeError (BS.ByteString, BS.ByteString)-decodeU16Bytes !bs = do-  (len, rest1) <- decodeU16E bs-  let !n = fromIntegral len-  unless (BS.length rest1 >= n) $ Left DecodeInsufficientBytes-  Right (BS.take n rest1, BS.drop n rest1)-{-# INLINE decodeU16Bytes #-}---- | Decode optional trailing TLV stream.-decodeOptionalTlvs-  :: BS.ByteString -> Either DecodeError (TlvStream, BS.ByteString)-decodeOptionalTlvs !bs-  | BS.null bs = Right (unsafeTlvStream [], BS.empty)-  | otherwise  = case decodeTlvStreamRaw bs of-      Left e  -> Left (DecodeTlvError e)-      Right t -> Right (t, BS.empty)-{-# INLINE decodeOptionalTlvs #-}---- Channel establishment v1 -------------------------------------------------------- | Encode an OpenChannel message (type 32).------ Wire format:--- - chain_hash: 32 bytes--- - temporary_channel_id: 32 bytes--- - funding_satoshis: u64--- - push_msat: u64--- - dust_limit_satoshis: u64--- - max_htlc_value_in_flight_msat: u64--- - channel_reserve_satoshis: u64--- - htlc_minimum_msat: u64--- - feerate_per_kw: u32--- - to_self_delay: u16--- - max_accepted_htlcs: u16--- - funding_pubkey: 33 bytes--- - revocation_basepoint: 33 bytes--- - payment_basepoint: 33 bytes--- - delayed_payment_basepoint: 33 bytes--- - htlc_basepoint: 33 bytes--- - first_per_commitment_point: 33 bytes--- - channel_flags: 1 byte--- - tlvs: TLV stream-encodeOpenChannel :: OpenChannel -> BS.ByteString-encodeOpenChannel !msg = mconcat-  [ unChainHash (openChannelChainHash msg)-  , unChannelId (openChannelTempChannelId msg)-  , encodeU64 (unSatoshis (openChannelFundingSatoshis msg))-  , encodeU64 (unMilliSatoshis (openChannelPushMsat msg))-  , encodeU64 (unSatoshis (openChannelDustLimitSatoshis msg))-  , encodeU64 (unMilliSatoshis (openChannelMaxHtlcValueInFlight msg))-  , encodeU64 (unSatoshis (openChannelChannelReserveSat msg))-  , encodeU64 (unMilliSatoshis (openChannelHtlcMinimumMsat msg))-  , encodeU32 (openChannelFeeratePerKw msg)-  , encodeU16 (openChannelToSelfDelay msg)-  , encodeU16 (openChannelMaxAcceptedHtlcs msg)-  , unPoint (openChannelFundingPubkey msg)-  , unPoint (openChannelRevocationBasepoint msg)-  , unPoint (openChannelPaymentBasepoint msg)-  , unPoint (openChannelDelayedPaymentBase msg)-  , unPoint (openChannelHtlcBasepoint msg)-  , unPoint (openChannelFirstPerCommitPoint msg)-  , BS.singleton (openChannelChannelFlags msg)-  , encodeTlvStream (openChannelTlvs msg)-  ]---- | Decode an OpenChannel message (type 32).-decodeOpenChannel-  :: BS.ByteString -> Either DecodeError (OpenChannel, BS.ByteString)-decodeOpenChannel !bs = do-  (chainHash', rest1) <- decodeChainHashBytes bs-  (tempChanId, rest2) <- decodeChannelIdBytes rest1-  (fundingSats, rest3) <- decodeSatoshis rest2-  (pushMsat, rest4) <- decodeMilliSatoshis rest3-  (dustLimit, rest5) <- decodeSatoshis rest4-  (maxHtlcVal, rest6) <- decodeMilliSatoshis rest5-  (chanReserve, rest7) <- decodeSatoshis rest6-  (htlcMin, rest8) <- decodeMilliSatoshis rest7-  (feerate, rest9) <- decodeU32E rest8-  (toSelfDelay, rest10) <- decodeU16E rest9-  (maxHtlcs, rest11) <- decodeU16E rest10-  (fundingPk, rest12) <- decodePointBytes rest11-  (revocBase, rest13) <- decodePointBytes rest12-  (paymentBase, rest14) <- decodePointBytes rest13-  (delayedBase, rest15) <- decodePointBytes rest14-  (htlcBase, rest16) <- decodePointBytes rest15-  (firstCommit, rest17) <- decodePointBytes rest16-  (flags, rest18) <- maybe (Left DecodeInsufficientBytes) Right-                       (decodeU8 rest17)-  tlvs <- decodeTlvs rest18-  let !msg = OpenChannel-        { openChannelChainHash            = chainHash'-        , openChannelTempChannelId        = tempChanId-        , openChannelFundingSatoshis      = fundingSats-        , openChannelPushMsat             = pushMsat-        , openChannelDustLimitSatoshis    = dustLimit-        , openChannelMaxHtlcValueInFlight = maxHtlcVal-        , openChannelChannelReserveSat    = chanReserve-        , openChannelHtlcMinimumMsat      = htlcMin-        , openChannelFeeratePerKw         = feerate-        , openChannelToSelfDelay          = toSelfDelay-        , openChannelMaxAcceptedHtlcs     = maxHtlcs-        , openChannelFundingPubkey        = fundingPk-        , openChannelRevocationBasepoint  = revocBase-        , openChannelPaymentBasepoint     = paymentBase-        , openChannelDelayedPaymentBase   = delayedBase-        , openChannelHtlcBasepoint        = htlcBase-        , openChannelFirstPerCommitPoint  = firstCommit-        , openChannelChannelFlags         = flags-        , openChannelTlvs                 = tlvs-        }-  Right (msg, BS.empty)---- | Encode an AcceptChannel message (type 33).------ Wire format:--- - temporary_channel_id: 32 bytes--- - dust_limit_satoshis: u64--- - max_htlc_value_in_flight_msat: u64--- - channel_reserve_satoshis: u64--- - htlc_minimum_msat: u64--- - minimum_depth: u32--- - to_self_delay: u16--- - max_accepted_htlcs: u16--- - funding_pubkey: 33 bytes--- - revocation_basepoint: 33 bytes--- - payment_basepoint: 33 bytes--- - delayed_payment_basepoint: 33 bytes--- - htlc_basepoint: 33 bytes--- - first_per_commitment_point: 33 bytes--- - tlvs: TLV stream-encodeAcceptChannel :: AcceptChannel -> BS.ByteString-encodeAcceptChannel !msg = mconcat-  [ unChannelId (acceptChannelTempChannelId msg)-  , encodeU64 (unSatoshis (acceptChannelDustLimitSatoshis msg))-  , encodeU64 (unMilliSatoshis (acceptChannelMaxHtlcValueInFlight msg))-  , encodeU64 (unSatoshis (acceptChannelChannelReserveSat msg))-  , encodeU64 (unMilliSatoshis (acceptChannelHtlcMinimumMsat msg))-  , encodeU32 (acceptChannelMinimumDepth msg)-  , encodeU16 (acceptChannelToSelfDelay msg)-  , encodeU16 (acceptChannelMaxAcceptedHtlcs msg)-  , unPoint (acceptChannelFundingPubkey msg)-  , unPoint (acceptChannelRevocationBasepoint msg)-  , unPoint (acceptChannelPaymentBasepoint msg)-  , unPoint (acceptChannelDelayedPaymentBase msg)-  , unPoint (acceptChannelHtlcBasepoint msg)-  , unPoint (acceptChannelFirstPerCommitPoint msg)-  , encodeTlvStream (acceptChannelTlvs msg)-  ]---- | Decode an AcceptChannel message (type 33).-decodeAcceptChannel-  :: BS.ByteString -> Either DecodeError (AcceptChannel, BS.ByteString)-decodeAcceptChannel !bs = do-  (tempChanId, rest1) <- decodeChannelIdBytes bs-  (dustLimit, rest2) <- decodeSatoshis rest1-  (maxHtlcVal, rest3) <- decodeMilliSatoshis rest2-  (chanReserve, rest4) <- decodeSatoshis rest3-  (htlcMin, rest5) <- decodeMilliSatoshis rest4-  (minDepth, rest6) <- decodeU32E rest5-  (toSelfDelay, rest7) <- decodeU16E rest6-  (maxHtlcs, rest8) <- decodeU16E rest7-  (fundingPk, rest9) <- decodePointBytes rest8-  (revocBase, rest10) <- decodePointBytes rest9-  (paymentBase, rest11) <- decodePointBytes rest10-  (delayedBase, rest12) <- decodePointBytes rest11-  (htlcBase, rest13) <- decodePointBytes rest12-  (firstCommit, rest14) <- decodePointBytes rest13-  tlvs <- decodeTlvs rest14-  let !msg = AcceptChannel-        { acceptChannelTempChannelId        = tempChanId-        , acceptChannelDustLimitSatoshis    = dustLimit-        , acceptChannelMaxHtlcValueInFlight = maxHtlcVal-        , acceptChannelChannelReserveSat    = chanReserve-        , acceptChannelHtlcMinimumMsat      = htlcMin-        , acceptChannelMinimumDepth         = minDepth-        , acceptChannelToSelfDelay          = toSelfDelay-        , acceptChannelMaxAcceptedHtlcs     = maxHtlcs-        , acceptChannelFundingPubkey        = fundingPk-        , acceptChannelRevocationBasepoint  = revocBase-        , acceptChannelPaymentBasepoint     = paymentBase-        , acceptChannelDelayedPaymentBase   = delayedBase-        , acceptChannelHtlcBasepoint        = htlcBase-        , acceptChannelFirstPerCommitPoint  = firstCommit-        , acceptChannelTlvs                 = tlvs-        }-  Right (msg, BS.empty)---- | Encode a FundingCreated message (type 34).------ Wire format:--- - temporary_channel_id: 32 bytes--- - funding_txid: 32 bytes--- - funding_output_index: u16--- - signature: 64 bytes-encodeFundingCreated :: FundingCreated -> BS.ByteString-encodeFundingCreated !msg = mconcat-  [ unChannelId (fundingCreatedTempChannelId msg)-  , unTxId (fundingCreatedFundingTxid msg)-  , encodeU16 (fundingCreatedFundingOutIdx msg)-  , unSignature (fundingCreatedSignature msg)-  ]---- | Decode a FundingCreated message (type 34).-decodeFundingCreated-  :: BS.ByteString -> Either DecodeError (FundingCreated, BS.ByteString)-decodeFundingCreated !bs = do-  (tempChanId, rest1) <- decodeChannelIdBytes bs-  (fundingTxid, rest2) <- decodeTxIdBytes rest1-  (outIdx, rest3) <- decodeU16E rest2-  (sig, rest4) <- decodeSignatureBytes rest3-  let !msg = FundingCreated-        { fundingCreatedTempChannelId = tempChanId-        , fundingCreatedFundingTxid   = fundingTxid-        , fundingCreatedFundingOutIdx = outIdx-        , fundingCreatedSignature     = sig-        }-  Right (msg, rest4)---- | Encode a FundingSigned message (type 35).------ Wire format:--- - channel_id: 32 bytes--- - signature: 64 bytes-encodeFundingSigned :: FundingSigned -> BS.ByteString-encodeFundingSigned !msg = mconcat-  [ unChannelId (fundingSignedChannelId msg)-  , unSignature (fundingSignedSignature msg)-  ]---- | Decode a FundingSigned message (type 35).-decodeFundingSigned-  :: BS.ByteString -> Either DecodeError (FundingSigned, BS.ByteString)-decodeFundingSigned !bs = do-  (chanId, rest1) <- decodeChannelIdBytes bs-  (sig, rest2) <- decodeSignatureBytes rest1-  let !msg = FundingSigned-        { fundingSignedChannelId = chanId-        , fundingSignedSignature = sig-        }-  Right (msg, rest2)---- | Encode a ChannelReady message (type 36).------ Wire format:--- - channel_id: 32 bytes--- - second_per_commitment_point: 33 bytes--- - tlvs: TLV stream-encodeChannelReady :: ChannelReady -> BS.ByteString-encodeChannelReady !msg = mconcat-  [ unChannelId (channelReadyChannelId msg)-  , unPoint (channelReadySecondPerCommitPoint msg)-  , encodeTlvStream (channelReadyTlvs msg)-  ]---- | Decode a ChannelReady message (type 36).-decodeChannelReady-  :: BS.ByteString -> Either DecodeError (ChannelReady, BS.ByteString)-decodeChannelReady !bs = do-  (chanId, rest1) <- decodeChannelIdBytes bs-  (secondCommit, rest2) <- decodePointBytes rest1-  tlvs <- decodeTlvs rest2-  let !msg = ChannelReady-        { channelReadyChannelId            = chanId-        , channelReadySecondPerCommitPoint = secondCommit-        , channelReadyTlvs                 = tlvs-        }-  Right (msg, BS.empty)---- Channel close ------------------------------------------------------------------- | Encode a Stfu message (type 2).------ Wire format:--- - channel_id: 32 bytes--- - initiator: 1 byte-encodeStfu :: Stfu -> BS.ByteString-encodeStfu !msg = mconcat-  [ unChannelId (stfuChannelId msg)-  , BS.singleton (stfuInitiator msg)-  ]---- | Decode a Stfu message (type 2).-decodeStfu :: BS.ByteString -> Either DecodeError (Stfu, BS.ByteString)-decodeStfu !bs = do-  (chanId, rest1) <- decodeChannelIdBytes bs-  (initiator, rest2) <- maybe (Left DecodeInsufficientBytes) Right-                          (decodeU8 rest1)-  let !msg = Stfu-        { stfuChannelId = chanId-        , stfuInitiator = initiator-        }-  Right (msg, rest2)---- | Encode a Shutdown message (type 38).------ Wire format:--- - channel_id: 32 bytes--- - len: u16--- - scriptpubkey: len bytes-encodeShutdown :: Shutdown -> Either EncodeError BS.ByteString-encodeShutdown !msg = do-  let !script = unScriptPubKey (shutdownScriptPubkey msg)-      !scriptLen = BS.length script-  if scriptLen > 65535-    then Left EncodeLengthOverflow-    else Right $ mconcat-           [ unChannelId (shutdownChannelId msg)-           , encodeU16 (fromIntegral scriptLen)-           , script-           ]---- | Decode a Shutdown message (type 38).-decodeShutdown-  :: BS.ByteString -> Either DecodeError (Shutdown, BS.ByteString)-decodeShutdown !bs = do-  (chanId, rest1) <- decodeChannelIdBytes bs-  (script, rest2) <- decodeScriptPubKey rest1-  let !msg = Shutdown-        { shutdownChannelId    = chanId-        , shutdownScriptPubkey = script-        }-  Right (msg, rest2)---- | Encode a ClosingSigned message (type 39).------ Wire format:--- - channel_id: 32 bytes--- - fee_satoshis: u64--- - signature: 64 bytes--- - tlvs: TLV stream-encodeClosingSigned :: ClosingSigned -> BS.ByteString-encodeClosingSigned !msg = mconcat-  [ unChannelId (closingSignedChannelId msg)-  , encodeU64 (unSatoshis (closingSignedFeeSatoshis msg))-  , unSignature (closingSignedSignature msg)-  , encodeTlvStream (closingSignedTlvs msg)-  ]---- | Decode a ClosingSigned message (type 39).-decodeClosingSigned-  :: BS.ByteString -> Either DecodeError (ClosingSigned, BS.ByteString)-decodeClosingSigned !bs = do-  (chanId, rest1) <- decodeChannelIdBytes bs-  (feeSats, rest2) <- decodeSatoshis rest1-  (sig, rest3) <- decodeSignatureBytes rest2-  tlvs <- decodeTlvs rest3-  let !msg = ClosingSigned-        { closingSignedChannelId   = chanId-        , closingSignedFeeSatoshis = feeSats-        , closingSignedSignature   = sig-        , closingSignedTlvs        = tlvs-        }-  Right (msg, BS.empty)---- | Encode a ClosingComplete message (type 40).------ Wire format:--- - channel_id: 32 bytes--- - len: u16 (closer script length)--- - closer_script: len bytes--- - len: u16 (closee script length)--- - closee_script: len bytes--- - fee_satoshis: u64--- - locktime: u32--- - tlvs: TLV stream-encodeClosingComplete :: ClosingComplete -> Either EncodeError BS.ByteString-encodeClosingComplete !msg = do-  let !closerScript = unScriptPubKey (closingCompleteCloserScript msg)-      !closeeScript = unScriptPubKey (closingCompleteCloseeScript msg)-      !closerLen = BS.length closerScript-      !closeeLen = BS.length closeeScript-  if closerLen > 65535 || closeeLen > 65535-    then Left EncodeLengthOverflow-    else Right $ mconcat-           [ unChannelId (closingCompleteChannelId msg)-           , encodeU16 (fromIntegral closerLen)-           , closerScript-           , encodeU16 (fromIntegral closeeLen)-           , closeeScript-           , encodeU64 (unSatoshis (closingCompleteFeeSatoshis msg))-           , encodeU32 (closingCompleteLocktime msg)-           , encodeTlvStream (closingCompleteTlvs msg)-           ]---- | Decode a ClosingComplete message (type 40).-decodeClosingComplete-  :: BS.ByteString -> Either DecodeError (ClosingComplete, BS.ByteString)-decodeClosingComplete !bs = do-  (chanId, rest1) <- decodeChannelIdBytes bs-  (closerScript, rest2) <- decodeScriptPubKey rest1-  (closeeScript, rest3) <- decodeScriptPubKey rest2-  (feeSats, rest4) <- decodeSatoshis rest3-  (locktime, rest5) <- decodeU32E rest4-  tlvs <- decodeTlvs rest5-  let !msg = ClosingComplete-        { closingCompleteChannelId    = chanId-        , closingCompleteCloserScript = closerScript-        , closingCompleteCloseeScript = closeeScript-        , closingCompleteFeeSatoshis  = feeSats-        , closingCompleteLocktime     = locktime-        , closingCompleteTlvs         = tlvs-        }-  Right (msg, BS.empty)---- | Encode a ClosingSig message (type 41).------ Wire format:--- - channel_id: 32 bytes--- - len: u16 (closer script length)--- - closer_script: len bytes--- - len: u16 (closee script length)--- - closee_script: len bytes--- - fee_satoshis: u64--- - locktime: u32--- - tlvs: TLV stream-encodeClosingSig :: ClosingSig -> Either EncodeError BS.ByteString-encodeClosingSig !msg = do-  let !closerScript = unScriptPubKey (closingSigCloserScript msg)-      !closeeScript = unScriptPubKey (closingSigCloseeScript msg)-      !closerLen = BS.length closerScript-      !closeeLen = BS.length closeeScript-  if closerLen > 65535 || closeeLen > 65535-    then Left EncodeLengthOverflow-    else Right $ mconcat-           [ unChannelId (closingSigChannelId msg)-           , encodeU16 (fromIntegral closerLen)-           , closerScript-           , encodeU16 (fromIntegral closeeLen)-           , closeeScript-           , encodeU64 (unSatoshis (closingSigFeeSatoshis msg))-           , encodeU32 (closingSigLocktime msg)-           , encodeTlvStream (closingSigTlvs msg)-           ]---- | Decode a ClosingSig message (type 41).-decodeClosingSig-  :: BS.ByteString -> Either DecodeError (ClosingSig, BS.ByteString)-decodeClosingSig !bs = do-  (chanId, rest1) <- decodeChannelIdBytes bs-  (closerScript, rest2) <- decodeScriptPubKey rest1-  (closeeScript, rest3) <- decodeScriptPubKey rest2-  (feeSats, rest4) <- decodeSatoshis rest3-  (locktime, rest5) <- decodeU32E rest4-  tlvs <- decodeTlvs rest5-  let !msg = ClosingSig-        { closingSigChannelId    = chanId-        , closingSigCloserScript = closerScript-        , closingSigCloseeScript = closeeScript-        , closingSigFeeSatoshis  = feeSats-        , closingSigLocktime     = locktime-        , closingSigTlvs         = tlvs-        }-  Right (msg, BS.empty)---- Channel establishment v2 (interactive-tx) --------------------------------------- | Encode an OpenChannel2 message (type 64).-encodeOpenChannel2 :: OpenChannel2 -> BS.ByteString-encodeOpenChannel2 !msg = mconcat-  [ unChainHash (openChannel2ChainHash msg)-  , unChannelId (openChannel2TempChannelId msg)-  , encodeU32 (openChannel2FundingFeeratePerkw msg)-  , encodeU32 (openChannel2CommitFeeratePerkw msg)-  , encodeU64 (unSatoshis (openChannel2FundingSatoshis msg))-  , encodeU64 (unSatoshis (openChannel2DustLimitSatoshis msg))-  , encodeU64 (unMilliSatoshis (openChannel2MaxHtlcValueInFlight msg))-  , encodeU64 (unMilliSatoshis (openChannel2HtlcMinimumMsat msg))-  , encodeU16 (openChannel2ToSelfDelay msg)-  , encodeU16 (openChannel2MaxAcceptedHtlcs msg)-  , encodeU32 (openChannel2Locktime msg)-  , unPoint (openChannel2FundingPubkey msg)-  , unPoint (openChannel2RevocationBasepoint msg)-  , unPoint (openChannel2PaymentBasepoint msg)-  , unPoint (openChannel2DelayedPaymentBase msg)-  , unPoint (openChannel2HtlcBasepoint msg)-  , unPoint (openChannel2FirstPerCommitPoint msg)-  , unPoint (openChannel2SecondPerCommitPoint msg)-  , BS.singleton (openChannel2ChannelFlags msg)-  , encodeTlvStream (openChannel2Tlvs msg)-  ]---- | Decode an OpenChannel2 message (type 64).-decodeOpenChannel2-  :: BS.ByteString -> Either DecodeError (OpenChannel2, BS.ByteString)-decodeOpenChannel2 !bs = do-  (ch, rest1) <- decodeChainHashBytes bs-  (tempCid, rest2) <- decodeChannelIdBytes rest1-  (fundingFeerate, rest3) <- decodeU32E rest2-  (commitFeerate, rest4) <- decodeU32E rest3-  (fundingSats, rest5) <- decodeSatoshis rest4-  (dustLimit, rest6) <- decodeSatoshis rest5-  (maxHtlcVal, rest7) <- decodeMilliSatoshis rest6-  (htlcMin, rest8) <- decodeMilliSatoshis rest7-  (toSelfDelay, rest9) <- decodeU16E rest8-  (maxHtlcs, rest10) <- decodeU16E rest9-  (locktime, rest11) <- decodeU32E rest10-  (fundingPk, rest12) <- decodePointBytes rest11-  (revBase, rest13) <- decodePointBytes rest12-  (payBase, rest14) <- decodePointBytes rest13-  (delayBase, rest15) <- decodePointBytes rest14-  (htlcBase, rest16) <- decodePointBytes rest15-  (firstPt, rest17) <- decodePointBytes rest16-  (secondPt, rest18) <- decodePointBytes rest17-  (flags, rest19) <- maybe (Left DecodeInsufficientBytes) Right (decodeU8 rest18)-  tlvs <- decodeTlvs rest19-  let !msg = OpenChannel2-        { openChannel2ChainHash            = ch-        , openChannel2TempChannelId        = tempCid-        , openChannel2FundingFeeratePerkw  = fundingFeerate-        , openChannel2CommitFeeratePerkw   = commitFeerate-        , openChannel2FundingSatoshis      = fundingSats-        , openChannel2DustLimitSatoshis    = dustLimit-        , openChannel2MaxHtlcValueInFlight = maxHtlcVal-        , openChannel2HtlcMinimumMsat      = htlcMin-        , openChannel2ToSelfDelay          = toSelfDelay-        , openChannel2MaxAcceptedHtlcs     = maxHtlcs-        , openChannel2Locktime             = locktime-        , openChannel2FundingPubkey        = fundingPk-        , openChannel2RevocationBasepoint  = revBase-        , openChannel2PaymentBasepoint     = payBase-        , openChannel2DelayedPaymentBase   = delayBase-        , openChannel2HtlcBasepoint        = htlcBase-        , openChannel2FirstPerCommitPoint  = firstPt-        , openChannel2SecondPerCommitPoint = secondPt-        , openChannel2ChannelFlags         = flags-        , openChannel2Tlvs                 = tlvs-        }-  Right (msg, BS.empty)---- | Encode an AcceptChannel2 message (type 65).-encodeAcceptChannel2 :: AcceptChannel2 -> BS.ByteString-encodeAcceptChannel2 !msg = mconcat-  [ unChannelId (acceptChannel2TempChannelId msg)-  , encodeU64 (unSatoshis (acceptChannel2FundingSatoshis msg))-  , encodeU64 (unSatoshis (acceptChannel2DustLimitSatoshis msg))-  , encodeU64 (unMilliSatoshis (acceptChannel2MaxHtlcValueInFlight msg))-  , encodeU64 (unMilliSatoshis (acceptChannel2HtlcMinimumMsat msg))-  , encodeU32 (acceptChannel2MinimumDepth msg)-  , encodeU16 (acceptChannel2ToSelfDelay msg)-  , encodeU16 (acceptChannel2MaxAcceptedHtlcs msg)-  , unPoint (acceptChannel2FundingPubkey msg)-  , unPoint (acceptChannel2RevocationBasepoint msg)-  , unPoint (acceptChannel2PaymentBasepoint msg)-  , unPoint (acceptChannel2DelayedPaymentBase msg)-  , unPoint (acceptChannel2HtlcBasepoint msg)-  , unPoint (acceptChannel2FirstPerCommitPoint msg)-  , unPoint (acceptChannel2SecondPerCommitPoint msg)-  , encodeTlvStream (acceptChannel2Tlvs msg)-  ]---- | Decode an AcceptChannel2 message (type 65).-decodeAcceptChannel2-  :: BS.ByteString -> Either DecodeError (AcceptChannel2, BS.ByteString)-decodeAcceptChannel2 !bs = do-  (tempCid, rest1) <- decodeChannelIdBytes bs-  (fundingSats, rest2) <- decodeSatoshis rest1-  (dustLimit, rest3) <- decodeSatoshis rest2-  (maxHtlcVal, rest4) <- decodeMilliSatoshis rest3-  (htlcMin, rest5) <- decodeMilliSatoshis rest4-  (minDepth, rest6) <- decodeU32E rest5-  (toSelfDelay, rest7) <- decodeU16E rest6-  (maxHtlcs, rest8) <- decodeU16E rest7-  (fundingPk, rest9) <- decodePointBytes rest8-  (revBase, rest10) <- decodePointBytes rest9-  (payBase, rest11) <- decodePointBytes rest10-  (delayBase, rest12) <- decodePointBytes rest11-  (htlcBase, rest13) <- decodePointBytes rest12-  (firstPt, rest14) <- decodePointBytes rest13-  (secondPt, rest15) <- decodePointBytes rest14-  tlvs <- decodeTlvs rest15-  let !msg = AcceptChannel2-        { acceptChannel2TempChannelId        = tempCid-        , acceptChannel2FundingSatoshis      = fundingSats-        , acceptChannel2DustLimitSatoshis    = dustLimit-        , acceptChannel2MaxHtlcValueInFlight = maxHtlcVal-        , acceptChannel2HtlcMinimumMsat      = htlcMin-        , acceptChannel2MinimumDepth         = minDepth-        , acceptChannel2ToSelfDelay          = toSelfDelay-        , acceptChannel2MaxAcceptedHtlcs     = maxHtlcs-        , acceptChannel2FundingPubkey        = fundingPk-        , acceptChannel2RevocationBasepoint  = revBase-        , acceptChannel2PaymentBasepoint     = payBase-        , acceptChannel2DelayedPaymentBase   = delayBase-        , acceptChannel2HtlcBasepoint        = htlcBase-        , acceptChannel2FirstPerCommitPoint  = firstPt-        , acceptChannel2SecondPerCommitPoint = secondPt-        , acceptChannel2Tlvs                 = tlvs-        }-  Right (msg, BS.empty)---- | Encode a TxAddInput message (type 66).-encodeTxAddInput :: TxAddInput -> Either EncodeError BS.ByteString-encodeTxAddInput !msg = do-  prevTxEnc <- encodeU16BytesE (txAddInputPrevTx msg)-  Right $! mconcat-    [ unChannelId (txAddInputChannelId msg)-    , encodeU64 (txAddInputSerialId msg)-    , prevTxEnc-    , encodeU32 (txAddInputPrevVout msg)-    , encodeU32 (txAddInputSequence msg)-    ]---- | Decode a TxAddInput message (type 66).-decodeTxAddInput-  :: BS.ByteString -> Either DecodeError (TxAddInput, BS.ByteString)-decodeTxAddInput !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (serialId, rest2) <- maybe (Left DecodeInsufficientBytes) Right-                         (decodeU64 rest1)-  (prevTx, rest3) <- decodeU16Bytes rest2-  (prevVout, rest4) <- decodeU32E rest3-  (seqNum, rest5) <- decodeU32E rest4-  let !msg = TxAddInput-        { txAddInputChannelId = cid-        , txAddInputSerialId  = serialId-        , txAddInputPrevTx    = prevTx-        , txAddInputPrevVout  = prevVout-        , txAddInputSequence  = seqNum-        }-  Right (msg, rest5)---- | Encode a TxAddOutput message (type 67).-encodeTxAddOutput :: TxAddOutput -> Either EncodeError BS.ByteString-encodeTxAddOutput !msg = do-  scriptEnc <- encodeU16BytesE (unScriptPubKey (txAddOutputScript msg))-  Right $! mconcat-    [ unChannelId (txAddOutputChannelId msg)-    , encodeU64 (txAddOutputSerialId msg)-    , encodeU64 (unSatoshis (txAddOutputSats msg))-    , scriptEnc-    ]---- | Decode a TxAddOutput message (type 67).-decodeTxAddOutput-  :: BS.ByteString -> Either DecodeError (TxAddOutput, BS.ByteString)-decodeTxAddOutput !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (serialId, rest2) <- maybe (Left DecodeInsufficientBytes) Right-                         (decodeU64 rest1)-  (sats, rest3) <- decodeSatoshis rest2-  (scriptBs, rest4) <- decodeU16Bytes rest3-  let !msg = TxAddOutput-        { txAddOutputChannelId = cid-        , txAddOutputSerialId  = serialId-        , txAddOutputSats      = sats-        , txAddOutputScript    = scriptPubKey scriptBs-        }-  Right (msg, rest4)---- | Encode a TxRemoveInput message (type 68).-encodeTxRemoveInput :: TxRemoveInput -> BS.ByteString-encodeTxRemoveInput !msg = mconcat-  [ unChannelId (txRemoveInputChannelId msg)-  , encodeU64 (txRemoveInputSerialId msg)-  ]---- | Decode a TxRemoveInput message (type 68).-decodeTxRemoveInput-  :: BS.ByteString -> Either DecodeError (TxRemoveInput, BS.ByteString)-decodeTxRemoveInput !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (serialId, rest2) <- maybe (Left DecodeInsufficientBytes) Right-                         (decodeU64 rest1)-  let !msg = TxRemoveInput-        { txRemoveInputChannelId = cid-        , txRemoveInputSerialId  = serialId-        }-  Right (msg, rest2)---- | Encode a TxRemoveOutput message (type 69).-encodeTxRemoveOutput :: TxRemoveOutput -> BS.ByteString-encodeTxRemoveOutput !msg = mconcat-  [ unChannelId (txRemoveOutputChannelId msg)-  , encodeU64 (txRemoveOutputSerialId msg)-  ]---- | Decode a TxRemoveOutput message (type 69).-decodeTxRemoveOutput-  :: BS.ByteString -> Either DecodeError (TxRemoveOutput, BS.ByteString)-decodeTxRemoveOutput !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (serialId, rest2) <- maybe (Left DecodeInsufficientBytes) Right-                         (decodeU64 rest1)-  let !msg = TxRemoveOutput-        { txRemoveOutputChannelId = cid-        , txRemoveOutputSerialId  = serialId-        }-  Right (msg, rest2)---- | Encode a TxComplete message (type 70).-encodeTxComplete :: TxComplete -> BS.ByteString-encodeTxComplete !msg = unChannelId (txCompleteChannelId msg)---- | Decode a TxComplete message (type 70).-decodeTxComplete-  :: BS.ByteString -> Either DecodeError (TxComplete, BS.ByteString)-decodeTxComplete !bs = do-  (cid, rest) <- decodeChannelIdBytes bs-  let !msg = TxComplete { txCompleteChannelId = cid }-  Right (msg, rest)---- | Encode a single witness with bounds checking.-encodeWitnessE :: Witness -> Either EncodeError BS.ByteString-encodeWitnessE (Witness !wdata) = encodeU16BytesE wdata---- | Decode a single witness.-decodeWitness :: BS.ByteString -> Either DecodeError (Witness, BS.ByteString)-decodeWitness !bs = do-  (wdata, rest) <- decodeU16Bytes bs-  Right (Witness wdata, rest)---- | Encode a TxSignatures message (type 71).-encodeTxSignatures :: TxSignatures -> Either EncodeError BS.ByteString-encodeTxSignatures !msg = do-  let !witnesses = txSignaturesWitnesses msg-  numWit <- checkListCountU16 (length witnesses)-  encodedWits <- traverse encodeWitnessE witnesses-  Right $! mconcat $-    [ unChannelId (txSignaturesChannelId msg)-    , unTxId (txSignaturesTxid msg)-    , encodeU16 numWit-    ] ++ encodedWits---- | Decode a TxSignatures message (type 71).-decodeTxSignatures-  :: BS.ByteString -> Either DecodeError (TxSignatures, BS.ByteString)-decodeTxSignatures !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (tid, rest2) <- decodeTxIdBytes rest1-  (numWit, rest3) <- decodeU16E rest2-  (witnesses, rest4) <- decodeWitnesses (fromIntegral numWit) rest3-  let !msg = TxSignatures-        { txSignaturesChannelId = cid-        , txSignaturesTxid      = tid-        , txSignaturesWitnesses = witnesses-        }-  Right (msg, rest4)-  where-    decodeWitnesses :: Int -> BS.ByteString-                    -> Either DecodeError ([Witness], BS.ByteString)-    decodeWitnesses 0 !rest = Right ([], rest)-    decodeWitnesses !n !rest = do-      (w, rest') <- decodeWitness rest-      (ws, rest'') <- decodeWitnesses (n - 1) rest'-      Right (w : ws, rest'')---- | Encode a TxInitRbf message (type 72).-encodeTxInitRbf :: TxInitRbf -> BS.ByteString-encodeTxInitRbf !msg = mconcat-  [ unChannelId (txInitRbfChannelId msg)-  , encodeU32 (txInitRbfLocktime msg)-  , encodeU32 (txInitRbfFeerate msg)-  , encodeTlvStream (txInitRbfTlvs msg)-  ]---- | Decode a TxInitRbf message (type 72).-decodeTxInitRbf-  :: BS.ByteString -> Either DecodeError (TxInitRbf, BS.ByteString)-decodeTxInitRbf !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (locktime, rest2) <- decodeU32E rest1-  (feerate, rest3) <- decodeU32E rest2-  tlvs <- decodeTlvs rest3-  let !msg = TxInitRbf-        { txInitRbfChannelId = cid-        , txInitRbfLocktime  = locktime-        , txInitRbfFeerate   = feerate-        , txInitRbfTlvs      = tlvs-        }-  Right (msg, BS.empty)---- | Encode a TxAckRbf message (type 73).-encodeTxAckRbf :: TxAckRbf -> BS.ByteString-encodeTxAckRbf !msg = mconcat-  [ unChannelId (txAckRbfChannelId msg)-  , encodeTlvStream (txAckRbfTlvs msg)-  ]---- | Decode a TxAckRbf message (type 73).-decodeTxAckRbf-  :: BS.ByteString -> Either DecodeError (TxAckRbf, BS.ByteString)-decodeTxAckRbf !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  tlvs <- decodeTlvs rest1-  let !msg = TxAckRbf-        { txAckRbfChannelId = cid-        , txAckRbfTlvs      = tlvs-        }-  Right (msg, BS.empty)---- | Encode a TxAbort message (type 74).-encodeTxAbort :: TxAbort -> Either EncodeError BS.ByteString-encodeTxAbort !msg = do-  dataEnc <- encodeU16BytesE (txAbortData msg)-  Right $! mconcat-    [ unChannelId (txAbortChannelId msg)-    , dataEnc-    ]---- | Decode a TxAbort message (type 74).-decodeTxAbort-  :: BS.ByteString -> Either DecodeError (TxAbort, BS.ByteString)-decodeTxAbort !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (dat, rest2) <- decodeU16Bytes rest1-  let !msg = TxAbort-        { txAbortChannelId = cid-        , txAbortData      = dat-        }-  Right (msg, rest2)---- Normal operation ---------------------------------------------------------------- | Encode an UpdateAddHtlc message (type 128).-encodeUpdateAddHtlc :: UpdateAddHtlc -> BS.ByteString-encodeUpdateAddHtlc !m = mconcat-  [ unChannelId (updateAddHtlcChannelId m)-  , encodeU64 (updateAddHtlcId m)-  , encodeU64 (unMilliSatoshis (updateAddHtlcAmountMsat m))-  , unPaymentHash (updateAddHtlcPaymentHash m)-  , encodeU32 (updateAddHtlcCltvExpiry m)-  , unOnionPacket (updateAddHtlcOnionPacket m)-  , encodeTlvStream (updateAddHtlcTlvs m)-  ]-{-# INLINABLE encodeUpdateAddHtlc #-}---- | Decode an UpdateAddHtlc message (type 128).-decodeUpdateAddHtlc-  :: BS.ByteString -> Either DecodeError (UpdateAddHtlc, BS.ByteString)-decodeUpdateAddHtlc !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (htlcId, rest2) <- maybe (Left DecodeInsufficientBytes) Right-                       (decodeU64 rest1)-  (amtMsat, rest3) <- maybe (Left DecodeInsufficientBytes) Right-                        (decodeU64 rest2)-  (pHash, rest4) <- decodePaymentHashBytes rest3-  (cltvExp, rest5) <- decodeU32E rest4-  (onion, rest6) <- decodeOnionPacketBytes rest5-  (tlvs, rest7) <- decodeOptionalTlvs rest6-  let !msg = UpdateAddHtlc-        { updateAddHtlcChannelId   = cid-        , updateAddHtlcId          = htlcId-        , updateAddHtlcAmountMsat  = MilliSatoshis amtMsat-        , updateAddHtlcPaymentHash = pHash-        , updateAddHtlcCltvExpiry  = cltvExp-        , updateAddHtlcOnionPacket = onion-        , updateAddHtlcTlvs        = tlvs-        }-  Right (msg, rest7)-{-# INLINABLE decodeUpdateAddHtlc #-}---- | Encode an UpdateFulfillHtlc message (type 130).-encodeUpdateFulfillHtlc :: UpdateFulfillHtlc -> BS.ByteString-encodeUpdateFulfillHtlc !m = mconcat-  [ unChannelId (updateFulfillHtlcChannelId m)-  , encodeU64 (updateFulfillHtlcId m)-  , unPaymentPreimage (updateFulfillHtlcPaymentPreimage m)-  , encodeTlvStream (updateFulfillHtlcTlvs m)-  ]---- | Decode an UpdateFulfillHtlc message (type 130).-decodeUpdateFulfillHtlc-  :: BS.ByteString -> Either DecodeError (UpdateFulfillHtlc, BS.ByteString)-decodeUpdateFulfillHtlc !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (htlcId, rest2) <- maybe (Left DecodeInsufficientBytes) Right-                       (decodeU64 rest1)-  (preimage, rest3) <- decodePaymentPreimageBytes rest2-  (tlvs, rest4) <- decodeOptionalTlvs rest3-  let !msg = UpdateFulfillHtlc-        { updateFulfillHtlcChannelId       = cid-        , updateFulfillHtlcId              = htlcId-        , updateFulfillHtlcPaymentPreimage = preimage-        , updateFulfillHtlcTlvs            = tlvs-        }-  Right (msg, rest4)---- | Encode an UpdateFailHtlc message (type 131).-encodeUpdateFailHtlc :: UpdateFailHtlc -> Either EncodeError BS.ByteString-encodeUpdateFailHtlc !m = do-  reasonEnc <- encodeU16BytesE (updateFailHtlcReason m)-  Right $! mconcat-    [ unChannelId (updateFailHtlcChannelId m)-    , encodeU64 (updateFailHtlcId m)-    , reasonEnc-    , encodeTlvStream (updateFailHtlcTlvs m)-    ]---- | Decode an UpdateFailHtlc message (type 131).-decodeUpdateFailHtlc-  :: BS.ByteString -> Either DecodeError (UpdateFailHtlc, BS.ByteString)-decodeUpdateFailHtlc !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (htlcId, rest2) <- maybe (Left DecodeInsufficientBytes) Right-                       (decodeU64 rest1)-  (reason, rest3) <- decodeU16Bytes rest2-  (tlvs, rest4) <- decodeOptionalTlvs rest3-  let !msg = UpdateFailHtlc-        { updateFailHtlcChannelId = cid-        , updateFailHtlcId        = htlcId-        , updateFailHtlcReason    = reason-        , updateFailHtlcTlvs      = tlvs-        }-  Right (msg, rest4)---- | Encode an UpdateFailMalformedHtlc message (type 135).-encodeUpdateFailMalformedHtlc :: UpdateFailMalformedHtlc -> BS.ByteString-encodeUpdateFailMalformedHtlc !m = mconcat-  [ unChannelId (updateFailMalformedHtlcChannelId m)-  , encodeU64 (updateFailMalformedHtlcId m)-  , unPaymentHash (updateFailMalformedHtlcSha256Onion m)-  , encodeU16 (updateFailMalformedHtlcFailureCode m)-  ]---- | Decode an UpdateFailMalformedHtlc message (type 135).-decodeUpdateFailMalformedHtlc-  :: BS.ByteString -> Either DecodeError (UpdateFailMalformedHtlc, BS.ByteString)-decodeUpdateFailMalformedHtlc !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (htlcId, rest2) <- maybe (Left DecodeInsufficientBytes) Right-                       (decodeU64 rest1)-  (sha256Onion, rest3) <- decodePaymentHashBytes rest2-  (failCode, rest4) <- decodeU16E rest3-  let !msg = UpdateFailMalformedHtlc-        { updateFailMalformedHtlcChannelId   = cid-        , updateFailMalformedHtlcId          = htlcId-        , updateFailMalformedHtlcSha256Onion = sha256Onion-        , updateFailMalformedHtlcFailureCode = failCode-        }-  Right (msg, rest4)---- | Encode a CommitmentSigned message (type 132).-encodeCommitmentSigned :: CommitmentSigned -> Either EncodeError BS.ByteString-encodeCommitmentSigned !m = do-  let !sigs = commitmentSignedHtlcSignatures m-  numHtlcs <- checkListCountU16 (length sigs)-  Right $! mconcat $-    [ unChannelId (commitmentSignedChannelId m)-    , unSignature (commitmentSignedSignature m)-    , encodeU16 numHtlcs-    ] ++ map unSignature sigs-{-# INLINABLE encodeCommitmentSigned #-}---- | Decode a CommitmentSigned message (type 132).-decodeCommitmentSigned-  :: BS.ByteString -> Either DecodeError (CommitmentSigned, BS.ByteString)-decodeCommitmentSigned !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (sig, rest2) <- decodeSignatureBytes rest1-  (numHtlcs, rest3) <- decodeU16E rest2-  (htlcSigs, rest4) <- decodeSignatures (fromIntegral numHtlcs) rest3-  let !msg = CommitmentSigned-        { commitmentSignedChannelId      = cid-        , commitmentSignedSignature      = sig-        , commitmentSignedHtlcSignatures = htlcSigs-        }-  Right (msg, rest4)-  where-    decodeSignatures :: Int -> BS.ByteString-                     -> Either DecodeError ([Signature], BS.ByteString)-    decodeSignatures !n !input = go n input []-      where-        go :: Int -> BS.ByteString -> [Signature]-           -> Either DecodeError ([Signature], BS.ByteString)-        go 0 !remaining !acc = Right (reverse acc, remaining)-        go !count !remaining !acc = do-          (s, rest) <- decodeSignatureBytes remaining-          go (count - 1) rest (s : acc)-{-# INLINABLE decodeCommitmentSigned #-}---- | Encode a RevokeAndAck message (type 133).-encodeRevokeAndAck :: RevokeAndAck -> BS.ByteString-encodeRevokeAndAck !m = mconcat-  [ unChannelId (revokeAndAckChannelId m)-  , unSecret (revokeAndAckPerCommitmentSecret m)-  , unPoint (revokeAndAckNextPerCommitPoint m)-  ]---- | Decode a RevokeAndAck message (type 133).-decodeRevokeAndAck-  :: BS.ByteString -> Either DecodeError (RevokeAndAck, BS.ByteString)-decodeRevokeAndAck !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (sec, rest2) <- decodeSecretBytes rest1-  (nextPoint, rest3) <- decodePointBytes rest2-  let !msg = RevokeAndAck-        { revokeAndAckChannelId           = cid-        , revokeAndAckPerCommitmentSecret = sec-        , revokeAndAckNextPerCommitPoint  = nextPoint-        }-  Right (msg, rest3)---- | Encode an UpdateFee message (type 134).-encodeUpdateFee :: UpdateFee -> BS.ByteString-encodeUpdateFee !m = mconcat-  [ unChannelId (updateFeeChannelId m)-  , encodeU32 (updateFeeFeeratePerKw m)-  ]---- | Decode an UpdateFee message (type 134).-decodeUpdateFee-  :: BS.ByteString -> Either DecodeError (UpdateFee, BS.ByteString)-decodeUpdateFee !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (feerate, rest2) <- decodeU32E rest1-  let !msg = UpdateFee-        { updateFeeChannelId    = cid-        , updateFeeFeeratePerKw = feerate-        }-  Right (msg, rest2)---- Channel reestablishment --------------------------------------------------------- | Encode a ChannelReestablish message (type 136).-encodeChannelReestablish :: ChannelReestablish -> BS.ByteString-encodeChannelReestablish !m = mconcat-  [ unChannelId (channelReestablishChannelId m)-  , encodeU64 (channelReestablishNextCommitNum m)-  , encodeU64 (channelReestablishNextRevocationNum m)-  , unSecret (channelReestablishYourLastCommitSecret m)-  , unPoint (channelReestablishMyCurrentCommitPoint m)-  , encodeTlvStream (channelReestablishTlvs m)-  ]---- | Decode a ChannelReestablish message (type 136).-decodeChannelReestablish-  :: BS.ByteString -> Either DecodeError (ChannelReestablish, BS.ByteString)-decodeChannelReestablish !bs = do-  (cid, rest1) <- decodeChannelIdBytes bs-  (nextCommit, rest2) <- maybe (Left DecodeInsufficientBytes) Right-                           (decodeU64 rest1)-  (nextRevoke, rest3) <- maybe (Left DecodeInsufficientBytes) Right-                           (decodeU64 rest2)-  (sec, rest4) <- decodeSecretBytes rest3-  (myPoint, rest5) <- decodePointBytes rest4-  (tlvs, rest6) <- decodeOptionalTlvs rest5-  let !msg = ChannelReestablish-        { channelReestablishChannelId            = cid-        , channelReestablishNextCommitNum        = nextCommit-        , channelReestablishNextRevocationNum    = nextRevoke-        , channelReestablishYourLastCommitSecret = sec-        , channelReestablishMyCurrentCommitPoint = myPoint-        , channelReestablishTlvs                 = tlvs-        }-  Right (msg, rest6)+{-# OPTIONS_HADDOCK hide #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}++-- |+-- Module: Lightning.Protocol.BOLT2.Codec+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Encoding and decoding of BOLT #2 messages.++module Lightning.Protocol.BOLT2.Codec (+    EncodeError(..)+  , DecodeError(..)++  , encode_message+  , decode_message++  , encode_open_channel+  , decode_open_channel+  , encode_accept_channel+  , decode_accept_channel+  , encode_funding_created+  , decode_funding_created+  , encode_funding_signed+  , decode_funding_signed+  , encode_channel_ready+  , decode_channel_ready++  , encode_open_channel2+  , decode_open_channel2+  , encode_accept_channel2+  , decode_accept_channel2+  , encode_tx_add_input+  , decode_tx_add_input+  , encode_tx_add_output+  , decode_tx_add_output+  , encode_tx_remove_input+  , decode_tx_remove_input+  , encode_tx_remove_output+  , decode_tx_remove_output+  , encode_tx_complete+  , decode_tx_complete+  , encode_tx_signatures+  , decode_tx_signatures+  , encode_tx_init_rbf+  , decode_tx_init_rbf+  , encode_tx_ack_rbf+  , decode_tx_ack_rbf+  , encode_tx_abort+  , decode_tx_abort++  , encode_stfu+  , decode_stfu++  , encode_shutdown+  , decode_shutdown+  , encode_closing_complete+  , decode_closing_complete+  , encode_closing_sig+  , decode_closing_sig+  , encode_closing_signed+  , decode_closing_signed++  , encode_update_add_htlc+  , decode_update_add_htlc+  , encode_update_fulfill_htlc+  , decode_update_fulfill_htlc+  , encode_update_fail_htlc+  , decode_update_fail_htlc+  , encode_update_fail_malformed_htlc+  , decode_update_fail_malformed_htlc+  , encode_commitment_signed+  , decode_commitment_signed+  , encode_revoke_and_ack+  , decode_revoke_and_ack+  , encode_update_fee+  , decode_update_fee++  , encode_channel_reestablish+  , decode_channel_reestablish+  ) where++import Bitcoin.Prim.Tx (TxId, mk_txid, un_txid)+import Control.DeepSeq (NFData)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BU+import Data.Int (Int64)+import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Generics (Generic)+import qualified Lightning.Protocol.BOLT1 as BOLT1+import Lightning.Protocol.BOLT1+  ( ChannelId, Signature, Point, TlvRecord(..), TlvStream, TlvError )+import qualified Lightning.Protocol.BOLT9 as BOLT9+import Lightning.Protocol.BOLT2.Messages+import Lightning.Protocol.BOLT2.Types++-- errors ---------------------------------------------------------------------++-- | Why a message failed to encode.+data EncodeError+  = EncodeLengthOverflow+    -- ^ a length-prefixed field or a counted list exceeds 65535+  | EncodeInvalidTlvs+    -- ^ a @_tlvs@ field contains a record of a type the message knows+  | EncodeMessageTooLarge+    -- ^ the message (type and payload) exceeds 65535 bytes+  deriving (Eq, Show, Generic)++instance NFData EncodeError++-- | Why a message failed to decode.+data DecodeError+  = DecodeInsufficientBytes+    -- ^ the input ended before a field did+  | DecodeInvalidPoint+    -- ^ a point lacks a compressed-encoding prefix+  | DecodeInvalidAmount+    -- ^ an amount exceeds 21 million BTC+  | DecodeInvalidInitiator+    -- ^ the @initiator@ byte of @stfu@ is neither 0 nor 1+  | DecodeTlvError !TlvError+    -- ^ the message's TLV stream is malformed, or has an unknown even+    --   type+  | DecodeInvalidTlvValue !Word64+    -- ^ a known TLV record (of the given type) has a malformed value+  | DecodeUnknownEvenType !Word16+    -- ^ a message type that BOLT #2 doesn't define (even)+  | DecodeUnknownOddType !Word16+    -- ^ a message type that BOLT #2 doesn't define (odd)+  deriving (Eq, Show, Generic)++instance NFData DecodeError++-- parsing --------------------------------------------------------------------++newtype Parser a = Parser+  { run_parser :: BS.ByteString -> Either DecodeError (a, BS.ByteString) }++instance Functor Parser where+  fmap f (Parser p) = Parser $ \bs -> case p bs of+    Left e        -> Left e+    Right (a, r)  -> Right (f a, r)+  {-# INLINE fmap #-}++instance Applicative Parser where+  pure a = Parser $ \bs -> Right (a, bs)+  {-# INLINE pure #-}+  Parser pf <*> Parser pa = Parser $ \bs -> case pf bs of+    Left e       -> Left e+    Right (f, r) -> case pa r of+      Left e        -> Left e+      Right (a, r') -> Right (f a, r')+  {-# INLINE (<*>) #-}++instance Monad Parser where+  Parser p >>= k = Parser $ \bs -> case p bs of+    Left e       -> Left e+    Right (a, r) -> run_parser (k a) r+  {-# INLINE (>>=) #-}++-- run a parser whose last step consumes the remaining input+parse :: Parser a -> BS.ByteString -> Either DecodeError a+parse p bs = fmap fst (run_parser p bs)+{-# INLINE parse #-}++failure :: DecodeError -> Parser a+failure e = Parser $ \_ -> Left e+{-# INLINE failure #-}++-- lift a bolt1 field decoder, whose only failure is truncation+field :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> Parser a+field f = Parser $ \bs -> case f bs of+  Nothing -> Left DecodeInsufficientBytes+  Just r  -> Right r+{-# INLINE field #-}++bytes :: Int -> Parser BS.ByteString+bytes n = Parser $ \bs ->+  if BS.length bs < n+    then Left DecodeInsufficientBytes+    else Right (BU.unsafeTake n bs, BU.unsafeDrop n bs)+{-# INLINE bytes #-}++-- a fixed-size field whose constructor checks only the length+sized :: Int -> (BS.ByteString -> Maybe a) -> Parser a+sized n f = do+  b <- bytes n+  maybe (failure DecodeInsufficientBytes) pure (f b)+{-# INLINE sized #-}++u8 :: Parser Word8+u8 = Parser $ \bs -> case BS.uncons bs of+  Nothing -> Left DecodeInsufficientBytes+  Just r  -> Right r+{-# INLINE u8 #-}++u16 :: Parser Word16+u16 = field BOLT1.decode_u16+{-# INLINE u16 #-}++u32 :: Parser Word32+u32 = field BOLT1.decode_u32+{-# INLINE u32 #-}++u64 :: Parser Word64+u64 = field BOLT1.decode_u64+{-# INLINE u64 #-}++chain_hash :: Parser BOLT1.ChainHash+chain_hash = field BOLT1.decode_chain_hash+{-# INLINE chain_hash #-}++channel_id :: Parser ChannelId+channel_id = field BOLT1.decode_channel_id+{-# INLINE channel_id #-}++signature :: Parser Signature+signature = field BOLT1.decode_signature+{-# INLINE signature #-}++payment_hash :: Parser BOLT1.PaymentHash+payment_hash = field BOLT1.decode_payment_hash+{-# INLINE payment_hash #-}++payment_preimage :: Parser BOLT1.PaymentPreimage+payment_preimage = field BOLT1.decode_payment_preimage+{-# INLINE payment_preimage #-}++per_commitment_secret :: Parser BOLT1.PerCommitmentSecret+per_commitment_secret = field BOLT1.decode_per_commitment_secret+{-# INLINE per_commitment_secret #-}++point :: Parser Point+point = do+  b <- bytes 33+  maybe (failure DecodeInvalidPoint) pure (BOLT1.point b)+{-# INLINE point #-}++satoshi :: Parser BOLT1.Satoshi+satoshi = do+  w <- u64+  maybe (failure DecodeInvalidAmount) pure (BOLT1.satoshi w)+{-# INLINE satoshi #-}++milli_satoshi :: Parser BOLT1.MilliSatoshi+milli_satoshi = do+  w <- u64+  maybe (failure DecodeInvalidAmount) pure (BOLT1.milli_satoshi w)+{-# INLINE milli_satoshi #-}++txid :: Parser TxId+txid = sized 32 mk_txid+{-# INLINE txid #-}++htlc_id :: Parser HtlcId+htlc_id = fmap HtlcId u64+{-# INLINE htlc_id #-}++serial_id :: Parser SerialId+serial_id = fmap SerialId u64+{-# INLINE serial_id #-}++prefixed :: Parser BS.ByteString+prefixed = field BOLT1.decode_u16_prefixed+{-# INLINE prefixed #-}++script :: Parser ScriptPubKey+script = do+  b <- prefixed+  maybe (failure DecodeInsufficientBytes) pure (script_pubkey b)+{-# INLINE script #-}++-- n items, each parsed by p+count :: Int -> Parser a -> Parser [a]+count n0 p = go n0 []+  where+    go !n !acc+      | n <= 0    = pure (reverse acc)+      | otherwise = p >>= \a -> go (n - 1) (a : acc)+{-# INLINE count #-}++-- the TLV stream occupying the rest of the payload, given the message's+-- known types+tlvs :: [Word64] -> Parser TlvStream+tlvs known = Parser $ \bs ->+  case BOLT1.decode_tlv_stream (`elem` known) bs of+    Left e  -> Left (DecodeTlvError e)+    Right s -> Right (s, BS.empty)+{-# INLINE tlvs #-}++-- the unknown records of a stream+unknown :: [Word64] -> TlvStream -> TlvStream+unknown known = BOLT1.filter_tlv_stream (`notElem` known)+{-# INLINE unknown #-}++-- the typed value of a known record, if present+record :: Word64 -> (BS.ByteString -> Maybe a) -> TlvStream -> Parser (Maybe a)+record t f s = case BOLT1.lookup_tlv t s of+  Nothing -> pure Nothing+  Just v  -> maybe (failure (DecodeInvalidTlvValue t)) (pure . Just) (f v)+{-# INLINE record #-}++-- whether a known record with an empty value is present+flag :: Word64 -> TlvStream -> Parser Bool+flag t s = fmap (maybe False (const True)) (record t empty_value s)+  where+    empty_value v+      | BS.null v = Just ()+      | otherwise = Nothing+{-# INLINE flag #-}++-- TLV values -----------------------------------------------------------------++-- run a field decoder over a whole TLV value+whole :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString+      -> Maybe a+whole f v = case f v of+  Just (a, r) | BS.null r -> Just a+  _ -> Nothing+{-# INLINE whole #-}++tlv_point :: BS.ByteString -> Maybe Point+tlv_point v+  | BS.length v == 33 = BOLT1.point v+  | otherwise         = Nothing++tlv_s64 :: BS.ByteString -> Maybe Int64+tlv_s64 = whole BOLT1.decode_s64++tlv_fee_range :: BS.ByteString -> Maybe FeeRange+tlv_fee_range v = do+  (lo, r0) <- BOLT1.decode_satoshi v+  hi <- whole BOLT1.decode_satoshi r0+  pure (FeeRange lo hi)++tlv_next_funding :: BS.ByteString -> Maybe NextFunding+tlv_next_funding v+  | BS.length v == 33 = do+      t <- mk_txid (BU.unsafeTake 32 v)+      pure (NextFunding t (BU.unsafeIndex v 32))+  | otherwise = Nothing++-- encoding -------------------------------------------------------------------++u16_prefixed :: BS.ByteString -> Either EncodeError BS.ByteString+u16_prefixed bs = maybe (Left EncodeLengthOverflow) Right+  (BOLT1.encode_u16_prefixed bs)+{-# INLINE u16_prefixed #-}++-- scripts are bounded, so their prefix can't overflow+script_bytes :: ScriptPubKey -> BS.ByteString+script_bytes s =+  let !b = un_script_pubkey s+  in  BOLT1.encode_u16 (fromIntegral (BS.length b)) <> b+{-# INLINE script_bytes #-}++count_prefix :: [a] -> Either EncodeError BS.ByteString+count_prefix xs+  | n > 65535 = Left EncodeLengthOverflow+  | otherwise = Right (BOLT1.encode_u16 (fromIntegral n))+  where+    !n = length xs+{-# INLINE count_prefix #-}++txid_bytes :: TxId -> BS.ByteString+txid_bytes = un_txid+{-# INLINE txid_bytes #-}++word8 :: Word8 -> BS.ByteString+word8 = BS.singleton+{-# INLINE word8 #-}++-- encode a message's TLV stream: its typed records plus the unknown+-- ones, which mustn't use a known type+encode_tlvs+  :: [Word64] -> [TlvRecord] -> TlvStream -> Either EncodeError BS.ByteString+encode_tlvs known recs extra+  | any ((`elem` known) . tlv_type) others = Left EncodeInvalidTlvs+  | otherwise = case BOLT1.tlv_stream (recs <> others) of+      Nothing -> Left EncodeInvalidTlvs+      Just s  -> Right (BOLT1.encode_tlv_stream s)+  where+    others = BOLT1.un_tlv_stream extra+{-# INLINE encode_tlvs #-}++opt :: Word64 -> (a -> BS.ByteString) -> Maybe a -> [TlvRecord]+opt t f = maybe [] (\a -> [TlvRecord t (f a)])+{-# INLINE opt #-}++opt_flag :: Word64 -> Bool -> [TlvRecord]+opt_flag t b = if b then [TlvRecord t BS.empty] else []+{-# INLINE opt_flag #-}++fee_range_bytes :: FeeRange -> BS.ByteString+fee_range_bytes (FeeRange lo hi) =+  BOLT1.encode_satoshi lo <> BOLT1.encode_satoshi hi++next_funding_bytes :: NextFunding -> BS.ByteString+next_funding_bytes (NextFunding t f) = txid_bytes t <> word8 f++-- messages -------------------------------------------------------------------++-- | Encode a BOLT #2 message, including its type. Fails if a field+--   can't be encoded or the result exceeds 65535 bytes.+--+--   >>> let stfu = Stfu cid True BOLT1.empty_tlv_stream+--   >>> fmap BS.length (encode_message (MsgStfu stfu))+--   Right 35+encode_message :: Message -> Either EncodeError BS.ByteString+encode_message m = do+  payload <- case m of+    MsgOpenChannel a             -> encode_open_channel a+    MsgAcceptChannel a           -> encode_accept_channel a+    MsgFundingCreated a          -> Right (encode_funding_created a)+    MsgFundingSigned a           -> Right (encode_funding_signed a)+    MsgChannelReady a            -> encode_channel_ready a+    MsgOpenChannel2 a            -> encode_open_channel2 a+    MsgAcceptChannel2 a          -> encode_accept_channel2 a+    MsgTxAddInput a              -> encode_tx_add_input a+    MsgTxAddOutput a             -> Right (encode_tx_add_output a)+    MsgTxRemoveInput a           -> Right (encode_tx_remove_input a)+    MsgTxRemoveOutput a          -> Right (encode_tx_remove_output a)+    MsgTxComplete a              -> Right (encode_tx_complete a)+    MsgTxSignatures a            -> encode_tx_signatures a+    MsgTxInitRbf a               -> encode_tx_init_rbf a+    MsgTxAckRbf a                -> encode_tx_ack_rbf a+    MsgTxAbort a                 -> encode_tx_abort a+    MsgStfu a                    -> Right (encode_stfu a)+    MsgShutdown a                -> Right (encode_shutdown a)+    MsgClosingComplete a         -> encode_closing_complete a+    MsgClosingSig a              -> encode_closing_sig a+    MsgClosingSigned a           -> encode_closing_signed a+    MsgUpdateAddHtlc a           -> encode_update_add_htlc a+    MsgUpdateFulfillHtlc a       -> encode_update_fulfill_htlc a+    MsgUpdateFailHtlc a          -> encode_update_fail_htlc a+    MsgUpdateFailMalformedHtlc a ->+      Right (encode_update_fail_malformed_htlc a)+    MsgCommitmentSigned a        -> encode_commitment_signed a+    MsgRevokeAndAck a            -> Right (encode_revoke_and_ack a)+    MsgUpdateFee a               -> Right (encode_update_fee a)+    MsgChannelReestablish a      -> encode_channel_reestablish a+  case BOLT1.encode_envelope (message_type m) payload of+    Left _  -> Left EncodeMessageTooLarge+    Right w -> Right w++-- | Decode a BOLT #2 message, including its type.+--+--   A type that BOLT #2 doesn't define (including the splicing+--   messages, which this library doesn't implement) yields+--   'DecodeUnknownEvenType' or 'DecodeUnknownOddType'.+--+--   >>> let wire = "\x00\x02" <> BS.replicate 32 0xab <> "\x01"+--   >>> fmap message_type (decode_message wire)+--   Right 2+--   >>> decode_message "\x00\x50"+--   Left (DecodeUnknownEvenType 80)+decode_message :: BS.ByteString -> Either DecodeError Message+decode_message bs = do+  (t, payload) <- case BOLT1.decode_envelope bs of+    Left _  -> Left DecodeInsufficientBytes+    Right r -> Right r+  case t of+    32  -> MsgOpenChannel <$> decode_open_channel payload+    33  -> MsgAcceptChannel <$> decode_accept_channel payload+    34  -> MsgFundingCreated <$> decode_funding_created payload+    35  -> MsgFundingSigned <$> decode_funding_signed payload+    36  -> MsgChannelReady <$> decode_channel_ready payload+    64  -> MsgOpenChannel2 <$> decode_open_channel2 payload+    65  -> MsgAcceptChannel2 <$> decode_accept_channel2 payload+    66  -> MsgTxAddInput <$> decode_tx_add_input payload+    67  -> MsgTxAddOutput <$> decode_tx_add_output payload+    68  -> MsgTxRemoveInput <$> decode_tx_remove_input payload+    69  -> MsgTxRemoveOutput <$> decode_tx_remove_output payload+    70  -> MsgTxComplete <$> decode_tx_complete payload+    71  -> MsgTxSignatures <$> decode_tx_signatures payload+    72  -> MsgTxInitRbf <$> decode_tx_init_rbf payload+    73  -> MsgTxAckRbf <$> decode_tx_ack_rbf payload+    74  -> MsgTxAbort <$> decode_tx_abort payload+    2   -> MsgStfu <$> decode_stfu payload+    38  -> MsgShutdown <$> decode_shutdown payload+    40  -> MsgClosingComplete <$> decode_closing_complete payload+    41  -> MsgClosingSig <$> decode_closing_sig payload+    39  -> MsgClosingSigned <$> decode_closing_signed payload+    128 -> MsgUpdateAddHtlc <$> decode_update_add_htlc payload+    130 -> MsgUpdateFulfillHtlc <$> decode_update_fulfill_htlc payload+    131 -> MsgUpdateFailHtlc <$> decode_update_fail_htlc payload+    135 -> MsgUpdateFailMalformedHtlc <$>+             decode_update_fail_malformed_htlc payload+    132 -> MsgCommitmentSigned <$> decode_commitment_signed payload+    133 -> MsgRevokeAndAck <$> decode_revoke_and_ack payload+    134 -> MsgUpdateFee <$> decode_update_fee payload+    136 -> MsgChannelReestablish <$> decode_channel_reestablish payload+    _ | even t    -> Left (DecodeUnknownEvenType t)+      | otherwise -> Left (DecodeUnknownOddType t)++-- open_channel ---------------------------------------------------------------++open_channel_known :: [Word64]+open_channel_known = [0, 1]++-- | Encode an t'OpenChannel' payload.+encode_open_channel :: OpenChannel -> Either EncodeError BS.ByteString+encode_open_channel m = do+  ts <- encode_tlvs open_channel_known+    (  opt 0 un_script_pubkey (open_channel_upfront_shutdown_script m)+    <> opt 1 BOLT9.render (open_channel_channel_type m) )+    (open_channel_tlvs m)+  pure $ mconcat [+      BOLT1.un_chain_hash (open_channel_chain_hash m)+    , BOLT1.un_channel_id (open_channel_temporary_channel_id m)+    , BOLT1.encode_satoshi (open_channel_funding_satoshis m)+    , BOLT1.encode_milli_satoshi (open_channel_push_msat m)+    , BOLT1.encode_satoshi (open_channel_dust_limit_satoshis m)+    , BOLT1.encode_u64 (open_channel_max_htlc_value_in_flight_msat m)+    , BOLT1.encode_satoshi (open_channel_channel_reserve_satoshis m)+    , BOLT1.encode_milli_satoshi (open_channel_htlc_minimum_msat m)+    , BOLT1.encode_u32 (open_channel_feerate_per_kw m)+    , BOLT1.encode_u16 (open_channel_to_self_delay m)+    , BOLT1.encode_u16 (open_channel_max_accepted_htlcs m)+    , BOLT1.un_point (open_channel_funding_pubkey m)+    , BOLT1.un_point (open_channel_revocation_basepoint m)+    , BOLT1.un_point (open_channel_payment_basepoint m)+    , BOLT1.un_point (open_channel_delayed_payment_basepoint m)+    , BOLT1.un_point (open_channel_htlc_basepoint m)+    , BOLT1.un_point (open_channel_first_per_commitment_point m)+    , word8 (open_channel_channel_flags m)+    , ts+    ]++-- | Decode an t'OpenChannel' payload.+decode_open_channel :: BS.ByteString -> Either DecodeError OpenChannel+decode_open_channel = parse $ do+  ch    <- chain_hash+  tcid  <- channel_id+  fund  <- satoshi+  push  <- milli_satoshi+  dust  <- satoshi+  maxv  <- u64+  res   <- satoshi+  hmin  <- milli_satoshi+  fee   <- u32+  delay <- u16+  maxa  <- u16+  fpk   <- point+  rev   <- point+  pay   <- point+  del   <- point+  htlc  <- point+  pcp   <- point+  flags <- u8+  s     <- tlvs open_channel_known+  shut  <- record 0 script_pubkey s+  ctype <- record 1 (Just . BOLT9.parse) s+  pure OpenChannel {+      open_channel_chain_hash                    = ch+    , open_channel_temporary_channel_id          = tcid+    , open_channel_funding_satoshis              = fund+    , open_channel_push_msat                     = push+    , open_channel_dust_limit_satoshis           = dust+    , open_channel_max_htlc_value_in_flight_msat = maxv+    , open_channel_channel_reserve_satoshis      = res+    , open_channel_htlc_minimum_msat             = hmin+    , open_channel_feerate_per_kw                = fee+    , open_channel_to_self_delay                 = delay+    , open_channel_max_accepted_htlcs            = maxa+    , open_channel_funding_pubkey                = fpk+    , open_channel_revocation_basepoint          = rev+    , open_channel_payment_basepoint             = pay+    , open_channel_delayed_payment_basepoint     = del+    , open_channel_htlc_basepoint                = htlc+    , open_channel_first_per_commitment_point    = pcp+    , open_channel_channel_flags                 = flags+    , open_channel_upfront_shutdown_script       = shut+    , open_channel_channel_type                  = ctype+    , open_channel_tlvs                          = unknown open_channel_known s+    }++-- accept_channel -------------------------------------------------------------++accept_channel_known :: [Word64]+accept_channel_known = [0, 1]++-- | Encode an t'AcceptChannel' payload.+encode_accept_channel :: AcceptChannel -> Either EncodeError BS.ByteString+encode_accept_channel m = do+  ts <- encode_tlvs accept_channel_known+    (  opt 0 un_script_pubkey (accept_channel_upfront_shutdown_script m)+    <> opt 1 BOLT9.render (accept_channel_channel_type m) )+    (accept_channel_tlvs m)+  pure $ mconcat [+      BOLT1.un_channel_id (accept_channel_temporary_channel_id m)+    , BOLT1.encode_satoshi (accept_channel_dust_limit_satoshis m)+    , BOLT1.encode_u64 (accept_channel_max_htlc_value_in_flight_msat m)+    , BOLT1.encode_satoshi (accept_channel_channel_reserve_satoshis m)+    , BOLT1.encode_milli_satoshi (accept_channel_htlc_minimum_msat m)+    , BOLT1.encode_u32 (accept_channel_minimum_depth m)+    , BOLT1.encode_u16 (accept_channel_to_self_delay m)+    , BOLT1.encode_u16 (accept_channel_max_accepted_htlcs m)+    , BOLT1.un_point (accept_channel_funding_pubkey m)+    , BOLT1.un_point (accept_channel_revocation_basepoint m)+    , BOLT1.un_point (accept_channel_payment_basepoint m)+    , BOLT1.un_point (accept_channel_delayed_payment_basepoint m)+    , BOLT1.un_point (accept_channel_htlc_basepoint m)+    , BOLT1.un_point (accept_channel_first_per_commitment_point m)+    , ts+    ]++-- | Decode an t'AcceptChannel' payload.+decode_accept_channel :: BS.ByteString -> Either DecodeError AcceptChannel+decode_accept_channel = parse $ do+  tcid  <- channel_id+  dust  <- satoshi+  maxv  <- u64+  res   <- satoshi+  hmin  <- milli_satoshi+  depth <- u32+  delay <- u16+  maxa  <- u16+  fpk   <- point+  rev   <- point+  pay   <- point+  del   <- point+  htlc  <- point+  pcp   <- point+  s     <- tlvs accept_channel_known+  shut  <- record 0 script_pubkey s+  ctype <- record 1 (Just . BOLT9.parse) s+  pure AcceptChannel {+      accept_channel_temporary_channel_id          = tcid+    , accept_channel_dust_limit_satoshis           = dust+    , accept_channel_max_htlc_value_in_flight_msat = maxv+    , accept_channel_channel_reserve_satoshis      = res+    , accept_channel_htlc_minimum_msat             = hmin+    , accept_channel_minimum_depth                 = depth+    , accept_channel_to_self_delay                 = delay+    , accept_channel_max_accepted_htlcs            = maxa+    , accept_channel_funding_pubkey                = fpk+    , accept_channel_revocation_basepoint          = rev+    , accept_channel_payment_basepoint             = pay+    , accept_channel_delayed_payment_basepoint     = del+    , accept_channel_htlc_basepoint                = htlc+    , accept_channel_first_per_commitment_point    = pcp+    , accept_channel_upfront_shutdown_script       = shut+    , accept_channel_channel_type                  = ctype+    , accept_channel_tlvs = unknown accept_channel_known s+    }++-- funding_created, funding_signed --------------------------------------------++-- | Encode a t'FundingCreated' payload.+encode_funding_created :: FundingCreated -> BS.ByteString+encode_funding_created m = mconcat [+    BOLT1.un_channel_id (funding_created_temporary_channel_id m)+  , txid_bytes (funding_created_funding_txid m)+  , BOLT1.encode_u16 (funding_created_funding_output_index m)+  , BOLT1.un_signature (funding_created_signature m)+  , BOLT1.encode_tlv_stream (funding_created_tlvs m)+  ]++-- | Decode a t'FundingCreated' payload.+decode_funding_created :: BS.ByteString -> Either DecodeError FundingCreated+decode_funding_created = parse $+  FundingCreated <$> channel_id <*> txid <*> u16 <*> signature <*> tlvs []++-- | Encode a t'FundingSigned' payload.+encode_funding_signed :: FundingSigned -> BS.ByteString+encode_funding_signed m = mconcat [+    BOLT1.un_channel_id (funding_signed_channel_id m)+  , BOLT1.un_signature (funding_signed_signature m)+  , BOLT1.encode_tlv_stream (funding_signed_tlvs m)+  ]++-- | Decode a t'FundingSigned' payload.+decode_funding_signed :: BS.ByteString -> Either DecodeError FundingSigned+decode_funding_signed = parse $+  FundingSigned <$> channel_id <*> signature <*> tlvs []++-- channel_ready --------------------------------------------------------------++channel_ready_known :: [Word64]+channel_ready_known = [1]++-- | Encode a t'ChannelReady' payload.+encode_channel_ready :: ChannelReady -> Either EncodeError BS.ByteString+encode_channel_ready m = do+  ts <- encode_tlvs channel_ready_known+    (opt 1 BOLT1.encode_short_channel_id (channel_ready_alias m))+    (channel_ready_tlvs m)+  pure $ mconcat [+      BOLT1.un_channel_id (channel_ready_channel_id m)+    , BOLT1.un_point (channel_ready_second_per_commitment_point m)+    , ts+    ]++-- | Decode a t'ChannelReady' payload.+decode_channel_ready :: BS.ByteString -> Either DecodeError ChannelReady+decode_channel_ready = parse $ do+  cid   <- channel_id+  pcp   <- point+  s     <- tlvs channel_ready_known+  alias <- record 1 (whole BOLT1.decode_short_channel_id) s+  pure (ChannelReady cid pcp alias (unknown channel_ready_known s))++-- open_channel2 --------------------------------------------------------------++opening_known :: [Word64]+opening_known = [0, 1, 2]++-- | Encode an t'OpenChannel2' payload.+encode_open_channel2 :: OpenChannel2 -> Either EncodeError BS.ByteString+encode_open_channel2 m = do+  ts <- encode_tlvs opening_known+    (  opt 0 un_script_pubkey (open_channel2_upfront_shutdown_script m)+    <> opt 1 BOLT9.render (open_channel2_channel_type m)+    <> opt_flag 2 (open_channel2_require_confirmed_inputs m) )+    (open_channel2_tlvs m)+  pure $ mconcat [+      BOLT1.un_chain_hash (open_channel2_chain_hash m)+    , BOLT1.un_channel_id (open_channel2_temporary_channel_id m)+    , BOLT1.encode_u32 (open_channel2_funding_feerate_perkw m)+    , BOLT1.encode_u32 (open_channel2_commitment_feerate_perkw m)+    , BOLT1.encode_satoshi (open_channel2_funding_satoshis m)+    , BOLT1.encode_satoshi (open_channel2_dust_limit_satoshis m)+    , BOLT1.encode_u64 (open_channel2_max_htlc_value_in_flight_msat m)+    , BOLT1.encode_milli_satoshi (open_channel2_htlc_minimum_msat m)+    , BOLT1.encode_u16 (open_channel2_to_self_delay m)+    , BOLT1.encode_u16 (open_channel2_max_accepted_htlcs m)+    , BOLT1.encode_u32 (open_channel2_locktime m)+    , BOLT1.un_point (open_channel2_funding_pubkey m)+    , BOLT1.un_point (open_channel2_revocation_basepoint m)+    , BOLT1.un_point (open_channel2_payment_basepoint m)+    , BOLT1.un_point (open_channel2_delayed_payment_basepoint m)+    , BOLT1.un_point (open_channel2_htlc_basepoint m)+    , BOLT1.un_point (open_channel2_first_per_commitment_point m)+    , BOLT1.un_point (open_channel2_second_per_commitment_point m)+    , word8 (open_channel2_channel_flags m)+    , ts+    ]++-- | Decode an t'OpenChannel2' payload.+decode_open_channel2 :: BS.ByteString -> Either DecodeError OpenChannel2+decode_open_channel2 = parse $ do+  ch    <- chain_hash+  tcid  <- channel_id+  ffee  <- u32+  cfee  <- u32+  fund  <- satoshi+  dust  <- satoshi+  maxv  <- u64+  hmin  <- milli_satoshi+  delay <- u16+  maxa  <- u16+  lock  <- u32+  fpk   <- point+  rev   <- point+  pay   <- point+  del   <- point+  htlc  <- point+  pcp1  <- point+  pcp2  <- point+  flags <- u8+  s     <- tlvs opening_known+  shut  <- record 0 script_pubkey s+  ctype <- record 1 (Just . BOLT9.parse) s+  conf  <- flag 2 s+  pure OpenChannel2 {+      open_channel2_chain_hash                    = ch+    , open_channel2_temporary_channel_id          = tcid+    , open_channel2_funding_feerate_perkw         = ffee+    , open_channel2_commitment_feerate_perkw      = cfee+    , open_channel2_funding_satoshis              = fund+    , open_channel2_dust_limit_satoshis           = dust+    , open_channel2_max_htlc_value_in_flight_msat = maxv+    , open_channel2_htlc_minimum_msat             = hmin+    , open_channel2_to_self_delay                 = delay+    , open_channel2_max_accepted_htlcs            = maxa+    , open_channel2_locktime                      = lock+    , open_channel2_funding_pubkey                = fpk+    , open_channel2_revocation_basepoint          = rev+    , open_channel2_payment_basepoint             = pay+    , open_channel2_delayed_payment_basepoint     = del+    , open_channel2_htlc_basepoint                = htlc+    , open_channel2_first_per_commitment_point    = pcp1+    , open_channel2_second_per_commitment_point   = pcp2+    , open_channel2_channel_flags                 = flags+    , open_channel2_upfront_shutdown_script       = shut+    , open_channel2_channel_type                  = ctype+    , open_channel2_require_confirmed_inputs      = conf+    , open_channel2_tlvs                          = unknown opening_known s+    }++-- accept_channel2 ------------------------------------------------------------++-- | Encode an t'AcceptChannel2' payload.+encode_accept_channel2 :: AcceptChannel2 -> Either EncodeError BS.ByteString+encode_accept_channel2 m = do+  ts <- encode_tlvs opening_known+    (  opt 0 un_script_pubkey (accept_channel2_upfront_shutdown_script m)+    <> opt 1 BOLT9.render (accept_channel2_channel_type m)+    <> opt_flag 2 (accept_channel2_require_confirmed_inputs m) )+    (accept_channel2_tlvs m)+  pure $ mconcat [+      BOLT1.un_channel_id (accept_channel2_temporary_channel_id m)+    , BOLT1.encode_satoshi (accept_channel2_funding_satoshis m)+    , BOLT1.encode_satoshi (accept_channel2_dust_limit_satoshis m)+    , BOLT1.encode_u64 (accept_channel2_max_htlc_value_in_flight_msat m)+    , BOLT1.encode_milli_satoshi (accept_channel2_htlc_minimum_msat m)+    , BOLT1.encode_u32 (accept_channel2_minimum_depth m)+    , BOLT1.encode_u16 (accept_channel2_to_self_delay m)+    , BOLT1.encode_u16 (accept_channel2_max_accepted_htlcs m)+    , BOLT1.un_point (accept_channel2_funding_pubkey m)+    , BOLT1.un_point (accept_channel2_revocation_basepoint m)+    , BOLT1.un_point (accept_channel2_payment_basepoint m)+    , BOLT1.un_point (accept_channel2_delayed_payment_basepoint m)+    , BOLT1.un_point (accept_channel2_htlc_basepoint m)+    , BOLT1.un_point (accept_channel2_first_per_commitment_point m)+    , BOLT1.un_point (accept_channel2_second_per_commitment_point m)+    , ts+    ]++-- | Decode an t'AcceptChannel2' payload.+decode_accept_channel2 :: BS.ByteString -> Either DecodeError AcceptChannel2+decode_accept_channel2 = parse $ do+  tcid  <- channel_id+  fund  <- satoshi+  dust  <- satoshi+  maxv  <- u64+  hmin  <- milli_satoshi+  depth <- u32+  delay <- u16+  maxa  <- u16+  fpk   <- point+  rev   <- point+  pay   <- point+  del   <- point+  htlc  <- point+  pcp1  <- point+  pcp2  <- point+  s     <- tlvs opening_known+  shut  <- record 0 script_pubkey s+  ctype <- record 1 (Just . BOLT9.parse) s+  conf  <- flag 2 s+  pure AcceptChannel2 {+      accept_channel2_temporary_channel_id          = tcid+    , accept_channel2_funding_satoshis              = fund+    , accept_channel2_dust_limit_satoshis           = dust+    , accept_channel2_max_htlc_value_in_flight_msat = maxv+    , accept_channel2_htlc_minimum_msat             = hmin+    , accept_channel2_minimum_depth                 = depth+    , accept_channel2_to_self_delay                 = delay+    , accept_channel2_max_accepted_htlcs            = maxa+    , accept_channel2_funding_pubkey                = fpk+    , accept_channel2_revocation_basepoint          = rev+    , accept_channel2_payment_basepoint             = pay+    , accept_channel2_delayed_payment_basepoint     = del+    , accept_channel2_htlc_basepoint                = htlc+    , accept_channel2_first_per_commitment_point    = pcp1+    , accept_channel2_second_per_commitment_point   = pcp2+    , accept_channel2_upfront_shutdown_script       = shut+    , accept_channel2_channel_type                  = ctype+    , accept_channel2_require_confirmed_inputs      = conf+    , accept_channel2_tlvs = unknown opening_known s+    }++-- interactive transaction construction ---------------------------------------++-- | Encode a t'TxAddInput' payload. Fails if @prevtx@ exceeds 65535+--   bytes.+encode_tx_add_input :: TxAddInput -> Either EncodeError BS.ByteString+encode_tx_add_input m = do+  prev <- u16_prefixed (tx_add_input_prevtx m)+  let SerialId sid = tx_add_input_serial_id m+  pure $ mconcat [+      BOLT1.un_channel_id (tx_add_input_channel_id m)+    , BOLT1.encode_u64 sid+    , prev+    , BOLT1.encode_u32 (tx_add_input_prevtx_vout m)+    , BOLT1.encode_u32 (tx_add_input_sequence m)+    , BOLT1.encode_tlv_stream (tx_add_input_tlvs m)+    ]++-- | Decode a t'TxAddInput' payload.+decode_tx_add_input :: BS.ByteString -> Either DecodeError TxAddInput+decode_tx_add_input = parse $+  TxAddInput <$> channel_id <*> serial_id <*> prefixed <*> u32 <*> u32+             <*> tlvs []++-- | Encode a t'TxAddOutput' payload.+encode_tx_add_output :: TxAddOutput -> BS.ByteString+encode_tx_add_output m =+  let SerialId sid = tx_add_output_serial_id m+  in  mconcat [+          BOLT1.un_channel_id (tx_add_output_channel_id m)+        , BOLT1.encode_u64 sid+        , BOLT1.encode_satoshi (tx_add_output_sats m)+        , script_bytes (tx_add_output_script m)+        , BOLT1.encode_tlv_stream (tx_add_output_tlvs m)+        ]++-- | Decode a t'TxAddOutput' payload.+decode_tx_add_output :: BS.ByteString -> Either DecodeError TxAddOutput+decode_tx_add_output = parse $+  TxAddOutput <$> channel_id <*> serial_id <*> satoshi <*> script+              <*> tlvs []++-- | Encode a t'TxRemoveInput' payload.+encode_tx_remove_input :: TxRemoveInput -> BS.ByteString+encode_tx_remove_input (TxRemoveInput cid (SerialId sid) ts) = mconcat [+    BOLT1.un_channel_id cid+  , BOLT1.encode_u64 sid+  , BOLT1.encode_tlv_stream ts+  ]++-- | Decode a t'TxRemoveInput' payload.+decode_tx_remove_input :: BS.ByteString -> Either DecodeError TxRemoveInput+decode_tx_remove_input = parse $+  TxRemoveInput <$> channel_id <*> serial_id <*> tlvs []++-- | Encode a t'TxRemoveOutput' payload.+encode_tx_remove_output :: TxRemoveOutput -> BS.ByteString+encode_tx_remove_output (TxRemoveOutput cid (SerialId sid) ts) = mconcat [+    BOLT1.un_channel_id cid+  , BOLT1.encode_u64 sid+  , BOLT1.encode_tlv_stream ts+  ]++-- | Decode a t'TxRemoveOutput' payload.+decode_tx_remove_output+  :: BS.ByteString -> Either DecodeError TxRemoveOutput+decode_tx_remove_output = parse $+  TxRemoveOutput <$> channel_id <*> serial_id <*> tlvs []++-- | Encode a t'TxComplete' payload.+encode_tx_complete :: TxComplete -> BS.ByteString+encode_tx_complete (TxComplete cid ts) =+  BOLT1.un_channel_id cid <> BOLT1.encode_tlv_stream ts++-- | Decode a t'TxComplete' payload.+decode_tx_complete :: BS.ByteString -> Either DecodeError TxComplete+decode_tx_complete = parse $ TxComplete <$> channel_id <*> tlvs []++-- | Encode a t'TxSignatures' payload. Fails if there are more than 65535+--   witnesses.+encode_tx_signatures :: TxSignatures -> Either EncodeError BS.ByteString+encode_tx_signatures m = do+  let ws = tx_signatures_witnesses m+  n <- count_prefix ws+  pure $ mconcat [+      BOLT1.un_channel_id (tx_signatures_channel_id m)+    , txid_bytes (tx_signatures_txid m)+    , n+    , mconcat [ BOLT1.encode_u16 (fromIntegral (BS.length w)) <> w+              | w <- map un_witness ws ]+    , BOLT1.encode_tlv_stream (tx_signatures_tlvs m)+    ]++-- | Decode a t'TxSignatures' payload.+decode_tx_signatures :: BS.ByteString -> Either DecodeError TxSignatures+decode_tx_signatures = parse $ do+  cid <- channel_id+  t   <- txid+  n   <- u16+  ws  <- count (fromIntegral n) wit+  TxSignatures cid t ws <$> tlvs []+  where+    wit = do+      b <- prefixed+      maybe (failure DecodeInsufficientBytes) pure (witness b)++rbf_known :: [Word64]+rbf_known = [0, 2]++-- | Encode a t'TxInitRbf' payload.+encode_tx_init_rbf :: TxInitRbf -> Either EncodeError BS.ByteString+encode_tx_init_rbf m = do+  ts <- encode_tlvs rbf_known+    (  opt 0 BOLT1.encode_s64 (tx_init_rbf_funding_output_contribution m)+    <> opt_flag 2 (tx_init_rbf_require_confirmed_inputs m) )+    (tx_init_rbf_tlvs m)+  pure $ mconcat [+      BOLT1.un_channel_id (tx_init_rbf_channel_id m)+    , BOLT1.encode_u32 (tx_init_rbf_locktime m)+    , BOLT1.encode_u32 (tx_init_rbf_feerate m)+    , ts+    ]++-- | Decode a t'TxInitRbf' payload.+decode_tx_init_rbf :: BS.ByteString -> Either DecodeError TxInitRbf+decode_tx_init_rbf = parse $ do+  cid  <- channel_id+  lock <- u32+  fee  <- u32+  s    <- tlvs rbf_known+  contrib <- record 0 tlv_s64 s+  conf <- flag 2 s+  pure (TxInitRbf cid lock fee contrib conf (unknown rbf_known s))++-- | Encode a t'TxAckRbf' payload.+encode_tx_ack_rbf :: TxAckRbf -> Either EncodeError BS.ByteString+encode_tx_ack_rbf m = do+  ts <- encode_tlvs rbf_known+    (  opt 0 BOLT1.encode_s64 (tx_ack_rbf_funding_output_contribution m)+    <> opt_flag 2 (tx_ack_rbf_require_confirmed_inputs m) )+    (tx_ack_rbf_tlvs m)+  pure (BOLT1.un_channel_id (tx_ack_rbf_channel_id m) <> ts)++-- | Decode a t'TxAckRbf' payload.+decode_tx_ack_rbf :: BS.ByteString -> Either DecodeError TxAckRbf+decode_tx_ack_rbf = parse $ do+  cid  <- channel_id+  s    <- tlvs rbf_known+  contrib <- record 0 tlv_s64 s+  conf <- flag 2 s+  pure (TxAckRbf cid contrib conf (unknown rbf_known s))++-- | Encode a t'TxAbort' payload. Fails if @data@ exceeds 65535 bytes.+encode_tx_abort :: TxAbort -> Either EncodeError BS.ByteString+encode_tx_abort (TxAbort cid dat ts) = do+  dat' <- u16_prefixed dat+  pure (BOLT1.un_channel_id cid <> dat' <> BOLT1.encode_tlv_stream ts)++-- | Decode a t'TxAbort' payload.+decode_tx_abort :: BS.ByteString -> Either DecodeError TxAbort+decode_tx_abort = parse $ TxAbort <$> channel_id <*> prefixed <*> tlvs []++-- stfu -----------------------------------------------------------------------++-- | Encode a t'Stfu' payload.+encode_stfu :: Stfu -> BS.ByteString+encode_stfu (Stfu cid ini ts) = mconcat [+    BOLT1.un_channel_id cid+  , word8 (if ini then 1 else 0)+  , BOLT1.encode_tlv_stream ts+  ]++-- | Decode a t'Stfu' payload. The @initiator@ byte must be 0 or 1.+decode_stfu :: BS.ByteString -> Either DecodeError Stfu+decode_stfu = parse $ do+  cid <- channel_id+  b   <- u8+  ini <- case b of+    0 -> pure False+    1 -> pure True+    _ -> failure DecodeInvalidInitiator+  Stfu cid ini <$> tlvs []++-- shutdown -------------------------------------------------------------------++-- | Encode a t'Shutdown' payload.+encode_shutdown :: Shutdown -> BS.ByteString+encode_shutdown (Shutdown cid spk ts) = mconcat [+    BOLT1.un_channel_id cid+  , script_bytes spk+  , BOLT1.encode_tlv_stream ts+  ]++-- | Decode a t'Shutdown' payload.+decode_shutdown :: BS.ByteString -> Either DecodeError Shutdown+decode_shutdown = parse $ Shutdown <$> channel_id <*> script <*> tlvs []++-- closing_complete, closing_sig ----------------------------------------------++closing_known :: [Word64]+closing_known = [1, 2, 3]++closing_records+  :: Maybe Signature -> Maybe Signature -> Maybe Signature -> [TlvRecord]+closing_records a b c =+     opt 1 BOLT1.un_signature a+  <> opt 2 BOLT1.un_signature b+  <> opt 3 BOLT1.un_signature c++-- | Encode a t'ClosingComplete' payload.+encode_closing_complete :: ClosingComplete -> Either EncodeError BS.ByteString+encode_closing_complete m = do+  ts <- encode_tlvs closing_known+    (closing_records+      (closing_complete_closer_output_only m)+      (closing_complete_closee_output_only m)+      (closing_complete_closer_and_closee_outputs m))+    (closing_complete_tlvs m)+  pure $ mconcat [+      BOLT1.un_channel_id (closing_complete_channel_id m)+    , script_bytes (closing_complete_closer_scriptpubkey m)+    , script_bytes (closing_complete_closee_scriptpubkey m)+    , BOLT1.encode_satoshi (closing_complete_fee_satoshis m)+    , BOLT1.encode_u32 (closing_complete_locktime m)+    , ts+    ]++-- | Decode a t'ClosingComplete' payload.+decode_closing_complete+  :: BS.ByteString -> Either DecodeError ClosingComplete+decode_closing_complete = parse $ do+  cid    <- channel_id+  closer <- script+  closee <- script+  fee    <- satoshi+  lock   <- u32+  s      <- tlvs closing_known+  a      <- record 1 BOLT1.signature s+  b      <- record 2 BOLT1.signature s+  c      <- record 3 BOLT1.signature s+  pure (ClosingComplete cid closer closee fee lock a b c+          (unknown closing_known s))++-- | Encode a t'ClosingSig' payload.+encode_closing_sig :: ClosingSig -> Either EncodeError BS.ByteString+encode_closing_sig m = do+  ts <- encode_tlvs closing_known+    (closing_records+      (closing_sig_closer_output_only m)+      (closing_sig_closee_output_only m)+      (closing_sig_closer_and_closee_outputs m))+    (closing_sig_tlvs m)+  pure $ mconcat [+      BOLT1.un_channel_id (closing_sig_channel_id m)+    , script_bytes (closing_sig_closer_scriptpubkey m)+    , script_bytes (closing_sig_closee_scriptpubkey m)+    , BOLT1.encode_satoshi (closing_sig_fee_satoshis m)+    , BOLT1.encode_u32 (closing_sig_locktime m)+    , ts+    ]++-- | Decode a t'ClosingSig' payload.+decode_closing_sig :: BS.ByteString -> Either DecodeError ClosingSig+decode_closing_sig = parse $ do+  cid    <- channel_id+  closer <- script+  closee <- script+  fee    <- satoshi+  lock   <- u32+  s      <- tlvs closing_known+  a      <- record 1 BOLT1.signature s+  b      <- record 2 BOLT1.signature s+  c      <- record 3 BOLT1.signature s+  pure (ClosingSig cid closer closee fee lock a b c+          (unknown closing_known s))++-- closing_signed -------------------------------------------------------------++closing_signed_known :: [Word64]+closing_signed_known = [1]++-- | Encode a t'ClosingSigned' payload.+encode_closing_signed :: ClosingSigned -> Either EncodeError BS.ByteString+encode_closing_signed m = do+  ts <- encode_tlvs closing_signed_known+    (opt 1 fee_range_bytes (closing_signed_fee_range m))+    (closing_signed_tlvs m)+  pure $ mconcat [+      BOLT1.un_channel_id (closing_signed_channel_id m)+    , BOLT1.encode_satoshi (closing_signed_fee_satoshis m)+    , BOLT1.un_signature (closing_signed_signature m)+    , ts+    ]++-- | Decode a t'ClosingSigned' payload.+decode_closing_signed :: BS.ByteString -> Either DecodeError ClosingSigned+decode_closing_signed = parse $ do+  cid   <- channel_id+  fee   <- satoshi+  sig   <- signature+  s     <- tlvs closing_signed_known+  range <- record 1 tlv_fee_range s+  pure (ClosingSigned cid fee sig range (unknown closing_signed_known s))++-- update_add_htlc ------------------------------------------------------------++update_add_htlc_known :: [Word64]+update_add_htlc_known = [0]++-- | Encode an t'UpdateAddHtlc' payload.+encode_update_add_htlc :: UpdateAddHtlc -> Either EncodeError BS.ByteString+encode_update_add_htlc m = do+  ts <- encode_tlvs update_add_htlc_known+    (opt 0 BOLT1.un_point (update_add_htlc_path_key m))+    (update_add_htlc_tlvs m)+  let HtlcId hid = update_add_htlc_id m+  pure $ mconcat [+      BOLT1.un_channel_id (update_add_htlc_channel_id m)+    , BOLT1.encode_u64 hid+    , BOLT1.encode_milli_satoshi (update_add_htlc_amount_msat m)+    , BOLT1.un_payment_hash (update_add_htlc_payment_hash m)+    , BOLT1.encode_u32 (update_add_htlc_cltv_expiry m)+    , un_onion_routing_packet (update_add_htlc_onion_routing_packet m)+    , ts+    ]++-- | Decode an t'UpdateAddHtlc' payload.+decode_update_add_htlc :: BS.ByteString -> Either DecodeError UpdateAddHtlc+decode_update_add_htlc = parse $ do+  cid   <- channel_id+  hid   <- htlc_id+  amt   <- milli_satoshi+  ph    <- payment_hash+  cltv  <- u32+  onion <- sized 1366 onion_routing_packet+  s     <- tlvs update_add_htlc_known+  pk    <- record 0 tlv_point s+  pure (UpdateAddHtlc cid hid amt ph cltv onion pk+          (unknown update_add_htlc_known s))++-- update_fulfill_htlc --------------------------------------------------------++update_fulfill_htlc_known :: [Word64]+update_fulfill_htlc_known = [1, 3]++-- | Encode an t'UpdateFulfillHtlc' payload.+encode_update_fulfill_htlc+  :: UpdateFulfillHtlc -> Either EncodeError BS.ByteString+encode_update_fulfill_htlc m = do+  ts <- encode_tlvs update_fulfill_htlc_known+    (  opt 1 un_attribution_data (update_fulfill_htlc_attribution_data m)+    <> opt 3 id (update_fulfill_htlc_fulfillment_payload m) )+    (update_fulfill_htlc_tlvs m)+  let HtlcId hid = update_fulfill_htlc_id m+  pure $ mconcat [+      BOLT1.un_channel_id (update_fulfill_htlc_channel_id m)+    , BOLT1.encode_u64 hid+    , BOLT1.un_payment_preimage (update_fulfill_htlc_payment_preimage m)+    , ts+    ]++-- | Decode an t'UpdateFulfillHtlc' payload.+decode_update_fulfill_htlc+  :: BS.ByteString -> Either DecodeError UpdateFulfillHtlc+decode_update_fulfill_htlc = parse $ do+  cid <- channel_id+  hid <- htlc_id+  pre <- payment_preimage+  s   <- tlvs update_fulfill_htlc_known+  att <- record 1 attribution_data s+  pay <- record 3 Just s+  pure (UpdateFulfillHtlc cid hid pre att pay+          (unknown update_fulfill_htlc_known s))++-- update_fail_htlc -----------------------------------------------------------++update_fail_htlc_known :: [Word64]+update_fail_htlc_known = [1]++-- | Encode an t'UpdateFailHtlc' payload. Fails if @reason@ exceeds 65535+--   bytes.+encode_update_fail_htlc :: UpdateFailHtlc -> Either EncodeError BS.ByteString+encode_update_fail_htlc m = do+  reason <- u16_prefixed (update_fail_htlc_reason m)+  ts <- encode_tlvs update_fail_htlc_known+    (opt 1 un_attribution_data (update_fail_htlc_attribution_data m))+    (update_fail_htlc_tlvs m)+  let HtlcId hid = update_fail_htlc_id m+  pure $ mconcat [+      BOLT1.un_channel_id (update_fail_htlc_channel_id m)+    , BOLT1.encode_u64 hid+    , reason+    , ts+    ]++-- | Decode an t'UpdateFailHtlc' payload.+decode_update_fail_htlc :: BS.ByteString -> Either DecodeError UpdateFailHtlc+decode_update_fail_htlc = parse $ do+  cid    <- channel_id+  hid    <- htlc_id+  reason <- prefixed+  s      <- tlvs update_fail_htlc_known+  att    <- record 1 attribution_data s+  pure (UpdateFailHtlc cid hid reason att (unknown update_fail_htlc_known s))++-- update_fail_malformed_htlc -------------------------------------------------++-- | Encode an t'UpdateFailMalformedHtlc' payload.+encode_update_fail_malformed_htlc :: UpdateFailMalformedHtlc -> BS.ByteString+encode_update_fail_malformed_htlc+  (UpdateFailMalformedHtlc cid (HtlcId hid) oh code ts) = mconcat [+      BOLT1.un_channel_id cid+    , BOLT1.encode_u64 hid+    , un_onion_hash oh+    , BOLT1.encode_u16 code+    , BOLT1.encode_tlv_stream ts+    ]++-- | Decode an t'UpdateFailMalformedHtlc' payload.+decode_update_fail_malformed_htlc+  :: BS.ByteString -> Either DecodeError UpdateFailMalformedHtlc+decode_update_fail_malformed_htlc = parse $+  UpdateFailMalformedHtlc <$> channel_id <*> htlc_id <*> sized 32 onion_hash+                          <*> u16 <*> tlvs []++-- commitment_signed ----------------------------------------------------------++commitment_signed_known :: [Word64]+commitment_signed_known = [1]++-- | Encode a t'CommitmentSigned' payload. Fails if there are more than+--   65535 HTLC signatures.+encode_commitment_signed+  :: CommitmentSigned -> Either EncodeError BS.ByteString+encode_commitment_signed m = do+  let sigs = commitment_signed_htlc_signatures m+  n  <- count_prefix sigs+  ts <- encode_tlvs commitment_signed_known+    (opt 1 txid_bytes (commitment_signed_funding_txid m))+    (commitment_signed_tlvs m)+  pure $ mconcat [+      BOLT1.un_channel_id (commitment_signed_channel_id m)+    , BOLT1.un_signature (commitment_signed_signature m)+    , n+    , mconcat (map BOLT1.un_signature sigs)+    , ts+    ]++-- | Decode a t'CommitmentSigned' payload.+decode_commitment_signed+  :: BS.ByteString -> Either DecodeError CommitmentSigned+decode_commitment_signed = parse $ do+  cid  <- channel_id+  sig  <- signature+  n    <- u16+  sigs <- count (fromIntegral n) signature+  s    <- tlvs commitment_signed_known+  fund <- record 1 mk_txid s+  pure (CommitmentSigned cid sig sigs fund (unknown commitment_signed_known s))++-- revoke_and_ack, update_fee -------------------------------------------------++-- | Encode a t'RevokeAndAck' payload.+encode_revoke_and_ack :: RevokeAndAck -> BS.ByteString+encode_revoke_and_ack (RevokeAndAck cid sec pcp ts) = mconcat [+    BOLT1.un_channel_id cid+  , BOLT1.un_per_commitment_secret sec+  , BOLT1.un_point pcp+  , BOLT1.encode_tlv_stream ts+  ]++-- | Decode a t'RevokeAndAck' payload.+decode_revoke_and_ack :: BS.ByteString -> Either DecodeError RevokeAndAck+decode_revoke_and_ack = parse $+  RevokeAndAck <$> channel_id <*> per_commitment_secret <*> point <*> tlvs []++-- | Encode an t'UpdateFee' payload.+encode_update_fee :: UpdateFee -> BS.ByteString+encode_update_fee (UpdateFee cid fee ts) = mconcat [+    BOLT1.un_channel_id cid+  , BOLT1.encode_u32 fee+  , BOLT1.encode_tlv_stream ts+  ]++-- | Decode an t'UpdateFee' payload.+decode_update_fee :: BS.ByteString -> Either DecodeError UpdateFee+decode_update_fee = parse $ UpdateFee <$> channel_id <*> u32 <*> tlvs []++-- channel_reestablish --------------------------------------------------------++channel_reestablish_known :: [Word64]+channel_reestablish_known = [1]++-- | Encode a t'ChannelReestablish' payload.+encode_channel_reestablish+  :: ChannelReestablish -> Either EncodeError BS.ByteString+encode_channel_reestablish m = do+  ts <- encode_tlvs channel_reestablish_known+    (opt 1 next_funding_bytes (channel_reestablish_next_funding m))+    (channel_reestablish_tlvs m)+  pure $ mconcat [+      BOLT1.un_channel_id (channel_reestablish_channel_id m)+    , BOLT1.encode_u64 (channel_reestablish_next_commitment_number m)+    , BOLT1.encode_u64 (channel_reestablish_next_revocation_number m)+    , BOLT1.un_per_commitment_secret+        (channel_reestablish_your_last_per_commitment_secret m)+    , BOLT1.un_point (channel_reestablish_my_current_per_commitment_point m)+    , ts+    ]++-- | Decode a t'ChannelReestablish' payload.+decode_channel_reestablish+  :: BS.ByteString -> Either DecodeError ChannelReestablish+decode_channel_reestablish = parse $ do+  cid  <- channel_id+  nc   <- u64+  nr   <- u64+  sec  <- per_commitment_secret+  pcp  <- point+  s    <- tlvs channel_reestablish_known+  next <- record 1 tlv_next_funding s+  pure (ChannelReestablish cid nc nr sec pcp next+          (unknown channel_reestablish_known s))

@@ -1,7 +1,5 @@-{-# OPTIONS_HADDOCK prune #-}-{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}  -- | -- Module: Lightning.Protocol.BOLT2.Messages@@ -9,27 +7,18 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Message types for BOLT #2 peer protocol.------ This module defines per-message record types and a top-level Message--- sum type for all BOLT #2 messages.+-- The messages defined by BOLT #2.  module Lightning.Protocol.BOLT2.Messages (-  -- * Message type codes-    MsgType(..)-  , msgTypeWord--  -- * Top-level message type-  , Message(..)+    Message(..)+  , message_type -  -- * Channel establishment v1   , OpenChannel(..)   , AcceptChannel(..)   , FundingCreated(..)   , FundingSigned(..)   , ChannelReady(..) -  -- * Channel establishment v2   , OpenChannel2(..)   , AcceptChannel2(..)   , TxAddInput(..)@@ -42,14 +31,13 @@   , TxAckRbf(..)   , TxAbort(..) -  -- * Channel close   , Stfu(..)+   , Shutdown(..)-  , ClosingSigned(..)   , ClosingComplete(..)   , ClosingSig(..)+  , ClosingSigned(..) -  -- * Normal operation   , UpdateAddHtlc(..)   , UpdateFulfillHtlc(..)   , UpdateFailHtlc(..)@@ -58,544 +46,556 @@   , RevokeAndAck(..)   , UpdateFee(..) -  -- * Reestablishment   , ChannelReestablish(..)--  -- * Witness data-  , Witness(..)   ) where +import Bitcoin.Prim.Tx (TxId) import Control.DeepSeq (NFData) import qualified Data.ByteString as BS+import Data.Int (Int64) import Data.Word (Word8, Word16, Word32, Word64) import GHC.Generics (Generic)-import Lightning.Protocol.BOLT1 (TlvStream)+import Lightning.Protocol.BOLT1+  ( ChainHash, ChannelId, Signature, Point, PaymentHash, PaymentPreimage+  , PerCommitmentSecret, ShortChannelId, Satoshi, MilliSatoshi, TlvStream )+import qualified Lightning.Protocol.BOLT9 as BOLT9 import Lightning.Protocol.BOLT2.Types --- Message type codes -------------------------------------------------------------- | BOLT #2 message type codes.-data MsgType-  = MsgStfu                    -- ^ 2-  | MsgOpenChannel             -- ^ 32-  | MsgAcceptChannel           -- ^ 33-  | MsgFundingCreated          -- ^ 34-  | MsgFundingSigned           -- ^ 35-  | MsgChannelReady            -- ^ 36-  | MsgShutdown                -- ^ 38-  | MsgClosingSigned           -- ^ 39-  | MsgClosingComplete         -- ^ 40-  | MsgClosingSig              -- ^ 41-  | MsgOpenChannel2            -- ^ 64-  | MsgAcceptChannel2          -- ^ 65-  | MsgTxAddInput              -- ^ 66-  | MsgTxAddOutput             -- ^ 67-  | MsgTxRemoveInput           -- ^ 68-  | MsgTxRemoveOutput          -- ^ 69-  | MsgTxComplete              -- ^ 70-  | MsgTxSignatures            -- ^ 71-  | MsgTxInitRbf               -- ^ 72-  | MsgTxAckRbf                -- ^ 73-  | MsgTxAbort                 -- ^ 74-  | MsgUpdateAddHtlc           -- ^ 128-  | MsgUpdateFulfillHtlc       -- ^ 130-  | MsgUpdateFailHtlc          -- ^ 131-  | MsgCommitmentSigned        -- ^ 132-  | MsgRevokeAndAck            -- ^ 133-  | MsgUpdateFee               -- ^ 134-  | MsgUpdateFailMalformedHtlc -- ^ 135-  | MsgChannelReestablish      -- ^ 136-  deriving stock (Eq, Ord, Show, Generic)--instance NFData MsgType---- | Get the numeric type code for a message type.-msgTypeWord :: MsgType -> Word16-msgTypeWord MsgStfu                    = 2-msgTypeWord MsgOpenChannel             = 32-msgTypeWord MsgAcceptChannel           = 33-msgTypeWord MsgFundingCreated          = 34-msgTypeWord MsgFundingSigned           = 35-msgTypeWord MsgChannelReady            = 36-msgTypeWord MsgShutdown                = 38-msgTypeWord MsgClosingSigned           = 39-msgTypeWord MsgClosingComplete         = 40-msgTypeWord MsgClosingSig              = 41-msgTypeWord MsgOpenChannel2            = 64-msgTypeWord MsgAcceptChannel2          = 65-msgTypeWord MsgTxAddInput              = 66-msgTypeWord MsgTxAddOutput             = 67-msgTypeWord MsgTxRemoveInput           = 68-msgTypeWord MsgTxRemoveOutput          = 69-msgTypeWord MsgTxComplete              = 70-msgTypeWord MsgTxSignatures            = 71-msgTypeWord MsgTxInitRbf               = 72-msgTypeWord MsgTxAckRbf                = 73-msgTypeWord MsgTxAbort                 = 74-msgTypeWord MsgUpdateAddHtlc           = 128-msgTypeWord MsgUpdateFulfillHtlc       = 130-msgTypeWord MsgUpdateFailHtlc          = 131-msgTypeWord MsgCommitmentSigned        = 132-msgTypeWord MsgRevokeAndAck            = 133-msgTypeWord MsgUpdateFee               = 134-msgTypeWord MsgUpdateFailMalformedHtlc = 135-msgTypeWord MsgChannelReestablish      = 136-{-# INLINE msgTypeWord #-}---- Channel establishment v1 ----------------------------------------------------+-- channel establishment v1 --------------------------------------------------- --- | The open_channel message (type 32).------ Contains information about a node and indicates its desire to set up--- a new channel.+-- | The @open_channel@ message (type 32). data OpenChannel = OpenChannel-  { openChannelChainHash             :: !ChainHash-  , openChannelTempChannelId         :: !ChannelId-  , openChannelFundingSatoshis       :: {-# UNPACK #-} !Satoshis-  , openChannelPushMsat              :: {-# UNPACK #-} !MilliSatoshis-  , openChannelDustLimitSatoshis     :: {-# UNPACK #-} !Satoshis-  , openChannelMaxHtlcValueInFlight  :: {-# UNPACK #-} !MilliSatoshis-  , openChannelChannelReserveSat     :: {-# UNPACK #-} !Satoshis-  , openChannelHtlcMinimumMsat       :: {-# UNPACK #-} !MilliSatoshis-  , openChannelFeeratePerKw          :: {-# UNPACK #-} !Word32-  , openChannelToSelfDelay           :: {-# UNPACK #-} !Word16-  , openChannelMaxAcceptedHtlcs      :: {-# UNPACK #-} !Word16-  , openChannelFundingPubkey         :: !Point-  , openChannelRevocationBasepoint   :: !Point-  , openChannelPaymentBasepoint      :: !Point-  , openChannelDelayedPaymentBase    :: !Point-  , openChannelHtlcBasepoint         :: !Point-  , openChannelFirstPerCommitPoint   :: !Point-  , openChannelChannelFlags          :: {-# UNPACK #-} !Word8-  , openChannelTlvs                  :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { open_channel_chain_hash                    :: !ChainHash+  , open_channel_temporary_channel_id          :: !ChannelId+  , open_channel_funding_satoshis              :: {-# UNPACK #-} !Satoshi+  , open_channel_push_msat                     :: {-# UNPACK #-} !MilliSatoshi+  , open_channel_dust_limit_satoshis           :: {-# UNPACK #-} !Satoshi+  , open_channel_max_htlc_value_in_flight_msat :: {-# UNPACK #-} !Word64+    -- ^ a cap, often @maxBound@, so not a bounded amount+  , open_channel_channel_reserve_satoshis      :: {-# UNPACK #-} !Satoshi+  , open_channel_htlc_minimum_msat             :: {-# UNPACK #-} !MilliSatoshi+  , open_channel_feerate_per_kw                :: {-# UNPACK #-} !Word32+  , open_channel_to_self_delay                 :: {-# UNPACK #-} !Word16+  , open_channel_max_accepted_htlcs            :: {-# UNPACK #-} !Word16+  , open_channel_funding_pubkey                :: !Point+  , open_channel_revocation_basepoint          :: !Point+  , open_channel_payment_basepoint             :: !Point+  , open_channel_delayed_payment_basepoint     :: !Point+  , open_channel_htlc_basepoint                :: !Point+  , open_channel_first_per_commitment_point    :: !Point+  , open_channel_channel_flags                 :: {-# UNPACK #-} !Word8+    -- ^ bit 0: @announce_channel@+  , open_channel_upfront_shutdown_script       :: !(Maybe ScriptPubKey)+    -- ^ TLV type 0; an empty script commits to no particular script+  , open_channel_channel_type                  :: !(Maybe BOLT9.FeatureVector)+    -- ^ TLV type 1+  , open_channel_tlvs                          :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData OpenChannel --- | The accept_channel message (type 33).------ Contains information about a node and indicates its acceptance of--- the new channel.+-- | The @accept_channel@ message (type 33). data AcceptChannel = AcceptChannel-  { acceptChannelTempChannelId       :: !ChannelId-  , acceptChannelDustLimitSatoshis   :: {-# UNPACK #-} !Satoshis-  , acceptChannelMaxHtlcValueInFlight :: {-# UNPACK #-} !MilliSatoshis-  , acceptChannelChannelReserveSat   :: {-# UNPACK #-} !Satoshis-  , acceptChannelHtlcMinimumMsat     :: {-# UNPACK #-} !MilliSatoshis-  , acceptChannelMinimumDepth        :: {-# UNPACK #-} !Word32-  , acceptChannelToSelfDelay         :: {-# UNPACK #-} !Word16-  , acceptChannelMaxAcceptedHtlcs    :: {-# UNPACK #-} !Word16-  , acceptChannelFundingPubkey       :: !Point-  , acceptChannelRevocationBasepoint :: !Point-  , acceptChannelPaymentBasepoint    :: !Point-  , acceptChannelDelayedPaymentBase  :: !Point-  , acceptChannelHtlcBasepoint       :: !Point-  , acceptChannelFirstPerCommitPoint :: !Point-  , acceptChannelTlvs                :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { accept_channel_temporary_channel_id          :: !ChannelId+  , accept_channel_dust_limit_satoshis           :: {-# UNPACK #-} !Satoshi+  , accept_channel_max_htlc_value_in_flight_msat :: {-# UNPACK #-} !Word64+    -- ^ a cap, often @maxBound@, so not a bounded amount+  , accept_channel_channel_reserve_satoshis      :: {-# UNPACK #-} !Satoshi+  , accept_channel_htlc_minimum_msat+      :: {-# UNPACK #-} !MilliSatoshi+  , accept_channel_minimum_depth                :: {-# UNPACK #-} !Word32+  , accept_channel_to_self_delay                 :: {-# UNPACK #-} !Word16+  , accept_channel_max_accepted_htlcs            :: {-# UNPACK #-} !Word16+  , accept_channel_funding_pubkey                :: !Point+  , accept_channel_revocation_basepoint          :: !Point+  , accept_channel_payment_basepoint             :: !Point+  , accept_channel_delayed_payment_basepoint     :: !Point+  , accept_channel_htlc_basepoint                :: !Point+  , accept_channel_first_per_commitment_point    :: !Point+  , accept_channel_upfront_shutdown_script       :: !(Maybe ScriptPubKey)+    -- ^ TLV type 0; an empty script commits to no particular script+  , accept_channel_channel_type+      :: !(Maybe BOLT9.FeatureVector)+    -- ^ TLV type 1+  , accept_channel_tlvs                          :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData AcceptChannel --- | The funding_created message (type 34).------ Describes the outpoint which the funder has created for the initial--- commitment transactions.+-- | The @funding_created@ message (type 34). data FundingCreated = FundingCreated-  { fundingCreatedTempChannelId   :: !ChannelId-  , fundingCreatedFundingTxid     :: !TxId-  , fundingCreatedFundingOutIdx   :: {-# UNPACK #-} !Word16-  , fundingCreatedSignature       :: !Signature-  } deriving stock (Eq, Show, Generic)+  { funding_created_temporary_channel_id :: !ChannelId+  , funding_created_funding_txid         :: !TxId+  , funding_created_funding_output_index :: {-# UNPACK #-} !Word16+  , funding_created_signature            :: !Signature+  , funding_created_tlvs                 :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData FundingCreated --- | The funding_signed message (type 35).------ Gives the funder the signature for the first commitment transaction.+-- | The @funding_signed@ message (type 35). data FundingSigned = FundingSigned-  { fundingSignedChannelId  :: !ChannelId-  , fundingSignedSignature  :: !Signature-  } deriving stock (Eq, Show, Generic)+  { funding_signed_channel_id :: !ChannelId+  , funding_signed_signature  :: !Signature+  , funding_signed_tlvs       :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData FundingSigned --- | The channel_ready message (type 36).------ Indicates that the funding transaction has sufficient confirms for--- channel use.+-- | The @channel_ready@ message (type 36). data ChannelReady = ChannelReady-  { channelReadyChannelId            :: !ChannelId-  , channelReadySecondPerCommitPoint :: !Point-  , channelReadyTlvs                 :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { channel_ready_channel_id                  :: !ChannelId+  , channel_ready_second_per_commitment_point :: !Point+  , channel_ready_alias                       :: !(Maybe ShortChannelId)+    -- ^ the @short_channel_id@ record (TLV type 1)+  , channel_ready_tlvs                        :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData ChannelReady --- Channel establishment v2 ----------------------------------------------------+-- channel establishment v2 --------------------------------------------------- --- | The open_channel2 message (type 64).------ Initiates the v2 channel establishment workflow.+-- | The @open_channel2@ message (type 64). data OpenChannel2 = OpenChannel2-  { openChannel2ChainHash            :: !ChainHash-  , openChannel2TempChannelId        :: !ChannelId-  , openChannel2FundingFeeratePerkw  :: {-# UNPACK #-} !Word32-  , openChannel2CommitFeeratePerkw   :: {-# UNPACK #-} !Word32-  , openChannel2FundingSatoshis      :: {-# UNPACK #-} !Satoshis-  , openChannel2DustLimitSatoshis    :: {-# UNPACK #-} !Satoshis-  , openChannel2MaxHtlcValueInFlight :: {-# UNPACK #-} !MilliSatoshis-  , openChannel2HtlcMinimumMsat      :: {-# UNPACK #-} !MilliSatoshis-  , openChannel2ToSelfDelay          :: {-# UNPACK #-} !Word16-  , openChannel2MaxAcceptedHtlcs     :: {-# UNPACK #-} !Word16-  , openChannel2Locktime             :: {-# UNPACK #-} !Word32-  , openChannel2FundingPubkey        :: !Point-  , openChannel2RevocationBasepoint  :: !Point-  , openChannel2PaymentBasepoint     :: !Point-  , openChannel2DelayedPaymentBase   :: !Point-  , openChannel2HtlcBasepoint        :: !Point-  , openChannel2FirstPerCommitPoint  :: !Point-  , openChannel2SecondPerCommitPoint :: !Point-  , openChannel2ChannelFlags         :: {-# UNPACK #-} !Word8-  , openChannel2Tlvs                 :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { open_channel2_chain_hash                    :: !ChainHash+  , open_channel2_temporary_channel_id          :: !ChannelId+  , open_channel2_funding_feerate_perkw         :: {-# UNPACK #-} !Word32+  , open_channel2_commitment_feerate_perkw      :: {-# UNPACK #-} !Word32+  , open_channel2_funding_satoshis              :: {-# UNPACK #-} !Satoshi+  , open_channel2_dust_limit_satoshis           :: {-# UNPACK #-} !Satoshi+  , open_channel2_max_htlc_value_in_flight_msat :: {-# UNPACK #-} !Word64+    -- ^ a cap, often @maxBound@, so not a bounded amount+  , open_channel2_htlc_minimum_msat+      :: {-# UNPACK #-} !MilliSatoshi+  , open_channel2_to_self_delay                 :: {-# UNPACK #-} !Word16+  , open_channel2_max_accepted_htlcs            :: {-# UNPACK #-} !Word16+  , open_channel2_locktime                      :: {-# UNPACK #-} !Word32+  , open_channel2_funding_pubkey                :: !Point+  , open_channel2_revocation_basepoint          :: !Point+  , open_channel2_payment_basepoint             :: !Point+  , open_channel2_delayed_payment_basepoint     :: !Point+  , open_channel2_htlc_basepoint                :: !Point+  , open_channel2_first_per_commitment_point    :: !Point+  , open_channel2_second_per_commitment_point   :: !Point+  , open_channel2_channel_flags                 :: {-# UNPACK #-} !Word8+    -- ^ bit 0: @announce_channel@+  , open_channel2_upfront_shutdown_script       :: !(Maybe ScriptPubKey)+    -- ^ TLV type 0; an empty script commits to no particular script+  , open_channel2_channel_type+      :: !(Maybe BOLT9.FeatureVector)+    -- ^ TLV type 1+  , open_channel2_require_confirmed_inputs      :: !Bool+    -- ^ TLV type 2+  , open_channel2_tlvs                          :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData OpenChannel2 --- | The accept_channel2 message (type 65).------ Indicates acceptance of the v2 channel.+-- | The @accept_channel2@ message (type 65). data AcceptChannel2 = AcceptChannel2-  { acceptChannel2TempChannelId        :: !ChannelId-  , acceptChannel2FundingSatoshis      :: {-# UNPACK #-} !Satoshis-  , acceptChannel2DustLimitSatoshis    :: {-# UNPACK #-} !Satoshis-  , acceptChannel2MaxHtlcValueInFlight :: {-# UNPACK #-} !MilliSatoshis-  , acceptChannel2HtlcMinimumMsat      :: {-# UNPACK #-} !MilliSatoshis-  , acceptChannel2MinimumDepth         :: {-# UNPACK #-} !Word32-  , acceptChannel2ToSelfDelay          :: {-# UNPACK #-} !Word16-  , acceptChannel2MaxAcceptedHtlcs     :: {-# UNPACK #-} !Word16-  , acceptChannel2FundingPubkey        :: !Point-  , acceptChannel2RevocationBasepoint  :: !Point-  , acceptChannel2PaymentBasepoint     :: !Point-  , acceptChannel2DelayedPaymentBase   :: !Point-  , acceptChannel2HtlcBasepoint        :: !Point-  , acceptChannel2FirstPerCommitPoint  :: !Point-  , acceptChannel2SecondPerCommitPoint :: !Point-  , acceptChannel2Tlvs                 :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { accept_channel2_temporary_channel_id          :: !ChannelId+  , accept_channel2_funding_satoshis              :: {-# UNPACK #-} !Satoshi+  , accept_channel2_dust_limit_satoshis           :: {-# UNPACK #-} !Satoshi+  , accept_channel2_max_htlc_value_in_flight_msat :: {-# UNPACK #-} !Word64+    -- ^ a cap, often @maxBound@, so not a bounded amount+  , accept_channel2_htlc_minimum_msat+      :: {-# UNPACK #-} !MilliSatoshi+  , accept_channel2_minimum_depth                 :: {-# UNPACK #-} !Word32+  , accept_channel2_to_self_delay                 :: {-# UNPACK #-} !Word16+  , accept_channel2_max_accepted_htlcs            :: {-# UNPACK #-} !Word16+  , accept_channel2_funding_pubkey                :: !Point+  , accept_channel2_revocation_basepoint          :: !Point+  , accept_channel2_payment_basepoint             :: !Point+  , accept_channel2_delayed_payment_basepoint     :: !Point+  , accept_channel2_htlc_basepoint                :: !Point+  , accept_channel2_first_per_commitment_point    :: !Point+  , accept_channel2_second_per_commitment_point   :: !Point+  , accept_channel2_upfront_shutdown_script+      :: !(Maybe ScriptPubKey)+    -- ^ TLV type 0; an empty script commits to no particular script+  , accept_channel2_channel_type+      :: !(Maybe BOLT9.FeatureVector)+    -- ^ TLV type 1+  , accept_channel2_require_confirmed_inputs      :: !Bool+    -- ^ TLV type 2+  , accept_channel2_tlvs                          :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData AcceptChannel2 --- Interactive transaction construction -------------------------------------------- | The tx_add_input message (type 66).------ Adds a transaction input to the collaborative transaction.+-- | The @tx_add_input@ message (type 66). data TxAddInput = TxAddInput-  { txAddInputChannelId :: !ChannelId-  , txAddInputSerialId  :: {-# UNPACK #-} !Word64-  , txAddInputPrevTx    :: !BS.ByteString-  , txAddInputPrevVout  :: {-# UNPACK #-} !Word32-  , txAddInputSequence  :: {-# UNPACK #-} !Word32-  } deriving stock (Eq, Show, Generic)+  { tx_add_input_channel_id  :: !ChannelId+  , tx_add_input_serial_id   :: !SerialId+  , tx_add_input_prevtx      :: !BS.ByteString+    -- ^ the serialized previous transaction+  , tx_add_input_prevtx_vout :: {-# UNPACK #-} !Word32+  , tx_add_input_sequence    :: {-# UNPACK #-} !Word32+  , tx_add_input_tlvs        :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData TxAddInput --- | The tx_add_output message (type 67).------ Adds a transaction output to the collaborative transaction.+-- | The @tx_add_output@ message (type 67). data TxAddOutput = TxAddOutput-  { txAddOutputChannelId :: !ChannelId-  , txAddOutputSerialId  :: {-# UNPACK #-} !Word64-  , txAddOutputSats      :: {-# UNPACK #-} !Satoshis-  , txAddOutputScript    :: !ScriptPubKey-  } deriving stock (Eq, Show, Generic)+  { tx_add_output_channel_id :: !ChannelId+  , tx_add_output_serial_id  :: !SerialId+  , tx_add_output_sats       :: {-# UNPACK #-} !Satoshi+  , tx_add_output_script     :: !ScriptPubKey+  , tx_add_output_tlvs       :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData TxAddOutput --- | The tx_remove_input message (type 68).------ Removes a previously added input from the collaborative transaction.+-- | The @tx_remove_input@ message (type 68). data TxRemoveInput = TxRemoveInput-  { txRemoveInputChannelId :: !ChannelId-  , txRemoveInputSerialId  :: {-# UNPACK #-} !Word64-  } deriving stock (Eq, Show, Generic)+  { tx_remove_input_channel_id :: !ChannelId+  , tx_remove_input_serial_id  :: !SerialId+  , tx_remove_input_tlvs       :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData TxRemoveInput --- | The tx_remove_output message (type 69).------ Removes a previously added output from the collaborative transaction.+-- | The @tx_remove_output@ message (type 69). data TxRemoveOutput = TxRemoveOutput-  { txRemoveOutputChannelId :: !ChannelId-  , txRemoveOutputSerialId  :: {-# UNPACK #-} !Word64-  } deriving stock (Eq, Show, Generic)+  { tx_remove_output_channel_id :: !ChannelId+  , tx_remove_output_serial_id  :: !SerialId+  , tx_remove_output_tlvs       :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData TxRemoveOutput --- | The tx_complete message (type 70).------ Signals the conclusion of a peer's transaction contributions.+-- | The @tx_complete@ message (type 70). data TxComplete = TxComplete-  { txCompleteChannelId :: !ChannelId-  } deriving stock (Eq, Show, Generic)+  { tx_complete_channel_id :: !ChannelId+  , tx_complete_tlvs       :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData TxComplete --- | Witness data for tx_signatures.-data Witness = Witness-  { witnessData :: !BS.ByteString-  } deriving stock (Eq, Show, Generic)--instance NFData Witness---- | The tx_signatures message (type 71).------ Contains signatures for the collaborative transaction.+-- | The @tx_signatures@ message (type 71). data TxSignatures = TxSignatures-  { txSignaturesChannelId :: !ChannelId-  , txSignaturesTxid      :: !TxId-  , txSignaturesWitnesses :: ![Witness]-  } deriving stock (Eq, Show, Generic)+  { tx_signatures_channel_id :: !ChannelId+  , tx_signatures_txid       :: !TxId+  , tx_signatures_witnesses  :: ![Witness]+    -- ^ ordered by the @serial_id@ of the inputs they spend+  , tx_signatures_tlvs       :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData TxSignatures --- | The tx_init_rbf message (type 72).------ Initiates a replacement of the transaction after it's been completed.+-- | The @tx_init_rbf@ message (type 72). data TxInitRbf = TxInitRbf-  { txInitRbfChannelId :: !ChannelId-  , txInitRbfLocktime  :: {-# UNPACK #-} !Word32-  , txInitRbfFeerate   :: {-# UNPACK #-} !Word32-  , txInitRbfTlvs      :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { tx_init_rbf_channel_id                  :: !ChannelId+  , tx_init_rbf_locktime                    :: {-# UNPACK #-} !Word32+  , tx_init_rbf_feerate                     :: {-# UNPACK #-} !Word32+  , tx_init_rbf_funding_output_contribution :: !(Maybe Int64)+    -- ^ TLV type 0, in satoshis+  , tx_init_rbf_require_confirmed_inputs    :: !Bool+    -- ^ TLV type 2+  , tx_init_rbf_tlvs                        :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData TxInitRbf --- | The tx_ack_rbf message (type 73).------ Acknowledges an RBF attempt.+-- | The @tx_ack_rbf@ message (type 73). data TxAckRbf = TxAckRbf-  { txAckRbfChannelId :: !ChannelId-  , txAckRbfTlvs      :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { tx_ack_rbf_channel_id                  :: !ChannelId+  , tx_ack_rbf_funding_output_contribution :: !(Maybe Int64)+    -- ^ TLV type 0, in satoshis+  , tx_ack_rbf_require_confirmed_inputs    :: !Bool+    -- ^ TLV type 2+  , tx_ack_rbf_tlvs                        :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData TxAckRbf --- | The tx_abort message (type 74).------ Aborts the collaborative transaction negotiation.+-- | The @tx_abort@ message (type 74). data TxAbort = TxAbort-  { txAbortChannelId :: !ChannelId-  , txAbortData      :: !BS.ByteString-  } deriving stock (Eq, Show, Generic)+  { tx_abort_channel_id :: !ChannelId+  , tx_abort_data       :: !BS.ByteString+  , tx_abort_tlvs       :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData TxAbort --- Channel close ---------------------------------------------------------------+-- channel quiescence --------------------------------------------------------- --- | The stfu message (type 2).------ Indicates "SomeThing Fundamental is Underway" - used for channel--- quiescence.+-- | The @stfu@ message (type 2). data Stfu = Stfu-  { stfuChannelId :: !ChannelId-  , stfuInitiator :: {-# UNPACK #-} !Word8-  } deriving stock (Eq, Show, Generic)+  { stfu_channel_id :: !ChannelId+  , stfu_initiator  :: !Bool+    -- ^ whether the sender initiated quiescence (sent as 1 or 0)+  , stfu_tlvs       :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData Stfu --- | The shutdown message (type 38).------ Initiates closing of the channel.+-- channel close --------------------------------------------------------------++-- | The @shutdown@ message (type 38). data Shutdown = Shutdown-  { shutdownChannelId    :: !ChannelId-  , shutdownScriptPubkey :: !ScriptPubKey-  } deriving stock (Eq, Show, Generic)+  { shutdown_channel_id   :: !ChannelId+  , shutdown_scriptpubkey :: !ScriptPubKey+  , shutdown_tlvs         :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData Shutdown --- | The closing_signed message (type 39).------ Used in legacy closing negotiation.-data ClosingSigned = ClosingSigned-  { closingSignedChannelId   :: !ChannelId-  , closingSignedFeeSatoshis :: {-# UNPACK #-} !Satoshis-  , closingSignedSignature   :: !Signature-  , closingSignedTlvs        :: !TlvStream-  } deriving stock (Eq, Show, Generic)--instance NFData ClosingSigned---- | The closing_complete message (type 40).------ Proposes a closing transaction in the new closing protocol.+-- | The @closing_complete@ message (type 40). data ClosingComplete = ClosingComplete-  { closingCompleteChannelId       :: !ChannelId-  , closingCompleteCloserScript    :: !ScriptPubKey-  , closingCompleteCloseeScript    :: !ScriptPubKey-  , closingCompleteFeeSatoshis     :: {-# UNPACK #-} !Satoshis-  , closingCompleteLocktime        :: {-# UNPACK #-} !Word32-  , closingCompleteTlvs            :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { closing_complete_channel_id                :: !ChannelId+  , closing_complete_closer_scriptpubkey       :: !ScriptPubKey+  , closing_complete_closee_scriptpubkey       :: !ScriptPubKey+  , closing_complete_fee_satoshis              :: {-# UNPACK #-} !Satoshi+  , closing_complete_locktime                  :: {-# UNPACK #-} !Word32+  , closing_complete_closer_output_only        :: !(Maybe Signature)+    -- ^ TLV type 1+  , closing_complete_closee_output_only        :: !(Maybe Signature)+    -- ^ TLV type 2+  , closing_complete_closer_and_closee_outputs :: !(Maybe Signature)+    -- ^ TLV type 3+  , closing_complete_tlvs                      :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData ClosingComplete --- | The closing_sig message (type 41).------ Signs a closing transaction in the new closing protocol.+-- | The @closing_sig@ message (type 41). A valid @closing_sig@ carries+--   exactly one signature, in a field set in the @closing_complete@ it+--   answers; checking that is left to the caller. data ClosingSig = ClosingSig-  { closingSigChannelId       :: !ChannelId-  , closingSigCloserScript    :: !ScriptPubKey-  , closingSigCloseeScript    :: !ScriptPubKey-  , closingSigFeeSatoshis     :: {-# UNPACK #-} !Satoshis-  , closingSigLocktime        :: {-# UNPACK #-} !Word32-  , closingSigTlvs            :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { closing_sig_channel_id                :: !ChannelId+  , closing_sig_closer_scriptpubkey       :: !ScriptPubKey+  , closing_sig_closee_scriptpubkey       :: !ScriptPubKey+  , closing_sig_fee_satoshis              :: {-# UNPACK #-} !Satoshi+  , closing_sig_locktime                  :: {-# UNPACK #-} !Word32+  , closing_sig_closer_output_only        :: !(Maybe Signature)+    -- ^ TLV type 1+  , closing_sig_closee_output_only        :: !(Maybe Signature)+    -- ^ TLV type 2+  , closing_sig_closer_and_closee_outputs :: !(Maybe Signature)+    -- ^ TLV type 3+  , closing_sig_tlvs                      :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData ClosingSig --- Normal operation ------------------------------------------------------------+-- | The legacy @closing_signed@ message (type 39), used when+--   @option_simple_close@ is not negotiated.+data ClosingSigned = ClosingSigned+  { closing_signed_channel_id   :: !ChannelId+  , closing_signed_fee_satoshis :: {-# UNPACK #-} !Satoshi+  , closing_signed_signature    :: !Signature+  , closing_signed_fee_range    :: !(Maybe FeeRange)+    -- ^ TLV type 1+  , closing_signed_tlvs         :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic) --- | The update_add_htlc message (type 128).------ Offers an HTLC to the other node, redeemable in return for a payment--- preimage.+instance NFData ClosingSigned++-- normal operation -----------------------------------------------------------++-- | The @update_add_htlc@ message (type 128). data UpdateAddHtlc = UpdateAddHtlc-  { updateAddHtlcChannelId       :: !ChannelId-  , updateAddHtlcId              :: {-# UNPACK #-} !Word64-  , updateAddHtlcAmountMsat      :: {-# UNPACK #-} !MilliSatoshis-  , updateAddHtlcPaymentHash     :: !PaymentHash-  , updateAddHtlcCltvExpiry      :: {-# UNPACK #-} !Word32-  , updateAddHtlcOnionPacket     :: !OnionPacket-  , updateAddHtlcTlvs            :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { update_add_htlc_channel_id           :: !ChannelId+  , update_add_htlc_id                   :: !HtlcId+  , update_add_htlc_amount_msat          :: {-# UNPACK #-} !MilliSatoshi+  , update_add_htlc_payment_hash         :: !PaymentHash+  , update_add_htlc_cltv_expiry          :: {-# UNPACK #-} !Word32+  , update_add_htlc_onion_routing_packet :: !OnionRoutingPacket+  , update_add_htlc_path_key             :: !(Maybe Point)+    -- ^ the @blinded_path@ record (TLV type 0)+  , update_add_htlc_tlvs                 :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData UpdateAddHtlc --- | The update_fulfill_htlc message (type 130).------ Supplies the preimage to fulfill an HTLC.+-- | The @update_fulfill_htlc@ message (type 130). data UpdateFulfillHtlc = UpdateFulfillHtlc-  { updateFulfillHtlcChannelId       :: !ChannelId-  , updateFulfillHtlcId              :: {-# UNPACK #-} !Word64-  , updateFulfillHtlcPaymentPreimage :: !PaymentPreimage-  , updateFulfillHtlcTlvs            :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { update_fulfill_htlc_channel_id          :: !ChannelId+  , update_fulfill_htlc_id                  :: !HtlcId+  , update_fulfill_htlc_payment_preimage    :: !PaymentPreimage+  , update_fulfill_htlc_attribution_data    :: !(Maybe AttributionData)+    -- ^ TLV type 1+  , update_fulfill_htlc_fulfillment_payload :: !(Maybe BS.ByteString)+    -- ^ TLV type 3+  , update_fulfill_htlc_tlvs                :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData UpdateFulfillHtlc --- | The update_fail_htlc message (type 131).------ Indicates an HTLC has failed.+-- | The @update_fail_htlc@ message (type 131). data UpdateFailHtlc = UpdateFailHtlc-  { updateFailHtlcChannelId :: !ChannelId-  , updateFailHtlcId        :: {-# UNPACK #-} !Word64-  , updateFailHtlcReason    :: !BS.ByteString-  , updateFailHtlcTlvs      :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { update_fail_htlc_channel_id       :: !ChannelId+  , update_fail_htlc_id               :: !HtlcId+  , update_fail_htlc_reason           :: !BS.ByteString+  , update_fail_htlc_attribution_data :: !(Maybe AttributionData)+    -- ^ TLV type 1+  , update_fail_htlc_tlvs             :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData UpdateFailHtlc --- | The update_fail_malformed_htlc message (type 135).------ Indicates an HTLC could not be parsed.+-- | The @update_fail_malformed_htlc@ message (type 135). data UpdateFailMalformedHtlc = UpdateFailMalformedHtlc-  { updateFailMalformedHtlcChannelId   :: !ChannelId-  , updateFailMalformedHtlcId          :: {-# UNPACK #-} !Word64-  , updateFailMalformedHtlcSha256Onion :: !PaymentHash-  , updateFailMalformedHtlcFailureCode :: {-# UNPACK #-} !Word16-  } deriving stock (Eq, Show, Generic)+  { update_fail_malformed_htlc_channel_id      :: !ChannelId+  , update_fail_malformed_htlc_id              :: !HtlcId+  , update_fail_malformed_htlc_sha256_of_onion :: !OnionHash+  , update_fail_malformed_htlc_failure_code    :: {-# UNPACK #-} !Word16+  , update_fail_malformed_htlc_tlvs            :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData UpdateFailMalformedHtlc --- | The commitment_signed message (type 132).------ Applies pending changes and provides signatures for the commitment--- transaction.+-- | The @commitment_signed@ message (type 132). data CommitmentSigned = CommitmentSigned-  { commitmentSignedChannelId      :: !ChannelId-  , commitmentSignedSignature      :: !Signature-  , commitmentSignedHtlcSignatures :: ![Signature]-  } deriving stock (Eq, Show, Generic)+  { commitment_signed_channel_id      :: !ChannelId+  , commitment_signed_signature       :: !Signature+  , commitment_signed_htlc_signatures :: ![Signature]+  , commitment_signed_funding_txid    :: !(Maybe TxId)+    -- ^ TLV type 1+  , commitment_signed_tlvs            :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData CommitmentSigned --- | The revoke_and_ack message (type 133).------ Revokes the previous commitment transaction and acknowledges receipt--- of the commitment_signed.+-- | The @revoke_and_ack@ message (type 133). data RevokeAndAck = RevokeAndAck-  { revokeAndAckChannelId             :: !ChannelId-  , revokeAndAckPerCommitmentSecret   :: !Secret-  , revokeAndAckNextPerCommitPoint    :: !Point-  } deriving stock (Eq, Show, Generic)+  { revoke_and_ack_channel_id                :: !ChannelId+  , revoke_and_ack_per_commitment_secret     :: !PerCommitmentSecret+  , revoke_and_ack_next_per_commitment_point :: !Point+  , revoke_and_ack_tlvs                      :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData RevokeAndAck --- | The update_fee message (type 134).------ Updates the fee rate for commitment transactions.+-- | The @update_fee@ message (type 134). data UpdateFee = UpdateFee-  { updateFeeChannelId    :: !ChannelId-  , updateFeeFeeratePerKw :: {-# UNPACK #-} !Word32-  } deriving stock (Eq, Show, Generic)+  { update_fee_channel_id     :: !ChannelId+  , update_fee_feerate_per_kw :: {-# UNPACK #-} !Word32+  , update_fee_tlvs           :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData UpdateFee --- Reestablishment -------------------------------------------------------------+-- message retransmission ----------------------------------------------------- --- | The channel_reestablish message (type 136).------ Used to re-establish a channel after reconnection.+-- | The @channel_reestablish@ message (type 136). data ChannelReestablish = ChannelReestablish-  { channelReestablishChannelId            :: !ChannelId-  , channelReestablishNextCommitNum        :: {-# UNPACK #-} !Word64-  , channelReestablishNextRevocationNum    :: {-# UNPACK #-} !Word64-  , channelReestablishYourLastCommitSecret :: !Secret-  , channelReestablishMyCurrentCommitPoint :: !Point-  , channelReestablishTlvs                 :: !TlvStream-  } deriving stock (Eq, Show, Generic)+  { channel_reestablish_channel_id                      :: !ChannelId+  , channel_reestablish_next_commitment_number+      :: {-# UNPACK #-} !Word64+  , channel_reestablish_next_revocation_number+      :: {-# UNPACK #-} !Word64+  , channel_reestablish_your_last_per_commitment_secret+      :: !PerCommitmentSecret+  , channel_reestablish_my_current_per_commitment_point :: !Point+  , channel_reestablish_next_funding+      :: !(Maybe NextFunding)+    -- ^ TLV type 1+  , channel_reestablish_tlvs                            :: !TlvStream+    -- ^ unknown TLV records+  } deriving (Eq, Show, Generic)  instance NFData ChannelReestablish --- Top-level message type ------------------------------------------------------+-- messages ------------------------------------------------------------------- --- | All BOLT #2 messages.+-- | A BOLT #2 message. data Message-  -- Channel establishment v1-  = MsgOpenChannelVal !OpenChannel-  | MsgAcceptChannelVal !AcceptChannel-  | MsgFundingCreatedVal !FundingCreated-  | MsgFundingSignedVal !FundingSigned-  | MsgChannelReadyVal !ChannelReady-  -- Channel establishment v2-  | MsgOpenChannel2Val !OpenChannel2-  | MsgAcceptChannel2Val !AcceptChannel2-  | MsgTxAddInputVal !TxAddInput-  | MsgTxAddOutputVal !TxAddOutput-  | MsgTxRemoveInputVal !TxRemoveInput-  | MsgTxRemoveOutputVal !TxRemoveOutput-  | MsgTxCompleteVal !TxComplete-  | MsgTxSignaturesVal !TxSignatures-  | MsgTxInitRbfVal !TxInitRbf-  | MsgTxAckRbfVal !TxAckRbf-  | MsgTxAbortVal !TxAbort-  -- Channel close-  | MsgStfuVal !Stfu-  | MsgShutdownVal !Shutdown-  | MsgClosingSignedVal !ClosingSigned-  | MsgClosingCompleteVal !ClosingComplete-  | MsgClosingSigVal !ClosingSig-  -- Normal operation-  | MsgUpdateAddHtlcVal !UpdateAddHtlc-  | MsgUpdateFulfillHtlcVal !UpdateFulfillHtlc-  | MsgUpdateFailHtlcVal !UpdateFailHtlc-  | MsgUpdateFailMalformedHtlcVal !UpdateFailMalformedHtlc-  | MsgCommitmentSignedVal !CommitmentSigned-  | MsgRevokeAndAckVal !RevokeAndAck-  | MsgUpdateFeeVal !UpdateFee-  -- Reestablishment-  | MsgChannelReestablishVal !ChannelReestablish-  deriving stock (Eq, Show, Generic)+  = MsgOpenChannel !OpenChannel+  | MsgAcceptChannel !AcceptChannel+  | MsgFundingCreated !FundingCreated+  | MsgFundingSigned !FundingSigned+  | MsgChannelReady !ChannelReady+  | MsgOpenChannel2 !OpenChannel2+  | MsgAcceptChannel2 !AcceptChannel2+  | MsgTxAddInput !TxAddInput+  | MsgTxAddOutput !TxAddOutput+  | MsgTxRemoveInput !TxRemoveInput+  | MsgTxRemoveOutput !TxRemoveOutput+  | MsgTxComplete !TxComplete+  | MsgTxSignatures !TxSignatures+  | MsgTxInitRbf !TxInitRbf+  | MsgTxAckRbf !TxAckRbf+  | MsgTxAbort !TxAbort+  | MsgStfu !Stfu+  | MsgShutdown !Shutdown+  | MsgClosingComplete !ClosingComplete+  | MsgClosingSig !ClosingSig+  | MsgClosingSigned !ClosingSigned+  | MsgUpdateAddHtlc !UpdateAddHtlc+  | MsgUpdateFulfillHtlc !UpdateFulfillHtlc+  | MsgUpdateFailHtlc !UpdateFailHtlc+  | MsgUpdateFailMalformedHtlc !UpdateFailMalformedHtlc+  | MsgCommitmentSigned !CommitmentSigned+  | MsgRevokeAndAck !RevokeAndAck+  | MsgUpdateFee !UpdateFee+  | MsgChannelReestablish !ChannelReestablish+  deriving (Eq, Show, Generic)  instance NFData Message++-- | The wire type of a 'Message'.+--+--   >>> message_type (MsgTxComplete (TxComplete cid BOLT1.empty_tlv_stream))+--   70+message_type :: Message -> Word16+message_type m = case m of+  MsgOpenChannel {}             -> 32+  MsgAcceptChannel {}           -> 33+  MsgFundingCreated {}          -> 34+  MsgFundingSigned {}           -> 35+  MsgChannelReady {}            -> 36+  MsgOpenChannel2 {}            -> 64+  MsgAcceptChannel2 {}          -> 65+  MsgTxAddInput {}              -> 66+  MsgTxAddOutput {}             -> 67+  MsgTxRemoveInput {}           -> 68+  MsgTxRemoveOutput {}          -> 69+  MsgTxComplete {}              -> 70+  MsgTxSignatures {}            -> 71+  MsgTxInitRbf {}               -> 72+  MsgTxAckRbf {}                -> 73+  MsgTxAbort {}                 -> 74+  MsgStfu {}                    -> 2+  MsgShutdown {}                -> 38+  MsgClosingComplete {}         -> 40+  MsgClosingSig {}              -> 41+  MsgClosingSigned {}           -> 39+  MsgUpdateAddHtlc {}           -> 128+  MsgUpdateFulfillHtlc {}       -> 130+  MsgUpdateFailHtlc {}          -> 131+  MsgUpdateFailMalformedHtlc {} -> 135+  MsgCommitmentSigned {}        -> 132+  MsgRevokeAndAck {}            -> 133+  MsgUpdateFee {}               -> 134+  MsgChannelReestablish {}      -> 136

@@ -1,8 +1,5 @@-{-# OPTIONS_HADDOCK prune #-}-{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}  -- | -- Module: Lightning.Protocol.BOLT2.Types@@ -10,492 +7,189 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- Core types for BOLT #2 peer protocol.------ This module provides newtypes for identifiers, amounts, hashes, and--- keys used in the Lightning Network peer protocol.+-- Field types specific to BOLT #2.  module Lightning.Protocol.BOLT2.Types (-  -- * Identifiers-    ChannelId-  , channelId-  , unChannelId--  -- * Amounts-  , Satoshis(..)-  , MilliSatoshis(..)-  , satoshisToMsat-  , msatToSatoshis--  -- * Cryptographic types-  , Signature-  , signature-  , unSignature-  , Point-  , point-  , unPoint-  , PaymentHash-  , paymentHash-  , unPaymentHash-  , PaymentPreimage-  , paymentPreimage-  , unPaymentPreimage-  , Secret-  , secret-  , unSecret--  -- * Transaction types-  , TxId-  , txId-  , unTxId-  , Outpoint(..)+    HtlcId(..)+  , SerialId(..)   , ScriptPubKey-  , scriptPubKey-  , unScriptPubKey--  -- * Chain types-  , ChainHash-  , chainHash-  , unChainHash-  , ShortChannelId(..)-  , shortChannelId-  , scidBlockHeight-  , scidTxIndex-  , scidOutputIndex--  -- * Protocol types-  , FeatureBits-  , featureBits-  , unFeatureBits-  , OnionPacket-  , onionPacket-  , unOnionPacket--  -- * Constants-  , channelIdLen-  , signatureLen-  , pointLen-  , txIdLen-  , chainHashLen-  , shortChannelIdLen-  , paymentHashLen-  , paymentPreimageLen-  , onionPacketLen-  , secretLen+  , script_pubkey+  , un_script_pubkey+  , Witness+  , witness+  , un_witness+  , OnionRoutingPacket+  , onion_routing_packet+  , un_onion_routing_packet+  , OnionHash+  , onion_hash+  , un_onion_hash+  , AttributionData+  , attribution_data+  , un_attribution_data+  , FeeRange(..)+  , NextFunding(..)   ) where +import Bitcoin.Prim.Tx (TxId) import Control.DeepSeq (NFData)-import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.), (.|.)) import qualified Data.ByteString as BS-import Data.Word (Word16, Word32, Word64)+import Data.Word (Word8, Word64) import GHC.Generics (Generic)---- constants ----------------------------------------------------------------------- | Length of a channel_id in bytes (32).-channelIdLen :: Int-channelIdLen = 32-{-# INLINE channelIdLen #-}---- | Length of a signature in bytes (64, compact format).-signatureLen :: Int-signatureLen = 64-{-# INLINE signatureLen #-}---- | Length of a compressed secp256k1 public key in bytes (33).-pointLen :: Int-pointLen = 33-{-# INLINE pointLen #-}---- | Length of a transaction ID in bytes (32).-txIdLen :: Int-txIdLen = 32-{-# INLINE txIdLen #-}---- | Length of a chain hash in bytes (32).-chainHashLen :: Int-chainHashLen = 32-{-# INLINE chainHashLen #-}---- | Length of a short_channel_id in bytes (8).-shortChannelIdLen :: Int-shortChannelIdLen = 8-{-# INLINE shortChannelIdLen #-}---- | Length of a payment hash in bytes (32).-paymentHashLen :: Int-paymentHashLen = 32-{-# INLINE paymentHashLen #-}---- | Length of a payment preimage in bytes (32).-paymentPreimageLen :: Int-paymentPreimageLen = 32-{-# INLINE paymentPreimageLen #-}---- | Length of an onion routing packet in bytes (1366).-onionPacketLen :: Int-onionPacketLen = 1366-{-# INLINE onionPacketLen #-}---- | Length of a per-commitment secret in bytes (32).-secretLen :: Int-secretLen = 32-{-# INLINE secretLen #-}---- identifiers --------------------------------------------------------------------- | A 32-byte channel identifier.------ Derived from the funding transaction by XORing @funding_txid@ with--- @funding_output_index@ (big-endian, altering the last 2 bytes).------ For v2 channels, derived as @SHA256(lesser-revocation-basepoint ||--- greater-revocation-basepoint)@.-newtype ChannelId = ChannelId BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData---- | Construct a 'ChannelId' from a 32-byte 'BS.ByteString'.------ Returns 'Nothing' if the input is not exactly 32 bytes.------ >>> channelId (BS.replicate 32 0x00)--- Just (ChannelId ...)--- >>> channelId (BS.replicate 31 0x00)--- Nothing-channelId :: BS.ByteString -> Maybe ChannelId-channelId !bs-  | BS.length bs == channelIdLen = Just $! ChannelId bs-  | otherwise                    = Nothing-{-# INLINABLE channelId #-}---- | Extract the underlying 'BS.ByteString' from a 'ChannelId'.-unChannelId :: ChannelId -> BS.ByteString-unChannelId (ChannelId bs) = bs-{-# INLINE unChannelId #-}---- amounts ------------------------------------------------------------------------- | Amount in satoshis (1/100,000,000 of a bitcoin).------ Stored as a 'Word64'. Maximum valid value is 21,000,000 * 100,000,000--- = 2,100,000,000,000,000 satoshis.-newtype Satoshis = Satoshis { unSatoshis :: Word64 }-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype (NFData, Num, Enum, Real, Integral)---- | Amount in millisatoshis (1/1000 of a satoshi).------ Stored as a 'Word64'. Used for HTLC amounts and channel balances.-newtype MilliSatoshis = MilliSatoshis { unMilliSatoshis :: Word64 }-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype (NFData, Num, Enum, Real, Integral)---- | Convert 'Satoshis' to 'MilliSatoshis'.------ >>> satoshisToMsat (Satoshis 1)--- MilliSatoshis 1000-satoshisToMsat :: Satoshis -> MilliSatoshis-satoshisToMsat (Satoshis !s) = MilliSatoshis $! s * 1000-{-# INLINE satoshisToMsat #-}---- | Convert 'MilliSatoshis' to 'Satoshis', rounding down.------ >>> msatToSatoshis (MilliSatoshis 1500)--- Satoshis 1-msatToSatoshis :: MilliSatoshis -> Satoshis-msatToSatoshis (MilliSatoshis !m) = Satoshis $! m `div` 1000-{-# INLINE msatToSatoshis #-}---- cryptographic types ------------------------------------------------------------- | A 64-byte compact ECDSA signature.------ Used for commitment transaction signatures, HTLC signatures, and--- closing transaction signatures.-newtype Signature = Signature BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData---- | Construct a 'Signature' from a 64-byte 'BS.ByteString'.------ Returns 'Nothing' if the input is not exactly 64 bytes.-signature :: BS.ByteString -> Maybe Signature-signature !bs-  | BS.length bs == signatureLen = Just $! Signature bs-  | otherwise                    = Nothing-{-# INLINABLE signature #-}---- | Extract the underlying 'BS.ByteString' from a 'Signature'.-unSignature :: Signature -> BS.ByteString-unSignature (Signature bs) = bs-{-# INLINE unSignature #-}---- | A 33-byte compressed secp256k1 public key.------ Used for funding pubkeys, basepoints, and per-commitment points.-newtype Point = Point BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData---- | Construct a 'Point' from a 33-byte 'BS.ByteString'.------ Returns 'Nothing' if the input is not exactly 33 bytes.------ Note: This only validates the length. Use secp256k1 libraries for--- full point validation.-point :: BS.ByteString -> Maybe Point-point !bs-  | BS.length bs == pointLen = Just $! Point bs-  | otherwise                = Nothing-{-# INLINABLE point #-}---- | Extract the underlying 'BS.ByteString' from a 'Point'.-unPoint :: Point -> BS.ByteString-unPoint (Point bs) = bs-{-# INLINE unPoint #-}---- | A 32-byte SHA256 payment hash.------ Used to identify HTLCs. The preimage that hashes to this value is--- required to claim the HTLC.-newtype PaymentHash = PaymentHash BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData---- | Construct a 'PaymentHash' from a 32-byte 'BS.ByteString'.------ Returns 'Nothing' if the input is not exactly 32 bytes.-paymentHash :: BS.ByteString -> Maybe PaymentHash-paymentHash !bs-  | BS.length bs == paymentHashLen = Just $! PaymentHash bs-  | otherwise                      = Nothing-{-# INLINABLE paymentHash #-}---- | Extract the underlying 'BS.ByteString' from a 'PaymentHash'.-unPaymentHash :: PaymentHash -> BS.ByteString-unPaymentHash (PaymentHash bs) = bs-{-# INLINE unPaymentHash #-}---- | A 32-byte payment preimage.------ The SHA256 hash of this value produces the corresponding 'PaymentHash'.--- Knowledge of the preimage allows claiming an HTLC.-newtype PaymentPreimage = PaymentPreimage BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData---- | Construct a 'PaymentPreimage' from a 32-byte 'BS.ByteString'.------ Returns 'Nothing' if the input is not exactly 32 bytes.-paymentPreimage :: BS.ByteString -> Maybe PaymentPreimage-paymentPreimage !bs-  | BS.length bs == paymentPreimageLen = Just $! PaymentPreimage bs-  | otherwise                          = Nothing-{-# INLINABLE paymentPreimage #-}+import Lightning.Protocol.BOLT1 (Satoshi) --- | Extract the underlying 'BS.ByteString' from a 'PaymentPreimage'.-unPaymentPreimage :: PaymentPreimage -> BS.ByteString-unPaymentPreimage (PaymentPreimage bs) = bs-{-# INLINE unPaymentPreimage #-}+-- | An HTLC identifier (the @id@ field of the HTLC messages). The+--   offerer numbers its HTLCs from 0, incrementing by 1.+newtype HtlcId = HtlcId Word64+  deriving (Eq, Ord, Show, Generic) --- | A 32-byte per-commitment secret.------ Used in revoke_and_ack and channel_reestablish messages to revoke--- old commitment transactions.-newtype Secret = Secret BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData+instance NFData HtlcId --- | Construct a 'Secret' from a 32-byte 'BS.ByteString'.------ Returns 'Nothing' if the input is not exactly 32 bytes.-secret :: BS.ByteString -> Maybe Secret-secret !bs-  | BS.length bs == secretLen = Just $! Secret bs-  | otherwise                 = Nothing-{-# INLINABLE secret #-}+-- | The @serial_id@ of an input or output in interactive transaction+--   construction. The initiator sends even values, the non-initiator+--   odd ones.+newtype SerialId = SerialId Word64+  deriving (Eq, Ord, Show, Generic) --- | Extract the underlying 'BS.ByteString' from a 'Secret'.-unSecret :: Secret -> BS.ByteString-unSecret (Secret bs) = bs-{-# INLINE unSecret #-}+instance NFData SerialId --- transaction types -----------------------------------------------------------+-- | A scriptPubKey, at most 65535 bytes (the most a u16 length prefix+--   can describe).+newtype ScriptPubKey = ScriptPubKey BS.ByteString+  deriving (Eq, Ord, Show, Generic) --- | A 32-byte transaction identifier.------ The double-SHA256 hash of a serialized transaction.-newtype TxId = TxId BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData+instance NFData ScriptPubKey --- | Construct a 'TxId' from a 32-byte 'BS.ByteString'.+-- | Construct a t'ScriptPubKey', failing above 65535 bytes. The script+--   itself isn't checked; the forms acceptable in @shutdown@ depend on+--   negotiated features. ----- Returns 'Nothing' if the input is not exactly 32 bytes.-txId :: BS.ByteString -> Maybe TxId-txId !bs-  | BS.length bs == txIdLen = Just $! TxId bs-  | otherwise               = Nothing-{-# INLINABLE txId #-}---- | Extract the underlying 'BS.ByteString' from a 'TxId'.-unTxId :: TxId -> BS.ByteString-unTxId (TxId bs) = bs-{-# INLINE unTxId #-}+--   >>> script_pubkey "\x51\x02\x4e\x73"+--   Just (ScriptPubKey "Q\STXNs")+--   >>> script_pubkey (BS.replicate 65536 0x00)+--   Nothing+script_pubkey :: BS.ByteString -> Maybe ScriptPubKey+script_pubkey bs+  | BS.length bs <= 65535 = Just (ScriptPubKey bs)+  | otherwise             = Nothing+{-# INLINE script_pubkey #-} --- | A transaction outpoint (txid + output index).------ Identifies a specific output of a transaction.-data Outpoint = Outpoint-  { outpointTxId :: {-# UNPACK #-} !TxId-  , outpointVout :: {-# UNPACK #-} !Word32-  }-  deriving stock (Eq, Ord, Show, Generic)+-- | The bytes of a t'ScriptPubKey'.+un_script_pubkey :: ScriptPubKey -> BS.ByteString+un_script_pubkey (ScriptPubKey bs) = bs+{-# INLINE un_script_pubkey #-} -instance NFData Outpoint+-- | The serialized witness of one input in @tx_signatures@ (encoded as+--   in Bitcoin's wire protocol), at most 65535 bytes.+newtype Witness = Witness BS.ByteString+  deriving (Eq, Ord, Show, Generic) --- | A script pubkey (output script).------ Variable length; used in shutdown messages, closing transactions, etc.-newtype ScriptPubKey = ScriptPubKey BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData+instance NFData Witness --- | Construct a 'ScriptPubKey' from a 'BS.ByteString'.+-- | Construct a t'Witness', failing above 65535 bytes. The contents+--   aren't checked. ----- Accepts any length; validation of script structure is left to higher--- layers.-scriptPubKey :: BS.ByteString -> ScriptPubKey-scriptPubKey = ScriptPubKey-{-# INLINE scriptPubKey #-}+--   >>> witness "\x01\x01\x2a"+--   Just (Witness "\SOH\SOH*")+witness :: BS.ByteString -> Maybe Witness+witness bs+  | BS.length bs <= 65535 = Just (Witness bs)+  | otherwise             = Nothing+{-# INLINE witness #-} --- | Extract the underlying 'BS.ByteString' from a 'ScriptPubKey'.-unScriptPubKey :: ScriptPubKey -> BS.ByteString-unScriptPubKey (ScriptPubKey bs) = bs-{-# INLINE unScriptPubKey #-}+-- | The bytes of a t'Witness'.+un_witness :: Witness -> BS.ByteString+un_witness (Witness bs) = bs+{-# INLINE un_witness #-} --- chain types -----------------------------------------------------------------+-- | The 1366-byte @onion_routing_packet@ of @update_add_htlc@, kept+--   opaque (BOLT #4 defines its structure).+newtype OnionRoutingPacket = OnionRoutingPacket BS.ByteString+  deriving (Eq, Ord, Show, Generic) --- | A 32-byte chain hash.------ Identifies the blockchain (typically the genesis block hash).--- Used in @open_channel@ to specify which chain the channel will reside on.-newtype ChainHash = ChainHash BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData+instance NFData OnionRoutingPacket --- | Construct a 'ChainHash' from a 32-byte 'BS.ByteString'.+-- | Construct an t'OnionRoutingPacket' from exactly 1366 bytes. ----- Returns 'Nothing' if the input is not exactly 32 bytes.-chainHash :: BS.ByteString -> Maybe ChainHash-chainHash !bs-  | BS.length bs == chainHashLen = Just $! ChainHash bs-  | otherwise                    = Nothing-{-# INLINABLE chainHash #-}+--   >>> let bs = BS.replicate 1366 0x00+--   >>> fmap un_onion_routing_packet (onion_routing_packet bs) == Just bs+--   True+--   >>> onion_routing_packet (BS.take 1365 bs)+--   Nothing+onion_routing_packet :: BS.ByteString -> Maybe OnionRoutingPacket+onion_routing_packet bs+  | BS.length bs == 1366 = Just (OnionRoutingPacket bs)+  | otherwise            = Nothing+{-# INLINE onion_routing_packet #-} --- | Extract the underlying 'BS.ByteString' from a 'ChainHash'.-unChainHash :: ChainHash -> BS.ByteString-unChainHash (ChainHash bs) = bs-{-# INLINE unChainHash #-}+-- | The bytes of an t'OnionRoutingPacket'.+un_onion_routing_packet :: OnionRoutingPacket -> BS.ByteString+un_onion_routing_packet (OnionRoutingPacket bs) = bs+{-# INLINE un_onion_routing_packet #-} --- | A short channel identifier (8 bytes).------ Encodes the block height (3 bytes), transaction index (3 bytes), and--- output index (2 bytes) of the funding transaction output.------ This is a compact representation for referencing channels in gossip--- and routing.-data ShortChannelId = ShortChannelId-  { scidBytes :: {-# UNPACK #-} !Word64-  }-  deriving stock (Eq, Ord, Show, Generic)+-- | The SHA256 hash of an onion routing packet (the @sha256_of_onion@+--   field of @update_fail_malformed_htlc@).+newtype OnionHash = OnionHash BS.ByteString+  deriving (Eq, Ord, Show, Generic) -instance NFData ShortChannelId+instance NFData OnionHash --- | Construct a 'ShortChannelId' from block height, tx index, and--- output index.------ Returns 'Nothing' if any component exceeds its maximum value:------ * block height: max 16,777,215 (2^24 - 1)--- * tx index: max 16,777,215 (2^24 - 1)--- * output index: max 65,535 (2^16 - 1)+-- | Construct an t'OnionHash' from exactly 32 bytes. ----- >>> shortChannelId 800000 1234 0--- Just (ShortChannelId ...)-shortChannelId-  :: Word32  -- ^ Block height (24 bits max)-  -> Word32  -- ^ Transaction index (24 bits max)-  -> Word16  -- ^ Output index-  -> Maybe ShortChannelId-shortChannelId !blockHeight !txIndex !outputIndex-  | blockHeight > 0xFFFFFF = Nothing-  | txIndex > 0xFFFFFF     = Nothing-  | otherwise              = Just $! ShortChannelId scid-  where-    !scid = (fromIntegral blockHeight `unsafeShiftL` 40)-        .|. (fromIntegral txIndex `unsafeShiftL` 16)-        .|. fromIntegral outputIndex-{-# INLINABLE shortChannelId #-}---- | Extract the block height from a 'ShortChannelId'.-scidBlockHeight :: ShortChannelId -> Word32-scidBlockHeight (ShortChannelId !w) =-  fromIntegral $! (w `unsafeShiftR` 40) .&. 0xFFFFFF-{-# INLINE scidBlockHeight #-}+--   >>> onion_hash (BS.replicate 31 0x00)+--   Nothing+onion_hash :: BS.ByteString -> Maybe OnionHash+onion_hash bs+  | BS.length bs == 32 = Just (OnionHash bs)+  | otherwise          = Nothing+{-# INLINE onion_hash #-} --- | Extract the transaction index from a 'ShortChannelId'.-scidTxIndex :: ShortChannelId -> Word32-scidTxIndex (ShortChannelId !w) =-  fromIntegral $! (w `unsafeShiftR` 16) .&. 0xFFFFFF-{-# INLINE scidTxIndex #-}+-- | The bytes of an t'OnionHash'.+un_onion_hash :: OnionHash -> BS.ByteString+un_onion_hash (OnionHash bs) = bs+{-# INLINE un_onion_hash #-} --- | Extract the output index from a 'ShortChannelId'.-scidOutputIndex :: ShortChannelId -> Word16-scidOutputIndex (ShortChannelId !w) = fromIntegral $! w .&. 0xFFFF-{-# INLINE scidOutputIndex #-}+-- | The 920-byte @attribution_data@ of @update_fulfill_htlc@ and+--   @update_fail_htlc@: twenty u32 HTLC hold times followed by 210+--   four-byte truncated HMACs. Kept opaque (BOLT #4 defines its use).+newtype AttributionData = AttributionData BS.ByteString+  deriving (Eq, Ord, Show, Generic) --- protocol types --------------------------------------------------------------+instance NFData AttributionData --- | Feature bits (variable length).+-- | Construct an t'AttributionData' from exactly 920 bytes. ----- Encodes supported/required features. Even bits indicate required--- features; odd bits indicate optional features.-newtype FeatureBits = FeatureBits BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData+--   >>> let bs = BS.replicate 920 0x00+--   >>> fmap un_attribution_data (attribution_data bs) == Just bs+--   True+--   >>> attribution_data (BS.drop 1 bs)+--   Nothing+attribution_data :: BS.ByteString -> Maybe AttributionData+attribution_data bs+  | BS.length bs == 920 = Just (AttributionData bs)+  | otherwise           = Nothing+{-# INLINE attribution_data #-} --- | Construct 'FeatureBits' from a 'BS.ByteString'.------ Accepts any length; feature bit parsing is left to higher layers.-featureBits :: BS.ByteString -> FeatureBits-featureBits = FeatureBits-{-# INLINE featureBits #-}+-- | The bytes of an t'AttributionData'.+un_attribution_data :: AttributionData -> BS.ByteString+un_attribution_data (AttributionData bs) = bs+{-# INLINE un_attribution_data #-} --- | Extract the underlying 'BS.ByteString' from 'FeatureBits'.-unFeatureBits :: FeatureBits -> BS.ByteString-unFeatureBits (FeatureBits bs) = bs-{-# INLINE unFeatureBits #-}+-- | The @fee_range@ of @closing_signed@: the fees the sender is+--   prepared to pay for the closing transaction.+data FeeRange = FeeRange+  { fee_range_min_fee_satoshis :: {-# UNPACK #-} !Satoshi+  , fee_range_max_fee_satoshis :: {-# UNPACK #-} !Satoshi+  } deriving (Eq, Show, Generic) --- | A 1366-byte onion routing packet.------ Contains encrypted routing information for HTLC forwarding, as--- specified in BOLT #4.-newtype OnionPacket = OnionPacket BS.ByteString-  deriving stock (Eq, Ord, Show, Generic)-  deriving newtype NFData+instance NFData FeeRange --- | Construct an 'OnionPacket' from a 1366-byte 'BS.ByteString'.------ Returns 'Nothing' if the input is not exactly 1366 bytes.-onionPacket :: BS.ByteString -> Maybe OnionPacket-onionPacket !bs-  | BS.length bs == onionPacketLen = Just $! OnionPacket bs-  | otherwise                      = Nothing-{-# INLINABLE onionPacket #-}+-- | The @next_funding@ record of @channel_reestablish@: an interactive+--   funding transaction whose signatures are still being exchanged.+data NextFunding = NextFunding+  { next_funding_txid             :: !TxId+  , next_funding_retransmit_flags :: {-# UNPACK #-} !Word8+    -- ^ bit 0: the sender wants @commitment_signed@ retransmitted+  } deriving (Eq, Show, Generic) --- | Extract the underlying 'BS.ByteString' from an 'OnionPacket'.-unOnionPacket :: OnionPacket -> BS.ByteString-unOnionPacket (OnionPacket bs) = bs-{-# INLINE unOnionPacket #-}+instance NFData NextFunding

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-bolt2-version:            0.0.1+version:            0.1.0 synopsis:           Peer protocol per BOLT #2 license:            MIT license-file:       LICENSE@@ -8,7 +8,7 @@ maintainer:         jared@ppad.tech category:           Cryptography build-type:         Simple-tested-with:        GHC == 9.10.3+tested-with:        GHC == { 9.10.3 } extra-doc-files:    CHANGELOG description:   Peer protocol, per@@ -25,6 +25,7 @@       -Wall   exposed-modules:       Lightning.Protocol.BOLT2+  other-modules:       Lightning.Protocol.BOLT2.Codec       Lightning.Protocol.BOLT2.Messages       Lightning.Protocol.BOLT2.Types@@ -32,7 +33,9 @@       base >= 4.9 && < 5     , bytestring >= 0.9 && < 0.13     , deepseq >= 1.4 && < 1.6-    , ppad-bolt1 >= 0.0.1 && < 0.1+    , ppad-bolt1 >= 0.1 && < 0.2+    , ppad-bolt9 >= 0.1 && < 0.2+    , ppad-tx >= 0.2 && < 0.3  test-suite bolt2-tests   type:                exitcode-stdio-1.0@@ -41,7 +44,7 @@   main-is:             Main.hs    ghc-options:-    -rtsopts -Wall -O2+    -rtsopts -Wall    build-depends:       base@@ -49,6 +52,8 @@     , ppad-base16     , ppad-bolt1     , ppad-bolt2+    , ppad-bolt9+    , ppad-tx     , tasty     , tasty-hunit     , tasty-quickcheck@@ -58,31 +63,35 @@   default-language:    Haskell2010   hs-source-dirs:      bench   main-is:             Main.hs+  other-modules:       Fixtures    ghc-options:-    -rtsopts -O2 -Wall -fno-warn-orphans+    -rtsopts -O2 -Wall    build-depends:       base     , bytestring     , criterion-    , deepseq     , ppad-bolt1     , ppad-bolt2+    , ppad-bolt9+    , ppad-tx  benchmark bolt2-weigh   type:                exitcode-stdio-1.0   default-language:    Haskell2010   hs-source-dirs:      bench   main-is:             Weight.hs+  other-modules:       Fixtures    ghc-options:-    -rtsopts -O2 -Wall -fno-warn-orphans+    -rtsopts -O2 -Wall    build-depends:       base     , bytestring-    , deepseq     , ppad-bolt1     , ppad-bolt2+    , ppad-bolt9+    , ppad-tx     , weigh

@@ -2,1291 +2,1307 @@  module Main where -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 Lightning.Protocol.BOLT2-import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck--main :: IO ()-main = defaultMain $ testGroup "ppad-bolt2" [-    v1_establishment_tests-  , v2_establishment_tests-  , close_tests-  , normal_operation_tests-  , reestablish_tests-  , error_tests-  , property_tests-  ]---- 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 $ txId (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 Secret (32 bytes).-testSecret :: Secret-testSecret = fromJust $ secret (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-              , openChannelFundingSatoshis = Satoshis 1000000-              , openChannelPushMsat = MilliSatoshis 500000-              , openChannelDustLimitSatoshis = Satoshis 546-              , openChannelMaxHtlcValueInFlight = MilliSatoshis 100000000-              , openChannelChannelReserveSat = Satoshis 10000-              , openChannelHtlcMinimumMsat = MilliSatoshis 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-              , acceptChannelDustLimitSatoshis = Satoshis 546-              , acceptChannelMaxHtlcValueInFlight = MilliSatoshis 100000000-              , acceptChannelChannelReserveSat = Satoshis 10000-              , acceptChannelHtlcMinimumMsat = MilliSatoshis 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-    ]-  ]---- 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-              , openChannel2FundingSatoshis = Satoshis 1000000-              , openChannel2DustLimitSatoshis = Satoshis 546-              , openChannel2MaxHtlcValueInFlight = MilliSatoshis 100000000-              , openChannel2HtlcMinimumMsat = MilliSatoshis 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-              , acceptChannel2FundingSatoshis = Satoshis 500000-              , acceptChannel2DustLimitSatoshis = Satoshis 546-              , acceptChannel2MaxHtlcValueInFlight = MilliSatoshis 100000000-              , acceptChannel2HtlcMinimumMsat = MilliSatoshis 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 = 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 = 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 = 54321-              , txAddOutputSats = Satoshis 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 = 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 = 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-    ]-  ]---- Channel Close Tests -----------------------------------------------------------close_tests :: TestTree-close_tests = testGroup "Channel Close" [-    testGroup "Stfu" [-      testCase "encode/decode initiator=1" $ do-        let msg = Stfu-              { stfuChannelId = testChannelId-              , stfuInitiator = 1-              }-            encoded = encodeStfu msg-        case decodeStfu encoded of-          Right (decoded, _) -> decoded @?= msg-          Left e -> assertFailure $ "decode failed: " ++ show e-    , testCase "encode/decode initiator=0" $ do-        let msg = Stfu-              { stfuChannelId = testChannelId-              , stfuInitiator = 0-              }-            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-              , closingSignedFeeSatoshis = Satoshis 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-              , closingCompleteFeeSatoshis = Satoshis 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-              , closingSigFeeSatoshis = Satoshis 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-    ]-  ]---- 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 = 0-              , updateAddHtlcAmountMsat = MilliSatoshis 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 = 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 = 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 = 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 = 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-    ]-  ]---- Reestablish Tests -------------------------------------------------------------reestablish_tests :: TestTree-reestablish_tests = testGroup "Channel Reestablish" [-    testCase "encode/decode roundtrip" $ do-      let sec = fromJust $ secret (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 $ secret (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-  ]---- 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 "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-              , closingCompleteFeeSatoshis = Satoshis 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-              , closingCompleteFeeSatoshis = Satoshis 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-              , closingSigFeeSatoshis = Satoshis 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-    ]-  ]---- 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-  ]---- Property: OpenChannel roundtrip-propOpenChannelRoundtrip :: Property-propOpenChannelRoundtrip = property $ do-  let msg = OpenChannel-        { openChannelChainHash = testChainHash-        , openChannelTempChannelId = testChannelId-        , openChannelFundingSatoshis = Satoshis 1000000-        , openChannelPushMsat = MilliSatoshis 500000-        , openChannelDustLimitSatoshis = Satoshis 546-        , openChannelMaxHtlcValueInFlight = MilliSatoshis 100000000-        , openChannelChannelReserveSat = Satoshis 10000-        , openChannelHtlcMinimumMsat = MilliSatoshis 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-        , acceptChannelDustLimitSatoshis = Satoshis 546-        , acceptChannelMaxHtlcValueInFlight = MilliSatoshis 100000000-        , acceptChannelChannelReserveSat = Satoshis 10000-        , acceptChannelHtlcMinimumMsat = MilliSatoshis 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-        , openChannel2FundingSatoshis = Satoshis 1000000-        , openChannel2DustLimitSatoshis = Satoshis 546-        , openChannel2MaxHtlcValueInFlight = MilliSatoshis 100000000-        , openChannel2HtlcMinimumMsat = MilliSatoshis 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-        , acceptChannel2FundingSatoshis = Satoshis 500000-        , acceptChannel2DustLimitSatoshis = Satoshis 546-        , acceptChannel2MaxHtlcValueInFlight = MilliSatoshis 100000000-        , acceptChannel2HtlcMinimumMsat = MilliSatoshis 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 = 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 = 54321-        , txAddOutputSats = Satoshis 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 serialId = property $ do-  let msg = TxRemoveInput-        { txRemoveInputChannelId = testChannelId-        , txRemoveInputSerialId = serialId-        }-      encoded = encodeTxRemoveInput msg-  case decodeTxRemoveInput encoded of-    Right (decoded, _) -> decoded == msg-    Left _ -> False---- Property: TxRemoveOutput roundtrip-propTxRemoveOutputRoundtrip :: Word64 -> Property-propTxRemoveOutputRoundtrip serialId = property $ do-  let msg = TxRemoveOutput-        { txRemoveOutputChannelId = testChannelId-        , txRemoveOutputSerialId = serialId-        }-      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 :: Word8 -> Property-propStfuRoundtrip initiator = property $ do-  let msg = Stfu-        { stfuChannelId = testChannelId-        , stfuInitiator = initiator-        }-      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-        , closingSignedFeeSatoshis = Satoshis 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-        , closingCompleteFeeSatoshis = Satoshis 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-        , closingSigFeeSatoshis = Satoshis 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 htlcId amountMsat cltvExpiry = property $ do-  let msg = UpdateAddHtlc-        { updateAddHtlcChannelId = testChannelId-        , updateAddHtlcId = htlcId-        , updateAddHtlcAmountMsat = MilliSatoshis 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 htlcId = property $ do-  let msg = UpdateFulfillHtlc-        { updateFulfillHtlcChannelId = testChannelId-        , updateFulfillHtlcId = htlcId-        , 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 htlcId reasonBytes = property $ do-  let failReason = BS.pack (take 1000 reasonBytes)-      msg = UpdateFailHtlc-        { updateFailHtlcChannelId = testChannelId-        , updateFailHtlcId = htlcId-        , 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 htlcId failCode = property $ do-  let msg = UpdateFailMalformedHtlc-        { updateFailMalformedHtlcChannelId = testChannelId-        , updateFailMalformedHtlcId = htlcId-        , 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 $ secret (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---- Helpers ------------------------------------------------------------------------- | Decode hex string. Returns Nothing on invalid hex.-unhex :: BS.ByteString -> Maybe BS.ByteString-unhex = B16.decode+import qualified Bitcoin.Prim.Tx as Tx+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+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 hiding (witness)++main :: IO ()+main = defaultMain $ testGroup "ppad-bolt2" [+    known_answers+  , tlv_handling+  , decoding_failures+  , encoding_failures+  , field_types+  , properties+  ]++-- 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.mk_txid =<< 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+  ]++-- 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)+  ]++-- 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+  ]++-- 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+  ]++-- 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+  ]++-- 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.mk_txid++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+  ]++-- 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+  ]++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'+  ]