diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,4 @@ +# Changelog + +- 0.0.1 (2025-01-25) + * Initial release. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,301 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Main +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- 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 + ] + ] + ] diff --git a/bench/Weight.hs b/bench/Weight.hs new file mode 100644 --- /dev/null +++ b/bench/Weight.hs @@ -0,0 +1,344 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Main +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- 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 diff --git a/lib/Lightning/Protocol/BOLT2.hs b/lib/Lightning/Protocol/BOLT2.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT2.hs @@ -0,0 +1,133 @@ +{-# OPTIONS_HADDOCK prune #-} + +-- | +-- Module: Lightning.Protocol.BOLT2 +-- Copyright: (c) 2025 Jared Tobin +-- License: MIT +-- Maintainer: Jared Tobin +-- +-- 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) diff --git a/lib/Lightning/Protocol/BOLT2/Codec.hs b/lib/Lightning/Protocol/BOLT2/Codec.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT2/Codec.hs @@ -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 +-- +-- 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) diff --git a/lib/Lightning/Protocol/BOLT2/Messages.hs b/lib/Lightning/Protocol/BOLT2/Messages.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT2/Messages.hs @@ -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 +-- +-- 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 diff --git a/lib/Lightning/Protocol/BOLT2/Types.hs b/lib/Lightning/Protocol/BOLT2/Types.hs new file mode 100644 --- /dev/null +++ b/lib/Lightning/Protocol/BOLT2/Types.hs @@ -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 +-- +-- 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 #-} diff --git a/ppad-bolt2.cabal b/ppad-bolt2.cabal new file mode 100644 --- /dev/null +++ b/ppad-bolt2.cabal @@ -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 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -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