commit e7543ba1ad63c0e56725ed1eedc97e133c359f2a
parent bb138778c6409032943e2139d8274f5d08962a03
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 25 Jan 2026 11:26:24 +0400
Add tests and benchmarks for BOLT #3 implementation
- Tests use official BOLT #3 test vectors from Appendix D and E
- Key derivation tests verify derive_pubkey and derive_revocationpubkey
- Secret generation tests verify generate_from_seed with 5 vectors
- Secret storage tests verify insert_secret with valid and invalid sequences
- Fee calculation tests verify commitment_fee, htlc_timeout_fee, htlc_success_fee
- Trimming tests verify is_trimmed behavior at dust thresholds
- Criterion benchmarks for key derivation, secret generation, fees, trimming
- Weigh allocation tracking for memory profiling
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
Diffstat:
5 files changed, 486 insertions(+), 2 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -3,9 +3,128 @@
module Main where
+import Control.DeepSeq (NFData(..))
import Criterion.Main
+import qualified Data.ByteString as BS
+import Lightning.Protocol.BOLT3
+
+-- NFData instances for benchmarking
+instance NFData Satoshi where
+ rnf (Satoshi x) = rnf x
+
+instance NFData MilliSatoshi where
+ rnf (MilliSatoshi x) = rnf x
+
+instance NFData Pubkey where
+ rnf (Pubkey x) = rnf x
+
+instance NFData Point where
+ rnf (Point x) = rnf x
+
+instance NFData PerCommitmentPoint where
+ rnf (PerCommitmentPoint x) = rnf x
+
+instance NFData RevocationPubkey where
+ rnf (RevocationPubkey x) = rnf x
+
+instance NFData RevocationBasepoint where
+ rnf (RevocationBasepoint x) = rnf x
+
+instance NFData ChannelFeatures where
+ rnf (ChannelFeatures x) = rnf x
+
+instance NFData FeeratePerKw where
+ rnf (FeeratePerKw x) = rnf x
+
+instance NFData DustLimit where
+ rnf (DustLimit x) = rnf x
+
+instance NFData PaymentHash where
+ rnf (PaymentHash x) = rnf x
+
+instance NFData CltvExpiry where
+ rnf (CltvExpiry x) = rnf x
+
+instance NFData HTLCDirection where
+ rnf HTLCOffered = ()
+ rnf HTLCReceived = ()
+
+instance NFData HTLC where
+ rnf (HTLC d a h c) = rnf d `seq` rnf a `seq` rnf h `seq` rnf c
main :: IO ()
main = defaultMain [
+ bgroup "key derivation" [
+ bench "derive_pubkey" $
+ whnf (derive_pubkey basepoint) perCommitmentPoint
+ , bench "derive_revocationpubkey" $
+ whnf (derive_revocationpubkey revocationBasepoint) perCommitmentPoint
+ ]
+ , bgroup "secret generation" [
+ bench "generate_from_seed (final node)" $
+ whnf (generate_from_seed seed) 281474976710655
+ , bench "generate_from_seed (first node)" $
+ whnf (generate_from_seed seed) 0
+ ]
+ , bgroup "fee calculation" [
+ bench "commitment_fee (no anchors, 0 htlcs)" $
+ whnf (commitment_fee feerate noAnchors) 0
+ , bench "commitment_fee (no anchors, 10 htlcs)" $
+ whnf (commitment_fee feerate noAnchors) 10
+ , bench "commitment_fee (anchors, 10 htlcs)" $
+ whnf (commitment_fee feerate withAnchors) 10
+ , bench "htlc_timeout_fee" $
+ whnf (htlc_timeout_fee feerate) noAnchors
+ , bench "htlc_success_fee" $
+ whnf (htlc_success_fee feerate) noAnchors
+ ]
+ , bgroup "trimming" [
+ bench "is_trimmed (offered, not trimmed)" $
+ whnf (is_trimmed dust feerate noAnchors) htlcNotTrimmed
+ , bench "is_trimmed (offered, trimmed)" $
+ whnf (is_trimmed dust feerate noAnchors) htlcTrimmed
+ , bench "htlc_trim_threshold (offered)" $
+ whnf (htlc_trim_threshold dust feerate noAnchors) HTLCOffered
+ ]
]
+ where
+ -- Key derivation test data
+ basepoint = Point $ BS.pack
+ [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7,
+ 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa,
+ 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2]
+
+ perCommitmentPoint = PerCommitmentPoint $ Point $ BS.pack
+ [0x02, 0x5f, 0x71, 0x17, 0xa7, 0x81, 0x50, 0xfe, 0x2e, 0xf9, 0x7d,
+ 0xb7, 0xcf, 0xc8, 0x3b, 0xd5, 0x7b, 0x2e, 0x2c, 0x0d, 0x0d, 0xd2,
+ 0x5e, 0xaf, 0x46, 0x7a, 0x4a, 0x1c, 0x2a, 0x45, 0xce, 0x14, 0x86]
+
+ revocationBasepoint = RevocationBasepoint $ Point $ BS.pack
+ [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7,
+ 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa,
+ 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2]
+
+ -- Secret generation test data
+ seed = BS.replicate 32 0xFF
+
+ -- Fee calculation test data
+ feerate = FeeratePerKw 5000
+ noAnchors = ChannelFeatures { cf_option_anchors = False }
+ withAnchors = ChannelFeatures { cf_option_anchors = True }
+
+ -- Trimming test data
+ dust = DustLimit (Satoshi 546)
+
+ htlcNotTrimmed = HTLC
+ { htlc_direction = HTLCOffered
+ , htlc_amount_msat = MilliSatoshi 5000000
+ , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
+ , htlc_cltv_expiry = CltvExpiry 500000
+ }
+ htlcTrimmed = HTLC
+ { htlc_direction = HTLCOffered
+ , htlc_amount_msat = MilliSatoshi 1000000
+ , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
+ , htlc_cltv_expiry = CltvExpiry 500000
+ }
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -3,9 +3,118 @@
module Main where
+import Control.DeepSeq (NFData(..))
+import qualified Data.ByteString as BS
+import Lightning.Protocol.BOLT3
import Weigh
+-- NFData instances for weigh
+instance NFData Satoshi where
+ rnf (Satoshi x) = rnf x
+
+instance NFData MilliSatoshi where
+ rnf (MilliSatoshi x) = rnf x
+
+instance NFData Pubkey where
+ rnf (Pubkey x) = rnf x
+
+instance NFData Point where
+ rnf (Point x) = rnf x
+
+instance NFData PerCommitmentPoint where
+ rnf (PerCommitmentPoint x) = rnf x
+
+instance NFData RevocationPubkey where
+ rnf (RevocationPubkey x) = rnf x
+
+instance NFData RevocationBasepoint where
+ rnf (RevocationBasepoint x) = rnf x
+
+instance NFData ChannelFeatures where
+ rnf (ChannelFeatures x) = rnf x
+
+instance NFData FeeratePerKw where
+ rnf (FeeratePerKw x) = rnf x
+
+instance NFData DustLimit where
+ rnf (DustLimit x) = rnf x
+
+instance NFData PaymentHash where
+ rnf (PaymentHash x) = rnf x
+
+instance NFData CltvExpiry where
+ rnf (CltvExpiry x) = rnf x
+
+instance NFData HTLCDirection where
+ rnf HTLCOffered = ()
+ rnf HTLCReceived = ()
+
+instance NFData HTLC where
+ rnf (HTLC d a h c) = rnf d `seq` rnf a `seq` rnf h `seq` rnf c
+
main :: IO ()
main = mainWith $ do
- pure ()
+ setColumns [Case, Allocated, GCs, Max]
+
+ -- Key derivation allocations
+ func "derive_pubkey" (derive_pubkey basepoint) perCommitmentPoint
+ func "derive_revocationpubkey"
+ (derive_revocationpubkey revocationBasepoint) perCommitmentPoint
+
+ -- Secret generation allocations
+ func "generate_from_seed (final)" (generate_from_seed seed) 281474976710655
+ func "generate_from_seed (first)" (generate_from_seed seed) 0
+
+ -- Fee calculation allocations
+ func "commitment_fee (0 htlcs)" (commitment_fee feerate noAnchors) 0
+ func "commitment_fee (10 htlcs)" (commitment_fee feerate noAnchors) 10
+ func "htlc_timeout_fee" (htlc_timeout_fee feerate) noAnchors
+ func "htlc_success_fee" (htlc_success_fee feerate) noAnchors
+
+ -- Trimming allocations
+ func "is_trimmed (not trimmed)"
+ (is_trimmed dust feerate noAnchors) htlcNotTrimmed
+ func "is_trimmed (trimmed)"
+ (is_trimmed dust feerate noAnchors) htlcTrimmed
+ func "htlc_trim_threshold"
+ (htlc_trim_threshold dust feerate noAnchors) HTLCOffered
+ where
+ -- Key derivation test data
+ basepoint = Point $ BS.pack
+ [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7,
+ 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa,
+ 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2]
+
+ perCommitmentPoint = PerCommitmentPoint $ Point $ BS.pack
+ [0x02, 0x5f, 0x71, 0x17, 0xa7, 0x81, 0x50, 0xfe, 0x2e, 0xf9, 0x7d,
+ 0xb7, 0xcf, 0xc8, 0x3b, 0xd5, 0x7b, 0x2e, 0x2c, 0x0d, 0x0d, 0xd2,
+ 0x5e, 0xaf, 0x46, 0x7a, 0x4a, 0x1c, 0x2a, 0x45, 0xce, 0x14, 0x86]
+
+ revocationBasepoint = RevocationBasepoint $ Point $ BS.pack
+ [0x03, 0x6d, 0x6c, 0xaa, 0xc2, 0x48, 0xaf, 0x96, 0xf6, 0xaf, 0xa7,
+ 0xf9, 0x04, 0xf5, 0x50, 0x25, 0x3a, 0x0f, 0x3e, 0xf3, 0xf5, 0xaa,
+ 0x2f, 0xe6, 0x83, 0x8a, 0x95, 0xb2, 0x16, 0x69, 0x14, 0x68, 0xe2]
+
+ -- Secret generation test data
+ seed = BS.replicate 32 0xFF
+
+ -- Fee calculation test data
+ feerate = FeeratePerKw 5000
+ noAnchors = ChannelFeatures { cf_option_anchors = False }
+
+ -- Trimming test data
+ dust = DustLimit (Satoshi 546)
+
+ htlcNotTrimmed = HTLC
+ { htlc_direction = HTLCOffered
+ , htlc_amount_msat = MilliSatoshi 5000000
+ , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
+ , htlc_cltv_expiry = CltvExpiry 500000
+ }
+ htlcTrimmed = HTLC
+ { htlc_direction = HTLCOffered
+ , htlc_amount_msat = MilliSatoshi 1000000
+ , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
+ , htlc_cltv_expiry = CltvExpiry 500000
+ }
diff --git a/lib/Lightning/Protocol/BOLT3/Types.hs b/lib/Lightning/Protocol/BOLT3/Types.hs
@@ -88,7 +88,6 @@ module Lightning.Protocol.BOLT3.Types (
, anchor_output_value
) where
-import Data.Bits ((.&.))
import Data.Word (Word16, Word32, Word64)
import qualified Data.ByteString as BS
import GHC.Generics (Generic)
diff --git a/ppad-bolt3.cabal b/ppad-bolt3.cabal
@@ -50,6 +50,7 @@ test-suite bolt3-tests
build-depends:
base
+ , base16-bytestring
, bytestring
, ppad-bolt3
, tasty
diff --git a/test/Main.hs b/test/Main.hs
@@ -2,9 +2,265 @@
module Main where
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base16 as B16
import Test.Tasty
+import Test.Tasty.HUnit
+import Lightning.Protocol.BOLT3
main :: IO ()
main = defaultMain $ testGroup "ppad-bolt3" [
+ testGroup "Key derivation" [
+ keyDerivationTests
+ ]
+ , testGroup "Secret generation" [
+ secretGenerationTests
+ ]
+ , testGroup "Secret storage" [
+ secretStorageTests
+ ]
+ , testGroup "Fee calculation" [
+ feeCalculationTests
+ ]
+ , testGroup "Trimming" [
+ trimmingTests
+ ]
]
+-- hex decoding helper
+hex :: BS.ByteString -> BS.ByteString
+hex h = case B16.decode h of
+ Right bs -> bs
+ Left _ -> error "invalid hex"
+
+-- Key derivation test vectors from Appendix E ---------------------------------
+
+keyDerivationTests :: TestTree
+keyDerivationTests = testGroup "BOLT #3 Appendix E" [
+ testCase "derive_pubkey" $ do
+ let basepoint = Point $ hex
+ "036d6caac248af96f6afa7f904f550253a0f3ef3f5aa2fe6838a95b216691468e2"
+ perCommitmentPoint = PerCommitmentPoint $ Point $ hex
+ "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486"
+ expected = hex
+ "0235f2dbfaa89b57ec7b055afe29849ef7ddfeb1cefdb9ebdc43f5494984db29e5"
+ case derive_pubkey basepoint perCommitmentPoint of
+ Nothing -> assertFailure "derive_pubkey returned Nothing"
+ Just (Pubkey pk) -> pk @?= expected
+
+ , testCase "derive_revocationpubkey" $ do
+ let revocationBasepoint = RevocationBasepoint $ Point $ hex
+ "036d6caac248af96f6afa7f904f550253a0f3ef3f5aa2fe6838a95b216691468e2"
+ perCommitmentPoint = PerCommitmentPoint $ Point $ hex
+ "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486"
+ expected = hex
+ "02916e326636d19c33f13e8c0c3a03dd157f332f3e99c317c141dd865eb01f8ff0"
+ case derive_revocationpubkey revocationBasepoint perCommitmentPoint of
+ Nothing -> assertFailure "derive_revocationpubkey returned Nothing"
+ Just (RevocationPubkey (Pubkey pk)) -> pk @?= expected
+ ]
+
+-- Secret generation test vectors from Appendix D ------------------------------
+
+secretGenerationTests :: TestTree
+secretGenerationTests = testGroup "BOLT #3 Appendix D - Generation" [
+ testCase "generate_from_seed 0 final node" $ do
+ let seed = hex
+ "0000000000000000000000000000000000000000000000000000000000000000"
+ i = 281474976710655
+ expected = hex
+ "02a40c85b6f28da08dfdbe0926c53fab2de6d28c10301f8f7c4073d5e42e3148"
+ generate_from_seed seed i @?= expected
+
+ , testCase "generate_from_seed FF final node" $ do
+ let seed = hex
+ "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF"
+ i = 281474976710655
+ expected = hex
+ "7cc854b54e3e0dcdb010d7a3fee464a9687be6e8db3be6854c475621e007a5dc"
+ generate_from_seed seed i @?= expected
+
+ , testCase "generate_from_seed FF alternate bits 1" $ do
+ let seed = hex
+ "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF"
+ i = 0xaaaaaaaaaaa
+ expected = hex
+ "56f4008fb007ca9acf0e15b054d5c9fd12ee06cea347914ddbaed70d1c13a528"
+ generate_from_seed seed i @?= expected
+
+ , testCase "generate_from_seed FF alternate bits 2" $ do
+ let seed = hex
+ "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF"
+ i = 0x555555555555
+ expected = hex
+ "9015daaeb06dba4ccc05b91b2f73bd54405f2be9f217fbacd3c5ac2e62327d31"
+ generate_from_seed seed i @?= expected
+
+ , testCase "generate_from_seed 01 last nontrivial node" $ do
+ let seed = hex
+ "0101010101010101010101010101010101010101010101010101010101010101"
+ i = 1
+ expected = hex
+ "915c75942a26bb3a433a8ce2cb0427c29ec6c1775cfc78328b57f6ba7bfeaa9c"
+ generate_from_seed seed i @?= expected
+ ]
+
+-- Secret storage test vectors from Appendix D ---------------------------------
+
+secretStorageTests :: TestTree
+secretStorageTests = testGroup "BOLT #3 Appendix D - Storage" [
+ testCase "insert_secret correct sequence" $ do
+ let secrets = [
+ (281474976710655, hex
+ "7cc854b54e3e0dcdb010d7a3fee464a9687be6e8db3be6854c475621e007a5dc")
+ , (281474976710654, hex
+ "c7518c8ae4660ed02894df8976fa1a3659c1a8b4b5bec0c4b872abeba4cb8964")
+ , (281474976710653, hex
+ "2273e227a5b7449b6e70f1fb4652864038b1cbf9cd7c043a7d6456b7fc275ad8")
+ , (281474976710652, hex
+ "27cddaa5624534cb6cb9d7da077cf2b22ab21e9b506fd4998a51d54502e99116")
+ , (281474976710651, hex
+ "c65716add7aa98ba7acb236352d665cab17345fe45b55fb879ff80e6bd0c41dd")
+ , (281474976710650, hex
+ "969660042a28f32d9be17344e09374b379962d03db1574df5a8a5a47e19ce3f2")
+ , (281474976710649, hex
+ "a5a64476122ca0925fb344bdc1854c1c0a59fc614298e50a33e331980a220f32")
+ , (281474976710648, hex
+ "05cde6323d949933f7f7b78776bcc1ea6d9b31447732e3802e1f7ac44b650e17")
+ ]
+ let insertAll store [] = Just store
+ insertAll store ((idx, secret):rest) =
+ case insert_secret secret idx store of
+ Nothing -> Nothing
+ Just store' -> insertAll store' rest
+ case insertAll empty_store secrets of
+ Nothing -> assertFailure "insert_secret failed on correct sequence"
+ Just _ -> return ()
+
+ , testCase "insert_secret #1 incorrect" $ do
+ -- First secret is from wrong seed, second should fail
+ let store0 = empty_store
+ case insert_secret (hex
+ "02a40c85b6f28da08dfdbe0926c53fab2de6d28c10301f8f7c4073d5e42e3148")
+ 281474976710655 store0 of
+ Nothing -> assertFailure "First insert should succeed"
+ Just store1 ->
+ case insert_secret (hex
+ "c7518c8ae4660ed02894df8976fa1a3659c1a8b4b5bec0c4b872abeba4cb8964")
+ 281474976710654 store1 of
+ Nothing -> return () -- Expected to fail
+ Just _ -> assertFailure "Second insert should fail"
+ ]
+
+-- Fee calculation tests -------------------------------------------------------
+
+feeCalculationTests :: TestTree
+feeCalculationTests = testGroup "Fee calculation" [
+ testCase "commitment_fee no anchors, 0 htlcs" $ do
+ let feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = False }
+ fee = commitment_fee feerate features 0
+ fee @?= Satoshi 3620 -- 5000 * 724 / 1000 = 3620
+
+ , testCase "commitment_fee no anchors, 2 htlcs" $ do
+ let feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = False }
+ fee = commitment_fee feerate features 2
+ -- weight = 724 + 172*2 = 1068
+ -- fee = 5000 * 1068 / 1000 = 5340
+ fee @?= Satoshi 5340
+
+ , testCase "commitment_fee with anchors, 0 htlcs" $ do
+ let feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = True }
+ fee = commitment_fee feerate features 0
+ -- 5000 * 1124 / 1000 = 5620
+ fee @?= Satoshi 5620
+
+ , testCase "htlc_timeout_fee no anchors" $ do
+ let feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = False }
+ fee = htlc_timeout_fee feerate features
+ -- 5000 * 663 / 1000 = 3315
+ fee @?= Satoshi 3315
+
+ , testCase "htlc_success_fee no anchors" $ do
+ let feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = False }
+ fee = htlc_success_fee feerate features
+ -- 5000 * 703 / 1000 = 3515
+ fee @?= Satoshi 3515
+
+ , testCase "htlc_timeout_fee with anchors is 0" $ do
+ let feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = True }
+ fee = htlc_timeout_fee feerate features
+ fee @?= Satoshi 0
+
+ , testCase "htlc_success_fee with anchors is 0" $ do
+ let feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = True }
+ fee = htlc_success_fee feerate features
+ fee @?= Satoshi 0
+ ]
+
+-- Trimming tests --------------------------------------------------------------
+
+trimmingTests :: TestTree
+trimmingTests = testGroup "HTLC trimming" [
+ testCase "offered HTLC above threshold not trimmed" $ do
+ let dust = DustLimit (Satoshi 546)
+ feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = False }
+ htlc = HTLC
+ { htlc_direction = HTLCOffered
+ , htlc_amount_msat = MilliSatoshi 5000000 -- 5000 sats
+ , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
+ , htlc_cltv_expiry = CltvExpiry 500000
+ }
+ -- threshold = 546 + 3315 = 3861
+ -- 5000 > 3861, so not trimmed
+ is_trimmed dust feerate features htlc @?= False
+
+ , testCase "offered HTLC below threshold is trimmed" $ do
+ let dust = DustLimit (Satoshi 546)
+ feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = False }
+ htlc = HTLC
+ { htlc_direction = HTLCOffered
+ , htlc_amount_msat = MilliSatoshi 1000000 -- 1000 sats
+ , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
+ , htlc_cltv_expiry = CltvExpiry 500000
+ }
+ -- threshold = 546 + 3315 = 3861
+ -- 1000 < 3861, so trimmed
+ is_trimmed dust feerate features htlc @?= True
+
+ , testCase "received HTLC above threshold not trimmed" $ do
+ let dust = DustLimit (Satoshi 546)
+ feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = False }
+ htlc = HTLC
+ { htlc_direction = HTLCReceived
+ , htlc_amount_msat = MilliSatoshi 7000000 -- 7000 sats
+ , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
+ , htlc_cltv_expiry = CltvExpiry 500000
+ }
+ -- threshold = 546 + 3515 = 4061
+ -- 7000 > 4061, so not trimmed
+ is_trimmed dust feerate features htlc @?= False
+
+ , testCase "received HTLC below threshold is trimmed" $ do
+ let dust = DustLimit (Satoshi 546)
+ feerate = FeeratePerKw 5000
+ features = ChannelFeatures { cf_option_anchors = False }
+ htlc = HTLC
+ { htlc_direction = HTLCReceived
+ , htlc_amount_msat = MilliSatoshi 800000 -- 800 sats
+ , htlc_payment_hash = PaymentHash (BS.replicate 32 0)
+ , htlc_cltv_expiry = CltvExpiry 500000
+ }
+ -- threshold = 546 + 3515 = 4061
+ -- 800 < 4061, so trimmed
+ is_trimmed dust feerate features htlc @?= True
+ ]
