ppad-bolt2 (empty) → 0.0.1
raw patch · 10 files changed
+4631/−0 lines, 10 filesdep +basedep +bytestringdep +criterion
Dependencies added: base, bytestring, criterion, deepseq, ppad-base16, ppad-bolt1, ppad-bolt2, tasty, tasty-hunit, tasty-quickcheck, weigh
Files
- CHANGELOG +4/−0
- LICENSE +20/−0
- bench/Main.hs +301/−0
- bench/Weight.hs +344/−0
- lib/Lightning/Protocol/BOLT2.hs +133/−0
- lib/Lightning/Protocol/BOLT2/Codec.hs +1347/−0
- lib/Lightning/Protocol/BOLT2/Messages.hs +601/−0
- lib/Lightning/Protocol/BOLT2/Types.hs +501/−0
- ppad-bolt2.cabal +88/−0
- test/Main.hs +1292/−0
+ CHANGELOG view
@@ -0,0 +1,4 @@+# Changelog++- 0.0.1 (2025-01-25)+ * Initial release.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2025 Jared Tobin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ bench/Main.hs view
@@ -0,0 +1,301 @@+{-# 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 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+ ]+ ]+ , 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 "close"+ [ bgroup "closing_signed"+ [ bench "encode" $ nf encodeClosingSigned testClosingSigned+ , bench "decode" $ nf decodeClosingSigned encodedClosingSigned+ ]+ ]+ , 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+ ]+ ]+ ]
+ bench/Weight.hs view
@@ -0,0 +1,344 @@+{-# 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 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
+ lib/Lightning/Protocol/BOLT2.hs view
@@ -0,0 +1,133 @@+{-# OPTIONS_HADDOCK prune #-}++-- |+-- Module: Lightning.Protocol.BOLT2+-- Copyright: (c) 2025 Jared Tobin+-- 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).++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++ -- * Codec functions+ -- | Re-exported from "Lightning.Protocol.BOLT2.Codec".+ , module Lightning.Protocol.BOLT2.Codec++ -- $messagetypes++ -- ** Channel establishment (v1)+ -- $v1establishment++ -- ** Channel establishment (v2)+ -- $v2establishment++ -- ** Channel close+ -- $close++ -- ** Normal operation+ -- $normal++ -- ** Message reestablishment+ -- $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)
+ lib/Lightning/Protocol/BOLT2/Codec.hs view
@@ -0,0 +1,1347 @@+{-# 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)
+ lib/Lightning/Protocol/BOLT2/Messages.hs view
@@ -0,0 +1,601 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}++-- |+-- Module: Lightning.Protocol.BOLT2.Messages+-- Copyright: (c) 2025 Jared Tobin+-- 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.++module Lightning.Protocol.BOLT2.Messages (+ -- * Message type codes+ MsgType(..)+ , msgTypeWord++ -- * Top-level message type+ , Message(..)++ -- * Channel establishment v1+ , OpenChannel(..)+ , AcceptChannel(..)+ , FundingCreated(..)+ , FundingSigned(..)+ , ChannelReady(..)++ -- * Channel establishment v2+ , OpenChannel2(..)+ , AcceptChannel2(..)+ , TxAddInput(..)+ , TxAddOutput(..)+ , TxRemoveInput(..)+ , TxRemoveOutput(..)+ , TxComplete(..)+ , TxSignatures(..)+ , TxInitRbf(..)+ , TxAckRbf(..)+ , TxAbort(..)++ -- * Channel close+ , Stfu(..)+ , Shutdown(..)+ , ClosingSigned(..)+ , ClosingComplete(..)+ , ClosingSig(..)++ -- * Normal operation+ , UpdateAddHtlc(..)+ , UpdateFulfillHtlc(..)+ , UpdateFailHtlc(..)+ , UpdateFailMalformedHtlc(..)+ , CommitmentSigned(..)+ , RevokeAndAck(..)+ , UpdateFee(..)++ -- * Reestablishment+ , ChannelReestablish(..)++ -- * Witness data+ , Witness(..)+ ) where++import Control.DeepSeq (NFData)+import qualified Data.ByteString as BS+import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Generics (Generic)+import Lightning.Protocol.BOLT1 (TlvStream)+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 ----------------------------------------------------++-- | The open_channel message (type 32).+--+-- Contains information about a node and indicates its desire to set up+-- a new channel.+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)++instance NFData OpenChannel++-- | The accept_channel message (type 33).+--+-- Contains information about a node and indicates its acceptance of+-- the new channel.+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)++instance NFData AcceptChannel++-- | The funding_created message (type 34).+--+-- Describes the outpoint which the funder has created for the initial+-- commitment transactions.+data FundingCreated = FundingCreated+ { fundingCreatedTempChannelId :: !ChannelId+ , fundingCreatedFundingTxid :: !TxId+ , fundingCreatedFundingOutIdx :: {-# UNPACK #-} !Word16+ , fundingCreatedSignature :: !Signature+ } deriving stock (Eq, Show, Generic)++instance NFData FundingCreated++-- | The funding_signed message (type 35).+--+-- Gives the funder the signature for the first commitment transaction.+data FundingSigned = FundingSigned+ { fundingSignedChannelId :: !ChannelId+ , fundingSignedSignature :: !Signature+ } deriving stock (Eq, Show, Generic)++instance NFData FundingSigned++-- | The channel_ready message (type 36).+--+-- Indicates that the funding transaction has sufficient confirms for+-- channel use.+data ChannelReady = ChannelReady+ { channelReadyChannelId :: !ChannelId+ , channelReadySecondPerCommitPoint :: !Point+ , channelReadyTlvs :: !TlvStream+ } deriving stock (Eq, Show, Generic)++instance NFData ChannelReady++-- Channel establishment v2 ----------------------------------------------------++-- | The open_channel2 message (type 64).+--+-- Initiates the v2 channel establishment workflow.+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)++instance NFData OpenChannel2++-- | The accept_channel2 message (type 65).+--+-- Indicates acceptance of the v2 channel.+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)++instance NFData AcceptChannel2++-- Interactive transaction construction ----------------------------------------++-- | The tx_add_input message (type 66).+--+-- Adds a transaction input to the collaborative transaction.+data TxAddInput = TxAddInput+ { txAddInputChannelId :: !ChannelId+ , txAddInputSerialId :: {-# UNPACK #-} !Word64+ , txAddInputPrevTx :: !BS.ByteString+ , txAddInputPrevVout :: {-# UNPACK #-} !Word32+ , txAddInputSequence :: {-# UNPACK #-} !Word32+ } deriving stock (Eq, Show, Generic)++instance NFData TxAddInput++-- | The tx_add_output message (type 67).+--+-- Adds a transaction output to the collaborative transaction.+data TxAddOutput = TxAddOutput+ { txAddOutputChannelId :: !ChannelId+ , txAddOutputSerialId :: {-# UNPACK #-} !Word64+ , txAddOutputSats :: {-# UNPACK #-} !Satoshis+ , txAddOutputScript :: !ScriptPubKey+ } deriving stock (Eq, Show, Generic)++instance NFData TxAddOutput++-- | The tx_remove_input message (type 68).+--+-- Removes a previously added input from the collaborative transaction.+data TxRemoveInput = TxRemoveInput+ { txRemoveInputChannelId :: !ChannelId+ , txRemoveInputSerialId :: {-# UNPACK #-} !Word64+ } deriving stock (Eq, Show, Generic)++instance NFData TxRemoveInput++-- | The tx_remove_output message (type 69).+--+-- Removes a previously added output from the collaborative transaction.+data TxRemoveOutput = TxRemoveOutput+ { txRemoveOutputChannelId :: !ChannelId+ , txRemoveOutputSerialId :: {-# UNPACK #-} !Word64+ } deriving stock (Eq, Show, Generic)++instance NFData TxRemoveOutput++-- | The tx_complete message (type 70).+--+-- Signals the conclusion of a peer's transaction contributions.+data TxComplete = TxComplete+ { txCompleteChannelId :: !ChannelId+ } deriving stock (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.+data TxSignatures = TxSignatures+ { txSignaturesChannelId :: !ChannelId+ , txSignaturesTxid :: !TxId+ , txSignaturesWitnesses :: ![Witness]+ } deriving stock (Eq, Show, Generic)++instance NFData TxSignatures++-- | The tx_init_rbf message (type 72).+--+-- Initiates a replacement of the transaction after it's been completed.+data TxInitRbf = TxInitRbf+ { txInitRbfChannelId :: !ChannelId+ , txInitRbfLocktime :: {-# UNPACK #-} !Word32+ , txInitRbfFeerate :: {-# UNPACK #-} !Word32+ , txInitRbfTlvs :: !TlvStream+ } deriving stock (Eq, Show, Generic)++instance NFData TxInitRbf++-- | The tx_ack_rbf message (type 73).+--+-- Acknowledges an RBF attempt.+data TxAckRbf = TxAckRbf+ { txAckRbfChannelId :: !ChannelId+ , txAckRbfTlvs :: !TlvStream+ } deriving stock (Eq, Show, Generic)++instance NFData TxAckRbf++-- | The tx_abort message (type 74).+--+-- Aborts the collaborative transaction negotiation.+data TxAbort = TxAbort+ { txAbortChannelId :: !ChannelId+ , txAbortData :: !BS.ByteString+ } deriving stock (Eq, Show, Generic)++instance NFData TxAbort++-- Channel close ---------------------------------------------------------------++-- | The stfu message (type 2).+--+-- Indicates "SomeThing Fundamental is Underway" - used for channel+-- quiescence.+data Stfu = Stfu+ { stfuChannelId :: !ChannelId+ , stfuInitiator :: {-# UNPACK #-} !Word8+ } deriving stock (Eq, Show, Generic)++instance NFData Stfu++-- | The shutdown message (type 38).+--+-- Initiates closing of the channel.+data Shutdown = Shutdown+ { shutdownChannelId :: !ChannelId+ , shutdownScriptPubkey :: !ScriptPubKey+ } deriving stock (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.+data ClosingComplete = ClosingComplete+ { closingCompleteChannelId :: !ChannelId+ , closingCompleteCloserScript :: !ScriptPubKey+ , closingCompleteCloseeScript :: !ScriptPubKey+ , closingCompleteFeeSatoshis :: {-# UNPACK #-} !Satoshis+ , closingCompleteLocktime :: {-# UNPACK #-} !Word32+ , closingCompleteTlvs :: !TlvStream+ } deriving stock (Eq, Show, Generic)++instance NFData ClosingComplete++-- | The closing_sig message (type 41).+--+-- Signs a closing transaction in the new closing protocol.+data ClosingSig = ClosingSig+ { closingSigChannelId :: !ChannelId+ , closingSigCloserScript :: !ScriptPubKey+ , closingSigCloseeScript :: !ScriptPubKey+ , closingSigFeeSatoshis :: {-# UNPACK #-} !Satoshis+ , closingSigLocktime :: {-# UNPACK #-} !Word32+ , closingSigTlvs :: !TlvStream+ } deriving stock (Eq, Show, Generic)++instance NFData ClosingSig++-- Normal operation ------------------------------------------------------------++-- | The update_add_htlc message (type 128).+--+-- Offers an HTLC to the other node, redeemable in return for a payment+-- preimage.+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)++instance NFData UpdateAddHtlc++-- | The update_fulfill_htlc message (type 130).+--+-- Supplies the preimage to fulfill an HTLC.+data UpdateFulfillHtlc = UpdateFulfillHtlc+ { updateFulfillHtlcChannelId :: !ChannelId+ , updateFulfillHtlcId :: {-# UNPACK #-} !Word64+ , updateFulfillHtlcPaymentPreimage :: !PaymentPreimage+ , updateFulfillHtlcTlvs :: !TlvStream+ } deriving stock (Eq, Show, Generic)++instance NFData UpdateFulfillHtlc++-- | The update_fail_htlc message (type 131).+--+-- Indicates an HTLC has failed.+data UpdateFailHtlc = UpdateFailHtlc+ { updateFailHtlcChannelId :: !ChannelId+ , updateFailHtlcId :: {-# UNPACK #-} !Word64+ , updateFailHtlcReason :: !BS.ByteString+ , updateFailHtlcTlvs :: !TlvStream+ } deriving stock (Eq, Show, Generic)++instance NFData UpdateFailHtlc++-- | The update_fail_malformed_htlc message (type 135).+--+-- Indicates an HTLC could not be parsed.+data UpdateFailMalformedHtlc = UpdateFailMalformedHtlc+ { updateFailMalformedHtlcChannelId :: !ChannelId+ , updateFailMalformedHtlcId :: {-# UNPACK #-} !Word64+ , updateFailMalformedHtlcSha256Onion :: !PaymentHash+ , updateFailMalformedHtlcFailureCode :: {-# UNPACK #-} !Word16+ } deriving stock (Eq, Show, Generic)++instance NFData UpdateFailMalformedHtlc++-- | The commitment_signed message (type 132).+--+-- Applies pending changes and provides signatures for the commitment+-- transaction.+data CommitmentSigned = CommitmentSigned+ { commitmentSignedChannelId :: !ChannelId+ , commitmentSignedSignature :: !Signature+ , commitmentSignedHtlcSignatures :: ![Signature]+ } deriving stock (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.+data RevokeAndAck = RevokeAndAck+ { revokeAndAckChannelId :: !ChannelId+ , revokeAndAckPerCommitmentSecret :: !Secret+ , revokeAndAckNextPerCommitPoint :: !Point+ } deriving stock (Eq, Show, Generic)++instance NFData RevokeAndAck++-- | The update_fee message (type 134).+--+-- Updates the fee rate for commitment transactions.+data UpdateFee = UpdateFee+ { updateFeeChannelId :: !ChannelId+ , updateFeeFeeratePerKw :: {-# UNPACK #-} !Word32+ } deriving stock (Eq, Show, Generic)++instance NFData UpdateFee++-- Reestablishment -------------------------------------------------------------++-- | The channel_reestablish message (type 136).+--+-- Used to re-establish a channel after reconnection.+data ChannelReestablish = ChannelReestablish+ { channelReestablishChannelId :: !ChannelId+ , channelReestablishNextCommitNum :: {-# UNPACK #-} !Word64+ , channelReestablishNextRevocationNum :: {-# UNPACK #-} !Word64+ , channelReestablishYourLastCommitSecret :: !Secret+ , channelReestablishMyCurrentCommitPoint :: !Point+ , channelReestablishTlvs :: !TlvStream+ } deriving stock (Eq, Show, Generic)++instance NFData ChannelReestablish++-- Top-level message type ------------------------------------------------------++-- | All BOLT #2 messages.+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)++instance NFData Message
+ lib/Lightning/Protocol/BOLT2/Types.hs view
@@ -0,0 +1,501 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- |+-- Module: Lightning.Protocol.BOLT2.Types+-- Copyright: (c) 2025 Jared Tobin+-- 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.++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(..)+ , 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+ ) where++import Control.DeepSeq (NFData)+import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.), (.|.))+import qualified Data.ByteString as BS+import Data.Word (Word16, Word32, 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 #-}++-- | Extract the underlying 'BS.ByteString' from a 'PaymentPreimage'.+unPaymentPreimage :: PaymentPreimage -> BS.ByteString+unPaymentPreimage (PaymentPreimage bs) = bs+{-# INLINE unPaymentPreimage #-}++-- | 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++-- | 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 #-}++-- | Extract the underlying 'BS.ByteString' from a 'Secret'.+unSecret :: Secret -> BS.ByteString+unSecret (Secret bs) = bs+{-# INLINE unSecret #-}++-- transaction types -----------------------------------------------------------++-- | 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++-- | Construct a 'TxId' from a 32-byte 'BS.ByteString'.+--+-- 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 #-}++-- | 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)++instance NFData Outpoint++-- | 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++-- | Construct a 'ScriptPubKey' from a 'BS.ByteString'.+--+-- Accepts any length; validation of script structure is left to higher+-- layers.+scriptPubKey :: BS.ByteString -> ScriptPubKey+scriptPubKey = ScriptPubKey+{-# INLINE scriptPubKey #-}++-- | Extract the underlying 'BS.ByteString' from a 'ScriptPubKey'.+unScriptPubKey :: ScriptPubKey -> BS.ByteString+unScriptPubKey (ScriptPubKey bs) = bs+{-# INLINE unScriptPubKey #-}++-- chain types -----------------------------------------------------------------++-- | 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++-- | Construct a 'ChainHash' from a 32-byte 'BS.ByteString'.+--+-- 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 #-}++-- | Extract the underlying 'BS.ByteString' from a 'ChainHash'.+unChainHash :: ChainHash -> BS.ByteString+unChainHash (ChainHash bs) = bs+{-# INLINE unChainHash #-}++-- | 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)++instance NFData ShortChannelId++-- | 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)+--+-- >>> 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 #-}++-- | Extract the transaction index from a 'ShortChannelId'.+scidTxIndex :: ShortChannelId -> Word32+scidTxIndex (ShortChannelId !w) =+ fromIntegral $! (w `unsafeShiftR` 16) .&. 0xFFFFFF+{-# INLINE scidTxIndex #-}++-- | Extract the output index from a 'ShortChannelId'.+scidOutputIndex :: ShortChannelId -> Word16+scidOutputIndex (ShortChannelId !w) = fromIntegral $! w .&. 0xFFFF+{-# INLINE scidOutputIndex #-}++-- protocol types --------------------------------------------------------------++-- | Feature bits (variable length).+--+-- 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++-- | 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 #-}++-- | Extract the underlying 'BS.ByteString' from 'FeatureBits'.+unFeatureBits :: FeatureBits -> BS.ByteString+unFeatureBits (FeatureBits bs) = bs+{-# INLINE unFeatureBits #-}++-- | 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++-- | 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 #-}++-- | Extract the underlying 'BS.ByteString' from an 'OnionPacket'.+unOnionPacket :: OnionPacket -> BS.ByteString+unOnionPacket (OnionPacket bs) = bs+{-# INLINE unOnionPacket #-}
+ ppad-bolt2.cabal view
@@ -0,0 +1,88 @@+cabal-version: 3.0+name: ppad-bolt2+version: 0.0.1+synopsis: Peer protocol per BOLT #2+license: MIT+license-file: LICENSE+author: Jared Tobin+maintainer: jared@ppad.tech+category: Cryptography+build-type: Simple+tested-with: GHC == 9.10.3+extra-doc-files: CHANGELOG+description:+ Peer protocol, per+ [BOLT #2](https://github.com/lightning/bolts/blob/master/02-peer-protocol.md).++source-repository head+ type: git+ location: git.ppad.tech/bolt2.git++library+ default-language: Haskell2010+ hs-source-dirs: lib+ ghc-options:+ -Wall+ exposed-modules:+ Lightning.Protocol.BOLT2+ Lightning.Protocol.BOLT2.Codec+ Lightning.Protocol.BOLT2.Messages+ Lightning.Protocol.BOLT2.Types+ build-depends:+ base >= 4.9 && < 5+ , bytestring >= 0.9 && < 0.13+ , deepseq >= 1.4 && < 1.6+ , ppad-bolt1 >= 0.0.1 && < 0.1++test-suite bolt2-tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Main.hs++ ghc-options:+ -rtsopts -Wall -O2++ build-depends:+ base+ , bytestring+ , ppad-base16+ , ppad-bolt1+ , ppad-bolt2+ , tasty+ , tasty-hunit+ , tasty-quickcheck++benchmark bolt2-bench+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs++ ghc-options:+ -rtsopts -O2 -Wall -fno-warn-orphans++ build-depends:+ base+ , bytestring+ , criterion+ , deepseq+ , ppad-bolt1+ , ppad-bolt2++benchmark bolt2-weigh+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Weight.hs++ ghc-options:+ -rtsopts -O2 -Wall -fno-warn-orphans++ build-depends:+ base+ , bytestring+ , deepseq+ , ppad-bolt1+ , ppad-bolt2+ , weigh
+ test/Main.hs view
@@ -0,0 +1,1292 @@+{-# LANGUAGE OverloadedStrings #-}++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