commit 32f758166843be8f40c47cb10c6697acfa2a6641
parent decf50f48cfa23dc0194f2127b3a7adb78d09b55
Author: Jared Tobin <jared@jtobin.io>
Date: Sun, 19 Apr 2026 12:54:30 +0800
lib: guard against fee underflow in spending functions
All fee-deducting spending functions now return Maybe SpendingTx,
returning Nothing when the calculated fee would exceed the output
value. This prevents Word64 subtraction underflow that would
produce ~2^64 output values.
Functions affected: spend_to_local, spend_htlc_output,
spend_remote_htlc_timeout, spend_remote_htlc_preimage,
spend_revoked_to_local, spend_revoked_htlc_output,
spend_revoked_htlc (both branches), spend_revoked_batch.
Also adapts to bolt3 API renames (paymentPreimage, msatToSat,
paymentHash).
Diffstat:
5 files changed, 295 insertions(+), 154 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -177,7 +177,7 @@ classify_benchmarks = bgroup "classify" [
dummyPaymentHash (CltvExpiry 500000))
]
where
- dummyPaymentHash = case payment_hash
+ dummyPaymentHash = case paymentHash
(BS.replicate 32 0xAA) of
Just ph -> ph
Nothing -> error "impossible"
diff --git a/flake.lock b/flake.lock
@@ -37,6 +37,43 @@
"ppad-base16": {
"inputs": {
"flake-utils": [
+ "ppad-bolt3",
+ "ppad-bolt1",
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-bolt3",
+ "ppad-bolt1",
+ "ppad-base16",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-nixpkgs": [
+ "ppad-bolt3",
+ "ppad-bolt1",
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1766934151,
+ "narHash": "sha256-BUFpuLfrGXE2xi3Wa9TYCEhhRhFp175Ghxnr0JRbG2I=",
+ "ref": "master",
+ "rev": "58dfb7922401a60d5de76825fcd5f6ecbcd7afe0",
+ "revCount": 26,
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/base16.git"
+ }
+ },
+ "ppad-base16_2": {
+ "inputs": {
+ "flake-utils": [
"ppad-ripemd160",
"ppad-base16",
"ppad-nixpkgs",
@@ -68,7 +105,7 @@
"url": "git://git.ppad.tech/base16.git"
}
},
- "ppad-base16_2": {
+ "ppad-base16_3": {
"inputs": {
"flake-utils": [
"ppad-secp256k1",
@@ -102,7 +139,7 @@
"url": "git://git.ppad.tech/base16.git"
}
},
- "ppad-base16_3": {
+ "ppad-base16_4": {
"inputs": {
"flake-utils": [
"ppad-sha256",
@@ -136,7 +173,7 @@
"url": "git://git.ppad.tech/base16.git"
}
},
- "ppad-base16_4": {
+ "ppad-base16_5": {
"inputs": {
"flake-utils": [
"ppad-tx",
@@ -170,6 +207,41 @@
"url": "git://git.ppad.tech/base16.git"
}
},
+ "ppad-bolt1": {
+ "inputs": {
+ "flake-utils": [
+ "ppad-bolt3",
+ "ppad-bolt1",
+ "ppad-nixpkgs",
+ "flake-utils"
+ ],
+ "nixpkgs": [
+ "ppad-bolt3",
+ "ppad-bolt1",
+ "ppad-nixpkgs",
+ "nixpkgs"
+ ],
+ "ppad-base16": "ppad-base16",
+ "ppad-nixpkgs": [
+ "ppad-bolt3",
+ "ppad-nixpkgs"
+ ]
+ },
+ "locked": {
+ "lastModified": 1776570879,
+ "narHash": "sha256-XsgGBvYWL+sD7pDZoPPi4l39DE7GH7maNnhm8iUeB/E=",
+ "ref": "master",
+ "rev": "20ea43188d781368e5e64c7c646285a6b0aaeb94",
+ "revCount": 27,
+ "type": "git",
+ "url": "git://git.ppad.tech/bolt1.git"
+ },
+ "original": {
+ "ref": "master",
+ "type": "git",
+ "url": "git://git.ppad.tech/bolt1.git"
+ }
+ },
"ppad-bolt3": {
"inputs": {
"flake-utils": [
@@ -182,6 +254,7 @@
"ppad-nixpkgs",
"nixpkgs"
],
+ "ppad-bolt1": "ppad-bolt1",
"ppad-nixpkgs": [
"ppad-nixpkgs"
],
@@ -199,11 +272,11 @@
]
},
"locked": {
- "lastModified": 1776519982,
- "narHash": "sha256-dIn6biw/e3oBlH/sBnMw1LgeNfyzJOp/69I6Im96BUE=",
+ "lastModified": 1776572200,
+ "narHash": "sha256-d3+A3XTTvKl4McyXkeQT840kpRI+9mtcXWwJQLoEbT0=",
"ref": "master",
- "rev": "7be7bbb7e4903df525c62baa2bc5ece23701f337",
- "revCount": 36,
+ "rev": "2113539a278a3b1ab8484a5b205d9388b758ddb6",
+ "revCount": 39,
"type": "git",
"url": "git://git.ppad.tech/bolt3.git"
},
@@ -324,7 +397,7 @@
"ppad-nixpkgs",
"nixpkgs"
],
- "ppad-base16": "ppad-base16",
+ "ppad-base16": "ppad-base16_2",
"ppad-nixpkgs": [
"ppad-nixpkgs"
]
@@ -356,7 +429,7 @@
"ppad-nixpkgs",
"nixpkgs"
],
- "ppad-base16": "ppad-base16_2",
+ "ppad-base16": "ppad-base16_3",
"ppad-fixed": "ppad-fixed",
"ppad-hmac-drbg": "ppad-hmac-drbg",
"ppad-nixpkgs": [
@@ -394,7 +467,7 @@
"ppad-nixpkgs",
"nixpkgs"
],
- "ppad-base16": "ppad-base16_3",
+ "ppad-base16": "ppad-base16_4",
"ppad-nixpkgs": [
"ppad-nixpkgs"
]
@@ -464,7 +537,7 @@
"ppad-nixpkgs",
"nixpkgs"
],
- "ppad-base16": "ppad-base16_4",
+ "ppad-base16": "ppad-base16_5",
"ppad-nixpkgs": [
"ppad-nixpkgs"
],
diff --git a/lib/Lightning/Protocol/BOLT5/Detect.hs b/lib/Lightning/Protocol/BOLT5/Detect.hs
@@ -265,7 +265,7 @@ classifyRevokedOutput !txid !revpk !idx !out =
-- commitment, the witness contains the preimage. The witness
-- stack for a preimage claim is:
--
--- @\<remotehtlcsig\> \<payment_preimage\>@
+-- @\<remotehtlcsig\> \<paymentPreimage\>@
--
-- The preimage is the second item (32 bytes) and must hash to
-- the expected payment hash.
@@ -274,7 +274,7 @@ extract_preimage_offered (Witness items) =
case items of
[_sig, preimageBytes]
| BS.length preimageBytes == 32 ->
- payment_preimage preimageBytes
+ paymentPreimage preimageBytes
_ -> Nothing
-- | Extract a payment preimage from an HTLC-success transaction
@@ -284,7 +284,7 @@ extract_preimage_offered (Witness items) =
-- commitment to claim a received HTLC, the witness contains the
-- preimage. The witness stack is:
--
--- @0 \<remotehtlcsig\> \<localhtlcsig\> \<payment_preimage\>@
+-- @0 \<remotehtlcsig\> \<localhtlcsig\> \<paymentPreimage\>@
--
-- The preimage is the fourth item (32 bytes).
extract_preimage_htlc_success
@@ -293,7 +293,7 @@ extract_preimage_htlc_success (Witness items) =
case items of
[_zero, _remoteSig, _localSig, preimageBytes]
| BS.length preimageBytes == 32 ->
- payment_preimage preimageBytes
+ paymentPreimage preimageBytes
_ -> Nothing
-- timeout check ------------------------------------------------------
diff --git a/lib/Lightning/Protocol/BOLT5/Spend.hs b/lib/Lightning/Protocol/BOLT5/Spend.hs
@@ -55,6 +55,8 @@ import Lightning.Protocol.BOLT5.Types
-- broadcasting. The caller signs with the local delayed privkey
-- and uses 'to_local_witness_spend' from bolt3.
--
+-- Returns 'Nothing' if the fee would exceed the output value.
+--
-- The input nSequence is set to the to_self_delay value.
spend_to_local
:: OutPoint
@@ -67,7 +69,7 @@ spend_to_local
-> Script
-- ^ Destination scriptPubKey.
-> FeeratePerKw
- -> SpendingTx
+ -> Maybe SpendingTx
spend_to_local !op !value !revpk !delay !delayedpk
!destScript !feerate =
let !witnessScript =
@@ -75,12 +77,16 @@ spend_to_local !op !value !revpk !delay !delayedpk
!weight = to_local_penalty_input_weight
+ penalty_tx_base_weight
!fee = spending_fee feerate weight
- !outputValue =
- Satoshi (unSatoshi value - unSatoshi fee)
- !tx = mk_spending_tx op
- (fromIntegral (unToSelfDelay delay))
- destScript outputValue 0
- in SpendingTx tx witnessScript value SIGHASH_ALL
+ in if unSatoshi fee >= unSatoshi value
+ then Nothing
+ else
+ let !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !tx = mk_spending_tx op
+ (fromIntegral (unToSelfDelay delay))
+ destScript outputValue 0
+ in Just (SpendingTx tx witnessScript value
+ SIGHASH_ALL)
-- | Construct an HTLC-timeout second-stage transaction.
--
@@ -104,7 +110,7 @@ spend_htlc_timeout !ctx !keys =
(htlc_payment_hash htlc)
features
!inputValue =
- msat_to_sat (htlc_amount_msat htlc)
+ msatToSat (htlc_amount_msat htlc)
!sighashType = if has_anchors features
then SIGHASH_SINGLE_ANYONECANPAY
else SIGHASH_ALL
@@ -134,7 +140,7 @@ spend_htlc_success !ctx !keys =
(htlc_cltv_expiry htlc)
features
!inputValue =
- msat_to_sat (htlc_amount_msat htlc)
+ msatToSat (htlc_amount_msat htlc)
!sighashType = if has_anchors features
then SIGHASH_SINGLE_ANYONECANPAY
else SIGHASH_ALL
@@ -147,6 +153,8 @@ spend_htlc_success !ctx !keys =
-- The output of an HTLC-timeout or HTLC-success tx uses the
-- same to_local script. The caller signs with the local
-- delayed privkey and uses 'htlc_output_witness_spend'.
+--
+-- Returns 'Nothing' if the fee would exceed the output value.
spend_htlc_output
:: OutPoint
-- ^ Outpoint of the second-stage output.
@@ -158,7 +166,7 @@ spend_htlc_output
-> Script
-- ^ Destination scriptPubKey.
-> FeeratePerKw
- -> SpendingTx
+ -> Maybe SpendingTx
spend_htlc_output = spend_to_local
-- remote commitment spends -------------------------------------------
@@ -168,6 +176,8 @@ spend_htlc_output = spend_to_local
--
-- On the remote commitment, their received HTLCs (our offered)
-- have timed out and we can sweep them directly.
+--
+-- Returns 'Nothing' if the fee would exceed the output value.
spend_remote_htlc_timeout
:: OutPoint
-- ^ Outpoint of the HTLC output.
@@ -181,7 +191,7 @@ spend_remote_htlc_timeout
-> Script
-- ^ Destination scriptPubKey.
-> FeeratePerKw
- -> SpendingTx
+ -> Maybe SpendingTx
spend_remote_htlc_timeout !op !value !htlc !keys
!features !destScript !feerate =
let !witnessScript = received_htlc_script
@@ -194,20 +204,27 @@ spend_remote_htlc_timeout !op !value !htlc !keys
!weight = accepted_htlc_penalty_input_weight
+ penalty_tx_base_weight
!fee = spending_fee feerate weight
- !outputValue =
- Satoshi (unSatoshi value - unSatoshi fee)
- !locktime =
- unCltvExpiry (htlc_cltv_expiry htlc)
- !seqNo = if has_anchors features then 1 else 0
- !tx = mk_spending_tx op seqNo destScript
- outputValue locktime
- in SpendingTx tx witnessScript value SIGHASH_ALL
+ in if unSatoshi fee >= unSatoshi value
+ then Nothing
+ else
+ let !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !locktime =
+ unCltvExpiry (htlc_cltv_expiry htlc)
+ !seqNo =
+ if has_anchors features then 1 else 0
+ !tx = mk_spending_tx op seqNo destScript
+ outputValue locktime
+ in Just (SpendingTx tx witnessScript value
+ SIGHASH_ALL)
-- | Spend a received HTLC directly with preimage on the remote
-- commitment.
--
-- On the remote commitment, their offered HTLCs (our received)
-- can be claimed with the payment preimage.
+--
+-- Returns 'Nothing' if the fee would exceed the output value.
spend_remote_htlc_preimage
:: OutPoint
-- ^ Outpoint of the HTLC output.
@@ -221,7 +238,7 @@ spend_remote_htlc_preimage
-> Script
-- ^ Destination scriptPubKey.
-> FeeratePerKw
- -> SpendingTx
+ -> Maybe SpendingTx
spend_remote_htlc_preimage !op !value !htlc !keys
!features !destScript !feerate =
let !witnessScript = offered_htlc_script
@@ -233,12 +250,17 @@ spend_remote_htlc_preimage !op !value !htlc !keys
!weight = offered_htlc_penalty_input_weight
+ penalty_tx_base_weight
!fee = spending_fee feerate weight
- !outputValue =
- Satoshi (unSatoshi value - unSatoshi fee)
- !seqNo = if has_anchors features then 1 else 0
- !tx = mk_spending_tx op seqNo destScript
- outputValue 0
- in SpendingTx tx witnessScript value SIGHASH_ALL
+ in if unSatoshi fee >= unSatoshi value
+ then Nothing
+ else
+ let !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !seqNo =
+ if has_anchors features then 1 else 0
+ !tx = mk_spending_tx op seqNo destScript
+ outputValue 0
+ in Just (SpendingTx tx witnessScript value
+ SIGHASH_ALL)
-- revoked commitment spends ------------------------------------------
@@ -246,6 +268,8 @@ spend_remote_htlc_preimage !op !value !htlc !keys
--
-- The caller signs with the revocation privkey and uses
-- 'to_local_witness_revoke' from bolt3.
+--
+-- Returns 'Nothing' if the fee would exceed the output value.
spend_revoked_to_local
:: OutPoint
-- ^ Outpoint of the to_local output.
@@ -257,7 +281,7 @@ spend_revoked_to_local
-> Script
-- ^ Destination scriptPubKey.
-> FeeratePerKw
- -> SpendingTx
+ -> Maybe SpendingTx
spend_revoked_to_local !op !value !revpk !delay
!delayedpk !destScript !feerate =
let !witnessScript =
@@ -265,11 +289,15 @@ spend_revoked_to_local !op !value !revpk !delay
!weight = to_local_penalty_input_weight
+ penalty_tx_base_weight
!fee = spending_fee feerate weight
- !outputValue =
- Satoshi (unSatoshi value - unSatoshi fee)
- !tx = mk_spending_tx op 0xFFFFFFFF destScript
- outputValue 0
- in SpendingTx tx witnessScript value SIGHASH_ALL
+ in if unSatoshi fee >= unSatoshi value
+ then Nothing
+ else
+ let !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !tx = mk_spending_tx op 0xFFFFFFFF destScript
+ outputValue 0
+ in Just (SpendingTx tx witnessScript value
+ SIGHASH_ALL)
-- | Spend a revoked HTLC output using the revocation key.
--
@@ -277,6 +305,9 @@ spend_revoked_to_local !op !value !revpk !delay
-- 'offered_htlc_witness_revoke' or
-- 'received_htlc_witness_revoke' from bolt3, depending on
-- the output type.
+--
+-- Returns 'Nothing' if the output type is not an HTLC, or
+-- if the fee would exceed the output value.
spend_revoked_htlc
:: OutPoint
-- ^ Outpoint of the HTLC output.
@@ -305,12 +336,16 @@ spend_revoked_htlc !op !value !otype !revpk !keys
!weight = offered_htlc_penalty_input_weight
+ penalty_tx_base_weight
!fee = spending_fee feerate weight
- !outputValue =
- Satoshi (unSatoshi value - unSatoshi fee)
- !tx = mk_spending_tx op 0xFFFFFFFF destScript
- outputValue 0
- in Just (SpendingTx tx witnessScript value
- SIGHASH_ALL)
+ in if unSatoshi fee >= unSatoshi value
+ then Nothing
+ else
+ let !outputValue =
+ Satoshi
+ (unSatoshi value - unSatoshi fee)
+ !tx = mk_spending_tx op 0xFFFFFFFF
+ destScript outputValue 0
+ in Just (SpendingTx tx witnessScript value
+ SIGHASH_ALL)
OutputReceivedHTLC expiry ->
let !witnessScript = received_htlc_script
revpk
@@ -322,12 +357,16 @@ spend_revoked_htlc !op !value !otype !revpk !keys
!weight = accepted_htlc_penalty_input_weight
+ penalty_tx_base_weight
!fee = spending_fee feerate weight
- !outputValue =
- Satoshi (unSatoshi value - unSatoshi fee)
- !tx = mk_spending_tx op 0xFFFFFFFF destScript
- outputValue 0
- in Just (SpendingTx tx witnessScript value
- SIGHASH_ALL)
+ in if unSatoshi fee >= unSatoshi value
+ then Nothing
+ else
+ let !outputValue =
+ Satoshi
+ (unSatoshi value - unSatoshi fee)
+ !tx = mk_spending_tx op 0xFFFFFFFF
+ destScript outputValue 0
+ in Just (SpendingTx tx witnessScript value
+ SIGHASH_ALL)
_ -> Nothing
-- | Spend a revoked second-stage HTLC output (HTLC-timeout or
@@ -336,6 +375,8 @@ spend_revoked_htlc !op !value !otype !revpk !keys
-- The output of a revoked HTLC-timeout/success tx uses the
-- to_local script. The caller signs with the revocation privkey
-- and uses 'htlc_output_witness_revoke'.
+--
+-- Returns 'Nothing' if the fee would exceed the output value.
spend_revoked_htlc_output
:: OutPoint
-- ^ Outpoint of the second-stage output.
@@ -347,7 +388,7 @@ spend_revoked_htlc_output
-> Script
-- ^ Destination scriptPubKey.
-> FeeratePerKw
- -> SpendingTx
+ -> Maybe SpendingTx
spend_revoked_htlc_output !op !value !revpk !delay
!delayedpk !destScript !feerate =
let !witnessScript =
@@ -355,11 +396,15 @@ spend_revoked_htlc_output !op !value !revpk !delay
!weight = to_local_penalty_input_weight
+ penalty_tx_base_weight
!fee = spending_fee feerate weight
- !outputValue =
- Satoshi (unSatoshi value - unSatoshi fee)
- !tx = mk_spending_tx op 0xFFFFFFFF destScript
- outputValue 0
- in SpendingTx tx witnessScript value SIGHASH_ALL
+ in if unSatoshi fee >= unSatoshi value
+ then Nothing
+ else
+ let !outputValue =
+ Satoshi (unSatoshi value - unSatoshi fee)
+ !tx = mk_spending_tx op 0xFFFFFFFF destScript
+ outputValue 0
+ in Just (SpendingTx tx witnessScript value
+ SIGHASH_ALL)
-- | Construct a batched penalty transaction spending multiple
-- revoked outputs.
@@ -368,7 +413,9 @@ spend_revoked_htlc_output !op !value !revpk !delay
-- be resolved in a single penalty transaction (within the
-- 400,000 weight limit). The caller signs each input with the
-- revocation privkey.
-spend_revoked_batch :: PenaltyContext -> SpendingTx
+-- | Returns 'Nothing' if the total fee would exceed the
+-- total input value.
+spend_revoked_batch :: PenaltyContext -> Maybe SpendingTx
spend_revoked_batch !ctx =
let !outs = pc_outputs ctx
!destScript = pc_destination ctx
@@ -380,27 +427,32 @@ spend_revoked_batch !ctx =
(NE.toList outs)
!fee = spending_fee feerate totalWeight
- !outputValue =
- Satoshi (unSatoshi totalValue - unSatoshi fee)
-
- -- Build inputs
- !txInputs = fmap mkPenaltyInput outs
-
- -- Single output
- !txOutput = TxOut
- (unSatoshi outputValue)
- (unScript destScript)
-
- !tx = Tx
- { tx_version = 2
- , tx_inputs = txInputs
- , tx_outputs = txOutput :| []
- , tx_witnesses = []
- , tx_locktime = 0
- }
-
- !witnessScript = Script BS.empty
- in SpendingTx tx witnessScript totalValue SIGHASH_ALL
+ in if unSatoshi fee >= unSatoshi totalValue
+ then Nothing
+ else
+ let !outputValue =
+ Satoshi
+ (unSatoshi totalValue - unSatoshi fee)
+
+ -- Build inputs
+ !txInputs = fmap mkPenaltyInput outs
+
+ -- Single output
+ !txOutput = TxOut
+ (unSatoshi outputValue)
+ (unScript destScript)
+
+ !tx = Tx
+ { tx_version = 2
+ , tx_inputs = txInputs
+ , tx_outputs = txOutput :| []
+ , tx_witnesses = []
+ , tx_locktime = 0
+ }
+
+ !witnessScript = Script BS.empty
+ in Just (SpendingTx tx witnessScript totalValue
+ SIGHASH_ALL)
where
go !totalVal !totalWt [] = (totalVal, totalWt)
go !totalVal !totalWt (uo:rest) =
diff --git a/test/Main.hs b/test/Main.hs
@@ -71,7 +71,7 @@ dummyFundingPubkey :: FundingPubkey
dummyFundingPubkey = FundingPubkey dummyPubkey
dummyPaymentHash :: PaymentHash
-dummyPaymentHash = case payment_hash dummyHash32 of
+dummyPaymentHash = case paymentHash dummyHash32 of
Just ph -> ph
Nothing -> error "impossible"
@@ -438,15 +438,16 @@ classify_tests = testGroup "Classify" [
spend_tests :: TestTree
spend_tests = testGroup "Spend" [
testCase "spend_to_local produces valid tx" $ do
- let stx = B5.spend_to_local
- dummyOutPoint
- (Satoshi 100000)
- dummyRevocationPubkey
- dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript
- dummyFeerate
- tx = B5.stx_tx stx
+ stx <- assertJust "spend_to_local" $
+ B5.spend_to_local
+ dummyOutPoint
+ (Satoshi 100000)
+ dummyRevocationPubkey
+ dummyDelay
+ dummyLocalDelayedPubkey
+ dummyDestScript
+ dummyFeerate
+ let tx = B5.stx_tx stx
-- Version should be 2
tx_version tx @?= 2
-- Single input
@@ -469,12 +470,13 @@ spend_tests = testGroup "Spend" [
, testCase "spend_to_local fee deduction" $ do
let value = Satoshi 100000
- stx = B5.spend_to_local
- dummyOutPoint value
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript dummyFeerate
- tx = B5.stx_tx stx
+ stx <- assertJust "spend_to_local" $
+ B5.spend_to_local
+ dummyOutPoint value
+ dummyRevocationPubkey dummyDelay
+ dummyLocalDelayedPubkey
+ dummyDestScript dummyFeerate
+ let tx = B5.stx_tx stx
outVal = txout_value
(head' (tx_outputs tx))
expectedFee = B5.spending_fee dummyFeerate
@@ -485,12 +487,13 @@ spend_tests = testGroup "Spend" [
- unSatoshi expectedFee)
, testCase "spend_revoked_to_local nSequence" $ do
- let stx = B5.spend_revoked_to_local
- dummyOutPoint (Satoshi 100000)
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript dummyFeerate
- tx = B5.stx_tx stx
+ stx <- assertJust "spend_revoked_to_local" $
+ B5.spend_revoked_to_local
+ dummyOutPoint (Satoshi 100000)
+ dummyRevocationPubkey dummyDelay
+ dummyLocalDelayedPubkey
+ dummyDestScript dummyFeerate
+ let tx = B5.stx_tx stx
inp = head' (tx_inputs tx)
txin_sequence inp @?= 0xFFFFFFFF
@@ -512,16 +515,18 @@ spend_tests = testGroup "Spend" [
txin_sequence inp @?= 16
, testCase "spend_htlc_output is spend_to_local" $ do
- let stx1 = B5.spend_to_local
- dummyOutPoint (Satoshi 50000)
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript dummyFeerate
- stx2 = B5.spend_htlc_output
- dummyOutPoint (Satoshi 50000)
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript dummyFeerate
+ stx1 <- assertJust "spend_to_local" $
+ B5.spend_to_local
+ dummyOutPoint (Satoshi 50000)
+ dummyRevocationPubkey dummyDelay
+ dummyLocalDelayedPubkey
+ dummyDestScript dummyFeerate
+ stx2 <- assertJust "spend_htlc_output" $
+ B5.spend_htlc_output
+ dummyOutPoint (Satoshi 50000)
+ dummyRevocationPubkey dummyDelay
+ dummyLocalDelayedPubkey
+ dummyDestScript dummyFeerate
B5.stx_tx stx1 @?= B5.stx_tx stx2
B5.stx_input_script stx1 @?=
B5.stx_input_script stx2
@@ -540,8 +545,9 @@ spend_tests = testGroup "Spend" [
, B5.pc_destination = dummyDestScript
, B5.pc_feerate = dummyFeerate
}
- stx = B5.spend_revoked_batch pctx
- tx = B5.stx_tx stx
+ stx <- assertJust "spend_revoked_batch" $
+ B5.spend_revoked_batch pctx
+ let tx = B5.stx_tx stx
outVal = txout_value
(head' (tx_outputs tx))
-- Output should be less than total input
@@ -564,7 +570,7 @@ htlc_spend_tests = testGroup "HTLC Spend" [
length (tx_outputs tx) @?= 1
B5.stx_sighash_type stx @?= SIGHASH_ALL
B5.stx_input_value stx
- @?= msat_to_sat (MilliSatoshi 1000000)
+ @?= msatToSat (MilliSatoshi 1000000)
, testCase "spend_htlc_success produces valid tx" $ do
let ctx = dummyHTLCContext
@@ -597,11 +603,12 @@ htlc_spend_tests = testGroup "HTLC Spend" [
remote_spend_tests :: TestTree
remote_spend_tests = testGroup "Remote Spend" [
testCase "spend_remote_htlc_timeout structure" $ do
- let stx = B5.spend_remote_htlc_timeout
- dummyOutPoint (Satoshi 50000)
- dummyHTLC dummyKeys dummyFeatures
- dummyDestScript dummyFeerate
- tx = B5.stx_tx stx
+ stx <- assertJust "spend_remote_htlc_timeout" $
+ B5.spend_remote_htlc_timeout
+ dummyOutPoint (Satoshi 50000)
+ dummyHTLC dummyKeys dummyFeatures
+ dummyDestScript dummyFeerate
+ let tx = B5.stx_tx stx
tx_version tx @?= 2
length (tx_inputs tx) @?= 1
B5.stx_sighash_type stx @?= SIGHASH_ALL
@@ -611,20 +618,22 @@ remote_spend_tests = testGroup "Remote Spend" [
, testCase "spend_remote_htlc_timeout fee deduction" $ do
let value = Satoshi 50000
- stx = B5.spend_remote_htlc_timeout
- dummyOutPoint value dummyHTLC
- dummyKeys dummyFeatures
- dummyDestScript dummyFeerate
- tx = B5.stx_tx stx
+ stx <- assertJust "spend_remote_htlc_timeout" $
+ B5.spend_remote_htlc_timeout
+ dummyOutPoint value dummyHTLC
+ dummyKeys dummyFeatures
+ dummyDestScript dummyFeerate
+ let tx = B5.stx_tx stx
outVal = txout_value (head' (tx_outputs tx))
assertBool "output < input" (outVal < 50000)
, testCase "spend_remote_htlc_preimage structure" $ do
- let stx = B5.spend_remote_htlc_preimage
- dummyOutPoint (Satoshi 50000)
- dummyReceivedHTLC dummyKeys
- dummyFeatures dummyDestScript dummyFeerate
- tx = B5.stx_tx stx
+ stx <- assertJust "spend_remote_htlc_preimage" $
+ B5.spend_remote_htlc_preimage
+ dummyOutPoint (Satoshi 50000)
+ dummyReceivedHTLC dummyKeys
+ dummyFeatures dummyDestScript dummyFeerate
+ let tx = B5.stx_tx stx
tx_version tx @?= 2
B5.stx_sighash_type stx @?= SIGHASH_ALL
-- locktime should be 0 for preimage claims
@@ -632,11 +641,12 @@ remote_spend_tests = testGroup "Remote Spend" [
, testCase "spend_remote_htlc_timeout anchors seq" $
do
- let stx = B5.spend_remote_htlc_timeout
- dummyOutPoint (Satoshi 50000)
- dummyHTLC dummyKeys dummyFeaturesAnchors
- dummyDestScript dummyFeerate
- tx = B5.stx_tx stx
+ stx <- assertJust "spend_remote_htlc_timeout" $
+ B5.spend_remote_htlc_timeout
+ dummyOutPoint (Satoshi 50000)
+ dummyHTLC dummyKeys dummyFeaturesAnchors
+ dummyDestScript dummyFeerate
+ let tx = B5.stx_tx stx
inp = head' (tx_inputs tx)
txin_sequence inp @?= 1
]
@@ -729,21 +739,23 @@ property_tests = testGroup "Properties" [
\(Positive val) ->
let value = Satoshi
(fromIntegral (val :: Int) + 100000)
- stx = B5.spend_to_local
- dummyOutPoint value
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript (FeeratePerKw 253)
- tx = B5.stx_tx stx
- outVal = txout_value
- (head' (tx_outputs tx))
expectedFee = B5.spending_fee
(FeeratePerKw 253)
(B5.to_local_penalty_input_weight
+ B5.penalty_tx_base_weight)
- in Satoshi outVal ==
- Satoshi (unSatoshi value
- - unSatoshi expectedFee)
+ in case B5.spend_to_local
+ dummyOutPoint value
+ dummyRevocationPubkey dummyDelay
+ dummyLocalDelayedPubkey
+ dummyDestScript (FeeratePerKw 253) of
+ Nothing -> False
+ Just stx ->
+ let tx = B5.stx_tx stx
+ outVal = txout_value
+ (head' (tx_outputs tx))
+ in Satoshi outVal ==
+ Satoshi (unSatoshi value
+ - unSatoshi expectedFee)
, testProperty "htlc_timed_out monotonic" $
\(NonNegative h1) (NonNegative h2) ->
@@ -762,3 +774,7 @@ property_tests = testGroup "Properties" [
-- | Total head for NonEmpty.
head' :: NonEmpty a -> a
head' (x :| _) = x
+
+-- | Assert a Maybe is Just, failing with a message otherwise.
+assertJust :: String -> Maybe a -> IO a
+assertJust msg = maybe (assertFailure msg) pure
