commit 9c3c9c72232c60c9a0b2aab82de6cec3378d09fe
parent 6a81645d68127087b8ab800dd034c74dadac9be5
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 15:22:34 +0400
test: port to the new API
Fixtures use bolt1's checked constructors through total helpers, and
commitments carry their HTLCs in bolt3's OutputHTLC. The Appendix C
and F tests now drive spend_htlc_tx and check the remote signature's
flag against bolt3's remote_htlc_sighash; preimage extraction is also
checked on witnesses built with bolt3's HTLC witness functions.
Adds assertions on witness scripts, outpoints and values, a
saturating-fee test, and a fee-exceeds-amount test for HTLC txs. The
max-HTLCs test now uses the spec's formula exactly. Drops tests that
no longer apply (empty commitments, unmatched HTLC lists) and
properties that held by construction or took no input. Removes -O2
from the test suite.
Diffstat:
2 files changed, 788 insertions(+), 1020 deletions(-)
diff --git a/ppad-bolt5.cabal b/ppad-bolt5.cabal
@@ -45,7 +45,7 @@ test-suite bolt5-tests
main-is: Main.hs
ghc-options:
- -rtsopts -Wall -O2
+ -rtsopts -Wall
build-depends:
base
diff --git a/test/Main.hs b/test/Main.hs
@@ -1,17 +1,18 @@
-{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
-import Bitcoin.Prim.Tx (TxOut(..), from_base16)
+import Bitcoin.Prim.Tx (OutPoint(..), Tx(..), TxId(..), TxIn(..),
+ TxOut(..), Witness(..))
+import qualified Bitcoin.Prim.Tx as BT
import Bitcoin.Prim.Tx.Sighash (SighashType(..), encode_sighash)
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString as BS
import Data.List.NonEmpty (NonEmpty(..))
import Data.Word (Word8, Word32, Word64)
-import Lightning.Protocol.BOLT3 hiding
- (txout_value, txout_script)
-import Lightning.Protocol.BOLT3.Types (Pubkey(..), PaymentHash(..))
+import Lightning.Protocol.BOLT1 (MilliSatoshi, PaymentHash, Satoshi)
+import qualified Lightning.Protocol.BOLT1 as BOLT1
+import Lightning.Protocol.BOLT3
import qualified Lightning.Protocol.BOLT5 as B5
import Test.Tasty
import Test.Tasty.HUnit
@@ -30,40 +31,154 @@ main = defaultMain $ testGroup "ppad-bolt5" [
, property_tests
]
--- test fixtures ------------------------------------------------------
+-- helpers ------------------------------------------------------------
--- Dummy 32-byte hash
-dummyHash32 :: BS.ByteString
-dummyHash32 = BS.replicate 32 0xAA
+-- | Unwrap a Just, failing the enclosing test on Nothing.
+need :: String -> Maybe a -> IO a
+need msg = maybe (assertFailure msg) pure
-dummyTxId :: TxId
-dummyTxId = TxId (BS.replicate 32 0x00)
+sat :: Word64 -> IO Satoshi
+sat = need "invalid satoshi amount" . BOLT1.satoshi
-dummyOutPoint :: OutPoint
-dummyOutPoint = OutPoint dummyTxId 0
+msat :: Word64 -> IO MilliSatoshi
+msat = need "invalid millisatoshi amount" . BOLT1.milli_satoshi
+
+-- | Decode a hex string.
+unhex :: BS.ByteString -> Maybe BS.ByteString
+unhex bs
+ | odd (BS.length bs) = Nothing
+ | otherwise = BS.pack <$> go (BS.unpack bs)
+ where
+ go (a:b:rest) = (:) <$> byte a b <*> go rest
+ go _ = Just []
+ byte a b = (\hi lo -> hi * 16 + lo) <$> nibble a <*> nibble b
+ nibble c
+ | c >= 0x30 && c <= 0x39 = Just (c - 0x30)
+ | c >= 0x61 && c <= 0x66 = Just (c - 0x57)
+ | otherwise = Nothing
--- Dummy 33-byte pubkey. Each role gets its own key, so a key used
--- in the wrong role changes the script.
-mkPubkey :: Word8 -> Pubkey
-mkPubkey b = Pubkey (BS.pack (0x02 : replicate 32 b))
+-- | A point from hex.
+pt :: BS.ByteString -> IO BOLT1.Point
+pt h = need ("invalid point " <> show h) (unhex h >>= BOLT1.point)
-dummyRevocationPubkey :: RevocationPubkey
-dummyRevocationPubkey = RevocationPubkey (mkPubkey 0x01)
+-- | Total head for NonEmpty.
+head' :: NonEmpty a -> a
+head' (x :| _) = x
-dummyLocalDelayedPubkey :: LocalDelayedPubkey
-dummyLocalDelayedPubkey = LocalDelayedPubkey (mkPubkey 0x02)
+-- | Value of a spending transaction's single output.
+out_value :: B5.SpendingTx -> Word64
+out_value = txout_value . head' . tx_outputs . B5.stx_tx
+
+-- | nSequence of a spending transaction's single input.
+in_sequence :: B5.SpendingTx -> Word32
+in_sequence = txin_sequence . head' . tx_inputs . B5.stx_tx
+
+-- fixtures -----------------------------------------------------------
+
+-- | Fixtures shared by the unit and property tests. Each key role
+-- gets its own point, so a key used in the wrong role changes the
+-- script.
+data Fx = Fx
+ { fx_revpk :: !RevocationPubkey
+ , fx_delayed :: !LocalDelayedPubkey
+ , fx_local_htlc :: !LocalHtlcPubkey
+ , fx_remote_htlc :: !RemoteHtlcPubkey
+ , fx_funding :: !FundingPubkey
+ , fx_keys :: !CommitmentKeys
+ , fx_hash :: !PaymentHash
+ , fx_offered :: !HTLC
+ -- ^ offered, 1000 sat, expiry 500000
+ , fx_received :: !HTLC
+ -- ^ as 'fx_offered', but received
+ , fx_local_commit :: !CommitmentTx
+ -- ^ to_local and to_remote outputs
+ , fx_htlc_commit :: !CommitmentTx
+ -- ^ as 'fx_local_commit', plus both HTLCs
+ , fx_remote_commit :: !CommitmentTx
+ -- ^ distinct from 'fx_local_commit'
+ }
-dummyLocalHtlcPubkey :: LocalHtlcPubkey
-dummyLocalHtlcPubkey = LocalHtlcPubkey (mkPubkey 0x03)
+fixtures :: Maybe Fx
+fixtures = do
+ let point b = BOLT1.point (BS.pack (0x02 : replicate 32 b))
+ revpk <- RevocationPubkey <$> point 0x01
+ delayed <- LocalDelayedPubkey <$> point 0x02
+ local_htlc <- LocalHtlcPubkey <$> point 0x03
+ remote_htlc <- RemoteHtlcPubkey <$> point 0x04
+ remote_payment <- RemotePubkey <$> point 0x06
+ funding <- FundingPubkey <$> point 0x07
+ remote_funding <- FundingPubkey <$> point 0x08
+ ph <- BOLT1.payment_hash (BS.replicate 32 0xAA)
+ amt <- BOLT1.milli_satoshi 1000000
+ v1000 <- BOLT1.satoshi 1000
+ v20k <- BOLT1.satoshi 20000
+ v30k <- BOLT1.satoshi 30000
+ v40k <- BOLT1.satoshi 40000
+ v50k <- BOLT1.satoshi 50000
+ let keys = CommitmentKeys
+ { ck_revocation_pubkey = revpk
+ , ck_local_delayed = delayed
+ , ck_local_htlc = local_htlc
+ , ck_remote_htlc = remote_htlc
+ , ck_remote_payment = remote_payment
+ , ck_local_funding = funding
+ , ck_remote_funding = remote_funding
+ }
+ offered = HTLC
+ { htlc_direction = HTLCOffered
+ , htlc_amount_msat = amt
+ , htlc_payment_hash = ph
+ , htlc_cltv_expiry = CltvExpiry 500000
+ }
+ received = offered { htlc_direction = HTLCReceived }
+ to_local = to_p2wsh (to_local_script revpk dummyDelay delayed)
+ htlc_out h = CommitmentOutput v1000
+ (to_p2wsh (htlc_witness_script keys StaticRemotekey h))
+ (OutputHTLC h)
+ commit lt outs = CommitmentTx
+ { ctx_version = 2
+ , ctx_locktime = Locktime lt
+ , ctx_input_outpoint = dummyOutPoint
+ , ctx_input_sequence = Sequence 0
+ , ctx_outputs = outs
+ , ctx_funding_script = dummyDestScript
+ }
+ local_outs =
+ CommitmentOutput v50k to_local OutputToLocal
+ :| [CommitmentOutput v30k dummyDestScript OutputToRemote]
+ pure Fx
+ { fx_revpk = revpk
+ , fx_delayed = delayed
+ , fx_local_htlc = local_htlc
+ , fx_remote_htlc = remote_htlc
+ , fx_funding = funding
+ , fx_keys = keys
+ , fx_hash = ph
+ , fx_offered = offered
+ , fx_received = received
+ , fx_local_commit = commit 0 local_outs
+ , fx_htlc_commit = commit 0 $ local_outs
+ <> (htlc_out offered :| [htlc_out received])
+ , fx_remote_commit = commit 1 $
+ CommitmentOutput v40k to_local OutputToLocal
+ :| [CommitmentOutput v20k dummyDestScript OutputToRemote]
+ }
-dummyRemoteHtlcPubkey :: RemoteHtlcPubkey
-dummyRemoteHtlcPubkey = RemoteHtlcPubkey (mkPubkey 0x04)
+-- | Run a test with the fixtures.
+with_fx :: (Fx -> Assertion) -> Assertion
+with_fx k = need "invalid fixtures" fixtures >>= k
-dummyFundingPubkey :: FundingPubkey
-dummyFundingPubkey = FundingPubkey (mkPubkey 0x07)
+-- | A property over the fixtures.
+prop_fx :: Testable p => (Fx -> p) -> Property
+prop_fx k = case fixtures of
+ Nothing -> counterexample "invalid fixtures" False
+ Just fx -> property (k fx)
-dummyPaymentHash :: PaymentHash
-dummyPaymentHash = PaymentHash dummyHash32
+dummyTxId :: TxId
+dummyTxId = TxId (BS.replicate 32 0x00)
+
+dummyOutPoint :: OutPoint
+dummyOutPoint = OutPoint dummyTxId 0
dummyDelay :: ToSelfDelay
dummyDelay = ToSelfDelay 144
@@ -71,246 +186,141 @@ dummyDelay = ToSelfDelay 144
dummyFeerate :: FeeratePerKw
dummyFeerate = FeeratePerKw 253
-dummyFeatures :: ChannelFeatures
-dummyFeatures = ChannelFeatures False
-
-dummyFeaturesAnchors :: ChannelFeatures
-dummyFeaturesAnchors = ChannelFeatures True
-
+-- | A P2WPKH scriptPubKey.
dummyDestScript :: Script
-dummyDestScript = Script $ BS.pack
- [0x00, 0x14] <> BS.replicate 20 0xCC
-
-dummyKeys :: CommitmentKeys
-dummyKeys = CommitmentKeys
- { ck_revocation_pubkey = dummyRevocationPubkey
- , ck_local_delayed = dummyLocalDelayedPubkey
- , ck_local_htlc = dummyLocalHtlcPubkey
- , ck_remote_htlc = dummyRemoteHtlcPubkey
- , ck_local_payment = LocalPubkey (mkPubkey 0x05)
- , ck_remote_payment = RemotePubkey (mkPubkey 0x06)
- , ck_local_funding = dummyFundingPubkey
- , ck_remote_funding = FundingPubkey (mkPubkey 0x08)
- }
-
-dummyHTLC :: HTLC
-dummyHTLC = HTLC
- { htlc_direction = HTLCOffered
- , htlc_amount_msat = MilliSatoshi 1000000
- , htlc_payment_hash = dummyPaymentHash
- , htlc_cltv_expiry = CltvExpiry 500000
- }
-
-dummyReceivedHTLC :: HTLC
-dummyReceivedHTLC = dummyHTLC
- { htlc_direction = HTLCReceived }
-
-dummyHTLCContext :: HTLCContext
-dummyHTLCContext = HTLCContext
- { hc_commitment_txid = dummyTxId
- , hc_output_index = 0
- , hc_htlc = dummyHTLC
- , hc_to_self_delay = dummyDelay
- , hc_feerate = dummyFeerate
- , hc_features = dummyFeatures
- , hc_revocation_pubkey = dummyRevocationPubkey
- , hc_local_delayed = dummyLocalDelayedPubkey
- }
-
--- Script that matches what findHTLC expects for offered
-offeredScript :: Script
-offeredScript = to_p2wsh $ offered_htlc_script
- dummyRevocationPubkey
- dummyRemoteHtlcPubkey
- dummyLocalHtlcPubkey
- dummyPaymentHash
- dummyFeatures
-
--- Script that matches what findHTLC expects for received
-receivedScript :: Script
-receivedScript = to_p2wsh $ received_htlc_script
- dummyRevocationPubkey
- dummyRemoteHtlcPubkey
- dummyLocalHtlcPubkey
- dummyPaymentHash
- (CltvExpiry 500000)
- dummyFeatures
-
-toLocalScript :: Script
-toLocalScript = to_p2wsh $ to_local_script
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey
-
--- CommitmentTx with to_local + to_remote outputs
-dummyLocalCommitTx :: CommitmentTx
-dummyLocalCommitTx = CommitmentTx
- { ctx_version = 2
- , ctx_locktime = Locktime 0
- , ctx_input_outpoint = dummyOutPoint
- , ctx_input_sequence = Sequence 0
- , ctx_outputs =
- [ TxOutput (Satoshi 50000) toLocalScript
- OutputToLocal
- , TxOutput (Satoshi 30000) dummyDestScript
- OutputToRemote
- ]
- , ctx_funding_script = dummyDestScript
- }
-
--- CommitmentTx with HTLC outputs
-dummyLocalCommitWithHTLCs :: CommitmentTx
-dummyLocalCommitWithHTLCs = CommitmentTx
- { ctx_version = 2
- , ctx_locktime = Locktime 0
- , ctx_input_outpoint = dummyOutPoint
- , ctx_input_sequence = Sequence 0
- , ctx_outputs =
- [ TxOutput (Satoshi 50000) toLocalScript
- OutputToLocal
- , TxOutput (Satoshi 30000) dummyDestScript
- OutputToRemote
- , TxOutput (Satoshi 1000) offeredScript
- (OutputOfferedHTLC (CltvExpiry 500000))
- , TxOutput (Satoshi 1000) receivedScript
- (OutputReceivedHTLC (CltvExpiry 500000))
- ]
- , ctx_funding_script = dummyDestScript
- }
-
--- A distinct CommitmentTx (different locktime)
-dummyRemoteCommitTx :: CommitmentTx
-dummyRemoteCommitTx = CommitmentTx
- { ctx_version = 2
- , ctx_locktime = Locktime 1
- , ctx_input_outpoint = dummyOutPoint
- , ctx_input_sequence = Sequence 0
- , ctx_outputs =
- [ TxOutput (Satoshi 40000) toLocalScript
- OutputToLocal
- , TxOutput (Satoshi 20000) dummyDestScript
- OutputToRemote
- ]
- , ctx_funding_script = dummyDestScript
+dummyDestScript = Script $ BS.pack [0x00, 0x14] <> BS.replicate 20 0xCC
+
+-- | The witness script of an HTLC output of a commitment with the
+-- given keys.
+htlc_witness_script :: CommitmentKeys -> CommitmentFormat -> HTLC -> Script
+htlc_witness_script keys fmt h = case htlc_direction h of
+ HTLCOffered -> offered_htlc_script (ck_revocation_pubkey keys)
+ (ck_remote_htlc keys) (ck_local_htlc keys) (htlc_payment_hash h) fmt
+ HTLCReceived -> received_htlc_script (ck_revocation_pubkey keys)
+ (ck_remote_htlc keys) (ck_local_htlc keys) (htlc_payment_hash h)
+ (htlc_cltv_expiry h) fmt
+
+-- | An HTLC context for one of the fixture HTLCs.
+htlc_context :: Fx -> HTLC -> CommitmentFormat -> HTLCContext
+htlc_context fx h fmt = HTLCContext
+ { hc_commitment_txid = dummyTxId
+ , hc_output_index = 0
+ , hc_htlc = h
+ , hc_to_self_delay = dummyDelay
+ , hc_feerate = dummyFeerate
+ , hc_format = fmt
+ , hc_revocation_pubkey = fx_revpk fx
+ , hc_local_delayed = fx_delayed fx
}
-- BOLT #3 Appendix C/F vectors -------------------------------------
-- | Payment hash of an Appendix C HTLC whose preimage is 32 copies
-- of the given byte.
-vecPaymentHash :: Word8 -> PaymentHash
-vecPaymentHash b = PaymentHash (SHA256.hash (BS.replicate 32 b))
-
--- | Decode a hex string.
-unhex :: BS.ByteString -> Maybe BS.ByteString
-unhex bs
- | odd (BS.length bs) = Nothing
- | otherwise = BS.pack <$> go (BS.unpack bs)
- where
- go (a:b:rest) = (:) <$> byte a b <*> go rest
- go _ = Just []
- byte a b = (\hi lo -> hi * 16 + lo) <$> nibble a <*> nibble b
- nibble c
- | c >= 0x30 && c <= 0x39 = Just (c - 0x30)
- | c >= 0x61 && c <= 0x66 = Just (c - 0x57)
- | otherwise = Nothing
+vecPaymentHash :: Word8 -> IO PaymentHash
+vecPaymentHash b =
+ need "payment hash" (BOLT1.payment_hash (SHA256.hash (BS.replicate 32 b)))
-- | An Appendix C HTLC, given its direction, amount (msat), expiry
-- and preimage byte.
-vecHtlc :: HTLCDirection -> Word64 -> Word32 -> Word8 -> HTLC
-vecHtlc dir msat expiry b = HTLC
- { htlc_direction = dir
- , htlc_amount_msat = MilliSatoshi msat
- , htlc_payment_hash = vecPaymentHash b
- , htlc_cltv_expiry = CltvExpiry expiry
- }
+vecHtlc :: HTLCDirection -> Word64 -> Word32 -> Word8 -> IO HTLC
+vecHtlc dir amt expiry b = do
+ a <- msat amt
+ ph <- vecPaymentHash b
+ pure HTLC
+ { htlc_direction = dir
+ , htlc_amount_msat = a
+ , htlc_payment_hash = ph
+ , htlc_cltv_expiry = CltvExpiry expiry
+ }
-vecHtlc0, vecHtlc1, vecHtlc2, vecHtlc3, vecHtlc4 :: HTLC
+vecHtlc0, vecHtlc1, vecHtlc2, vecHtlc3, vecHtlc4 :: IO HTLC
vecHtlc0 = vecHtlc HTLCReceived 1000000 500 0x00
vecHtlc1 = vecHtlc HTLCReceived 2000000 501 0x01
vecHtlc2 = vecHtlc HTLCOffered 2000000 502 0x02
vecHtlc3 = vecHtlc HTLCOffered 3000000 503 0x03
vecHtlc4 = vecHtlc HTLCReceived 4000000 504 0x04
-vecHtlc5, vecHtlc6 :: HTLC
+vecHtlc5, vecHtlc6 :: IO HTLC
vecHtlc5 = vecHtlc HTLCOffered 5000000 506 0x05
vecHtlc6 = vecHtlc HTLCOffered 5000001 505 0x05
-- | Appendix C keys for the local commitment (Appendix F uses the
-- same keys).
-vecKeys :: Maybe CommitmentKeys
+vecKeys :: IO CommitmentKeys
vecKeys = do
- rev <- key
+ rev <- pt
"0212a140cd0c6539d07cd08dfe09984dec3251ea808b892efeac3ede9402bf2b19"
- delayed <- key
+ delayed <- pt
"03fd5960528dc152014952efdb702a88f71e3c1653b2314431701ec77e57fde83c"
- localHtlc <- key
+ localHtlc <- pt
"030d417a46946384f88d5f3337267c5e579765875dc4daca813e21734b140639e7"
- remoteHtlc <- key
+ remoteHtlc <- pt
"0394854aa6eab5b2a8122cc726e9dded053a2184d88256816826d6231c068d4a5b"
- localPayment <- key
- "034f355bdcb7cc0af728ef3cceb9615d90684bb5b2ca5f859ab0f0b704075871aa"
- remotePayment <- key
+ remotePayment <- pt
"032c0b7cf95324a07d05398b240174dc0c2be444d96b159aa6c7f7b1e668680991"
- localFunding <- key
+ localFunding <- pt
"023da092f6980e58d2c037173180e9a465476026ee50f96695963e8efe436f54eb"
- remoteFunding <- key
+ remoteFunding <- pt
"030e9f7b623d2ccc7c9bd44d66d5ce21ce504c0acf6385a132cec6d3c39fa711c1"
pure CommitmentKeys
{ ck_revocation_pubkey = RevocationPubkey rev
- , ck_local_delayed = LocalDelayedPubkey delayed
- , ck_local_htlc = LocalHtlcPubkey localHtlc
- , ck_remote_htlc = RemoteHtlcPubkey remoteHtlc
- , ck_local_payment = LocalPubkey localPayment
- , ck_remote_payment = RemotePubkey remotePayment
- , ck_local_funding = FundingPubkey localFunding
- , ck_remote_funding = FundingPubkey remoteFunding
+ , ck_local_delayed = LocalDelayedPubkey delayed
+ , ck_local_htlc = LocalHtlcPubkey localHtlc
+ , ck_remote_htlc = RemoteHtlcPubkey remoteHtlc
+ , ck_remote_payment = RemotePubkey remotePayment
+ , ck_local_funding = FundingPubkey localFunding
+ , ck_remote_funding = FundingPubkey remoteFunding
}
- where
- key h = unhex h >>= pubkey
-- | Rebuild an Appendix C/F local commitment with bolt3, given the
--- feerate, channel features, to_local balance and HTLCs.
+-- feerate, commitment format, to_local balance (msat) and HTLCs.
vecCommitment
- :: FeeratePerKw -> ChannelFeatures -> MilliSatoshi -> [HTLC]
- -> Maybe CommitmentTx
-vecCommitment feerate features toLocal htlcs = do
+ :: FeeratePerKw -> CommitmentFormat -> Word64 -> [HTLC]
+ -> IO CommitmentTx
+vecCommitment feerate fmt toLocal htlcs = do
keys <- vecKeys
- fundingTxid <- mkTxId =<< unhex
+ fundingTxid <- need "funding txid" $ BT.mkTxId =<< unhex
"bef67e4e2fb9ddeeb3461973cd4c62abb35050b1add772995b820b584a488489"
- cn <- commitment_number 42
- localBp <- point =<< unhex
+ cn <- need "commitment number" (commitment_number 42)
+ localBp <- pt
"034f355bdcb7cc0af728ef3cceb9615d90684bb5b2ca5f859ab0f0b704075871aa"
- remoteBp <- point =<< unhex
+ remoteBp <- pt
"032c0b7cf95324a07d05398b240174dc0c2be444d96b159aa6c7f7b1e668680991"
- pure $ build_commitment_tx CommitmentContext
- { cc_funding_outpoint = OutPoint fundingTxid 0
+ dust <- sat 546
+ toLocalMsat <- msat toLocal
+ toRemoteMsat <- msat 3000000000
+ need "build_commitment_tx" $ build_commitment_tx CommitmentContext
+ { cc_funding_outpoint = OutPoint fundingTxid 0
, cc_commitment_number = cn
- , cc_local_payment_bp = PaymentBasepoint localBp
+ , cc_local_payment_bp = PaymentBasepoint localBp
, cc_remote_payment_bp = PaymentBasepoint remoteBp
- , cc_to_self_delay = ToSelfDelay 144
- , cc_dust_limit = DustLimit (Satoshi 546)
- , cc_feerate = feerate
- , cc_features = features
- , cc_is_funder = True
- , cc_to_local_msat = toLocal
- , cc_to_remote_msat = MilliSatoshi 3000000000
- , cc_htlcs = htlcs
- , cc_keys = keys
+ , cc_to_self_delay = ToSelfDelay 144
+ , cc_dust_limit = DustLimit dust
+ , cc_feerate = feerate
+ , cc_format = fmt
+ , cc_is_funder = True
+ , cc_to_local_msat = toLocalMsat
+ , cc_to_remote_msat = toRemoteMsat
+ , cc_htlcs = htlcs
+ , cc_keys = keys
}
-- | The Appendix C commitment with two offered HTLCs sharing a
-- payment hash and amount.
-vecCommitSameHash :: Maybe CommitmentTx
-vecCommitSameHash = vecCommitment (FeeratePerKw 253)
- (ChannelFeatures False) (MilliSatoshi 6987999999)
- [vecHtlc1, vecHtlc5, vecHtlc6]
+vecCommitSameHash :: IO CommitmentTx
+vecCommitSameHash = do
+ h1 <- vecHtlc1
+ h5 <- vecHtlc5
+ h6 <- vecHtlc6
+ vecCommitment (FeeratePerKw 253) StaticRemotekey 6987999999 [h1, h5, h6]
-- | The Appendix F (anchors) "commitment tx with seven outputs
-- untrimmed".
-vecCommitAnchors :: Maybe CommitmentTx
-vecCommitAnchors = vecCommitment (FeeratePerKw 644)
- (ChannelFeatures True) (MilliSatoshi 6988000000)
- [vecHtlc0, vecHtlc1, vecHtlc2, vecHtlc3, vecHtlc4]
+vecCommitAnchors :: IO CommitmentTx
+vecCommitAnchors = do
+ hs <- sequence [vecHtlc0, vecHtlc1, vecHtlc2, vecHtlc3, vecHtlc4]
+ vecCommitment (FeeratePerKw 644) Anchors 6988000000 hs
-- | Appendix C: commitment tx with 3 htlc outputs, 2 offered
-- having the same amount and preimage (signed).
@@ -420,9 +430,10 @@ vecFHtlcSuccess1 =
\875dc4daca813e21734b140639e752ae677502f501b175ac6851b27568000000\
\00"
+
-- | Parse a hex-encoded transaction, failing the test otherwise.
parseTx :: BS.ByteString -> IO Tx
-parseTx = assertJust "invalid transaction hex" . from_base16
+parseTx = need "invalid transaction hex" . BT.from_base16
-- | Witness stack of a single-input transaction.
singleWitness :: Tx -> IO [BS.ByteString]
@@ -432,32 +443,42 @@ singleWitness tx = case tx_witnesses tx of
-- | Remote signature and offered HTLC witness script, taken from the
-- Appendix C HTLC-timeout tx for htlc #5.
-offeredClaimParts :: IO (BS.ByteString, BS.ByteString)
+offeredClaimParts :: IO (BS.ByteString, Script)
offeredClaimParts = do
items <- singleWitness =<< parseTx vecCHtlcTimeout5
case items of
- [_, sig, _, _, script] -> pure (sig, script)
+ [_, sig, _, _, script] -> pure (sig, Script script)
_ -> assertFailure "unexpected HTLC-timeout witness"
+-- | Signatures and received HTLC witness script, taken from the
+-- Appendix C HTLC-success tx for htlc #1.
+successParts :: IO (BS.ByteString, BS.ByteString, Script)
+successParts = do
+ items <- singleWitness =<< parseTx vecCHtlcSuccess1
+ case items of
+ [_, remoteSig, localSig, _, script] ->
+ pure (remoteSig, localSig, Script script)
+ _ -> assertFailure "unexpected HTLC-success witness"
+
-- | Build the HTLC tx for an HTLC output of an Appendix C/F
-- commitment (to_self_delay 144).
vecHtlcTx :: FeeratePerKw -> B5.UnresolvedOutput -> IO B5.SpendingTx
vecHtlcTx feerate uo = case B5.uo_type uo of
- B5.SpendHTLCTimeout htlc keys features ->
- pure (B5.spend_htlc_timeout (ctx htlc keys features) keys)
- B5.SpendHTLCSuccess htlc keys features ->
- pure (B5.spend_htlc_success (ctx htlc keys features) keys)
+ B5.SpendHTLCTimeout htlc keys fmt -> build htlc keys fmt
+ B5.SpendHTLCSuccess htlc keys fmt -> build htlc keys fmt
other -> assertFailure ("expected an HTLC output, got " <> show other)
where
- ctx htlc keys features = HTLCContext
- { hc_commitment_txid = op_txid (B5.uo_outpoint uo)
- , hc_output_index = op_vout (B5.uo_outpoint uo)
- , hc_htlc = htlc
- , hc_to_self_delay = ToSelfDelay 144
- , hc_feerate = feerate
- , hc_features = features
+ build htlc keys fmt = need "spend_htlc_tx" $
+ B5.spend_htlc_tx (ctx htlc keys fmt) keys
+ ctx htlc keys fmt = HTLCContext
+ { hc_commitment_txid = op_txid (B5.uo_outpoint uo)
+ , hc_output_index = op_vout (B5.uo_outpoint uo)
+ , hc_htlc = htlc
+ , hc_to_self_delay = ToSelfDelay 144
+ , hc_feerate = feerate
+ , hc_format = fmt
, hc_revocation_pubkey = ck_revocation_pubkey keys
- , hc_local_delayed = ck_local_delayed keys
+ , hc_local_delayed = ck_local_delayed keys
}
-- | Check an HTLC tx against a signed BOLT #3 vector: the unsigned
@@ -473,14 +494,14 @@ assertHtlcTx stx vec = do
-- | Check the sighash flags of the signatures in a signed BOLT #3
-- HTLC-tx vector: the local one must be the type the 'SpendingTx'
--- gives, the remote one the given type.
+-- gives, the remote one bolt3's 'remote_htlc_sighash'.
assertSighashFlags
- :: B5.SpendingTx -> SighashType -> BS.ByteString -> Assertion
-assertSighashFlags stx remoteType vec = do
+ :: B5.SpendingTx -> CommitmentFormat -> BS.ByteString -> Assertion
+assertSighashFlags stx fmt vec = do
items <- singleWitness =<< parseTx vec
case items of
[_, remoteSig, localSig, _, _] -> do
- flag remoteSig @?= Just (encode_sighash remoteType)
+ flag remoteSig @?= Just (encode_sighash (remote_htlc_sighash fmt))
flag localSig
@?= Just (encode_sighash (B5.stx_sighash_type stx))
_ -> assertFailure "unexpected HTLC-tx witness"
@@ -497,14 +518,16 @@ types_tests = testGroup "Types" [
B5.RemoteCommitClose @?= B5.RemoteCommitClose
B5.RevokedCommitClose @?= B5.RevokedCommitClose
- , testCase "spending_fee calculation" $ do
- let fee = B5.spending_fee (FeeratePerKw 1000) 500
- fee @?= Satoshi 500
+ , testCase "spending_fee calculation" $
+ BOLT1.un_satoshi (B5.spending_fee (FeeratePerKw 1000) 500) @?= 500
- , testCase "spending_fee at low feerate" $ do
- let fee = B5.spending_fee (FeeratePerKw 253) 324
+ , testCase "spending_fee at low feerate" $
-- 253 * 324 / 1000 = 81.972 -> 81
- fee @?= Satoshi 81
+ BOLT1.un_satoshi (B5.spending_fee (FeeratePerKw 253) 324) @?= 81
+
+ , testCase "spending_fee saturates at 21 million BTC" $
+ B5.spending_fee (FeeratePerKw maxBound) maxBound
+ @?= BOLT1.max_satoshi
, testCase "weight constants" $ do
B5.to_local_penalty_witness_weight @?= 160
@@ -523,481 +546,359 @@ detect_tests :: TestTree
detect_tests = testGroup "Detect" [
testCase "extract_preimage_htlc_success - Appendix C" $ do
items <- singleWitness =<< parseTx vecCHtlcSuccess1
- fmap unPaymentPreimage
- (B5.extract_preimage_htlc_success
- (vecPaymentHash 0x01) (Witness items))
+ ph <- vecPaymentHash 0x01
+ fmap BOLT1.un_payment_preimage
+ (B5.extract_preimage_htlc_success ph (Witness items))
@?= Just (BS.replicate 32 0x01)
, testCase "extract_preimage_htlc_success - Appendix F" $ do
items <- singleWitness =<< parseTx vecFHtlcSuccess1
- fmap unPaymentPreimage
- (B5.extract_preimage_htlc_success
- (vecPaymentHash 0x01) (Witness items))
+ ph <- vecPaymentHash 0x01
+ fmap BOLT1.un_payment_preimage
+ (B5.extract_preimage_htlc_success ph (Witness items))
@?= Just (BS.replicate 32 0x01)
+ , testCase "extract_preimage_htlc_success - bolt3 witness" $ do
+ (remoteSig, localSig, script) <- successParts
+ ph <- vecPaymentHash 0x01
+ preimage <- need "preimage"
+ (BOLT1.payment_preimage (BS.replicate 32 0x01))
+ B5.extract_preimage_htlc_success ph
+ (htlc_success_witness remoteSig localSig preimage script)
+ @?= Just preimage
+
, testCase "extract_preimage_htlc_success - wrong hash" $ do
items <- singleWitness =<< parseTx vecCHtlcSuccess1
- B5.extract_preimage_htlc_success
- (vecPaymentHash 0x05) (Witness items)
- @?= Nothing
+ ph <- vecPaymentHash 0x05
+ B5.extract_preimage_htlc_success ph (Witness items) @?= Nothing
, testCase "extract_preimage_htlc_success - timeout witness" $ do
items <- singleWitness =<< parseTx vecCHtlcTimeout5
- B5.extract_preimage_htlc_success
- (vecPaymentHash 0x05) (Witness items)
+ ph <- vecPaymentHash 0x05
+ B5.extract_preimage_htlc_success ph (Witness items) @?= Nothing
+ (remoteSig, localSig, script) <- successParts
+ B5.extract_preimage_htlc_success ph
+ (htlc_timeout_witness remoteSig localSig script)
@?= Nothing
, testCase "extract_preimage_htlc_success - no script" $ do
items <- singleWitness =<< parseTx vecCHtlcSuccess1
- B5.extract_preimage_htlc_success
- (vecPaymentHash 0x01) (Witness (take 4 items))
+ ph <- vecPaymentHash 0x01
+ B5.extract_preimage_htlc_success ph (Witness (take 4 items))
@?= Nothing
, testCase "extract_preimage_offered - remote claim" $ do
-- <remotehtlcsig> <payment_preimage> <witness_script>; the
-- signature is not checked.
(sig, script) <- offeredClaimParts
- let preimage = BS.replicate 32 0x05
- fmap unPaymentPreimage
- (B5.extract_preimage_offered (vecPaymentHash 0x05)
- (Witness [sig, preimage, script]))
+ ph <- vecPaymentHash 0x05
+ preimage <- need "preimage"
+ (BOLT1.payment_preimage (BS.replicate 32 0x05))
+ B5.extract_preimage_offered ph
+ (offered_htlc_witness_preimage sig preimage script)
@?= Just preimage
, testCase "extract_preimage_offered - wrong hash" $ do
(sig, script) <- offeredClaimParts
- B5.extract_preimage_offered (vecPaymentHash 0x01)
- (Witness [sig, BS.replicate 32 0x05, script])
+ ph <- vecPaymentHash 0x01
+ preimage <- need "preimage"
+ (BOLT1.payment_preimage (BS.replicate 32 0x05))
+ B5.extract_preimage_offered ph
+ (offered_htlc_witness_preimage sig preimage script)
@?= Nothing
- , testCase "extract_preimage_offered - revocation spend" $ do
- -- <revocation_sig> <revocationpubkey> <witness_script>
- (sig, script) <- offeredClaimParts
- B5.extract_preimage_offered (vecPaymentHash 0x05)
- (Witness [sig, unPubkey (mkPubkey 0x01), script])
- @?= Nothing
+ , testCase "extract_preimage_offered - revocation spend" $ with_fx $
+ \fx -> do
+ -- <revocation_sig> <revocationpubkey> <witness_script>
+ (sig, script) <- offeredClaimParts
+ ph <- vecPaymentHash 0x05
+ B5.extract_preimage_offered ph
+ (offered_htlc_witness_revoke sig (fx_revpk fx) script)
+ @?= Nothing
, testCase "extract_preimage_offered - no script" $ do
(sig, _) <- offeredClaimParts
- B5.extract_preimage_offered (vecPaymentHash 0x05)
+ ph <- vecPaymentHash 0x05
+ B5.extract_preimage_offered ph
(Witness [sig, BS.replicate 32 0x05])
@?= Nothing
- , testCase "htlc_timed_out - at expiry" $ do
- let htlc = dummyHTLC
- { htlc_cltv_expiry = CltvExpiry 500000 }
- B5.htlc_timed_out 500000 htlc @?= True
+ , testCase "htlc_timed_out - at expiry" $ with_fx $ \fx ->
+ B5.htlc_timed_out 500000 (fx_offered fx) @?= True
- , testCase "htlc_timed_out - past expiry" $ do
- let htlc = dummyHTLC
- { htlc_cltv_expiry = CltvExpiry 500000 }
- B5.htlc_timed_out 500001 htlc @?= True
+ , testCase "htlc_timed_out - past expiry" $ with_fx $ \fx ->
+ B5.htlc_timed_out 500001 (fx_offered fx) @?= True
- , testCase "htlc_timed_out - before expiry" $ do
- let htlc = dummyHTLC
- { htlc_cltv_expiry = CltvExpiry 500000 }
- B5.htlc_timed_out 499999 htlc @?= False
+ , testCase "htlc_timed_out - before expiry" $ with_fx $ \fx ->
+ B5.htlc_timed_out 499999 (fx_offered fx) @?= False
]
-- classify tests -----------------------------------------------------
classify_tests :: TestTree
classify_tests = testGroup "Classify" [
- testCase "identify_close - signed local commitment" $ do
- commit <- assertJust "commitment" vecCommitSameHash
- signed <- assertJust "hex" (unhex vecCCommitSameHash)
- B5.identify_close commit dummyRemoteCommitTx signed
+ testCase "identify_close - signed local commitment" $ with_fx $
+ \fx -> do
+ commit <- vecCommitSameHash
+ signed <- need "hex" (unhex vecCCommitSameHash)
+ B5.identify_close commit (fx_remote_commit fx) signed
+ @?= Just B5.LocalCommitClose
+
+ , testCase "identify_close - signed remote commitment" $ with_fx $
+ \fx -> do
+ commit <- vecCommitSameHash
+ signed <- need "hex" (unhex vecCCommitSameHash)
+ B5.identify_close (fx_local_commit fx) commit signed
+ @?= Just B5.RemoteCommitClose
+
+ , testCase "identify_close - unsigned commitment" $ with_fx $ \fx -> do
+ commit <- vecCommitSameHash
+ B5.identify_close commit (fx_remote_commit fx)
+ (encode_commitment_tx commit)
@?= Just B5.LocalCommitClose
- , testCase "identify_close - signed remote commitment" $ do
- commit <- assertJust "commitment" vecCommitSameHash
- signed <- assertJust "hex" (unhex vecCCommitSameHash)
- B5.identify_close dummyLocalCommitTx commit signed
- @?= Just B5.RemoteCommitClose
-
- , testCase "identify_close - unsigned commitment" $ do
- commit <- assertJust "commitment" vecCommitSameHash
- unsigned <- assertJust "encode" (encode_tx_for_signing commit)
- B5.identify_close commit dummyRemoteCommitTx unsigned
- @?= Just B5.LocalCommitClose
-
- , testCase "identify_close - no match" $ do
- signed <- assertJust "hex" (unhex vecCCommitSameHash)
- B5.identify_close
- dummyLocalCommitTx dummyRemoteCommitTx signed
+ , testCase "identify_close - no match" $ with_fx $ \fx -> do
+ signed <- need "hex" (unhex vecCCommitSameHash)
+ B5.identify_close (fx_local_commit fx) (fx_remote_commit fx) signed
@?= Nothing
- , testCase "identify_close - unparseable" $ do
- B5.identify_close
- dummyLocalCommitTx
- dummyRemoteCommitTx
+ , testCase "identify_close - unparseable" $ with_fx $ \fx ->
+ B5.identify_close (fx_local_commit fx) (fx_remote_commit fx)
"unknown bytes"
- @?= Nothing
+ @?= Nothing
- , testCase "classify_local - to_local and to_remote" $ do
- let outs = B5.classify_local_commit_outputs
- dummyLocalCommitTx dummyKeys
- dummyDelay dummyFeatures []
- length outs @?= 2
- case outs of
- [o1, o2] -> do
- case B5.uo_type o1 of
- B5.SpendToLocal d rk dk -> do
- d @?= dummyDelay
- rk @?= dummyRevocationPubkey
- dk @?= dummyLocalDelayedPubkey
- other -> assertFailure $
- "expected SpendToLocal, got " <> show other
- B5.uo_type o2 @?= B5.Resolved
- _ -> assertFailure "expected 2 outputs"
-
- , testCase "classify_local - HTLC outputs" $ do
- let outs = B5.classify_local_commit_outputs
- dummyLocalCommitWithHTLCs dummyKeys
- dummyDelay dummyFeatures
- [dummyHTLC, dummyReceivedHTLC]
- length outs @?= 4
- case outs of
- [_, _, o3, o4] -> do
- case B5.uo_type o3 of
- B5.SpendHTLCTimeout _ _ _ -> pure ()
- other -> assertFailure $
- "expected SpendHTLCTimeout, got "
- <> show other
- case B5.uo_type o4 of
- B5.SpendHTLCSuccess _ _ _ -> pure ()
- other -> assertFailure $
- "expected SpendHTLCSuccess, got "
- <> show other
- _ -> assertFailure "expected 4 outputs"
-
- , testCase "classify_remote - HTLC outputs" $ do
- let commitTx = CommitmentTx
- { ctx_version = 2
- , ctx_locktime = Locktime 0
- , ctx_input_outpoint = dummyOutPoint
- , ctx_input_sequence = Sequence 0
- , ctx_outputs =
- [ TxOutput (Satoshi 50000) toLocalScript
- OutputToLocal
- , TxOutput (Satoshi 1000) offeredScript
- (OutputOfferedHTLC
- (CltvExpiry 500000))
- , TxOutput (Satoshi 1000) receivedScript
- (OutputReceivedHTLC
- (CltvExpiry 500000))
- ]
- , ctx_funding_script = dummyDestScript
+ , testCase "classify_local - to_local and to_remote" $ with_fx $ \fx ->
+ map B5.uo_type
+ (B5.classify_local_commit_outputs (fx_local_commit fx)
+ (fx_keys fx) dummyDelay StaticRemotekey)
+ @?= [ B5.SpendToLocal dummyDelay (fx_revpk fx) (fx_delayed fx)
+ , B5.Resolved
+ ]
+
+ , testCase "classify_local - outpoints and values" $ with_fx $ \fx -> do
+ let commit = fx_htlc_commit fx
+ txid = BT.txid (commitment_to_tx commit)
+ outs = B5.classify_local_commit_outputs commit (fx_keys fx)
+ dummyDelay StaticRemotekey
+ map B5.uo_outpoint outs @?= map (OutPoint txid) [0 .. 3]
+ map (BOLT1.un_satoshi . B5.uo_value) outs
+ @?= [50000, 30000, 1000, 1000]
+
+ , testCase "classify_local - HTLC outputs" $ with_fx $ \fx ->
+ map B5.uo_type
+ (drop 2 (B5.classify_local_commit_outputs (fx_htlc_commit fx)
+ (fx_keys fx) dummyDelay StaticRemotekey))
+ @?= [ B5.SpendHTLCTimeout (fx_offered fx) (fx_keys fx)
+ StaticRemotekey
+ , B5.SpendHTLCSuccess (fx_received fx) (fx_keys fx)
+ StaticRemotekey
+ ]
+
+ , testCase "classify_remote - HTLC outputs" $ with_fx $ \fx ->
+ map B5.uo_type
+ (B5.classify_remote_commit_outputs (fx_htlc_commit fx)
+ (fx_keys fx))
+ @?= [ B5.Resolved
+ , B5.Resolved
+ , B5.SpendHTLCPreimageDirect (fx_offered fx)
+ , B5.SpendHTLCTimeoutDirect (fx_received fx)
+ ]
+
+ , testCase "classify_revoked - to_local and HTLCs" $ with_fx $ \fx ->
+ map B5.uo_type
+ (B5.classify_revoked_commit_outputs (fx_htlc_commit fx)
+ (fx_revpk fx))
+ @?= [ B5.Revoke (fx_revpk fx)
+ , B5.Resolved
+ , B5.RevokeHTLC (fx_revpk fx)
+ (B5.HTLCOfferedOutput (CltvExpiry 500000))
+ , B5.RevokeHTLC (fx_revpk fx)
+ (B5.HTLCReceivedOutput (CltvExpiry 500000))
+ ]
+
+ , testCase "classify - anchor outputs" $ with_fx $ \fx -> do
+ v330 <- sat 330
+ let keys = fx_keys fx
+ anchor pk = to_p2wsh (anchor_script pk)
+ commit = (fx_local_commit fx)
+ { ctx_outputs =
+ CommitmentOutput v330 (anchor (ck_local_funding keys))
+ OutputLocalAnchor
+ :| [CommitmentOutput v330
+ (anchor (ck_remote_funding keys))
+ OutputRemoteAnchor]
}
- outs = B5.classify_remote_commit_outputs
- commitTx dummyKeys dummyFeatures
- [dummyHTLC, dummyReceivedHTLC]
- length outs @?= 3
- case outs of
- [o1, o2, o3] -> do
- B5.uo_type o1 @?= B5.Resolved
- case B5.uo_type o2 of
- B5.SpendHTLCPreimageDirect _ -> pure ()
- other -> assertFailure $
- "expected SpendHTLCPreimageDirect, got "
- <> show other
- case B5.uo_type o3 of
- B5.SpendHTLCTimeoutDirect _ -> pure ()
- other -> assertFailure $
- "expected SpendHTLCTimeoutDirect, got "
- <> show other
- _ -> assertFailure "expected 3 outputs"
-
- , testCase "classify_revoked - to_local revoked" $ do
- let outs = B5.classify_revoked_commit_outputs
- dummyLocalCommitWithHTLCs dummyKeys
- dummyRevocationPubkey dummyFeatures
- [dummyHTLC, dummyReceivedHTLC]
- length outs @?= 4
- case outs of
- [o1, o2, o3, o4] -> do
- B5.uo_type o1
- @?= B5.Revoke dummyRevocationPubkey
- B5.uo_type o2 @?= B5.Resolved
- case B5.uo_type o3 of
- B5.RevokeHTLC _ (B5.HTLCOfferedOutput _) ->
- pure ()
- other -> assertFailure $
- "expected RevokeHTLC offered, got "
- <> show other
- case B5.uo_type o4 of
- B5.RevokeHTLC _ (B5.HTLCReceivedOutput _) ->
- pure ()
- other -> assertFailure $
- "expected RevokeHTLC received, got "
- <> show other
- _ -> assertFailure "expected 4 outputs"
-
- , testCase "classify_local - anchor outputs" $ do
- let anchorScript = to_p2wsh $
- anchor_script dummyFundingPubkey
- remoteFundPk = ck_remote_funding dummyKeys
- remoteAnchorScript = to_p2wsh $
- anchor_script remoteFundPk
- commitTx = CommitmentTx
- { ctx_version = 2
- , ctx_locktime = Locktime 0
- , ctx_input_outpoint = dummyOutPoint
- , ctx_input_sequence = Sequence 0
- , ctx_outputs =
- [ TxOutput (Satoshi 330) anchorScript
- OutputLocalAnchor
- , TxOutput (Satoshi 330) remoteAnchorScript
- OutputRemoteAnchor
- ]
- , ctx_funding_script = dummyDestScript
- }
- outs = B5.classify_local_commit_outputs
- commitTx dummyKeys dummyDelay
- dummyFeaturesAnchors []
- length outs @?= 2
- case outs of
- [o1, o2] -> do
- case B5.uo_type o1 of
- B5.AnchorSpend _ -> pure ()
- other -> assertFailure $
- "expected AnchorSpend, got "
- <> show other
- B5.uo_type o2 @?= B5.Resolved
- _ -> assertFailure "expected 2 outputs"
-
- , testCase "classify_remote - non-HTLC outputs" $ do
- let outs = B5.classify_remote_commit_outputs
- dummyRemoteCommitTx dummyKeys
- dummyFeatures []
- length outs @?= 2
- case outs of
- [o1, o2] -> do
- B5.uo_type o1 @?= B5.Resolved
- B5.uo_type o2 @?= B5.Resolved
- _ -> assertFailure "expected 2 outputs"
-
- , testCase "classify_local - unmatched HTLC" $ do
- let outs = B5.classify_local_commit_outputs
- dummyLocalCommitWithHTLCs dummyKeys
- dummyDelay dummyFeatures []
- -- With no HTLCs passed, HTLC outputs -> Resolved
- length outs @?= 4
- case outs of
- [_, _, o3, o4] -> do
- B5.uo_type o3 @?= B5.Resolved
- B5.uo_type o4 @?= B5.Resolved
- _ -> assertFailure "expected 4 outputs"
-
- , testCase "classify_local - empty commit" $ do
- let emptyCommit = CommitmentTx
- { ctx_version = 2
- , ctx_locktime = Locktime 0
- , ctx_input_outpoint = dummyOutPoint
- , ctx_input_sequence = Sequence 0
- , ctx_outputs = []
- , ctx_funding_script = dummyDestScript
- }
- B5.classify_local_commit_outputs
- emptyCommit dummyKeys dummyDelay
- dummyFeatures []
- @?= []
+ map B5.uo_type
+ (B5.classify_local_commit_outputs commit keys dummyDelay Anchors)
+ @?= [B5.AnchorSpend (ck_local_funding keys), B5.Resolved]
+ map B5.uo_type (B5.classify_remote_commit_outputs commit keys)
+ @?= [B5.Resolved, B5.AnchorSpend (ck_remote_funding keys)]
+ map B5.uo_type
+ (B5.classify_revoked_commit_outputs commit (fx_revpk fx))
+ @?= [B5.Resolved, B5.Resolved]
+
+ , testCase "classify_remote - non-HTLC outputs" $ with_fx $ \fx ->
+ map B5.uo_type
+ (B5.classify_remote_commit_outputs (fx_remote_commit fx)
+ (fx_keys fx))
+ @?= [B5.Resolved, B5.Resolved]
, testCase "classify_local - HTLCs sharing a payment hash" $ do
-- Appendix C: htlcs #5 and #6 share a payment hash and amount
-- (5000 sat) and differ only in CLTV expiry (506 and 505).
- commit <- assertJust "commitment" vecCommitSameHash
- keys <- assertJust "keys" vecKeys
- let features = ChannelFeatures False
- outs = B5.classify_local_commit_outputs commit keys
- (ToSelfDelay 144) features
- [vecHtlc1, vecHtlc5, vecHtlc6]
+ commit <- vecCommitSameHash
+ keys <- vecKeys
+ h1 <- vecHtlc1
+ h5 <- vecHtlc5
+ h6 <- vecHtlc6
+ let outs = B5.classify_local_commit_outputs commit keys
+ (ToSelfDelay 144) StaticRemotekey
map B5.uo_type (take 3 outs) @?=
- [ B5.SpendHTLCSuccess vecHtlc1 keys features
- , B5.SpendHTLCTimeout vecHtlc6 keys features
- , B5.SpendHTLCTimeout vecHtlc5 keys features
+ [ B5.SpendHTLCSuccess h1 keys StaticRemotekey
+ , B5.SpendHTLCTimeout h6 keys StaticRemotekey
+ , B5.SpendHTLCTimeout h5 keys StaticRemotekey
]
, testCase "HTLC txs - Appendix C, shared payment hash" $ do
- commit <- assertJust "commitment" vecCommitSameHash
- keys <- assertJust "keys" vecKeys
+ commit <- vecCommitSameHash
+ keys <- vecKeys
let outs = B5.classify_local_commit_outputs commit keys
- (ToSelfDelay 144) (ChannelFeatures False)
- [vecHtlc1, vecHtlc5, vecHtlc6]
+ (ToSelfDelay 144) StaticRemotekey
case outs of
o0 : o1 : o2 : _ -> do
stx0 <- vecHtlcTx (FeeratePerKw 253) o0
assertHtlcTx stx0 vecCHtlcSuccess1
stx1 <- vecHtlcTx (FeeratePerKw 253) o1
assertHtlcTx stx1 vecCHtlcTimeout6
- assertSighashFlags stx1 SIGHASH_ALL vecCHtlcTimeout6
+ assertSighashFlags stx1 StaticRemotekey vecCHtlcTimeout6
stx2 <- vecHtlcTx (FeeratePerKw 253) o2
assertHtlcTx stx2 vecCHtlcTimeout5
_ -> assertFailure "expected at least 3 outputs"
, testCase "classify_remote - HTLCs sharing a payment hash" $ do
- commit <- assertJust "commitment" vecCommitSameHash
- keys <- assertJust "keys" vecKeys
+ commit <- vecCommitSameHash
+ keys <- vecKeys
+ h1 <- vecHtlc1
+ h5 <- vecHtlc5
+ h6 <- vecHtlc6
let outs = B5.classify_remote_commit_outputs commit keys
- (ChannelFeatures False)
- [vecHtlc1, vecHtlc5, vecHtlc6]
map B5.uo_type (take 3 outs) @?=
- [ B5.SpendHTLCTimeoutDirect vecHtlc1
- , B5.SpendHTLCPreimageDirect vecHtlc6
- , B5.SpendHTLCPreimageDirect vecHtlc5
+ [ B5.SpendHTLCTimeoutDirect h1
+ , B5.SpendHTLCPreimageDirect h6
+ , B5.SpendHTLCPreimageDirect h5
]
, testCase "classify_local - HTLCs differing only in amount" $ do
- let hA = vecHtlc HTLCOffered 5000000 600 0x07
- hB = vecHtlc HTLCOffered 9000000 600 0x07
- features = ChannelFeatures False
- commit <- assertJust "commitment" $ vecCommitment
- (FeeratePerKw 253) features (MilliSatoshi 6000000000)
- [hA, hB]
- keys <- assertJust "keys" vecKeys
+ hA <- vecHtlc HTLCOffered 5000000 600 0x07
+ hB <- vecHtlc HTLCOffered 9000000 600 0x07
+ commit <- vecCommitment (FeeratePerKw 253) StaticRemotekey
+ 6000000000 [hB, hA]
+ keys <- vecKeys
let outs = B5.classify_local_commit_outputs commit keys
- (ToSelfDelay 144) features [hB, hA]
- [ (B5.uo_value o, h)
+ (ToSelfDelay 144) StaticRemotekey
+ [ (BOLT1.un_satoshi (B5.uo_value o), h)
| o <- outs
, B5.SpendHTLCTimeout h _ _ <- [B5.uo_type o] ]
- @?= [(Satoshi 5000, hA), (Satoshi 9000, hB)]
-
- , testCase "classify_local - each HTLC matches one output" $ do
- let h = vecHtlc HTLCOffered 5000000 600 0x07
- features = ChannelFeatures False
- commit <- assertJust "commitment" $ vecCommitment
- (FeeratePerKw 253) features (MilliSatoshi 6000000000)
- [h, h]
- keys <- assertJust "keys" vecKeys
- let timeouts hs = length
+ @?= [(5000, hA), (9000, hB)]
+
+ , testCase "classify_local - one resolution per HTLC output" $ do
+ h <- vecHtlc HTLCOffered 5000000 600 0x07
+ keys <- vecKeys
+ let timeouts commit = length
[ ()
| o <- B5.classify_local_commit_outputs commit keys
- (ToSelfDelay 144) features hs
+ (ToSelfDelay 144) StaticRemotekey
, B5.SpendHTLCTimeout {} <- [B5.uo_type o] ]
- timeouts [h] @?= 1
- timeouts [h, h] @?= 2
+ one <- vecCommitment (FeeratePerKw 253) StaticRemotekey
+ 6000000000 [h]
+ two <- vecCommitment (FeeratePerKw 253) StaticRemotekey
+ 6000000000 [h, h]
+ timeouts one @?= 1
+ timeouts two @?= 2
]
-- spend tests --------------------------------------------------------
spend_tests :: TestTree
spend_tests = testGroup "Spend" [
- testCase "spend_to_local produces valid tx" $ do
- stx <- assertJust "spend_to_local" $
- B5.spend_to_local
- dummyOutPoint
- (Satoshi 100000)
- dummyRevocationPubkey
- dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript
- dummyFeerate
+ testCase "spend_to_local produces valid tx" $ with_fx $ \fx -> do
+ value <- sat 100000
+ stx <- need "spend_to_local" $
+ B5.spend_to_local dummyOutPoint value (fx_revpk fx) dummyDelay
+ (fx_delayed fx) dummyDestScript dummyFeerate
let tx = B5.stx_tx stx
- -- Version should be 2
tx_version tx @?= 2
- -- Single input
length (tx_inputs tx) @?= 1
- -- Single output
length (tx_outputs tx) @?= 1
- -- Output value should be less than input
- let outVal = txout_value
- (head' (tx_outputs tx))
- assertBool "output < input"
- (outVal < 100000)
- -- Sighash should be ALL
+ assertBool "output < input" (out_value stx < 100000)
B5.stx_sighash_type stx @?= SIGHASH_ALL
- -- Input value should match
- B5.stx_input_value stx @?= Satoshi 100000
- -- nSequence should encode delay
- let inp = head' (tx_inputs tx)
- txin_sequence inp @?= fromIntegral
- (unToSelfDelay dummyDelay)
-
- , testCase "spend_to_local fee deduction" $ do
- let value = Satoshi 100000
- 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
- (B5.to_local_penalty_input_weight
- + B5.penalty_tx_base_weight)
- Satoshi outVal @?=
- Satoshi (unSatoshi value
- - unSatoshi expectedFee)
-
- , testCase "spend_revoked_to_local nSequence" $ do
- 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
-
- , testCase "spend_anchor_owner tx structure" $ do
- let stx = B5.spend_anchor_owner
- dummyOutPoint (Satoshi 330)
- dummyFundingPubkey dummyDestScript
+ B5.stx_input_value stx @?= value
+ B5.stx_input_script stx
+ @?= to_local_script (fx_revpk fx) dummyDelay (fx_delayed fx)
+ -- nSequence encodes the delay
+ in_sequence stx @?= 144
+
+ , testCase "spend_to_local fee deduction" $ with_fx $ \fx -> do
+ value <- sat 100000
+ stx <- need "spend_to_local" $
+ B5.spend_to_local dummyOutPoint value (fx_revpk fx) dummyDelay
+ (fx_delayed fx) dummyDestScript dummyFeerate
+ let fee = B5.spending_fee dummyFeerate
+ (B5.to_local_penalty_input_weight + B5.penalty_tx_base_weight)
+ out_value stx @?= 100000 - BOLT1.un_satoshi fee
+
+ , testCase "spend_revoked_to_local nSequence" $ with_fx $ \fx -> do
+ value <- sat 100000
+ stx <- need "spend_revoked_to_local" $
+ B5.spend_revoked_to_local dummyOutPoint value (fx_revpk fx)
+ dummyDelay (fx_delayed fx) dummyDestScript dummyFeerate
+ in_sequence stx @?= 0xFFFFFFFF
+ B5.stx_input_script stx
+ @?= to_local_script (fx_revpk fx) dummyDelay (fx_delayed fx)
+
+ , testCase "spend_anchor_owner tx structure" $ with_fx $ \fx -> do
+ value <- sat 330
+ let stx = B5.spend_anchor_owner dummyOutPoint value
+ (fx_funding fx) dummyDestScript
tx = B5.stx_tx stx
tx_version tx @?= 2
tx_locktime tx @?= 0
B5.stx_sighash_type stx @?= SIGHASH_ALL
+ B5.stx_input_script stx @?= anchor_script (fx_funding fx)
+
+ , testCase "spend_anchor_anyone nSequence" $ with_fx $ \fx -> do
+ value <- sat 330
+ let stx = B5.spend_anchor_anyone dummyOutPoint value
+ (fx_funding fx) dummyDestScript
+ in_sequence stx @?= 16
+
+ , testCase "spend_htlc_output is spend_to_local" $ with_fx $ \fx -> do
+ value <- sat 50000
+ let spend f = f dummyOutPoint value (fx_revpk fx) dummyDelay
+ (fx_delayed fx) dummyDestScript dummyFeerate
+ stx1 <- need "spend_to_local" (spend B5.spend_to_local)
+ stx2 <- need "spend_htlc_output" (spend B5.spend_htlc_output)
+ stx1 @?= stx2
+
+ , testCase "spend_to_local fee underflow" $ with_fx $ \fx -> do
+ value <- sat 1
+ B5.spend_to_local dummyOutPoint value (fx_revpk fx) dummyDelay
+ (fx_delayed fx) dummyDestScript dummyFeerate
+ @?= Nothing
- , testCase "spend_anchor_anyone nSequence" $ do
- let stx = B5.spend_anchor_anyone
- dummyOutPoint (Satoshi 330)
- dummyFundingPubkey dummyDestScript
- tx = B5.stx_tx stx
- inp = head' (tx_inputs tx)
- txin_sequence inp @?= 16
-
- , testCase "spend_htlc_output is spend_to_local" $ do
- 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
-
- , testCase "spend_to_local fee underflow" $ do
- B5.spend_to_local
- dummyOutPoint (Satoshi 1)
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript dummyFeerate
- @?= Nothing
-
- , testCase "spend_to_local dust threshold by script" $ do
- let fee = unSatoshi $ B5.spending_fee dummyFeerate
- (B5.to_local_penalty_input_weight
- + B5.penalty_tx_base_weight)
- sweep dest v = B5.spend_to_local
- dummyOutPoint (Satoshi v)
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey dest dummyFeerate
- outValue = fmap
- (txout_value . head' . tx_outputs . B5.stx_tx)
+ , testCase "spend_to_local dust threshold by script" $ with_fx $ \fx -> do
+ let fee = BOLT1.un_satoshi $ B5.spending_fee dummyFeerate
+ (B5.to_local_penalty_input_weight + B5.penalty_tx_base_weight)
+ sweep dest v = do
+ value <- sat v
+ pure $ B5.spend_to_local dummyOutPoint value (fx_revpk fx)
+ dummyDelay (fx_delayed fx) dest dummyFeerate
check (name, dest, dust) = do
+ at <- sweep dest (fee + dust)
assertEqual (name <> " at threshold") (Just dust)
- (outValue (sweep dest (fee + dust)))
- assertEqual (name <> " below threshold") Nothing
- (sweep dest (fee + dust - 1))
+ (fmap out_value at)
+ below <- sweep dest (fee + dust - 1)
+ assertEqual (name <> " below threshold") Nothing below
mapM_ check
[ ("p2pkh", Script $ BS.pack ([0x76, 0xa9, 0x14]
<> replicate 20 0xCC <> [0x88, 0xac]), 546)
@@ -1009,60 +910,69 @@ spend_tests = testGroup "Spend" [
, ("p2tr", Script $ BS.pack ([0x51, 0x20]
<> replicate 32 0xCC), 330)
]
-
]
-- htlc spend tests ---------------------------------------------------
htlc_spend_tests :: TestTree
htlc_spend_tests = testGroup "HTLC Spend" [
- testCase "spend_htlc_timeout produces valid tx" $ do
- let stx = B5.spend_htlc_timeout
- dummyHTLCContext dummyKeys
- tx = B5.stx_tx stx
+ testCase "spend_htlc_tx - HTLC-timeout" $ with_fx $ \fx -> do
+ stx <- need "spend_htlc_tx" $ B5.spend_htlc_tx
+ (htlc_context fx (fx_offered fx) StaticRemotekey) (fx_keys fx)
+ let tx = B5.stx_tx stx
tx_version tx @?= 2
length (tx_inputs tx) @?= 1
length (tx_outputs tx) @?= 1
+ tx_locktime tx @?= 500000
+ in_sequence stx @?= 0
B5.stx_sighash_type stx @?= SIGHASH_ALL
B5.stx_input_value stx
- @?= msatToSat (MilliSatoshi 1000000)
+ @?= BOLT1.msat_to_sat (htlc_amount_msat (fx_offered fx))
+ B5.stx_input_script stx @?=
+ htlc_witness_script (fx_keys fx) StaticRemotekey (fx_offered fx)
- , testCase "spend_htlc_success produces valid tx" $ do
- let ctx = dummyHTLCContext
- { hc_htlc = dummyReceivedHTLC }
- stx = B5.spend_htlc_success ctx dummyKeys
- tx = B5.stx_tx stx
+ , testCase "spend_htlc_tx - HTLC-success" $ with_fx $ \fx -> do
+ stx <- need "spend_htlc_tx" $ B5.spend_htlc_tx
+ (htlc_context fx (fx_received fx) StaticRemotekey) (fx_keys fx)
+ let tx = B5.stx_tx stx
tx_version tx @?= 2
length (tx_inputs tx) @?= 1
+ tx_locktime tx @?= 0
B5.stx_sighash_type stx @?= SIGHASH_ALL
-
- , testCase "spend_htlc_timeout anchors sighash" $ do
- let ctx = dummyHTLCContext
- { hc_features = dummyFeaturesAnchors }
- stx = B5.spend_htlc_timeout ctx dummyKeys
- B5.stx_sighash_type stx @?= SIGHASH_ALL
-
- , testCase "spend_htlc_success anchors sighash" $ do
- let ctx = dummyHTLCContext
- { hc_htlc = dummyReceivedHTLC
- , hc_features = dummyFeaturesAnchors
- }
- stx = B5.spend_htlc_success ctx dummyKeys
- B5.stx_sighash_type stx @?= SIGHASH_ALL
+ B5.stx_input_script stx @?=
+ htlc_witness_script (fx_keys fx) StaticRemotekey (fx_received fx)
+
+ , testCase "spend_htlc_tx - HTLC-timeout anchors sighash" $ with_fx $
+ \fx -> do
+ stx <- need "spend_htlc_tx" $ B5.spend_htlc_tx
+ (htlc_context fx (fx_offered fx) Anchors) (fx_keys fx)
+ B5.stx_sighash_type stx @?= SIGHASH_ALL
+ in_sequence stx @?= 1
+
+ , testCase "spend_htlc_tx - HTLC-success anchors sighash" $ with_fx $
+ \fx -> do
+ stx <- need "spend_htlc_tx" $ B5.spend_htlc_tx
+ (htlc_context fx (fx_received fx) Anchors) (fx_keys fx)
+ B5.stx_sighash_type stx @?= SIGHASH_ALL
+
+ , testCase "spend_htlc_tx - fee exceeds amount" $ with_fx $ \fx -> do
+ -- 5000 * 663 / 1000 = 3315 sat, more than the 1000 sat HTLC
+ let ctx = (htlc_context fx (fx_offered fx) StaticRemotekey)
+ { hc_feerate = FeeratePerKw 5000 }
+ B5.spend_htlc_tx ctx (fx_keys fx) @?= Nothing
, testCase "HTLC txs - Appendix F (anchors)" $ do
-- The local signature uses SIGHASH_ALL and the remote one
-- SIGHASH_SINGLE|SIGHASH_ANYONECANPAY.
- commit <- assertJust "commitment" vecCommitAnchors
- keys <- assertJust "keys" vecKeys
+ commit <- vecCommitAnchors
+ keys <- vecKeys
let outs = B5.classify_local_commit_outputs commit keys
- (ToSelfDelay 144) (ChannelFeatures True)
- [vecHtlc0, vecHtlc1, vecHtlc2, vecHtlc3, vecHtlc4]
+ (ToSelfDelay 144) Anchors
check uo vec = do
stx <- vecHtlcTx (FeeratePerKw 644) uo
assertHtlcTx stx vec
B5.stx_sighash_type stx @?= SIGHASH_ALL
- assertSighashFlags stx SIGHASH_SINGLE_ANYONECANPAY vec
+ assertSighashFlags stx Anchors vec
case drop 3 outs of
o3 : o4 : _ -> do
check o3 vecFHtlcTimeout2
@@ -1074,139 +984,121 @@ htlc_spend_tests = testGroup "HTLC Spend" [
remote_spend_tests :: TestTree
remote_spend_tests = testGroup "Remote Spend" [
- testCase "spend_remote_htlc_timeout structure" $ do
- stx <- assertJust "spend_remote_htlc_timeout" $
- B5.spend_remote_htlc_timeout
- dummyOutPoint (Satoshi 50000)
- dummyHTLC dummyKeys dummyFeatures
- dummyDestScript dummyFeerate
+ testCase "spend_remote_htlc_timeout structure" $ with_fx $ \fx -> do
+ value <- sat 50000
+ stx <- need "spend_remote_htlc_timeout" $
+ B5.spend_remote_htlc_timeout dummyOutPoint value (fx_offered fx)
+ (fx_keys fx) StaticRemotekey dummyDestScript dummyFeerate
let tx = B5.stx_tx stx
tx_version tx @?= 2
length (tx_inputs tx) @?= 1
B5.stx_sighash_type stx @?= SIGHASH_ALL
- B5.stx_input_value stx @?= Satoshi 50000
- -- locktime should be HTLC CLTV expiry
+ B5.stx_input_value stx @?= value
+ B5.stx_input_script stx @?=
+ htlc_witness_script (fx_keys fx) StaticRemotekey (fx_received fx)
+ -- locktime is the HTLC's CLTV expiry
tx_locktime tx @?= 500000
- , testCase "spend_remote_htlc_timeout fee deduction" $ do
- let value = Satoshi 50000
- stx <- assertJust "spend_remote_htlc_timeout" $
- B5.spend_remote_htlc_timeout
- dummyOutPoint value dummyHTLC
- dummyKeys dummyFeatures
+ , testCase "spend_remote_htlc_timeout fee deduction" $ with_fx $
+ \fx -> do
+ value <- sat 50000
+ stx <- need "spend_remote_htlc_timeout" $
+ B5.spend_remote_htlc_timeout dummyOutPoint value
+ (fx_offered fx) (fx_keys fx) StaticRemotekey
+ dummyDestScript dummyFeerate
+ let fee = B5.spending_fee dummyFeerate
+ (B5.accepted_htlc_penalty_input_weight
+ + B5.penalty_tx_base_weight)
+ out_value stx @?= 50000 - BOLT1.un_satoshi fee
+
+ , testCase "spend_remote_htlc_preimage structure" $ with_fx $ \fx -> do
+ value <- sat 50000
+ stx <- need "spend_remote_htlc_preimage" $
+ B5.spend_remote_htlc_preimage dummyOutPoint value
+ (fx_received fx) (fx_keys fx) StaticRemotekey
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
- 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
+ B5.stx_input_script stx @?=
+ htlc_witness_script (fx_keys fx) StaticRemotekey (fx_offered fx)
+ -- locktime is 0 for preimage claims
tx_locktime tx @?= 0
- , testCase "spend_remote_htlc_timeout anchors seq" $
- do
- stx <- assertJust "spend_remote_htlc_timeout" $
- B5.spend_remote_htlc_timeout
- dummyOutPoint (Satoshi 50000)
- dummyHTLC dummyKeys dummyFeaturesAnchors
+ , testCase "spend_remote_htlc_timeout anchors seq" $ with_fx $ \fx -> do
+ value <- sat 50000
+ stx <- need "spend_remote_htlc_timeout" $
+ B5.spend_remote_htlc_timeout dummyOutPoint value (fx_offered fx)
+ (fx_keys fx) Anchors dummyDestScript dummyFeerate
+ in_sequence stx @?= 1
+
+ , testCase "spend_remote_htlc_timeout no-anchor seq" $ with_fx $
+ \fx -> do
+ value <- sat 50000
+ stx <- need "spend_remote_htlc_timeout" $
+ B5.spend_remote_htlc_timeout dummyOutPoint value
+ (fx_offered fx) (fx_keys fx) StaticRemotekey
+ dummyDestScript dummyFeerate
+ in_sequence stx @?= 0
+
+ , testCase "spend_remote_htlc_preimage nSequence" $ with_fx $ \fx -> do
+ value <- sat 50000
+ stx <- need "spend_remote_htlc_preimage" $
+ B5.spend_remote_htlc_preimage dummyOutPoint value
+ (fx_received fx) (fx_keys fx) StaticRemotekey
dummyDestScript dummyFeerate
- let tx = B5.stx_tx stx
- inp = head' (tx_inputs tx)
- txin_sequence inp @?= 1
-
- , testCase "spend_remote_htlc_timeout no-anchor seq" $
- do
- 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
- inp = head' (tx_inputs tx)
- txin_sequence inp @?= 0
-
- , testCase "spend_remote_htlc_preimage nSequence" $ do
- 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
- inp = head' (tx_inputs tx)
- txin_sequence inp @?= 0
+ in_sequence stx @?= 0
]
-- revoked htlc spend tests ------------------------------------------
revoked_htlc_spend_tests :: TestTree
revoked_htlc_spend_tests = testGroup "Revoked HTLC Spend" [
- testCase "spend_revoked_htlc - offered" $ do
- case B5.spend_revoked_htlc
- dummyOutPoint (Satoshi 50000)
- (B5.HTLCOfferedOutput (CltvExpiry 500000))
- dummyRevocationPubkey dummyKeys
- dummyFeatures dummyPaymentHash
- dummyDestScript dummyFeerate of
- Nothing -> assertFailure "expected Just"
- Just stx -> do
- let tx = B5.stx_tx stx
- tx_version tx @?= 2
- B5.stx_sighash_type stx @?= SIGHASH_ALL
- let inp = head' (tx_inputs tx)
- txin_sequence inp @?= 0xFFFFFFFF
-
- , testCase "spend_revoked_htlc - received" $ do
- case B5.spend_revoked_htlc
- dummyOutPoint (Satoshi 50000)
- (B5.HTLCReceivedOutput
- (CltvExpiry 500000))
- dummyRevocationPubkey dummyKeys
- dummyFeatures dummyPaymentHash
- dummyDestScript dummyFeerate of
- Nothing -> assertFailure "expected Just"
- Just stx -> do
- B5.stx_sighash_type stx @?= SIGHASH_ALL
- let tx = B5.stx_tx stx
- outVal = txout_value
- (head' (tx_outputs tx))
- assertBool "output < input"
- (outVal < 50000)
-
- , testCase "htlcOutputType - valid HTLC types" $ do
- B5.htlcOutputType
- (OutputOfferedHTLC (CltvExpiry 500))
- @?= Just (B5.HTLCOfferedOutput (CltvExpiry 500))
- B5.htlcOutputType
- (OutputReceivedHTLC (CltvExpiry 600))
- @?= Just (B5.HTLCReceivedOutput
- (CltvExpiry 600))
-
- , testCase "htlcOutputType - non-HTLC types" $ do
- B5.htlcOutputType OutputToLocal @?= Nothing
- B5.htlcOutputType OutputToRemote @?= Nothing
- B5.htlcOutputType OutputLocalAnchor @?= Nothing
- B5.htlcOutputType OutputRemoteAnchor @?= Nothing
-
- , testCase "spend_revoked_htlc_output structure" $ do
- stx <- assertJust "spend_revoked_htlc_output" $
- B5.spend_revoked_htlc_output
- dummyOutPoint (Satoshi 50000)
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript dummyFeerate
- let tx = B5.stx_tx stx
- tx_version tx @?= 2
+ testCase "spend_revoked_htlc - offered" $ with_fx $ \fx -> do
+ value <- sat 50000
+ stx <- need "spend_revoked_htlc" $
+ B5.spend_revoked_htlc dummyOutPoint value
+ (B5.HTLCOfferedOutput (CltvExpiry 500000)) (fx_revpk fx)
+ (fx_keys fx) StaticRemotekey (fx_hash fx) dummyDestScript
+ dummyFeerate
+ tx_version (B5.stx_tx stx) @?= 2
B5.stx_sighash_type stx @?= SIGHASH_ALL
- let inp = head' (tx_inputs tx)
- txin_sequence inp @?= 0xFFFFFFFF
+ in_sequence stx @?= 0xFFFFFFFF
+ B5.stx_input_script stx @?=
+ htlc_witness_script (fx_keys fx) StaticRemotekey (fx_offered fx)
+
+ , testCase "spend_revoked_htlc - received" $ with_fx $ \fx -> do
+ value <- sat 50000
+ stx <- need "spend_revoked_htlc" $
+ B5.spend_revoked_htlc dummyOutPoint value
+ (B5.HTLCReceivedOutput (CltvExpiry 500000)) (fx_revpk fx)
+ (fx_keys fx) StaticRemotekey (fx_hash fx) dummyDestScript
+ dummyFeerate
+ B5.stx_sighash_type stx @?= SIGHASH_ALL
+ assertBool "output < input" (out_value stx < 50000)
+ B5.stx_input_script stx @?=
+ htlc_witness_script (fx_keys fx) StaticRemotekey (fx_received fx)
+
+ , testCase "htlc_output_type - HTLC outputs" $ with_fx $ \fx -> do
+ B5.htlc_output_type (OutputHTLC (fx_offered fx))
+ @?= Just (B5.HTLCOfferedOutput (CltvExpiry 500000))
+ B5.htlc_output_type (OutputHTLC (fx_received fx))
+ @?= Just (B5.HTLCReceivedOutput (CltvExpiry 500000))
+
+ , testCase "htlc_output_type - non-HTLC outputs" $ do
+ B5.htlc_output_type OutputToLocal @?= Nothing
+ B5.htlc_output_type OutputToRemote @?= Nothing
+ B5.htlc_output_type OutputLocalAnchor @?= Nothing
+ B5.htlc_output_type OutputRemoteAnchor @?= Nothing
+
+ , testCase "spend_revoked_htlc_output structure" $ with_fx $ \fx -> do
+ value <- sat 50000
+ stx <- need "spend_revoked_htlc_output" $
+ B5.spend_revoked_htlc_output dummyOutPoint value (fx_revpk fx)
+ dummyDelay (fx_delayed fx) dummyDestScript dummyFeerate
+ tx_version (B5.stx_tx stx) @?= 2
+ B5.stx_sighash_type stx @?= SIGHASH_ALL
+ in_sequence stx @?= 0xFFFFFFFF
]
-- weight tests -------------------------------------------------------
@@ -1229,281 +1121,157 @@ weight_tests = testGroup "Weight" [
B5.accepted_htlc_penalty_input_weight_anchors @?=
(164 + B5.accepted_htlc_penalty_witness_weight_anchors)
- , testCase "penalty witness weights match HTLC scripts" $ do
- -- 1 (item count) + 1 + 73 (signature) + 1 + 33
- -- (revocationpubkey) + 1 + script, for a 3-byte CLTV expiry
- let witnessWeight script =
- fromIntegral (110 + BS.length (unScript script))
- offered = offered_htlc_script
- dummyRevocationPubkey dummyRemoteHtlcPubkey
- dummyLocalHtlcPubkey dummyPaymentHash
- received = received_htlc_script
- dummyRevocationPubkey dummyRemoteHtlcPubkey
- dummyLocalHtlcPubkey dummyPaymentHash
- (CltvExpiry 500000)
- witnessWeight (offered dummyFeatures)
- @?= B5.offered_htlc_penalty_witness_weight
- witnessWeight (received dummyFeatures)
- @?= B5.accepted_htlc_penalty_witness_weight
- witnessWeight (offered dummyFeaturesAnchors)
- @?= B5.offered_htlc_penalty_witness_weight_anchors
- witnessWeight (received dummyFeaturesAnchors)
- @?= B5.accepted_htlc_penalty_witness_weight_anchors
-
- , testCase "spend_revoked_htlc weight by channel type" $ do
- let value = 50000
- outValue features htype = fmap
- (txout_value . head' . tx_outputs . B5.stx_tx)
- (B5.spend_revoked_htlc dummyOutPoint (Satoshi value)
- htype dummyRevocationPubkey dummyKeys features
- dummyPaymentHash dummyDestScript dummyFeerate)
- expected inputWeight = Just $ value - unSatoshi
- (B5.spending_fee dummyFeerate
- (inputWeight + B5.penalty_tx_base_weight))
- offered = B5.HTLCOfferedOutput (CltvExpiry 500000)
- received = B5.HTLCReceivedOutput (CltvExpiry 500000)
- outValue dummyFeatures offered
- @?= expected B5.offered_htlc_penalty_input_weight
- outValue dummyFeatures received
- @?= expected B5.accepted_htlc_penalty_input_weight
- outValue dummyFeaturesAnchors offered
- @?= expected B5.offered_htlc_penalty_input_weight_anchors
- outValue dummyFeaturesAnchors received
- @?= expected B5.accepted_htlc_penalty_input_weight_anchors
-
- , testCase "max HTLCs in single penalty tx" $ do
- -- Per spec: (400000 - 324 - 272 - 212 - 2) / 413
- -- = 399190 / 413 = 966
- let maxHtlcs = (B5.max_standard_weight
- - B5.to_local_penalty_input_weight
- - B5.to_remote_input_weight
- - B5.penalty_tx_base_weight
- - 2) `div`
- B5.accepted_htlc_penalty_input_weight
- assertBool "can sweep 483 bidirectional HTLCs"
- (maxHtlcs >= 966)
+ , testCase "penalty witness weights match HTLC scripts" $ with_fx $
+ \fx -> do
+ -- 1 (item count) + 1 + 73 (signature) + 1 + 33
+ -- (revocationpubkey) + 1 + script, for a 3-byte CLTV expiry
+ let witnessWeight fmt h =
+ let Script s = htlc_witness_script (fx_keys fx) fmt h
+ in fromIntegral (110 + BS.length s)
+ witnessWeight StaticRemotekey (fx_offered fx)
+ @?= B5.offered_htlc_penalty_witness_weight
+ witnessWeight StaticRemotekey (fx_received fx)
+ @?= B5.accepted_htlc_penalty_witness_weight
+ witnessWeight Anchors (fx_offered fx)
+ @?= B5.offered_htlc_penalty_witness_weight_anchors
+ witnessWeight Anchors (fx_received fx)
+ @?= B5.accepted_htlc_penalty_witness_weight_anchors
+
+ , testCase "spend_revoked_htlc weight by commitment format" $ with_fx $
+ \fx -> do
+ value <- sat 50000
+ let outValue fmt htype = fmap out_value
+ (B5.spend_revoked_htlc dummyOutPoint value htype
+ (fx_revpk fx) (fx_keys fx) fmt (fx_hash fx)
+ dummyDestScript dummyFeerate)
+ expected inputWeight = Just $ 50000 - BOLT1.un_satoshi
+ (B5.spending_fee dummyFeerate
+ (inputWeight + B5.penalty_tx_base_weight))
+ offered = B5.HTLCOfferedOutput (CltvExpiry 500000)
+ received = B5.HTLCReceivedOutput (CltvExpiry 500000)
+ outValue StaticRemotekey offered
+ @?= expected B5.offered_htlc_penalty_input_weight
+ outValue StaticRemotekey received
+ @?= expected B5.accepted_htlc_penalty_input_weight
+ outValue Anchors offered
+ @?= expected B5.offered_htlc_penalty_input_weight_anchors
+ outValue Anchors received
+ @?= expected B5.accepted_htlc_penalty_input_weight_anchors
+
+ , testCase "max HTLCs in single penalty tx" $
+ -- Per spec: (400000 - 324 - 272 - (4 * 53) - 2) / 413 = 966,
+ -- where penalty_tx_base_weight = 4 * 53 + 2.
+ (B5.max_standard_weight
+ - B5.to_local_penalty_input_weight
+ - B5.to_remote_input_weight
+ - B5.penalty_tx_base_weight)
+ `div` B5.accepted_htlc_penalty_input_weight
+ @?= 966
]
-- property tests -----------------------------------------------------
property_tests :: TestTree
property_tests = testGroup "Properties" [
- testProperty "spending_fee always non-negative" $
- \(NonNegative rate) (NonNegative weight) ->
- let fee = B5.spending_fee
- (FeeratePerKw (fromIntegral (rate :: Int)))
- (fromIntegral (weight :: Int))
- in unSatoshi fee >= 0
-
- , testProperty "spend_to_local fee deduction correct" $
- \(Positive val) ->
- let value = Satoshi
- (fromIntegral (val :: Int) + 100000)
- expectedFee = B5.spending_fee
- (FeeratePerKw 253)
- (B5.to_local_penalty_input_weight
- + B5.penalty_tx_base_weight)
- 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 "sweeps never create dust outputs" $
- forAll (choose (0, 3000 :: Int)) $ \v ->
- let value = Satoshi (fromIntegral v)
- sweeps =
- [ B5.spend_to_local dummyOutPoint value
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey dummyDestScript
- dummyFeerate
+ testProperty "output + fee = input (spend_to_local)" $ prop_fx $
+ \fx -> forAll (choose (100000, 2100000000000000)) $ \v ->
+ let fee = B5.spending_fee dummyFeerate
+ (B5.to_local_penalty_input_weight + B5.penalty_tx_base_weight)
+ spent = do
+ value <- BOLT1.satoshi v
+ B5.spend_to_local dummyOutPoint value (fx_revpk fx)
+ dummyDelay (fx_delayed fx) dummyDestScript dummyFeerate
+ in fmap (\stx -> out_value stx + BOLT1.un_satoshi fee) spent
+ === Just v
+
+ , testProperty "sweeps never create dust outputs" $ prop_fx $ \fx ->
+ forAll (choose (0, 3000)) $ \v ->
+ let sweeps value =
+ [ B5.spend_to_local dummyOutPoint value (fx_revpk fx)
+ dummyDelay (fx_delayed fx) dummyDestScript dummyFeerate
, B5.spend_remote_htlc_timeout dummyOutPoint value
- dummyHTLC dummyKeys dummyFeatures
+ (fx_offered fx) (fx_keys fx) StaticRemotekey
dummyDestScript dummyFeerate
, B5.spend_remote_htlc_preimage dummyOutPoint value
- dummyReceivedHTLC dummyKeys dummyFeatures
+ (fx_received fx) (fx_keys fx) StaticRemotekey
dummyDestScript dummyFeerate
, B5.spend_revoked_to_local dummyOutPoint value
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey dummyDestScript
- dummyFeerate
+ (fx_revpk fx) dummyDelay (fx_delayed fx)
+ dummyDestScript dummyFeerate
, B5.spend_revoked_htlc dummyOutPoint value
(B5.HTLCOfferedOutput (CltvExpiry 500000))
- dummyRevocationPubkey dummyKeys dummyFeatures
- dummyPaymentHash dummyDestScript dummyFeerate
+ (fx_revpk fx) (fx_keys fx) StaticRemotekey
+ (fx_hash fx) dummyDestScript dummyFeerate
, B5.spend_revoked_htlc dummyOutPoint value
(B5.HTLCReceivedOutput (CltvExpiry 500000))
- dummyRevocationPubkey dummyKeys dummyFeatures
- dummyPaymentHash dummyDestScript dummyFeerate
+ (fx_revpk fx) (fx_keys fx) StaticRemotekey
+ (fx_hash fx) dummyDestScript dummyFeerate
, B5.spend_revoked_htlc_output dummyOutPoint value
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey dummyDestScript
- dummyFeerate
+ (fx_revpk fx) dummyDelay (fx_delayed fx)
+ dummyDestScript dummyFeerate
]
- notDust = maybe True $ \stx ->
- txout_value (head' (tx_outputs (B5.stx_tx stx)))
- >= 294
- in all notDust sweeps
-
- , testProperty "htlc_timed_out monotonic" $
- \(NonNegative h1) (NonNegative h2) ->
- let height1 = fromIntegral (h1 :: Int)
- height2 = fromIntegral (h2 :: Int)
- htlc = dummyHTLC
- { htlc_cltv_expiry = CltvExpiry 1000 }
- in if height1 <= height2
- then not (B5.htlc_timed_out height1 htlc)
- || B5.htlc_timed_out height2 htlc
- else True
-
- , testProperty "output + fee = input (spend_to_local)" $
- \(Positive val) ->
- let value = Satoshi
- (fromIntegral (val :: Int) + 100000)
- fee = B5.spending_fee (FeeratePerKw 253)
- (B5.to_local_penalty_input_weight
- + B5.penalty_tx_base_weight)
- 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 outVal + unSatoshi fee ==
- unSatoshi value
+ notDust = maybe True (\stx -> out_value stx >= 294)
+ in case BOLT1.satoshi v of
+ Nothing -> counterexample "invalid amount" False
+ Just value -> property (all notDust (sweeps value))
+
+ , testProperty "htlc_timed_out monotonic" $ prop_fx $
+ \fx (NonNegative h1) (NonNegative h2) ->
+ let htlc = (fx_offered fx) { htlc_cltv_expiry = CltvExpiry 1000 }
+ lo = min h1 h2
+ hi = max h1 h2
+ in not (B5.htlc_timed_out lo htlc) || B5.htlc_timed_out hi htlc
, testProperty "fee monotonic in feerate" $
- \(Positive r1) (Positive r2) ->
- let rate1 = fromIntegral (r1 :: Int)
- rate2 = fromIntegral (r2 :: Int)
- w = B5.to_local_penalty_input_weight
- + B5.penalty_tx_base_weight
- fee1 = B5.spending_fee
- (FeeratePerKw rate1) w
- fee2 = B5.spending_fee
- (FeeratePerKw rate2) w
- in if rate1 <= rate2
- then unSatoshi fee1 <= unSatoshi fee2
- else unSatoshi fee1 >= unSatoshi fee2
-
- , testProperty "classify preserves output count" $
- \(NonNegative n') ->
- let n = min (n' :: Int) 10
- outputs =
- [ TxOutput (Satoshi 50000) toLocalScript
- OutputToLocal
- | _ <- [1..n] ]
- commitTx = CommitmentTx
- { ctx_version = 2
- , ctx_locktime = Locktime 0
- , ctx_input_outpoint = dummyOutPoint
- , ctx_input_sequence = Sequence 0
- , ctx_outputs = outputs
- , ctx_funding_script = dummyDestScript
- }
- outs = B5.classify_local_commit_outputs
- commitTx dummyKeys dummyDelay
- dummyFeatures []
- in length outs == n
-
- , testProperty "spend_to_local always version 2" $
- \(Positive val) ->
- let value = Satoshi
- (fromIntegral (val :: Int) + 100000)
- in case B5.spend_to_local
- dummyOutPoint value
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript (FeeratePerKw 253) of
- Nothing -> False
- Just stx ->
- tx_version (B5.stx_tx stx) == 2
-
- , testProperty "revoked nSequence is 0xFFFFFFFF" $
- \(Positive val) ->
- let value = Satoshi
- (fromIntegral (val :: Int) + 100000)
- in case B5.spend_revoked_to_local
- dummyOutPoint value
- dummyRevocationPubkey dummyDelay
- dummyLocalDelayedPubkey
- dummyDestScript (FeeratePerKw 253) of
- Nothing -> False
- Just stx ->
- let inp = head'
- (tx_inputs (B5.stx_tx stx))
- in txin_sequence inp == 0xFFFFFFFF
-
- , testProperty "htlcOutputType preserves expiry" $
- \expiry ->
+ \r1 r2 ->
+ let w = B5.to_local_penalty_input_weight + B5.penalty_tx_base_weight
+ fee r = B5.spending_fee (FeeratePerKw r) w
+ in fee (min r1 r2) <= fee (max r1 r2)
+
+ , testProperty "spend_to_local always version 2" $ prop_fx $
+ \fx -> forAll (choose (100000, 2100000000000000)) $ \v ->
+ let spent = do
+ value <- BOLT1.satoshi v
+ B5.spend_to_local dummyOutPoint value (fx_revpk fx)
+ dummyDelay (fx_delayed fx) dummyDestScript dummyFeerate
+ in fmap (tx_version . B5.stx_tx) spent === Just 2
+
+ , testProperty "revoked nSequence is 0xFFFFFFFF" $ prop_fx $
+ \fx -> forAll (choose (100000, 2100000000000000)) $ \v ->
+ let spent = do
+ value <- BOLT1.satoshi v
+ B5.spend_revoked_to_local dummyOutPoint value (fx_revpk fx)
+ dummyDelay (fx_delayed fx) dummyDestScript dummyFeerate
+ in fmap in_sequence spent === Just 0xFFFFFFFF
+
+ , testProperty "htlc_output_type preserves direction and expiry" $
+ prop_fx $ \fx expiry ->
let ce = CltvExpiry expiry
- in B5.htlcOutputType (OutputOfferedHTLC ce)
- == Just (B5.HTLCOfferedOutput ce)
- &&
- B5.htlcOutputType (OutputReceivedHTLC ce)
- == Just (B5.HTLCReceivedOutput ce)
-
- , testProperty "htlcOutputType rejects non-HTLC" $
- property $
- B5.htlcOutputType OutputToLocal == Nothing
- && B5.htlcOutputType OutputToRemote == Nothing
- && B5.htlcOutputType OutputLocalAnchor == Nothing
- && B5.htlcOutputType OutputRemoteAnchor
- == Nothing
+ at h = OutputHTLC h { htlc_cltv_expiry = ce }
+ in B5.htlc_output_type (at (fx_offered fx))
+ == Just (B5.HTLCOfferedOutput ce)
+ && B5.htlc_output_type (at (fx_received fx))
+ == Just (B5.HTLCReceivedOutput ce)
, testProperty "revoked_output_weight by type" $
\expiry ->
let ce = CltvExpiry expiry
- roLocal = B5.RevokedOutput
- dummyOutPoint (Satoshi 1000)
- B5.RevokedToLocal
- roOffered = B5.RevokedOutput
- dummyOutPoint (Satoshi 1000)
- (B5.RevokedHTLC
- (B5.HTLCOfferedOutput ce))
- roReceived = B5.RevokedOutput
- dummyOutPoint (Satoshi 1000)
- (B5.RevokedHTLC
- (B5.HTLCReceivedOutput ce))
- weight = B5.revoked_output_weight
- in weight dummyFeatures roLocal
- == B5.to_local_penalty_input_weight
- &&
- weight dummyFeatures roOffered
- == B5.offered_htlc_penalty_input_weight
- &&
- weight dummyFeatures roReceived
- == B5.accepted_htlc_penalty_input_weight
- &&
- weight dummyFeaturesAnchors roLocal
- == B5.to_local_penalty_input_weight
- &&
- weight dummyFeaturesAnchors roOffered
- == B5.offered_htlc_penalty_input_weight_anchors
- &&
- weight dummyFeaturesAnchors roReceived
- == B5.accepted_htlc_penalty_input_weight_anchors
-
+ ro t = case BOLT1.satoshi 1000 of
+ Nothing -> Nothing
+ Just v -> Just (B5.RevokedOutput dummyOutPoint v t)
+ weight fmt t = fmap (B5.revoked_output_weight fmt) (ro t)
+ offered = B5.RevokedHTLC (B5.HTLCOfferedOutput ce)
+ received = B5.RevokedHTLC (B5.HTLCReceivedOutput ce)
+ in weight StaticRemotekey B5.RevokedToLocal
+ == Just B5.to_local_penalty_input_weight
+ && weight StaticRemotekey offered
+ == Just B5.offered_htlc_penalty_input_weight
+ && weight StaticRemotekey received
+ == Just B5.accepted_htlc_penalty_input_weight
+ && weight Anchors B5.RevokedToLocal
+ == Just B5.to_local_penalty_input_weight
+ && weight Anchors offered
+ == Just B5.offered_htlc_penalty_input_weight_anchors
+ && weight Anchors received
+ == Just B5.accepted_htlc_penalty_input_weight_anchors
]
-
--- helpers ------------------------------------------------------------
-
--- | 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
