commit 1709ab3ae333760b07fb2b90354fb9d03d33541e
parent 2fd8129b9ee18680bfb9b61d176286d575c90f55
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 14:53:33 +0400
lib: port to ppad-bolt1 0.1.0 and ppad-tx 0.2.0, redesign the API
Ports to bolt1's abstract types and bounded amounts (with checked
arithmetic) and to ppad-tx 0.2.0. bolt3's Pubkey is merged into
bolt1's Point, wrapped in the role newtypes. Only
Lightning.Protocol.BOLT3 is exposed; types with invariants are
abstract, and every public type has an NFData instance.
- CommitmentFormat (StaticRemotekey | Anchors) replaces
ChannelFeatures.
- build_commitment_tx orders the payment basepoints for the obscured
commitment number by cc_is_funder, so CommitmentContext is
owner-relative throughout, and returns Nothing rather than an
output-less transaction.
- OutputType carries the HTLC an output pays (OutputHTLC); outputs are
CommitmentOutput values, whose field names no longer clash with
ppad-tx's. build_htlc_tx replaces the timeout/success pair and fails
if the fee exceeds the amount.
- Closing: build_legacy_closing_tx applies the signer's dust limit to
both outputs and can omit the signer's own output;
build_closing_tx (option_simple_close) charges the closer, takes an
explicit choice of outputs and gives OP_RETURN outputs amount zero.
- to_remote_script is split into to_remote_witness_script and
to_remote_script_pubkey. Witness functions append the witness script
and take typed keys; funding_witness orders signatures by pubkey.
Adds HTLC transaction input witnesses and remote_htlc_sighash.
- Per-commitment secrets: Seed and SecretIndex types,
PerCommitmentSecret throughout, commitment_secret_index, and an
abstract SecretStore with a redacted Show instance and
secret_store/un_secret_store for persistence.
- Adds derive_commitment_keys, derive_privkey and
derive_revocationprivkey (with constant-time arithmetic modulo the
group order). Key derivation rejects the point at infinity.
- encode_tx becomes encode_commitment_tx; the encoders are documented
as unsigned, witness-free serializations.
- Removes Validate, Decode, Encode and Internal, the role-specific
derivation functions and their wNAF variants (derive_pubkey and the
context variants of derive_per_commitment_point and
derive_commitment_keys remain), encode_tx_for_signing, the witness
encoders, has_anchors, sort_outputs, the trimming filters,
derive_secret, the HTLC output aliases, weight constants and unused
fields.
Diffstat:
10 files changed, 1855 insertions(+), 2672 deletions(-)
diff --git a/lib/Lightning/Protocol/BOLT3.hs b/lib/Lightning/Protocol/BOLT3.hs
@@ -6,176 +6,135 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Bitcoin transaction formats for the Lightning Network, per
--- [BOLT #3](https://github.com/lightning/bolts/blob/master/03-transactions.md).
+-- Bitcoin transaction and script formats for the Lightning Network, per
+-- [BOLT #3](https://github.com/lightning/bolts/blob/master/03-transactions.md)
+-- (commitment, HTLC and closing transactions, their output scripts and
+-- witnesses, per-commitment key derivation, and per-commitment secret
+-- generation and storage).
--
--- = Overview
---
--- This library implements the transaction and script formats defined in
--- BOLT #3, including:
---
--- * Commitment transactions with to_local, to_remote, anchor, and HTLC
--- outputs
--- * HTLC-timeout and HTLC-success second-stage transactions
--- * Closing transactions (legacy and option_simple_close)
--- * Per-commitment key derivation and secret storage
--- * Transaction serialization and parsing
--- * Stateless validation
---
--- = Quick Start
---
--- @
--- import Lightning.Protocol.BOLT3
---
--- -- Build a commitment transaction
--- let ctx = CommitmentContext { ... }
--- tx = build_commitment_tx ctx
---
--- -- Serialize for signing
--- let bytes = encode_tx tx
---
--- -- Validate the transaction
--- case validate_commitment_tx dustLimit features tx of
--- Right () -> putStrLn "Valid"
--- Left err -> print err
--- @
---
--- = Modules
---
--- * "Lightning.Protocol.BOLT3.Types" - Core types (Satoshi, Pubkey, HTLC,
--- etc.)
--- * "Lightning.Protocol.BOLT3.Keys" - Per-commitment key derivation and
--- secret storage
--- * "Lightning.Protocol.BOLT3.Scripts" - Witness script templates (funding,
--- to_local, HTLC, anchor)
--- * "Lightning.Protocol.BOLT3.Tx" - Transaction assembly
--- * "Lightning.Protocol.BOLT3.Encode" - Transaction serialization
--- * "Lightning.Protocol.BOLT3.Decode" - Transaction parsing
--- * "Lightning.Protocol.BOLT3.Validate" - Stateless validation
+-- Amounts, points, hashes and per-commitment secrets are the types of
+-- ppad-bolt1's "Lightning.Protocol.BOLT1"; transactions convert to
+-- ppad-tx's "Bitcoin.Prim.Tx" for txids, sighashes and serialization.
+-- The @option_static_remotekey@ and @option_anchors@ commitment formats
+-- are supported ('CommitmentFormat').
module Lightning.Protocol.BOLT3 (
- -- * Types
- -- ** Monetary amounts
- Satoshi(..)
- , MilliSatoshi(..)
- , msatToSat
- , satToMsat
-
- -- ** Keys and points
- , Pubkey
- , unPubkey
- , pubkey
- , Seckey
- , unSeckey
- , seckey
- , Point
- , unPoint
- , point
-
- -- ** Hashes
- , PaymentHash
- , unPaymentHash
- , paymentHash
- , PaymentPreimage
- , unPaymentPreimage
- , paymentPreimage
+ -- * Commitment transactions
+ CommitmentContext(..)
+ , CommitmentFormat(..)
+ , CommitmentTx(..)
+ , CommitmentOutput(..)
+ , OutputType(..)
+ , build_commitment_tx
- -- ** Transaction primitives
- , TxId(..)
- , mkTxId
- , OutPoint(..)
- , Sequence(..)
- , Locktime(..)
+ -- ** HTLCs
+ , HTLC(..)
+ , HTLCDirection(..)
-- ** Channel parameters
, CommitmentNumber
- , unCommitmentNumber
, commitment_number
+ , un_commitment_number
, next_commitment_number
, ToSelfDelay(..)
, CltvExpiry(..)
, DustLimit(..)
, FeeratePerKw(..)
+ , Locktime(..)
+ , Sequence(..)
- -- ** HTLC types
- , HTLC(..)
- , HTLCDirection(..)
+ -- ** Fees and trimming
+ , commitment_fee
+ , htlc_timeout_fee
+ , htlc_success_fee
+ , htlc_trim_threshold
+ , is_trimmed
+ , anchor_output_value
+
+ -- * HTLC transactions
+ , HTLCContext(..)
+ , HTLCTx(..)
+ , build_htlc_tx
+
+ -- * Closing transactions
+ , ClosingTx(..)
+ , ClosingOutput(..)
+ , ClosingContext(..)
+ , ClosingOutputs(..)
+ , build_closing_tx
+ , LegacyClosingContext(..)
+ , build_legacy_closing_tx
+
+ -- ** Dust thresholds
+ , dust_p2pkh
+ , dust_p2sh
+ , dust_p2wpkh
+ , dust_p2wsh
+
+ -- * Serialization
+ , commitment_to_tx
+ , htlc_to_tx
+ , closing_to_tx
+ , encode_commitment_tx
+ , encode_htlc_tx
+ , encode_closing_tx
- -- ** Basepoints
+ -- * Keys
+ -- ** Basepoints and per-commitment points
, Basepoints(..)
- , PerCommitmentPoint(..)
- , PerCommitmentSecret
- , unPerCommitmentSecret
- , perCommitmentSecret
, RevocationBasepoint(..)
, PaymentBasepoint(..)
, DelayedPaymentBasepoint(..)
, HtlcBasepoint(..)
+ , PerCommitmentPoint(..)
+ , derive_per_commitment_point
+ , derive_per_commitment_point'
- -- ** Derived keys
- , LocalPubkey(..)
- , RemotePubkey(..)
+ -- ** Public keys
+ , CommitmentKeys(..)
+ , derive_commitment_keys
+ , derive_commitment_keys'
+ , RevocationPubkey(..)
, LocalDelayedPubkey(..)
- , RemoteDelayedPubkey(..)
, LocalHtlcPubkey(..)
, RemoteHtlcPubkey(..)
- , RevocationPubkey(..)
+ , RemotePubkey(..)
, FundingPubkey(..)
-
- -- ** Script and witness
- , Script(..)
- , Witness(..)
-
- -- ** Channel features
- , ChannelFeatures(..)
- , has_anchors
-
- -- ** Constants
- , commitment_weight_no_anchors
- , commitment_weight_anchors
- , htlc_timeout_weight_no_anchors
- , htlc_timeout_weight_anchors
- , htlc_success_weight_no_anchors
- , htlc_success_weight_anchors
- , htlc_output_weight
- , dust_p2pkh
- , dust_p2sh
- , dust_p2wpkh
- , dust_p2wsh
- , anchor_output_value
-
- -- * Key derivation
- , derive_per_commitment_point
- , derive_per_commitment_point'
, derive_pubkey
- , derive_pubkey'
- , derive_localpubkey
- , derive_localpubkey'
- , derive_local_htlcpubkey
- , derive_local_htlcpubkey'
- , derive_remote_htlcpubkey
- , derive_remote_htlcpubkey'
- , derive_local_delayedpubkey
- , derive_local_delayedpubkey'
- , derive_remote_delayedpubkey
- , derive_remote_delayedpubkey'
, derive_revocationpubkey
- -- ** Secret generation
+ -- ** Private keys
+ , Seckey
+ , seckey
+ , un_seckey
+ , derive_privkey
+ , derive_revocationprivkey
+
+ -- * Per-commitment secrets
+ , Seed
+ , seed
+ , un_seed
+ , SecretIndex
+ , secret_index
+ , un_secret_index
+ , commitment_secret_index
, generate_from_seed
- , derive_secret
- -- ** Secret storage
- , SecretStore(..)
- , SecretEntry(..)
- , empty_store
+ -- ** Storage
+ , SecretStore
+ , empty_secret_store
, insert_secret
, derive_old_secret
+ , secret_store
+ , un_secret_store
- -- ** Commitment number
+ -- ** Commitment number obscuring
, obscured_commitment_number
- -- * Scripts
+ -- * Scripts and witnesses
+ , Script(..)
+ , to_p2wsh
+
-- ** Funding output
, funding_script
, funding_witness
@@ -186,7 +145,8 @@ module Lightning.Protocol.BOLT3 (
, to_local_witness_revoke
-- ** to_remote output
- , to_remote_script
+ , to_remote_witness_script
+ , to_remote_script_pubkey
, to_remote_witness
-- ** Anchor outputs
@@ -194,105 +154,23 @@ module Lightning.Protocol.BOLT3 (
, anchor_witness_owner
, anchor_witness_anyone
- -- ** Offered HTLC
+ -- ** Offered HTLC outputs
, offered_htlc_script
, offered_htlc_witness_preimage
, offered_htlc_witness_revoke
- -- ** Received HTLC
+ -- ** Received HTLC outputs
, received_htlc_script
, received_htlc_witness_timeout
, received_htlc_witness_revoke
- -- ** HTLC output (same as to_local)
- , htlc_output_script
- , htlc_output_witness_spend
- , htlc_output_witness_revoke
-
- -- ** P2WSH helpers
- , to_p2wsh
- , witness_script_hash
-
- -- * Transaction assembly
- -- ** Commitment transactions
- , CommitmentTx(..)
- , CommitmentContext(..)
- , CommitmentKeys(..)
- , build_commitment_tx
-
- -- ** HTLC transactions
- , HTLCTx(..)
- , HTLCContext(..)
- , build_htlc_timeout_tx
- , build_htlc_success_tx
-
- -- ** Closing transactions
- , ClosingTx(..)
- , ClosingContext(..)
- , build_closing_tx
- , build_legacy_closing_tx
-
- -- ** Transaction outputs
- , TxOutput(..)
- , OutputType(..)
-
- -- ** Fee calculation
- , commitment_fee
- , commitment_weight
- , htlc_timeout_fee
- , htlc_success_fee
-
- -- ** Trimming
- , htlc_trim_threshold
- , is_trimmed
- , trimmed_htlcs
- , untrimmed_htlcs
-
- -- ** Output ordering
- , sort_outputs
-
- -- * Conversion to ppad-tx
- , commitment_to_tx
- , htlc_to_tx
- , closing_to_tx
-
- -- * Serialization
- , encode_tx
- , encode_htlc_tx
- , encode_closing_tx
- , encode_tx_for_signing
- , encode_witness
- , encode_funding_witness
-
- -- * Parsing
- , BT.Tx(..)
- , BT.TxIn(..)
- , BT.TxOut(BT.TxOut)
- , BT.from_bytes
- , decode_tx
-
- -- * Validation
- , ValidationError(..)
- , validate_commitment_tx
- , validate_commitment_locktime
- , validate_commitment_sequence
- , validate_htlc_tx
- , validate_htlc_timeout_tx
- , validate_htlc_success_tx
- , validate_closing_tx
- , validate_legacy_closing_tx
- , validate_output_ordering
- , validate_dust_limits
- , validate_anchor_outputs
- , validate_commitment_fee
- , validate_htlc_fee
+ -- ** HTLC transaction inputs
+ , htlc_success_witness
+ , htlc_timeout_witness
+ , remote_htlc_sighash
) where
-import qualified Bitcoin.Prim.Tx as BT
-import Lightning.Protocol.BOLT3.Types
import Lightning.Protocol.BOLT3.Keys
import Lightning.Protocol.BOLT3.Scripts
import Lightning.Protocol.BOLT3.Tx
-import Lightning.Protocol.BOLT3.Encode
-import Lightning.Protocol.BOLT3.Decode
-import Lightning.Protocol.BOLT3.Validate
+import Lightning.Protocol.BOLT3.Types
diff --git a/lib/Lightning/Protocol/BOLT3/Decode.hs b/lib/Lightning/Protocol/BOLT3/Decode.hs
@@ -1,27 +0,0 @@
-{-# OPTIONS_HADDOCK prune #-}
-
--- |
--- Module: Lightning.Protocol.BOLT3.Decode
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Parsing for BOLT #3 transactions.
---
--- Delegates to ppad-tx for transaction decoding.
-
-module Lightning.Protocol.BOLT3.Decode (
- decode_tx
- ) where
-
-import qualified Bitcoin.Prim.Tx as BT
-import qualified Data.ByteString as BS
-
--- | Decode a raw Bitcoin transaction from bytes.
---
--- Handles both legacy and SegWit transaction formats.
---
--- >>> decode_tx rawTxBytes
--- Just (Tx {...})
-decode_tx :: BS.ByteString -> Maybe BT.Tx
-decode_tx = BT.from_bytes
diff --git a/lib/Lightning/Protocol/BOLT3/Encode.hs b/lib/Lightning/Protocol/BOLT3/Encode.hs
@@ -1,102 +0,0 @@
-{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
-
--- |
--- Module: Lightning.Protocol.BOLT3.Encode
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Serialization for BOLT #3 transactions and scripts.
---
--- Delegates to ppad-tx for transaction encoding.
-
-module Lightning.Protocol.BOLT3.Encode (
- -- * Transaction serialization
- encode_tx
- , encode_htlc_tx
- , encode_closing_tx
- , encode_tx_for_signing
-
- -- * Witness serialization
- , encode_witness
- , encode_funding_witness
- ) where
-
-import qualified Bitcoin.Prim.Tx as BT
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Builder as BSB
-import Data.Word (Word64)
-import Lightning.Protocol.BOLT3.Types
-import Lightning.Protocol.BOLT3.Tx
-
--- transaction encoding --------------------------------------------------------
-
--- | Encode a commitment transaction (SegWit format).
---
--- Returns 'Nothing' if the transaction has no outputs.
-encode_tx :: CommitmentTx -> Maybe BS.ByteString
-encode_tx = fmap BT.to_bytes . commitment_to_tx
-
--- | Encode an HTLC transaction (SegWit format).
-encode_htlc_tx :: HTLCTx -> BS.ByteString
-encode_htlc_tx = BT.to_bytes . htlc_to_tx
-
--- | Encode a closing transaction (SegWit format).
---
--- Returns 'Nothing' if the transaction has no outputs.
-encode_closing_tx :: ClosingTx -> Maybe BS.ByteString
-encode_closing_tx = fmap BT.to_bytes . closing_to_tx
-
--- | Encode a commitment transaction for signing (stripped
--- format, no witness).
---
--- Returns 'Nothing' if the transaction has no outputs.
-encode_tx_for_signing
- :: CommitmentTx -> Maybe BS.ByteString
-encode_tx_for_signing =
- fmap BT.to_bytes_legacy . commitment_to_tx
-
--- witness encoding ------------------------------------------------------------
-
--- | Encode a witness stack.
---
--- Format: varint item count, then for each item:
--- varint length followed by item data.
-encode_witness :: Witness -> BS.ByteString
-encode_witness (Witness !items) =
- BT.to_strict $
- put_varint (fromIntegral (length items))
- <> foldMap put_item items
- where
- put_item :: BS.ByteString -> BSB.Builder
- put_item !bs =
- put_varint (fromIntegral (BS.length bs))
- <> BSB.byteString bs
-
--- | Encode a varint to a 'BSB.Builder'.
-put_varint :: Word64 -> BSB.Builder
-put_varint !n
- | n < 0xFD = BSB.word8 (fromIntegral n)
- | n <= 0xFFFF =
- BSB.word8 0xFD <> BSB.word16LE (fromIntegral n)
- | n <= 0xFFFFFFFF =
- BSB.word8 0xFE <> BSB.word32LE (fromIntegral n)
- | otherwise =
- BSB.word8 0xFF <> BSB.word64LE n
-{-# INLINE put_varint #-}
-
--- | Encode a funding witness (2-of-2 multisig).
---
--- The witness stack is: @0 <sig1> <sig2> <witnessScript>@
---
--- Signatures must be ordered to match pubkey order in the
--- funding script.
-encode_funding_witness
- :: BS.ByteString -- ^ Signature for lesser pubkey
- -> BS.ByteString -- ^ Signature for greater pubkey
- -> Script -- ^ The funding witness script
- -> BS.ByteString
-encode_funding_witness !sig1 !sig2 (Script !ws) =
- encode_witness
- (Witness [BS.empty, sig1, sig2, ws])
diff --git a/lib/Lightning/Protocol/BOLT3/Internal.hs b/lib/Lightning/Protocol/BOLT3/Internal.hs
@@ -1,56 +0,0 @@
-{-# OPTIONS_HADDOCK hide #-}
-
--- |
--- Module: Lightning.Protocol.BOLT3.Internal
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Internal definitions for BOLT #3.
---
--- This module exports unsafe constructors that bypass
--- validation. Use only in tests or trusted internal code.
-
-module Lightning.Protocol.BOLT3.Internal (
- -- * Unsafe constructors (bypass validation)
- unsafePubkey
- , unsafeSeckey
- , unsafeCommitmentNumber
- , unsafeSequence
- , unsafeLocktime
- ) where
-
-import qualified Data.ByteString as BS
-import Data.Word (Word32, Word64)
-import Lightning.Protocol.BOLT3.Types
-
--- | Construct a 'Pubkey' without length validation.
---
--- For test use only.
-unsafePubkey :: BS.ByteString -> Pubkey
-unsafePubkey = Pubkey
-
--- | Construct a 'Seckey' without length validation.
---
--- For test use only.
-unsafeSeckey :: BS.ByteString -> Seckey
-unsafeSeckey = Seckey
-
--- | Construct a 'CommitmentNumber' without range
--- validation.
---
--- For test use only.
-unsafeCommitmentNumber :: Word64 -> CommitmentNumber
-unsafeCommitmentNumber = CommitmentNumber
-
--- | Construct a 'Sequence' directly.
---
--- For test use only.
-unsafeSequence :: Word32 -> Sequence
-unsafeSequence = Sequence
-
--- | Construct a 'Locktime' directly.
---
--- For test use only.
-unsafeLocktime :: Word32 -> Locktime
-unsafeLocktime = Locktime
diff --git a/lib/Lightning/Protocol/BOLT3/Keys.hs b/lib/Lightning/Protocol/BOLT3/Keys.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -8,532 +8,624 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Per-commitment key derivation per BOLT #3.
---
--- Implements key derivation formulas:
---
--- @
--- pubkey = basepoint + SHA256(per_commitment_point || basepoint) * G
--- revocationpubkey = revocation_basepoint * SHA256(revocation_basepoint
--- || per_commitment_point)
--- + per_commitment_point * SHA256(per_commitment_point
--- || revocation_basepoint)
--- @
+-- Key derivation, per-commitment secrets and commitment number
+-- obscuring, per BOLT #3.
module Lightning.Protocol.BOLT3.Keys (
- -- * Per-commitment point derivation
+ -- * Per-commitment points
derive_per_commitment_point
, derive_per_commitment_point'
- -- * Key derivation
+ -- * Public keys
, derive_pubkey
- , derive_pubkey'
- , derive_localpubkey
- , derive_localpubkey'
- , derive_local_htlcpubkey
- , derive_local_htlcpubkey'
- , derive_remote_htlcpubkey
- , derive_remote_htlcpubkey'
- , derive_local_delayedpubkey
- , derive_local_delayedpubkey'
- , derive_remote_delayedpubkey
- , derive_remote_delayedpubkey'
-
- -- * Revocation key derivation
, derive_revocationpubkey
+ , CommitmentKeys(..)
+ , derive_commitment_keys
+ , derive_commitment_keys'
- -- * Per-commitment secret generation
- , generate_from_seed
- , derive_secret
+ -- * Private keys
+ , derive_privkey
+ , derive_revocationprivkey
- -- * Per-commitment secret storage
- , SecretStore(..)
- , SecretEntry(..)
- , empty_store
+ -- * Per-commitment secrets
+ , generate_from_seed
+ , SecretStore
+ , empty_secret_store
, insert_secret
, derive_old_secret
+ , secret_store
+ , un_secret_store
-- * Commitment number obscuring
, obscured_commitment_number
) where
-import Data.Bits ((.&.), xor, shiftL, testBit, complementBit)
+import Control.DeepSeq (NFData(..))
+import qualified Crypto.Curve.Secp256k1 as S
+import qualified Crypto.Hash.SHA256 as SHA256
+import Data.Bits ((.&.), (.|.), complement, complementBit, shiftL, shiftR,
+ testBit, xor)
import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as BSB
+import qualified Data.ByteString.Lazy as BSL
+import qualified Data.ByteString.Unsafe as BU
import Data.Word (Word64)
import GHC.Generics (Generic)
-import qualified Crypto.Curve.Secp256k1 as S
-import qualified Crypto.Hash.SHA256 as SHA256
+import Lightning.Protocol.BOLT1 (Point, PerCommitmentSecret)
+import qualified Lightning.Protocol.BOLT1 as BOLT1
import Lightning.Protocol.BOLT3.Types
--- Per-commitment point derivation ----------------------------------------
+-- points ---------------------------------------------------------------------
+
+-- Serialize a secp256k1 point, failing on the point at infinity.
+to_point :: S.Projective -> Maybe Point
+to_point p
+ | p == S._CURVE_ZERO = Nothing
+ | otherwise = case BOLT1.point (S.serialize_point p) of
+ Just pt -> Just pt
+ Nothing -> internal_error
+{-# INLINE to_point #-}
+
+-- per-commitment points ------------------------------------------------------
--- | Derive the per-commitment point from a per-commitment secret.
+-- | Derive the per-commitment point from a per-commitment secret:
--
--- @per_commitment_point = per_commitment_secret * G@
+-- @per_commitment_point = per_commitment_secret * G@
--
--- >>> let secret = PerCommitmentSecret (BS.replicate 32 0x01)
--- >>> derive_per_commitment_point secret
--- Just (PerCommitmentPoint ...)
+-- Fails if the secret is not a valid secp256k1 secret key.
+--
+-- >>> let Just s = BOLT1.per_commitment_secret (BS.pack [31, 30 .. 0])
+-- >>> let Just (PerCommitmentPoint p) = derive_per_commitment_point s
+-- >>> B16.encode (BOLT1.un_point p)
+-- "025f7117a78150fe2ef97db7cfc83bd57b2e2c0d0dd25eaf467a4a1c2a45ce1486"
derive_per_commitment_point
:: PerCommitmentSecret
-> Maybe PerCommitmentPoint
-derive_per_commitment_point (PerCommitmentSecret sec) = do
- sk <- S.parse_int256 sec
+derive_per_commitment_point s = do
+ sk <- S.parse_int256 (BOLT1.un_per_commitment_secret s)
pk <- S.derive_pub sk
- let !bs = S.serialize_point pk
- pure $! PerCommitmentPoint (Point bs)
-{-# INLINE derive_per_commitment_point #-}
+ PerCommitmentPoint <$> to_point pk
--- | As 'derive_per_commitment_point', but takes a precomputed
--- secp256k1 'S.Context' so the @G@-base scalar mult uses wNAF.
--- Caller threads a single context across many calls.
---
--- >>> let !tex = S.precompute
--- >>> derive_per_commitment_point' tex secret
--- Just (PerCommitmentPoint ...)
+-- | As 'derive_per_commitment_point', but uses a precomputed
+-- 'S.Context' to speed up the scalar multiplication.
derive_per_commitment_point'
:: S.Context
-> PerCommitmentSecret
-> Maybe PerCommitmentPoint
-derive_per_commitment_point' tex (PerCommitmentSecret sec) = do
- sk <- S.parse_int256 sec
+derive_per_commitment_point' tex s = do
+ sk <- S.parse_int256 (BOLT1.un_per_commitment_secret s)
pk <- S.derive_pub' tex sk
- let !bs = S.serialize_point pk
- pure $! PerCommitmentPoint (Point bs)
-{-# INLINE derive_per_commitment_point' #-}
+ PerCommitmentPoint <$> to_point pk
--- Key derivation ---------------------------------------------------------
+-- public keys ----------------------------------------------------------------
--- | Derive a pubkey from a basepoint and per-commitment point.
---
--- @pubkey = basepoint + SHA256(per_commitment_point || basepoint) * G@
+-- | Derive a per-commitment public key from a basepoint:
--
--- This is the general derivation formula used for localpubkey,
--- local_htlcpubkey, remote_htlcpubkey, local_delayedpubkey, and
--- remote_delayedpubkey.
+-- @pubkey = basepoint + SHA256(per_commitment_point || basepoint) * G@
--
--- >>> derive_pubkey basepoint per_commitment_point
--- Just (Pubkey ...)
-derive_pubkey
- :: Point -- ^ basepoint
- -> PerCommitmentPoint -- ^ per_commitment_point
- -> Maybe Pubkey
-derive_pubkey (Point basepointBs) (PerCommitmentPoint (Point pcpBs)) = do
- basepoint <- S.parse_point basepointBs
- -- SHA256(per_commitment_point || basepoint)
- let !h = SHA256.hash (pcpBs <> basepointBs)
- -- Treat hash as scalar and multiply by G
- tweak <- S.parse_int256 h
- tweakPoint <- S.derive_pub tweak
- -- Add basepoint + tweak*G
- let !result = S.add basepoint tweakPoint
- !bs = S.serialize_point result
- pure $! Pubkey bs
-{-# INLINE derive_pubkey #-}
-
--- | As 'derive_pubkey', but takes a precomputed secp256k1
--- 'S.Context'. The @tweak * G@ multiplication uses wNAF; this is
--- the highest-leverage variant since 'derive_pubkey' fires five
--- times per commitment-key derivation.
+-- This gives @local_htlcpubkey@, @remote_htlcpubkey@,
+-- @local_delayedpubkey@ and the like, depending on the basepoint;
+-- 'derive_commitment_keys' derives all of a commitment's keys at
+-- once.
--
--- >>> let !tex = S.precompute
--- >>> derive_pubkey' tex basepoint per_commitment_point
--- Just (Pubkey ...)
-derive_pubkey'
- :: S.Context
- -> Point -- ^ basepoint
- -> PerCommitmentPoint -- ^ per_commitment_point
- -> Maybe Pubkey
-derive_pubkey'
- tex
- (Point basepointBs)
- (PerCommitmentPoint (Point pcpBs)) = do
- basepoint <- S.parse_point basepointBs
- let !h = SHA256.hash (pcpBs <> basepointBs)
- tweak <- S.parse_int256 h
- tweakPoint <- S.derive_pub' tex tweak
- let !result = S.add basepoint tweakPoint
- !bs = S.serialize_point result
- pure $! Pubkey bs
-{-# INLINE derive_pubkey' #-}
-
--- | Derive localpubkey from payment_basepoint and per_commitment_point.
+-- Fails if the basepoint is not on the curve.
--
--- >>> derive_localpubkey payment_basepoint per_commitment_point
--- Just (LocalPubkey ...)
-derive_localpubkey
- :: PaymentBasepoint
- -> PerCommitmentPoint
- -> Maybe LocalPubkey
-derive_localpubkey (PaymentBasepoint pt) pcp =
- LocalPubkey <$> derive_pubkey pt pcp
-{-# INLINE derive_localpubkey #-}
-
--- | As 'derive_localpubkey', but uses 'derive_pubkey'' internally
--- (wNAF-accelerated).
-derive_localpubkey'
- :: S.Context
- -> PaymentBasepoint
- -> PerCommitmentPoint
- -> Maybe LocalPubkey
-derive_localpubkey' tex (PaymentBasepoint pt) pcp =
- LocalPubkey <$> derive_pubkey' tex pt pcp
-{-# INLINE derive_localpubkey' #-}
-
--- | Derive local_htlcpubkey from htlc_basepoint and per_commitment_point.
---
--- >>> derive_local_htlcpubkey htlc_basepoint per_commitment_point
--- Just (LocalHtlcPubkey ...)
-derive_local_htlcpubkey
- :: HtlcBasepoint
- -> PerCommitmentPoint
- -> Maybe LocalHtlcPubkey
-derive_local_htlcpubkey (HtlcBasepoint pt) pcp =
- LocalHtlcPubkey <$> derive_pubkey pt pcp
-{-# INLINE derive_local_htlcpubkey #-}
-
--- | As 'derive_local_htlcpubkey', wNAF variant.
-derive_local_htlcpubkey'
- :: S.Context
- -> HtlcBasepoint
- -> PerCommitmentPoint
- -> Maybe LocalHtlcPubkey
-derive_local_htlcpubkey' tex (HtlcBasepoint pt) pcp =
- LocalHtlcPubkey <$> derive_pubkey' tex pt pcp
-{-# INLINE derive_local_htlcpubkey' #-}
-
--- | Derive remote_htlcpubkey from htlc_basepoint and per_commitment_point.
---
--- >>> derive_remote_htlcpubkey htlc_basepoint per_commitment_point
--- Just (RemoteHtlcPubkey ...)
-derive_remote_htlcpubkey
- :: HtlcBasepoint
- -> PerCommitmentPoint
- -> Maybe RemoteHtlcPubkey
-derive_remote_htlcpubkey (HtlcBasepoint pt) pcp =
- RemoteHtlcPubkey <$> derive_pubkey pt pcp
-{-# INLINE derive_remote_htlcpubkey #-}
-
--- | As 'derive_remote_htlcpubkey', wNAF variant.
-derive_remote_htlcpubkey'
- :: S.Context
- -> HtlcBasepoint
- -> PerCommitmentPoint
- -> Maybe RemoteHtlcPubkey
-derive_remote_htlcpubkey' tex (HtlcBasepoint pt) pcp =
- RemoteHtlcPubkey <$> derive_pubkey' tex pt pcp
-{-# INLINE derive_remote_htlcpubkey' #-}
+-- >>> let Just s = BOLT1.per_commitment_secret (BS.pack [31, 30 .. 0])
+-- >>> let Just pcp = derive_per_commitment_point s
+-- >>> let Just b = BOLT1.per_commitment_secret (BS.pack [0 .. 31])
+-- >>> let Just (PerCommitmentPoint bp) = derive_per_commitment_point b
+-- >>> fmap (B16.encode . BOLT1.un_point) (derive_pubkey bp pcp)
+-- Just "0235f2dbfaa89b57ec7b055afe29849ef7ddfeb1cefdb9ebdc43f5494984db29e5"
+derive_pubkey :: Point -> PerCommitmentPoint -> Maybe Point
+derive_pubkey = derive_pubkey_with mul_g
+{-# INLINE derive_pubkey #-}
--- | Derive local_delayedpubkey from delayed_payment_basepoint and
--- per_commitment_point.
---
--- >>> derive_local_delayedpubkey delayed_payment_basepoint per_commitment_point
--- Just (LocalDelayedPubkey ...)
-derive_local_delayedpubkey
- :: DelayedPaymentBasepoint
- -> PerCommitmentPoint
- -> Maybe LocalDelayedPubkey
-derive_local_delayedpubkey (DelayedPaymentBasepoint pt) pcp =
- LocalDelayedPubkey <$> derive_pubkey pt pcp
-{-# INLINE derive_local_delayedpubkey #-}
+-- Multiply the generator by a 32-byte scalar.
+mul_g :: BS.ByteString -> Maybe S.Projective
+mul_g bs = S.derive_pub =<< S.parse_int256 bs
+{-# INLINE mul_g #-}
--- | As 'derive_local_delayedpubkey', wNAF variant.
-derive_local_delayedpubkey'
- :: S.Context
- -> DelayedPaymentBasepoint
- -> PerCommitmentPoint
- -> Maybe LocalDelayedPubkey
-derive_local_delayedpubkey' tex (DelayedPaymentBasepoint pt) pcp =
- LocalDelayedPubkey <$> derive_pubkey' tex pt pcp
-{-# INLINE derive_local_delayedpubkey' #-}
-
--- | Derive remote_delayedpubkey from delayed_payment_basepoint and
--- per_commitment_point.
---
--- >>> derive_remote_delayedpubkey delayed_payment_basepoint pcp
--- Just (RemoteDelayedPubkey ...)
-derive_remote_delayedpubkey
- :: DelayedPaymentBasepoint
- -> PerCommitmentPoint
- -> Maybe RemoteDelayedPubkey
-derive_remote_delayedpubkey (DelayedPaymentBasepoint pt) pcp =
- RemoteDelayedPubkey <$> derive_pubkey pt pcp
-{-# INLINE derive_remote_delayedpubkey #-}
+-- As 'mul_g', using a precomputed context.
+mul_g' :: S.Context -> BS.ByteString -> Maybe S.Projective
+mul_g' tex bs = S.derive_pub' tex =<< S.parse_int256 bs
+{-# INLINE mul_g' #-}
--- | As 'derive_remote_delayedpubkey', wNAF variant.
-derive_remote_delayedpubkey'
- :: S.Context
- -> DelayedPaymentBasepoint
+derive_pubkey_with
+ :: (BS.ByteString -> Maybe S.Projective)
+ -> Point
-> PerCommitmentPoint
- -> Maybe RemoteDelayedPubkey
-derive_remote_delayedpubkey' tex (DelayedPaymentBasepoint pt) pcp =
- RemoteDelayedPubkey <$> derive_pubkey' tex pt pcp
-{-# INLINE derive_remote_delayedpubkey' #-}
-
--- Revocation key derivation ----------------------------------------------
-
--- Note: no @derive_revocationpubkey'@ is provided. The two scalar
--- mults inside this function are general (basepoint * scalar, not
--- @G * scalar@), so the wNAF table built by 'S.precompute' — which
--- stores multiples of the generator — doesn't apply.
-
--- | Derive revocationpubkey from revocation_basepoint and
--- per_commitment_point.
---
--- @
--- revocationpubkey = revocation_basepoint
--- * SHA256(revocation_basepoint || per_commitment_point)
--- + per_commitment_point
--- * SHA256(per_commitment_point || revocation_basepoint)
--- @
---
--- >>> derive_revocationpubkey revocation_basepoint per_commitment_point
--- Just (RevocationPubkey ...)
+ -> Maybe Point
+derive_pubkey_with mul bp (PerCommitmentPoint pcp) = do
+ let !bp_bs = BOLT1.un_point bp
+ base <- S.parse_point bp_bs
+ t <- mul (SHA256.hash (BOLT1.un_point pcp <> bp_bs))
+ to_point (S.add base t)
+{-# INLINE derive_pubkey_with #-}
+
+-- | Derive a commitment's @revocationpubkey@ from the revocation
+-- basepoint of the party that will hold the revocation key, and the
+-- commitment owner's per-commitment point:
+--
+-- @
+-- revocationpubkey =
+-- revocation_basepoint
+-- * SHA256(revocation_basepoint || per_commitment_point)
+-- + per_commitment_point
+-- * SHA256(per_commitment_point || revocation_basepoint)
+-- @
+--
+-- Fails if either point is not on the curve.
+--
+-- >>> let Just s = BOLT1.per_commitment_secret (BS.pack [31, 30 .. 0])
+-- >>> let Just pcp = derive_per_commitment_point s
+-- >>> let Just b = BOLT1.per_commitment_secret (BS.pack [0 .. 31])
+-- >>> let Just (PerCommitmentPoint p) = derive_per_commitment_point b
+-- >>> let Just r = derive_revocationpubkey (RevocationBasepoint p) pcp
+-- >>> (\(RevocationPubkey k) -> B16.encode (BOLT1.un_point k)) r
+-- "02916e326636d19c33f13e8c0c3a03dd157f332f3e99c317c141dd865eb01f8ff0"
derive_revocationpubkey
:: RevocationBasepoint
-> PerCommitmentPoint
-> Maybe RevocationPubkey
derive_revocationpubkey
- (RevocationBasepoint (Point rbpBs))
- (PerCommitmentPoint (Point pcpBs)) = do
- rbp <- S.parse_point rbpBs
- pcp <- S.parse_point pcpBs
- -- SHA256(revocation_basepoint || per_commitment_point)
- let !h1 = SHA256.hash (rbpBs <> pcpBs)
- -- SHA256(per_commitment_point || revocation_basepoint)
- let !h2 = SHA256.hash (pcpBs <> rbpBs)
- -- Multiply points by their respective scalars
- s1 <- S.parse_int256 h1
- s2 <- S.parse_int256 h2
- p1 <- S.mul rbp s1 -- revocation_basepoint * h1
- p2 <- S.mul pcp s2 -- per_commitment_point * h2
- -- Add the two points
- let !result = S.add p1 p2
- !bs = S.serialize_point result
- pure $! RevocationPubkey (Pubkey bs)
-{-# INLINE derive_revocationpubkey #-}
-
--- Per-commitment secret generation ---------------------------------------
-
--- | Generate the I'th per-commitment secret from a seed.
---
--- Implements the generate_from_seed algorithm from BOLT #3:
---
--- @
--- generate_from_seed(seed, I):
--- P = seed
--- for B in 47 down to 0:
--- if B set in I:
--- flip(B) in P
--- P = SHA256(P)
--- return P
--- @
---
--- >>> generate_from_seed seed 281474976710655
--- <32-byte secret>
-generate_from_seed
- :: BS.ByteString -- ^ seed (32 bytes)
- -> Word64 -- ^ index I (max 2^48 - 1)
- -> BS.ByteString -- ^ per-commitment secret (32 bytes)
-generate_from_seed seed idx = go 47 seed where
- go :: Int -> BS.ByteString -> BS.ByteString
- go !b !p
- | b < 0 = p
- | testBit idx b =
- let !p' = flip_bit b p
- !p'' = SHA256.hash p'
- in go (b - 1) p''
- | otherwise = go (b - 1) p
-{-# INLINE generate_from_seed #-}
-
--- | Derive a secret from a base secret.
---
--- This is a generalization of generate_from_seed used for efficient
--- secret storage. Given a base secret whose index has bits..47 the same
--- as target index I, derive the I'th secret.
---
--- @
--- derive_secret(base, bits, I):
--- P = base
--- for B in bits - 1 down to 0:
--- if B set in I:
--- flip(B) in P
--- P = SHA256(P)
--- return P
--- @
-derive_secret
- :: BS.ByteString -- ^ base secret
- -> Int -- ^ bits (number of trailing bits to process)
- -> Word64 -- ^ target index I
- -> BS.ByteString -- ^ derived secret
-derive_secret base bits idx = go (bits - 1) base where
- go :: Int -> BS.ByteString -> BS.ByteString
- go !b !p
- | b < 0 = p
- | testBit idx b =
- let !p' = flip_bit b p
- !p'' = SHA256.hash p'
- in go (b - 1) p''
- | otherwise = go (b - 1) p
-{-# INLINE derive_secret #-}
-
--- | Flip bit B in a 32-byte bytestring.
---
--- "flip(B)" alternates the (B mod 8) bit of the (B div 8) byte.
+ (RevocationBasepoint rbp)
+ (PerCommitmentPoint pcp) = do
+ let !rbp_bs = BOLT1.un_point rbp
+ !pcp_bs = BOLT1.un_point pcp
+ r <- S.parse_point rbp_bs
+ p <- S.parse_point pcp_bs
+ s1 <- S.parse_int256 (SHA256.hash (rbp_bs <> pcp_bs))
+ s2 <- S.parse_int256 (SHA256.hash (pcp_bs <> rbp_bs))
+ p1 <- S.mul r s1
+ p2 <- S.mul p s2
+ RevocationPubkey <$> to_point (S.add p1 p2)
+
+-- | The keys a commitment transaction's scripts use.
+data CommitmentKeys = CommitmentKeys
+ { ck_revocation_pubkey :: !RevocationPubkey
+ , ck_local_delayed :: !LocalDelayedPubkey
+ , ck_local_htlc :: !LocalHtlcPubkey
+ , ck_remote_htlc :: !RemoteHtlcPubkey
+ , ck_remote_payment :: !RemotePubkey
+ , ck_local_funding :: !FundingPubkey
+ , ck_remote_funding :: !FundingPubkey
+ } deriving (Eq, Show, Generic)
+
+instance NFData CommitmentKeys
+
+-- | Derive the keys for a commitment transaction from both parties'
+-- basepoints and funding pubkeys, and the commitment owner's
+-- per-commitment point.
+--
+-- The owner is the "local" party: its delayed and HTLC basepoints
+-- give @local_delayedpubkey@ and @local_htlcpubkey@, while the other
+-- party's revocation and HTLC basepoints give @revocationpubkey@ and
+-- @remote_htlcpubkey@. As every supported 'CommitmentFormat' uses
+-- @option_static_remotekey@, @remotepubkey@ is the other party's
+-- @payment_basepoint@.
+--
+-- Fails if a basepoint it derives a key from, or the per-commitment
+-- point, is not on the curve.
+derive_commitment_keys
+ :: Basepoints -- ^ the owner's basepoints
+ -> FundingPubkey -- ^ the owner's funding pubkey
+ -> Basepoints -- ^ the other party's basepoints
+ -> FundingPubkey -- ^ the other party's funding pubkey
+ -> PerCommitmentPoint -- ^ the owner's per-commitment point
+ -> Maybe CommitmentKeys
+derive_commitment_keys = derive_commitment_keys_with mul_g
+
+-- | As 'derive_commitment_keys', but uses a precomputed 'S.Context'
+-- to speed up the scalar multiplications.
+derive_commitment_keys'
+ :: S.Context
+ -> Basepoints
+ -> FundingPubkey
+ -> Basepoints
+ -> FundingPubkey
+ -> PerCommitmentPoint
+ -> Maybe CommitmentKeys
+derive_commitment_keys' tex = derive_commitment_keys_with (mul_g' tex)
+
+derive_commitment_keys_with
+ :: (BS.ByteString -> Maybe S.Projective)
+ -> Basepoints
+ -> FundingPubkey
+ -> Basepoints
+ -> FundingPubkey
+ -> PerCommitmentPoint
+ -> Maybe CommitmentKeys
+derive_commitment_keys_with mul local local_fund remote remote_fund pcp = do
+ let DelayedPaymentBasepoint local_delayed_bp = bp_delayed_payment local
+ HtlcBasepoint local_htlc_bp = bp_htlc local
+ HtlcBasepoint remote_htlc_bp = bp_htlc remote
+ PaymentBasepoint remote_payment_bp = bp_payment remote
+ revocation <- derive_revocationpubkey (bp_revocation remote) pcp
+ delayed <- derive_pubkey_with mul local_delayed_bp pcp
+ local_htlc <- derive_pubkey_with mul local_htlc_bp pcp
+ remote_htlc <- derive_pubkey_with mul remote_htlc_bp pcp
+ pure CommitmentKeys
+ { ck_revocation_pubkey = revocation
+ , ck_local_delayed = LocalDelayedPubkey delayed
+ , ck_local_htlc = LocalHtlcPubkey local_htlc
+ , ck_remote_htlc = RemoteHtlcPubkey remote_htlc
+ , ck_remote_payment = RemotePubkey remote_payment_bp
+ , ck_local_funding = local_fund
+ , ck_remote_funding = remote_fund
+ }
+
+-- private keys ---------------------------------------------------------------
+
+-- | Derive the private key for a per-commitment public key from its
+-- basepoint secret:
+--
+-- @privkey = basepoint_secret + SHA256(per_commitment_point || basepoint)@
+--
+-- where @basepoint = basepoint_secret * G@. The result is the secret
+-- key for @'derive_pubkey' basepoint per_commitment_point@.
+--
+-- The arithmetic on the secret is constant-time. Fails (with
+-- negligible probability) if the result is zero.
+--
+-- >>> let Just s = BOLT1.per_commitment_secret (BS.pack [31, 30 .. 0])
+-- >>> let Just pcp = derive_per_commitment_point s
+-- >>> let Just k = seckey (BS.pack [0 .. 31])
+-- >>> fmap (B16.encode . un_seckey) (derive_privkey k pcp)
+-- Just "cbced912d3b21bf196a766651e436aff192362621ce317704ea2f75d87e7be0f"
+derive_privkey :: Seckey -> PerCommitmentPoint -> Maybe Seckey
+derive_privkey (Seckey sk_bs) (PerCommitmentPoint pcp) = do
+ sk <- S.parse_int256 sk_bs
+ bp <- to_point =<< S.derive_pub sk
+ let !h = SHA256.hash (BOLT1.un_point pcp <> BOLT1.un_point bp)
+ !r = add_mod_n (w4 sk_bs) (reduce_n (w4 h))
+ to_seckey r
+
+-- | Derive a commitment's @revocationprivkey@ from the revocation
+-- basepoint secret and the commitment's (revealed) per-commitment
+-- secret:
+--
+-- @
+-- revocationprivkey =
+-- revocation_basepoint_secret
+-- * SHA256(revocation_basepoint || per_commitment_point)
+-- + per_commitment_secret
+-- * SHA256(per_commitment_point || revocation_basepoint)
+-- @
+--
+-- The result is the secret key for the 'derive_revocationpubkey'
+-- of the corresponding points.
+--
+-- The arithmetic on the secrets is constant-time. Fails if the
+-- per-commitment secret is not a valid secret key, or (with
+-- negligible probability) if the result is zero.
+--
+-- >>> let Just s = BOLT1.per_commitment_secret (BS.pack [31, 30 .. 0])
+-- >>> let Just k = seckey (BS.pack [0 .. 31])
+-- >>> fmap (B16.encode . un_seckey) (derive_revocationprivkey k s)
+-- Just "d09ffff62ddb2297ab000cc85bcb4283fdeb6aa052affbc9dddcf33b61078110"
+derive_revocationprivkey
+ :: Seckey -- ^ revocation basepoint secret
+ -> PerCommitmentSecret -- ^ per-commitment secret
+ -> Maybe Seckey
+derive_revocationprivkey (Seckey rbs_bs) pcs = do
+ let !pcs_bs = BOLT1.un_per_commitment_secret pcs
+ rbs <- S.parse_int256 rbs_bs
+ ps <- S.parse_int256 pcs_bs
+ rbp <- to_point =<< S.derive_pub rbs
+ pcp <- to_point =<< S.derive_pub ps
+ let !rbp_bs = BOLT1.un_point rbp
+ !pcp_bs = BOLT1.un_point pcp
+ !h1 = reduce_n (w4 (SHA256.hash (rbp_bs <> pcp_bs)))
+ !h2 = reduce_n (w4 (SHA256.hash (pcp_bs <> rbp_bs)))
+ !r = add_mod_n (mul_mod_n (w4 rbs_bs) h1) (mul_mod_n (w4 pcs_bs) h2)
+ to_seckey r
+
+-- constant-time arithmetic modulo the secp256k1 group order ------------------
+
+-- A 256-bit integer as four 64-bit limbs, least significant first.
+data W4 = W4
+ {-# UNPACK #-} !Word64
+ {-# UNPACK #-} !Word64
+ {-# UNPACK #-} !Word64
+ {-# UNPACK #-} !Word64
+
+-- The secp256k1 group order n.
+_N :: W4
+_N = W4 0xBFD25E8CD0364141 0xBAAEDCE6AF48A03B
+ 0xFFFFFFFFFFFFFFFE 0xFFFFFFFFFFFFFFFF
+
+-- Read 32 big-endian bytes (the length is checked by the caller).
+w4 :: BS.ByteString -> W4
+w4 bs = W4 (limb 24) (limb 16) (limb 8) (limb 0) where
+ limb :: Int -> Word64
+ limb o = go 0 0 where
+ go !acc !i
+ | i == 8 = acc
+ | otherwise =
+ go ((acc `shiftL` 8) .|. fromIntegral (BU.unsafeIndex bs (o + i)))
+ (i + 1)
+
+-- Write 32 big-endian bytes.
+unw4 :: W4 -> BS.ByteString
+unw4 (W4 a b c d) = BSL.toStrict . BSB.toLazyByteString $
+ BSB.word64BE d <> BSB.word64BE c <> BSB.word64BE b <> BSB.word64BE a
+
+-- A valid secret key from a result in [0, n), failing on zero.
+to_seckey :: W4 -> Maybe Seckey
+to_seckey r@(W4 a b c d)
+ | (a .|. b .|. c .|. d) == 0 = Nothing
+ | otherwise = Just (Seckey (unw4 r))
+
+-- a + b + c, for a carry c in {0, 1}; returns the sum and carry out.
+adc :: Word64 -> Word64 -> Word64 -> (Word64, Word64)
+adc a b c =
+ let !s = a + b + c
+ !o = ((a .&. b) .|. ((a .|. b) .&. complement s)) `shiftR` 63
+ in (s, o)
+{-# INLINE adc #-}
+
+-- a - b - c, for a borrow c in {0, 1}; returns the difference and
+-- borrow out.
+sbb :: Word64 -> Word64 -> Word64 -> (Word64, Word64)
+sbb a b c =
+ let !s = a - b - c
+ !o = ((complement a .&. b) .|. (complement (a `xor` b) .&. s))
+ `shiftR` 63
+ in (s, o)
+{-# INLINE sbb #-}
+
+add4 :: W4 -> W4 -> (W4, Word64)
+add4 (W4 a0 a1 a2 a3) (W4 b0 b1 b2 b3) =
+ let !(s0, c0) = adc a0 b0 0
+ !(s1, c1) = adc a1 b1 c0
+ !(s2, c2) = adc a2 b2 c1
+ !(s3, c3) = adc a3 b3 c2
+ in (W4 s0 s1 s2 s3, c3)
+{-# INLINE add4 #-}
+
+sub4 :: W4 -> W4 -> (W4, Word64)
+sub4 (W4 a0 a1 a2 a3) (W4 b0 b1 b2 b3) =
+ let !(s0, c0) = sbb a0 b0 0
+ !(s1, c1) = sbb a1 b1 c0
+ !(s2, c2) = sbb a2 b2 c1
+ !(s3, c3) = sbb a3 b3 c2
+ in (W4 s0 s1 s2 s3, c3)
+{-# INLINE sub4 #-}
+
+-- x if the bit is 1, y if it is 0.
+select :: Word64 -> W4 -> W4 -> W4
+select bit (W4 x0 x1 x2 x3) (W4 y0 y1 y2 y3) =
+ let !m = negate bit
+ f x y = (x .&. m) .|. (y .&. complement m)
+ in W4 (f x0 y0) (f x1 y1) (f x2 y2) (f x3 y3)
+{-# INLINE select #-}
+
+-- x mod n, for any 256-bit x (one subtraction suffices, as 2^256 < 2n).
+reduce_n :: W4 -> W4
+reduce_n x =
+ let !(t, borrow) = sub4 x _N
+ in select borrow x t
+
+-- a + b mod n, for a, b < n.
+add_mod_n :: W4 -> W4 -> W4
+add_mod_n a b =
+ let !(s, carry) = add4 a b
+ !(t, borrow) = sub4 s _N
+ in select (carry .|. (borrow `xor` 1)) t s
+
+-- a * b mod n, for a, b < n, by double-and-add over all 256 bits of b.
+mul_mod_n :: W4 -> W4 -> W4
+mul_mod_n a (W4 b0 b1 b2 b3) = go (255 :: Int) (W4 0 0 0 0) where
+ go !i !acc
+ | i < 0 = acc
+ | otherwise =
+ let !d = add_mod_n acc acc
+ !bit = (limb (i `shiftR` 6) `shiftR` (i .&. 63)) .&. 1
+ in go (i - 1) (select bit (add_mod_n d a) d)
+ limb :: Int -> Word64
+ limb j = case j of
+ 0 -> b0
+ 1 -> b1
+ 2 -> b2
+ _ -> b3
+
+-- per-commitment secrets -----------------------------------------------------
+
+-- Wrap a 32-byte value as a per-commitment secret.
+to_secret :: BS.ByteString -> PerCommitmentSecret
+to_secret bs = case BOLT1.per_commitment_secret bs of
+ Just s -> s
+ Nothing -> internal_error
+{-# INLINE to_secret #-}
+
+-- Flip bit b (< 256) of a 32-byte value: the (b mod 8) bit of the
+-- (b div 8) byte.
flip_bit :: Int -> BS.ByteString -> BS.ByteString
flip_bit b bs =
- let !byteIdx = b `div` 8
- !bitIdx = b `mod` 8
- !len = BS.length bs
- in if byteIdx >= len
- then bs
- else
- let !prefix = BS.take byteIdx bs
- !byte = BS.index bs byteIdx
- !byte' = complementBit byte bitIdx
- !suffix = BS.drop (byteIdx + 1) bs
- in prefix <> BS.singleton byte' <> suffix
+ let !(pre, post) = BS.splitAt (b `shiftR` 3) bs
+ in case BS.uncons post of
+ Just (h, t) -> pre <> BS.cons (complementBit h (b .&. 7)) t
+ Nothing -> bs
{-# INLINE flip_bit #-}
--- Per-commitment secret storage ------------------------------------------
-
--- | Entry in the secret store: (bucket, index, secret).
-data SecretEntry = SecretEntry
- { se_bucket :: {-# UNPACK #-} !Int
- , se_index :: {-# UNPACK #-} !Word64
- , se_secret :: !BS.ByteString
- } deriving (Eq, Show, Generic)
-
--- | Compact storage for per-commitment secrets.
---
--- Stores up to 49 (value, index) pairs, allowing efficient derivation
--- of any previously-received secret. This is possible because for a
--- given secret on a 2^X boundary, all secrets up to the next 2^X
--- boundary can be derived from it.
-newtype SecretStore = SecretStore { unSecretStore :: [SecretEntry] }
- deriving (Eq, Show, Generic)
-
--- | Empty secret store.
-empty_store :: SecretStore
-empty_store = SecretStore []
-{-# INLINE empty_store #-}
-
--- | Determine which bucket to store a secret in based on its index.
---
--- Counts trailing zeros in the index. Returns 0-47 for normal indices,
--- or 48 if index is 0 (the seed).
-where_to_put_secret :: Word64 -> Int
-where_to_put_secret idx = go 0 where
+-- The spec's derive_secret: the secret for index i, from a base
+-- secret whose index agrees with i in bits 47 down to 'bits'.
+derive_secret :: BS.ByteString -> Int -> Word64 -> BS.ByteString
+derive_secret base bits i = go (bits - 1) base where
+ go !b !p
+ | b < 0 = p
+ | testBit i b = go (b - 1) (SHA256.hash (flip_bit b p))
+ | otherwise = go (b - 1) p
+
+-- | Generate the per-commitment secret with a given index from a seed,
+-- per BOLT #3's @generate_from_seed@.
+--
+-- >>> let Just s = seed (BS.replicate 32 0xff)
+-- >>> let Just i = secret_index 281474976710655
+-- >>> B16.encode (BOLT1.un_per_commitment_secret (generate_from_seed s i))
+-- "7cc854b54e3e0dcdb010d7a3fee464a9687be6e8db3be6854c475621e007a5dc"
+generate_from_seed :: Seed -> SecretIndex -> PerCommitmentSecret
+generate_from_seed (Seed s) (SecretIndex i) = to_secret (derive_secret s 48 i)
+
+-- | Compact storage for the per-commitment secrets received from a
+-- peer, per BOLT #3's "Efficient Per-commitment Secret Storage".
+--
+-- Holds at most 49 secrets, from which every secret received so far
+-- can be derived. This is secret material: its 'Show' instance is
+-- redacted, and it has no 'Eq' instance.
+newtype SecretStore = SecretStore [Entry]
+
+-- A stored secret: its bucket (the number of trailing zeros of its
+-- index), index, and value. Kept in ascending bucket order.
+data Entry = Entry
+ {-# UNPACK #-} !Int
+ {-# UNPACK #-} !Word64
+ !BS.ByteString
+
+instance Show SecretStore where
+ showsPrec d _ = showParen (d > 10) $
+ showString "SecretStore <redacted>"
+
+instance NFData SecretStore where
+ rnf (SecretStore es) = rnf_entries es where
+ rnf_entries [] = ()
+ rnf_entries (Entry _ _ s : rest) = rnf s `seq` rnf_entries rest
+
+-- | The empty 'SecretStore'.
+empty_secret_store :: SecretStore
+empty_secret_store = SecretStore []
+
+-- The bucket for an index: its number of trailing zeros (48 for 0).
+bucket_of :: Word64 -> Int
+bucket_of i = go 0 where
go !b
- | b > 47 = 48 -- index 0, this is the seed
- | testBit idx b = b
- | otherwise = go (b + 1)
-{-# INLINE where_to_put_secret #-}
-
--- | Insert a secret into the store, validating against existing secrets.
---
--- Implements insert_secret from BOLT #3: the secret is checked against
--- every known secret in a lower bucket, then replaces the entry in its
--- own bucket. Entries in all other buckets are kept, so that every
--- previously-inserted secret remains derivable via 'derive_old_secret'.
--- Entries are kept in ascending bucket order.
---
--- Returns Nothing if the secret is not 32 bytes, if the index is not
--- below 2^48, or if a known secret doesn't derive correctly from the
--- new one (indicating the secrets weren't generated from the same
--- seed).
---
--- >>> insert_secret secret 281474976710655 empty_store
--- Just (SecretStore ...)
+ | b > 47 = 48
+ | testBit i b = b
+ | otherwise = go (b + 1)
+
+-- Whether a secret at index j in bucket b can derive index i.
+can_derive :: Int -> Word64 -> Word64 -> Bool
+can_derive b j i = i .&. complement ((1 `shiftL` b) - 1) == j
+{-# INLINE can_derive #-}
+
+-- | Add a newly received per-commitment secret to the store, per
+-- BOLT #3's @insert_secret@.
+--
+-- Fails if a stored secret cannot be derived from the new one, i.e.
+-- if the secrets were not generated from the same seed (or were not
+-- received in order).
+--
+-- >>> let Just s = seed (BS.replicate 32 0xff)
+-- >>> let Just i = secret_index 281474976710655
+-- >>> let secret = generate_from_seed s i
+-- >>> let Just st = insert_secret secret i empty_secret_store
+-- >>> fmap (== secret) (derive_old_secret i st)
+-- Just True
insert_secret
- :: BS.ByteString -- ^ secret (32 bytes)
- -> Word64 -- ^ index (max 2^48 - 1)
- -> SecretStore -- ^ current store
+ :: PerCommitmentSecret
+ -> SecretIndex
+ -> SecretStore
-> Maybe SecretStore
-insert_secret secret idx (SecretStore known)
- | BS.length secret /= 32 = Nothing
- | idx > 0xFFFFFFFFFFFF = Nothing
+insert_secret pcs (SecretIndex i) (SecretStore known)
| all derives known = Just $! SecretStore (put known)
- | otherwise = Nothing
+ | otherwise = Nothing
where
- !bucket = where_to_put_secret idx
- !entry = SecretEntry bucket idx secret
+ !s = BOLT1.un_per_commitment_secret pcs
+ !b = bucket_of i
+ !e = Entry b i s
- -- known secrets in lower buckets must derive from the new one
- derives (SecretEntry b knownIdx knownSecret)
- | b < bucket = derive_secret secret bucket knownIdx == knownSecret
+ -- every secret in a lower bucket must derive from the new one
+ derives (Entry kb ki ks)
+ | kb < b = to_secret (derive_secret s b ki) == to_secret ks
| otherwise = True
- -- replace this bucket's entry, preserving ascending bucket order
- put [] = [entry]
- put (e : es) = case compare (se_bucket e) bucket of
- LT -> e : put es
- EQ -> entry : es
- GT -> entry : e : es
-{-# INLINE insert_secret #-}
+ -- replace this bucket's entry, keeping ascending bucket order
+ put [] = [e]
+ put (k@(Entry kb _ _) : ks) = case compare kb b of
+ LT -> k : put ks
+ EQ -> e : ks
+ GT -> e : k : ks
--- | Derive a previously-received secret from the store.
---
--- Iterates over known secrets to find one whose index is a prefix of
--- the target index, then derives the target secret from it.
---
--- >>> derive_old_secret 281474976710654 store
--- Just <32-byte secret>
+-- | Derive a previously received per-commitment secret from the
+-- store. Fails if the index has not been received.
derive_old_secret
- :: Word64 -- ^ target index
- -> SecretStore -- ^ store
- -> Maybe BS.ByteString
-derive_old_secret targetIdx (SecretStore known) = go known where
- go :: [SecretEntry] -> Maybe BS.ByteString
+ :: SecretIndex
+ -> SecretStore
+ -> Maybe PerCommitmentSecret
+derive_old_secret (SecretIndex i) (SecretStore known) = go known where
go [] = Nothing
- go (SecretEntry bucket knownIdx knownSecret : rest) =
- -- Mask off the non-zero prefix of the index using the entry's bucket
- let !mask = complement ((1 `shiftL` bucket) - 1)
- in if (targetIdx .&. mask) == knownIdx
- then Just $! derive_secret knownSecret bucket targetIdx
- else go rest
-
- complement :: Word64 -> Word64
- complement x = x `xor` 0xFFFFFFFFFFFFFFFF
-{-# INLINE derive_old_secret #-}
-
--- Commitment number obscuring --------------------------------------------
-
--- | Calculate the obscured commitment number.
---
--- The 48-bit commitment number is obscured by XOR with the lower 48 bits
--- of SHA256(payment_basepoint from open_channel
--- || payment_basepoint from accept_channel).
---
--- >>> obscured_commitment_number local_payment_bp remote_payment_bp cn
--- <obscured value>
+ go (Entry b j s : rest)
+ | can_derive b j i = Just $! to_secret (derive_secret s b i)
+ | otherwise = go rest
+
+-- | Rebuild a 'SecretStore' from its entries, e.g. as produced by
+-- 'un_secret_store'.
+--
+-- Fails if two entries share a bucket (i.e. their indices have the
+-- same number of trailing zeros), or if an entry contradicts another
+-- from which it can be derived.
+secret_store
+ :: [(SecretIndex, PerCommitmentSecret)]
+ -> Maybe SecretStore
+secret_store = go [] where
+ go acc [] = Just (SecretStore acc)
+ go acc ((SecretIndex i, pcs) : rest) = do
+ let !e = Entry (bucket_of i) i (BOLT1.un_per_commitment_secret pcs)
+ acc' <- place e acc
+ go acc' rest
+
+ -- insert in ascending bucket order, checking consistency with the
+ -- entries already placed
+ place e@(Entry b i s) es
+ | all (consistent e) es = put es
+ | otherwise = Nothing
+ where
+ put [] = Just [e]
+ put (k@(Entry kb _ _) : ks) = case compare kb b of
+ LT -> (k :) <$> put ks
+ EQ -> Nothing
+ GT -> Just (e : k : ks)
+ consistent _ (Entry kb ki ks)
+ | kb > b && can_derive kb ki i =
+ to_secret (derive_secret ks kb i) == to_secret s
+ | kb < b && can_derive b i ki =
+ to_secret (derive_secret s b ki) == to_secret ks
+ | otherwise = True
+
+-- | The entries of a 'SecretStore', for persistence; see
+-- 'secret_store'.
+un_secret_store :: SecretStore -> [(SecretIndex, PerCommitmentSecret)]
+un_secret_store (SecretStore es) =
+ [ (SecretIndex i, to_secret s) | Entry _ i s <- es ]
+
+-- commitment number obscuring ------------------------------------------------
+
+-- | Obscure a commitment number, by XOR with the lower 48 bits of
+--
+-- @SHA256(payment_basepoint from open_channel
+-- || payment_basepoint from accept_channel)@
+--
+-- As XOR is an involution, applying this to an obscured number
+-- recovers the commitment number. ('build_commitment_tx' obscures
+-- the commitment number itself.)
+--
+-- >>> let pay h = fmap PaymentBasepoint (BOLT1.point =<< B16.decode h)
+-- >>> let o1 = "034f355bdcb7cc0af728ef3cceb9615d9068"
+-- >>> let Just o = pay (o1 <> "4bb5b2ca5f859ab0f0b704075871aa")
+-- >>> let a1 = "032c0b7cf95324a07d05398b240174dc0c2b"
+-- >>> let Just a = pay (a1 <> "e444d96b159aa6c7f7b1e668680991")
+-- >>> fmap (obscured_commitment_number o a) (commitment_number 42)
+-- Just 48035859142974
obscured_commitment_number
:: PaymentBasepoint -- ^ opener's payment_basepoint
-> PaymentBasepoint -- ^ accepter's payment_basepoint
- -> CommitmentNumber -- ^ commitment number (48-bit)
- -> Word64 -- ^ obscured commitment number
+ -> CommitmentNumber
+ -> Word64
obscured_commitment_number
- (PaymentBasepoint (Point openerBs))
- (PaymentBasepoint (Point accepterBs))
- (CommitmentNumber cn) =
- let !h = SHA256.hash (openerBs <> accepterBs)
- -- Extract lower 48 bits (6 bytes) from the hash
- !lower48 = extractLower48 h
- -- Mask commitment number to 48 bits
- !cn48 = cn .&. 0xFFFFFFFFFFFF
- in cn48 `xor` lower48
-{-# INLINE obscured_commitment_number #-}
-
--- | Extract lower 48 bits from a 32-byte hash.
---
--- Takes bytes 26-31 (last 6 bytes) and interprets as big-endian Word64.
-extractLower48 :: BS.ByteString -> Word64
-extractLower48 h =
- let !b0 = fromIntegral (BS.index h 26) `shiftL` 40
- !b1 = fromIntegral (BS.index h 27) `shiftL` 32
- !b2 = fromIntegral (BS.index h 28) `shiftL` 24
- !b3 = fromIntegral (BS.index h 29) `shiftL` 16
- !b4 = fromIntegral (BS.index h 30) `shiftL` 8
- !b5 = fromIntegral (BS.index h 31)
- in b0 + b1 + b2 + b3 + b4 + b5
-{-# INLINE extractLower48 #-}
+ (PaymentBasepoint opener)
+ (PaymentBasepoint accepter)
+ cn =
+ let !h = SHA256.hash (BOLT1.un_point opener <> BOLT1.un_point accepter)
+ !mask = BS.foldl' (\acc x -> (acc `shiftL` 8) .|. fromIntegral x) 0
+ (BS.drop 26 h)
+ in un_commitment_number cn `xor` mask
diff --git a/lib/Lightning/Protocol/BOLT3/Scripts.hs b/lib/Lightning/Protocol/BOLT3/Scripts.hs
@@ -1,6 +1,5 @@
-{-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: Lightning.Protocol.BOLT3.Scripts
@@ -8,17 +7,7 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Script templates for BOLT #3 transaction outputs.
---
--- Includes witness scripts for:
---
--- * Funding output (2-of-2 multisig)
--- * to_local output (revocable with CSV delay)
--- * to_remote output (P2WPKH or anchored)
--- * Anchor outputs
--- * Offered HTLC outputs
--- * Received HTLC outputs
--- * HTLC-timeout/success output (revocable with delay)
+-- Scripts and witnesses for BOLT #3 transaction outputs.
module Lightning.Protocol.BOLT3.Scripts (
-- * Funding output
@@ -31,7 +20,8 @@ module Lightning.Protocol.BOLT3.Scripts (
, to_local_witness_revoke
-- * to_remote output
- , to_remote_script
+ , to_remote_witness_script
+ , to_remote_script_pubkey
, to_remote_witness
-- * Anchor outputs
@@ -39,639 +29,475 @@ module Lightning.Protocol.BOLT3.Scripts (
, anchor_witness_owner
, anchor_witness_anyone
- -- * Offered HTLC output
+ -- * Offered HTLC outputs
, offered_htlc_script
, offered_htlc_witness_preimage
, offered_htlc_witness_revoke
- -- * Received HTLC output
+ -- * Received HTLC outputs
, received_htlc_script
, received_htlc_witness_timeout
, received_htlc_witness_revoke
- -- * HTLC-timeout/success output (same as to_local)
- , htlc_output_script
- , htlc_output_witness_spend
- , htlc_output_witness_revoke
+ -- * HTLC transaction inputs
+ , htlc_success_witness
+ , htlc_timeout_witness
+ , remote_htlc_sighash
- -- * P2WSH helpers
+ -- * P2WSH
, to_p2wsh
- , witness_script_hash
) where
+import Bitcoin.Prim.Tx (Witness(..))
+import Bitcoin.Prim.Tx.Sighash (SighashType(..))
+import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
+import qualified Crypto.Hash.SHA256 as SHA256
import Data.Bits ((.&.), shiftR)
-import Data.Word (Word8, Word16, Word32)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy as BSL
-import qualified Crypto.Hash.SHA256 as SHA256
-import qualified Crypto.Hash.RIPEMD160 as RIPEMD160
+import Data.Word (Word8, Word16, Word32)
+import Lightning.Protocol.BOLT1 (Point, PaymentPreimage)
+import qualified Lightning.Protocol.BOLT1 as BOLT1
import Lightning.Protocol.BOLT3.Types
--- opcodes ---------------------------------------------------------------------
-
--- | OP_0 / OP_FALSE (0x00)
-op_0 :: Word8
-op_0 = 0x00
+-- opcodes --------------------------------------------------------------------
--- | OP_PUSHDATA for 1-75 bytes just uses the length as opcode
--- For data <=75 bytes, opcode is just the length
-
--- | OP_IF (0x63)
-op_if :: Word8
-op_if = 0x63
+op_0, op_1, op_2, op_16 :: Word8
+op_0 = 0x00
+op_1 = 0x51
+op_2 = 0x52
+op_16 = 0x60
--- | OP_NOTIF (0x64)
-op_notif :: Word8
+op_if, op_notif, op_else, op_endif, op_drop, op_dup, op_ifdup :: Word8
+op_if = 0x63
op_notif = 0x64
-
--- | OP_ELSE (0x67)
-op_else :: Word8
-op_else = 0x67
-
--- | OP_ENDIF (0x68)
-op_endif :: Word8
+op_else = 0x67
op_endif = 0x68
-
--- | OP_DROP (0x75)
-op_drop :: Word8
-op_drop = 0x75
-
--- | OP_DUP (0x76)
-op_dup :: Word8
-op_dup = 0x76
-
--- | OP_SWAP (0x7c)
-op_swap :: Word8
-op_swap = 0x7c
-
--- | OP_SIZE (0x82)
-op_size :: Word8
-op_size = 0x82
-
--- | OP_EQUAL (0x87)
-op_equal :: Word8
-op_equal = 0x87
-
--- | OP_EQUALVERIFY (0x88)
-op_equalverify :: Word8
-op_equalverify = 0x88
-
--- | OP_IFDUP (0x73)
-op_ifdup :: Word8
op_ifdup = 0x73
+op_drop = 0x75
+op_dup = 0x76
--- | OP_HASH160 (0xa9)
-op_hash160 :: Word8
-op_hash160 = 0xa9
-
--- | OP_CHECKSIG (0xac)
-op_checksig :: Word8
-op_checksig = 0xac
+op_swap, op_size, op_equal, op_equalverify, op_hash160 :: Word8
+op_swap = 0x7c
+op_size = 0x82
+op_equal = 0x87
+op_equalverify = 0x88
+op_hash160 = 0xa9
--- | OP_CHECKSIGVERIFY (0xad)
-op_checksigverify :: Word8
+op_checksig, op_checksigverify, op_checkmultisig :: Word8
+op_checksig = 0xac
op_checksigverify = 0xad
+op_checkmultisig = 0xae
--- | OP_CHECKMULTISIG (0xae)
-op_checkmultisig :: Word8
-op_checkmultisig = 0xae
-
--- | OP_CHECKLOCKTIMEVERIFY (0xb1)
-op_checklocktimeverify :: Word8
+op_checklocktimeverify, op_checksequenceverify :: Word8
op_checklocktimeverify = 0xb1
-
--- | OP_CHECKSEQUENCEVERIFY (0xb2)
-op_checksequenceverify :: Word8
op_checksequenceverify = 0xb2
--- | OP_1 (0x51)
-op_1 :: Word8
-op_1 = 0x51
+-- helpers --------------------------------------------------------------------
--- | OP_2 (0x52)
-op_2 :: Word8
-op_2 = 0x52
+op :: Word8 -> BSB.Builder
+op = BSB.word8
+{-# INLINE op #-}
--- | OP_16 (0x60)
-op_16 :: Word8
-op_16 = 0x60
+-- Push data of at most 75 bytes (all pushes here are keys, hashes or
+-- short numbers).
+push :: BS.ByteString -> BSB.Builder
+push bs = BSB.word8 (fromIntegral (BS.length bs)) <> BSB.byteString bs
+{-# INLINE push #-}
--- helpers ---------------------------------------------------------------------
+push_point :: Point -> BSB.Builder
+push_point = push . BOLT1.un_point
+{-# INLINE push_point #-}
--- | Push a bytestring onto the stack (handles length encoding).
---
--- For data <= 75 bytes, the length itself is the opcode.
-push_data :: BS.ByteString -> BSB.Builder
-push_data !bs
- | len <= 75 = BSB.word8 (fromIntegral len) <> BSB.byteString bs
- | len <= 255 = BSB.word8 0x4c <> BSB.word8 (fromIntegral len)
- <> BSB.byteString bs
- | len <= 65535 = BSB.word8 0x4d <> BSB.word16LE (fromIntegral len)
- <> BSB.byteString bs
- | otherwise = BSB.word8 0x4e <> BSB.word32LE (fromIntegral len)
- <> BSB.byteString bs
+-- Push a non-negative number, minimally encoded.
+push_num :: Word32 -> BSB.Builder
+push_num n
+ | n == 0 = op op_0
+ | n <= 16 = op (0x50 + fromIntegral n)
+ | otherwise = push (BS.pack (signed (le n)))
where
- !len = BS.length bs
-{-# INLINE push_data #-}
-
--- | Encode a Word16 as minimal script number (for CSV delays).
-push_csv_delay :: Word16 -> BSB.Builder
-push_csv_delay !n
- | n == 0 = BSB.word8 op_0
- | n <= 16 = BSB.word8 (0x50 + fromIntegral n)
- | n <= 0x7f = push_data (BS.singleton (fromIntegral n))
- | n <= 0x7fff = push_data (BS.pack [lo, hi])
- | otherwise = push_data (BS.pack [lo, hi, 0x00]) -- need sign byte
- where
- !lo = fromIntegral (n .&. 0xff)
- !hi = fromIntegral ((n `shiftR` 8) .&. 0xff)
-{-# INLINE push_csv_delay #-}
-
--- | Encode a Word32 as minimal script number (for CLTV).
-push_cltv :: Word32 -> BSB.Builder
-push_cltv !n
- | n == 0 = BSB.word8 op_0
- | n <= 16 = BSB.word8 (0x50 + fromIntegral n)
- | otherwise = push_data (encode_scriptnum n)
- where
- encode_scriptnum :: Word32 -> BS.ByteString
- encode_scriptnum 0 = BS.empty
- encode_scriptnum !v =
- let -- Build bytes little-endian (LSB first)
- go :: Word32 -> [Word8]
- go 0 = []
- go !x = fromIntegral (x .&. 0xff) : go (x `shiftR` 8)
- !bytes = go v
- -- If MSB has high bit set, need 0x00 suffix for positive numbers
- !result = case reverse bytes of
- [] -> bytes
- (msb:_) | msb .&. 0x80 /= 0 -> bytes ++ [0x00]
- _ -> bytes
- in BS.pack result
-{-# INLINE push_cltv #-}
-
--- | Build script from builder.
-build_script :: BSB.Builder -> Script
-build_script = Script . BSL.toStrict . BSB.toLazyByteString
-{-# INLINE build_script #-}
-
--- | HASH160 = RIPEMD160(SHA256(x))
+ -- little-endian magnitude
+ le :: Word32 -> [Word8]
+ le !x
+ | x == 0 = []
+ | otherwise = fromIntegral (x .&. 0xff) : le (x `shiftR` 8)
+
+ -- append a sign byte if the top bit is set
+ signed bs = case reverse bs of
+ (h : _) | h .&. 0x80 /= 0 -> bs <> [0x00]
+ _ -> bs
+
+push_delay :: Word16 -> BSB.Builder
+push_delay = push_num . fromIntegral
+{-# INLINE push_delay #-}
+
+script :: BSB.Builder -> Script
+script = Script . BSL.toStrict . BSB.toLazyByteString
+{-# INLINE script #-}
+
hash160 :: BS.ByteString -> BS.ByteString
hash160 = RIPEMD160.hash . SHA256.hash
{-# INLINE hash160 #-}
--- P2WSH helpers ---------------------------------------------------------------
+-- Append a witness script to a witness stack.
+with_script :: [BS.ByteString] -> Script -> Witness
+with_script items (Script s) = Witness (items <> [s])
+{-# INLINE with_script #-}
--- | Compute SHA256 hash of a witness script.
---
--- >>> witness_script_hash (Script "some_script")
--- <32-byte SHA256 hash>
-witness_script_hash :: Script -> BS.ByteString
-witness_script_hash (Script !s) = SHA256.hash s
-{-# INLINE witness_script_hash #-}
+-- P2WSH ----------------------------------------------------------------------
--- | Convert a witness script to P2WSH scriptPubKey.
---
--- P2WSH format: OP_0 <32-byte-hash>
---
--- >>> to_p2wsh some_witness_script
--- Script "\x00\x20<32-byte-hash>"
+-- | The P2WSH scriptPubKey for a witness script:
+-- @0 \<SHA256(script)\>@.
to_p2wsh :: Script -> Script
-to_p2wsh !script =
- let !h = witness_script_hash script
- in build_script (BSB.word8 op_0 <> push_data h)
-{-# INLINE to_p2wsh #-}
+to_p2wsh (Script s) = script (op op_0 <> push (SHA256.hash s))
--- funding output --------------------------------------------------------------
+-- funding output -------------------------------------------------------------
--- | Funding output witness script (2-of-2 multisig).
---
--- Script: @2 <pubkey1> <pubkey2> 2 OP_CHECKMULTISIG@
+-- | The funding output's witness script:
--
--- Where pubkey1 is lexicographically lesser.
+-- @2 \<pubkey1\> \<pubkey2\> 2 OP_CHECKMULTISIG@
--
--- >>> funding_script pk1 pk2
--- Script "R!<pk_lesser>!<pk_greater>R\xae"
+-- where @pubkey1@ is the lexicographically lesser of the two funding
+-- pubkeys. The argument order doesn't matter.
funding_script :: FundingPubkey -> FundingPubkey -> Script
-funding_script (FundingPubkey (Pubkey !pk1)) (FundingPubkey (Pubkey !pk2)) =
- let (!lesser, !greater) = if pk1 <= pk2 then (pk1, pk2) else (pk2, pk1)
- in build_script $
- BSB.word8 op_2
- <> push_data lesser
- <> push_data greater
- <> BSB.word8 op_2
- <> BSB.word8 op_checkmultisig
-
--- | Witness for spending funding output.
---
--- Witness: @0 <sig1> <sig2>@
---
--- Signatures ordered to match pubkey order in script.
---
--- >>> funding_witness sig1 sig2
--- Witness ["", sig1, sig2]
-funding_witness :: BS.ByteString -> BS.ByteString -> Witness
-funding_witness !sig1 !sig2 = Witness [BS.empty, sig1, sig2]
-
--- to_local output -------------------------------------------------------------
-
--- | to_local witness script (revocable with CSV delay).
---
--- Script:
---
--- @
--- OP_IF
--- <revocationpubkey>
--- OP_ELSE
--- <to_self_delay>
--- OP_CHECKSEQUENCEVERIFY
--- OP_DROP
--- <local_delayedpubkey>
--- OP_ENDIF
--- OP_CHECKSIG
--- @
---
--- >>> to_local_script revpk delay localpk
--- Script "c!<revpk>g<delay>\xb2u!<localpk>h\xac"
+funding_script (FundingPubkey a) (FundingPubkey b) =
+ let (lo, hi) = if a <= b then (a, b) else (b, a)
+ in script $
+ op op_2 <> push_point lo <> push_point hi
+ <> op op_2 <> op op_checkmultisig
+
+-- | The witness spending the funding output, given each party's
+-- funding pubkey and signature (DER-encoded, with sighash byte):
+--
+-- @0 \<signature_for_pubkey1\> \<signature_for_pubkey2\> \<script\>@
+--
+-- The signatures are ordered to match the pubkeys in
+-- 'funding_script', so the argument order doesn't matter.
+funding_witness
+ :: FundingPubkey -> BS.ByteString
+ -> FundingPubkey -> BS.ByteString
+ -> Witness
+funding_witness pa@(FundingPubkey a) sa pb@(FundingPubkey b) sb =
+ let (s1, s2) = if a <= b then (sa, sb) else (sb, sa)
+ in with_script [BS.empty, s1, s2] (funding_script pa pb)
+
+-- to_local output ------------------------------------------------------------
+
+-- | The @to_local@ output's witness script:
+--
+-- @
+-- OP_IF
+-- \<revocationpubkey\>
+-- OP_ELSE
+-- \<to_self_delay\> OP_CHECKSEQUENCEVERIFY OP_DROP
+-- \<local_delayedpubkey\>
+-- OP_ENDIF
+-- OP_CHECKSIG
+-- @
+--
+-- HTLC-success and HTLC-timeout transaction outputs use the same
+-- script.
to_local_script
:: RevocationPubkey
-> ToSelfDelay
-> LocalDelayedPubkey
-> Script
to_local_script
- (RevocationPubkey (Pubkey !revpk))
- (ToSelfDelay !delay)
- (LocalDelayedPubkey (Pubkey !localpk)) =
- build_script $
- BSB.word8 op_if
- <> push_data revpk
- <> BSB.word8 op_else
- <> push_csv_delay delay
- <> BSB.word8 op_checksequenceverify
- <> BSB.word8 op_drop
- <> push_data localpk
- <> BSB.word8 op_endif
- <> BSB.word8 op_checksig
-
--- | Witness for delayed spend of to_local output.
---
--- Input nSequence must be set to to_self_delay.
---
--- Witness: @<local_delayedsig> <>@
---
--- >>> to_local_witness_spend sig
--- Witness [sig, ""]
-to_local_witness_spend :: BS.ByteString -> Witness
-to_local_witness_spend !sig = Witness [sig, BS.empty]
-
--- | Witness for revocation spend of to_local output.
---
--- Witness: @<revocation_sig> 1@
---
--- >>> to_local_witness_revoke sig
--- Witness [sig, "\x01"]
-to_local_witness_revoke :: BS.ByteString -> Witness
-to_local_witness_revoke !sig = Witness [sig, BS.singleton 0x01]
-
--- to_remote output ------------------------------------------------------------
-
--- | to_remote witness script.
---
--- With option_anchors:
---
--- @
--- <remotepubkey> OP_CHECKSIGVERIFY 1 OP_CHECKSEQUENCEVERIFY
--- @
---
--- Without option_anchors: P2WPKH (just the pubkey hash).
---
--- >>> to_remote_script pk (ChannelFeatures True)
--- Script "!<pk>\xadQ\xb2"
-to_remote_script :: RemotePubkey -> ChannelFeatures -> Script
-to_remote_script (RemotePubkey (Pubkey !pk)) !features
- | has_anchors features =
- -- Anchors: script with 1-block CSV
- build_script $
- push_data pk
- <> BSB.word8 op_checksigverify
- <> BSB.word8 op_1
- <> BSB.word8 op_checksequenceverify
- | otherwise =
- -- No anchors: P2WPKH (OP_0 <20-byte-hash>)
- let !h = hash160 pk
- in build_script (BSB.word8 op_0 <> push_data h)
-
--- | Witness for spending to_remote output.
---
--- With option_anchors (P2WSH), input nSequence must be 1.
--- Witness: @<remote_sig>@ (witness script appended by caller)
---
--- Without option_anchors (P2WPKH):
--- Witness: @<remote_sig> <remotepubkey>@
---
--- >>> to_remote_witness sig pk (ChannelFeatures False)
--- Witness [sig, pk]
-to_remote_witness :: BS.ByteString -> RemotePubkey -> ChannelFeatures -> Witness
-to_remote_witness !sig (RemotePubkey (Pubkey !pk)) !features
- | has_anchors features = Witness [sig]
- | otherwise = Witness [sig, pk]
-
--- anchor outputs --------------------------------------------------------------
-
--- | Anchor output witness script.
---
--- Script:
---
--- @
--- <funding_pubkey> OP_CHECKSIG OP_IFDUP
--- OP_NOTIF
--- OP_16 OP_CHECKSEQUENCEVERIFY
--- OP_ENDIF
--- @
---
--- >>> anchor_script fundpk
--- Script "!<fundpk>\xac\x73d`\xb2h"
+ (RevocationPubkey rev)
+ (ToSelfDelay delay)
+ (LocalDelayedPubkey delayed) = script $
+ op op_if
+ <> push_point rev
+ <> op op_else
+ <> push_delay delay
+ <> op op_checksequenceverify
+ <> op op_drop
+ <> push_point delayed
+ <> op op_endif
+ <> op op_checksig
+
+-- | The witness for the owner's delayed spend of a @to_local@ (or
+-- HTLC transaction) output, given its witness script:
+--
+-- @\<local_delayedsig\> \<\> \<script\>@
+--
+-- The spending input's @nSequence@ must be @to_self_delay@.
+to_local_witness_spend :: BS.ByteString -> Script -> Witness
+to_local_witness_spend sig = with_script [sig, BS.empty]
+
+-- | The witness for the revocation spend of a @to_local@ (or HTLC
+-- transaction) output, given its witness script:
+--
+-- @\<revocation_sig\> 1 \<script\>@
+to_local_witness_revoke :: BS.ByteString -> Script -> Witness
+to_local_witness_revoke sig = with_script [sig, BS.singleton 0x01]
+
+-- to_remote output -----------------------------------------------------------
+
+-- | The @to_remote@ output's witness script under 'Anchors':
+--
+-- @\<remotepubkey\> OP_CHECKSIGVERIFY 1 OP_CHECKSEQUENCEVERIFY@
+--
+-- (Under 'StaticRemotekey' the output is P2WPKH, with no witness
+-- script; see 'to_remote_script_pubkey'.)
+to_remote_witness_script :: RemotePubkey -> Script
+to_remote_witness_script (RemotePubkey pk) = script $
+ push_point pk
+ <> op op_checksigverify
+ <> op op_1
+ <> op op_checksequenceverify
+
+-- | The @to_remote@ output's scriptPubKey: P2WPKH to @remotepubkey@
+-- under 'StaticRemotekey', and P2WSH of 'to_remote_witness_script'
+-- under 'Anchors'.
+to_remote_script_pubkey :: RemotePubkey -> CommitmentFormat -> Script
+to_remote_script_pubkey pk@(RemotePubkey p) fmt = case fmt of
+ StaticRemotekey -> script (op op_0 <> push (hash160 (BOLT1.un_point p)))
+ Anchors -> to_p2wsh (to_remote_witness_script pk)
+
+-- | The witness spending a @to_remote@ output: @\<remote_sig\>
+-- \<remotepubkey\>@ (P2WPKH) under 'StaticRemotekey', and
+-- @\<remote_sig\> \<script\>@ under 'Anchors', where the spending
+-- input's @nSequence@ must be 1.
+to_remote_witness
+ :: BS.ByteString -> RemotePubkey -> CommitmentFormat -> Witness
+to_remote_witness sig pk@(RemotePubkey p) fmt = case fmt of
+ StaticRemotekey -> Witness [sig, BOLT1.un_point p]
+ Anchors -> with_script [sig] (to_remote_witness_script pk)
+
+-- anchor outputs -------------------------------------------------------------
+
+-- | An anchor output's witness script, for the funding pubkey of the
+-- party it belongs to:
+--
+-- @
+-- \<funding_pubkey\> OP_CHECKSIG OP_IFDUP
+-- OP_NOTIF
+-- OP_16 OP_CHECKSEQUENCEVERIFY
+-- OP_ENDIF
+-- @
anchor_script :: FundingPubkey -> Script
-anchor_script (FundingPubkey (Pubkey !pk)) =
- build_script $
- push_data pk
- <> BSB.word8 op_checksig
- <> BSB.word8 op_ifdup
- <> BSB.word8 op_notif
- <> BSB.word8 op_16
- <> BSB.word8 op_checksequenceverify
- <> BSB.word8 op_endif
-
--- | Witness for owner to spend anchor output.
---
--- Witness: @<sig>@
---
--- >>> anchor_witness_owner sig
--- Witness [sig]
-anchor_witness_owner :: BS.ByteString -> Witness
-anchor_witness_owner !sig = Witness [sig]
-
--- | Witness for anyone to sweep anchor output after 16 blocks.
---
--- Witness: @<>@
---
--- >>> anchor_witness_anyone
--- Witness [""]
-anchor_witness_anyone :: Witness
-anchor_witness_anyone = Witness [BS.empty]
-
--- offered HTLC output ---------------------------------------------------------
-
--- | Offered HTLC witness script.
---
--- Without option_anchors:
---
--- @
--- OP_DUP OP_HASH160 <RIPEMD160(SHA256(revocationpubkey))> OP_EQUAL
--- OP_IF
--- OP_CHECKSIG
--- OP_ELSE
--- <remote_htlcpubkey> OP_SWAP OP_SIZE 32 OP_EQUAL
--- OP_NOTIF
--- OP_DROP 2 OP_SWAP <local_htlcpubkey> 2 OP_CHECKMULTISIG
--- OP_ELSE
--- OP_HASH160 <RIPEMD160(payment_hash)> OP_EQUALVERIFY
--- OP_CHECKSIG
--- OP_ENDIF
--- OP_ENDIF
--- @
---
--- With option_anchors, adds @1 OP_CHECKSEQUENCEVERIFY OP_DROP@ before
--- final OP_ENDIF.
+anchor_script (FundingPubkey pk) = script $
+ push_point pk
+ <> op op_checksig
+ <> op op_ifdup
+ <> op op_notif
+ <> op op_16
+ <> op op_checksequenceverify
+ <> op op_endif
+
+-- | The witness for an anchor's owner to spend it:
+-- @\<sig\> \<script\>@.
+anchor_witness_owner :: BS.ByteString -> FundingPubkey -> Witness
+anchor_witness_owner sig pk = with_script [sig] (anchor_script pk)
+
+-- | The witness for anyone to sweep an anchor, 16 blocks after the
+-- commitment transaction confirms: @\<\> \<script\>@.
+anchor_witness_anyone :: FundingPubkey -> Witness
+anchor_witness_anyone pk = with_script [BS.empty] (anchor_script pk)
+
+-- offered HTLC outputs -------------------------------------------------------
+
+-- csv suffix for anchors HTLC scripts
+htlc_csv :: CommitmentFormat -> BSB.Builder
+htlc_csv fmt = case fmt of
+ StaticRemotekey -> mempty
+ Anchors -> op op_1 <> op op_checksequenceverify <> op op_drop
+{-# INLINE htlc_csv #-}
+
+-- | An offered HTLC output's witness script:
+--
+-- @
+-- OP_DUP OP_HASH160 \<RIPEMD160(SHA256(revocationpubkey))\> OP_EQUAL
+-- OP_IF
+-- OP_CHECKSIG
+-- OP_ELSE
+-- \<remote_htlcpubkey\> OP_SWAP OP_SIZE 32 OP_EQUAL
+-- OP_NOTIF
+-- OP_DROP 2 OP_SWAP \<local_htlcpubkey\> 2 OP_CHECKMULTISIG
+-- OP_ELSE
+-- OP_HASH160 \<RIPEMD160(payment_hash)\> OP_EQUALVERIFY
+-- OP_CHECKSIG
+-- OP_ENDIF
+-- OP_ENDIF
+-- @
+--
+-- Under 'Anchors', @1 OP_CHECKSEQUENCEVERIFY OP_DROP@ precedes the
+-- final @OP_ENDIF@.
offered_htlc_script
:: RevocationPubkey
-> RemoteHtlcPubkey
-> LocalHtlcPubkey
- -> PaymentHash
- -> ChannelFeatures
+ -> BOLT1.PaymentHash
+ -> CommitmentFormat
-> Script
offered_htlc_script
- (RevocationPubkey (Pubkey !revpk))
- (RemoteHtlcPubkey (Pubkey !remotepk))
- (LocalHtlcPubkey (Pubkey !localpk))
- (PaymentHash !ph)
- !features =
- let !revpk_hash = hash160 revpk
- !payment_hash160 = RIPEMD160.hash ph
- !csv_suffix = if has_anchors features
- then BSB.word8 op_1
- <> BSB.word8 op_checksequenceverify
- <> BSB.word8 op_drop
- else mempty
- in build_script $
- -- OP_DUP OP_HASH160 <revpk_hash> OP_EQUAL
- BSB.word8 op_dup
- <> BSB.word8 op_hash160
- <> push_data revpk_hash
- <> BSB.word8 op_equal
- -- OP_IF OP_CHECKSIG
- <> BSB.word8 op_if
- <> BSB.word8 op_checksig
- -- OP_ELSE
- <> BSB.word8 op_else
- -- <remote_htlcpubkey> OP_SWAP OP_SIZE 32 OP_EQUAL
- <> push_data remotepk
- <> BSB.word8 op_swap
- <> BSB.word8 op_size
- <> push_data (BS.singleton 32)
- <> BSB.word8 op_equal
- -- OP_NOTIF
- <> BSB.word8 op_notif
- -- OP_DROP 2 OP_SWAP <local_htlcpubkey> 2 OP_CHECKMULTISIG
- <> BSB.word8 op_drop
- <> BSB.word8 op_2
- <> BSB.word8 op_swap
- <> push_data localpk
- <> BSB.word8 op_2
- <> BSB.word8 op_checkmultisig
- -- OP_ELSE
- <> BSB.word8 op_else
- -- OP_HASH160 <payment_hash160> OP_EQUALVERIFY OP_CHECKSIG
- <> BSB.word8 op_hash160
- <> push_data payment_hash160
- <> BSB.word8 op_equalverify
- <> BSB.word8 op_checksig
- -- OP_ENDIF
- <> BSB.word8 op_endif
- -- CSV suffix for anchors
- <> csv_suffix
- -- OP_ENDIF
- <> BSB.word8 op_endif
-
--- | Witness for remote node to claim offered HTLC with preimage.
---
--- With option_anchors, input nSequence must be 1.
---
--- Witness: @<remotehtlcsig> <payment_preimage>@
---
--- >>> offered_htlc_witness_preimage sig preimage
--- Witness [sig, preimage]
+ (RevocationPubkey rev)
+ (RemoteHtlcPubkey remote)
+ (LocalHtlcPubkey local)
+ ph
+ fmt = script $
+ op op_dup <> op op_hash160
+ <> push (hash160 (BOLT1.un_point rev))
+ <> op op_equal
+ <> op op_if
+ <> op op_checksig
+ <> op op_else
+ <> push_point remote <> op op_swap <> op op_size
+ <> push (BS.singleton 32) <> op op_equal
+ <> op op_notif
+ <> op op_drop <> op op_2 <> op op_swap
+ <> push_point local <> op op_2 <> op op_checkmultisig
+ <> op op_else
+ <> op op_hash160
+ <> push (RIPEMD160.hash (BOLT1.un_payment_hash ph))
+ <> op op_equalverify <> op op_checksig
+ <> op op_endif
+ <> htlc_csv fmt
+ <> op op_endif
+
+-- | The witness for the remote party to claim an offered HTLC output
+-- with the payment preimage, given its witness script:
+--
+-- @\<remotehtlcsig\> \<payment_preimage\> \<script\>@
+--
+-- Under 'Anchors' the spending input's @nSequence@ must be 1.
offered_htlc_witness_preimage
- :: BS.ByteString -> PaymentPreimage -> Witness
-offered_htlc_witness_preimage !sig (PaymentPreimage !preimage) =
- Witness [sig, preimage]
-
--- | Witness for revocation spend of offered HTLC.
---
--- Witness: @<revocation_sig> <revocationpubkey>@
---
--- >>> offered_htlc_witness_revoke sig revpk
--- Witness [sig, revpk]
-offered_htlc_witness_revoke :: BS.ByteString -> Pubkey -> Witness
-offered_htlc_witness_revoke !sig (Pubkey !revpk) = Witness [sig, revpk]
-
--- received HTLC output --------------------------------------------------------
-
--- | Received HTLC witness script.
---
--- Without option_anchors:
---
--- @
--- OP_DUP OP_HASH160 <RIPEMD160(SHA256(revocationpubkey))> OP_EQUAL
--- OP_IF
--- OP_CHECKSIG
--- OP_ELSE
--- <remote_htlcpubkey> OP_SWAP OP_SIZE 32 OP_EQUAL
--- OP_IF
--- OP_HASH160 <RIPEMD160(payment_hash)> OP_EQUALVERIFY
--- 2 OP_SWAP <local_htlcpubkey> 2 OP_CHECKMULTISIG
--- OP_ELSE
--- OP_DROP <cltv_expiry> OP_CHECKLOCKTIMEVERIFY OP_DROP
--- OP_CHECKSIG
--- OP_ENDIF
--- OP_ENDIF
--- @
---
--- With option_anchors, adds @1 OP_CHECKSEQUENCEVERIFY OP_DROP@ before
--- final OP_ENDIF.
+ :: BS.ByteString -> PaymentPreimage -> Script -> Witness
+offered_htlc_witness_preimage sig pre =
+ with_script [sig, BOLT1.un_payment_preimage pre]
+
+-- | The witness for the revocation spend of an offered HTLC output,
+-- given its witness script:
+--
+-- @\<revocation_sig\> \<revocationpubkey\> \<script\>@
+offered_htlc_witness_revoke
+ :: BS.ByteString -> RevocationPubkey -> Script -> Witness
+offered_htlc_witness_revoke sig (RevocationPubkey rev) =
+ with_script [sig, BOLT1.un_point rev]
+
+-- received HTLC outputs ------------------------------------------------------
+
+-- | A received HTLC output's witness script:
+--
+-- @
+-- OP_DUP OP_HASH160 \<RIPEMD160(SHA256(revocationpubkey))\> OP_EQUAL
+-- OP_IF
+-- OP_CHECKSIG
+-- OP_ELSE
+-- \<remote_htlcpubkey\> OP_SWAP OP_SIZE 32 OP_EQUAL
+-- OP_IF
+-- OP_HASH160 \<RIPEMD160(payment_hash)\> OP_EQUALVERIFY
+-- 2 OP_SWAP \<local_htlcpubkey\> 2 OP_CHECKMULTISIG
+-- OP_ELSE
+-- OP_DROP \<cltv_expiry\> OP_CHECKLOCKTIMEVERIFY OP_DROP
+-- OP_CHECKSIG
+-- OP_ENDIF
+-- OP_ENDIF
+-- @
+--
+-- Under 'Anchors', @1 OP_CHECKSEQUENCEVERIFY OP_DROP@ precedes the
+-- final @OP_ENDIF@.
received_htlc_script
:: RevocationPubkey
-> RemoteHtlcPubkey
-> LocalHtlcPubkey
- -> PaymentHash
+ -> BOLT1.PaymentHash
-> CltvExpiry
- -> ChannelFeatures
+ -> CommitmentFormat
-> Script
received_htlc_script
- (RevocationPubkey (Pubkey !revpk))
- (RemoteHtlcPubkey (Pubkey !remotepk))
- (LocalHtlcPubkey (Pubkey !localpk))
- (PaymentHash !ph)
- (CltvExpiry !expiry)
- !features =
- let !revpk_hash = hash160 revpk
- !payment_hash160 = RIPEMD160.hash ph
- !csv_suffix = if has_anchors features
- then BSB.word8 op_1
- <> BSB.word8 op_checksequenceverify
- <> BSB.word8 op_drop
- else mempty
- in build_script $
- -- OP_DUP OP_HASH160 <revpk_hash> OP_EQUAL
- BSB.word8 op_dup
- <> BSB.word8 op_hash160
- <> push_data revpk_hash
- <> BSB.word8 op_equal
- -- OP_IF OP_CHECKSIG
- <> BSB.word8 op_if
- <> BSB.word8 op_checksig
- -- OP_ELSE
- <> BSB.word8 op_else
- -- <remote_htlcpubkey> OP_SWAP OP_SIZE 32 OP_EQUAL
- <> push_data remotepk
- <> BSB.word8 op_swap
- <> BSB.word8 op_size
- <> push_data (BS.singleton 32)
- <> BSB.word8 op_equal
- -- OP_IF
- <> BSB.word8 op_if
- -- OP_HASH160 <payment_hash160> OP_EQUALVERIFY
- <> BSB.word8 op_hash160
- <> push_data payment_hash160
- <> BSB.word8 op_equalverify
- -- 2 OP_SWAP <local_htlcpubkey> 2 OP_CHECKMULTISIG
- <> BSB.word8 op_2
- <> BSB.word8 op_swap
- <> push_data localpk
- <> BSB.word8 op_2
- <> BSB.word8 op_checkmultisig
- -- OP_ELSE
- <> BSB.word8 op_else
- -- OP_DROP <cltv_expiry> OP_CHECKLOCKTIMEVERIFY OP_DROP OP_CHECKSIG
- <> BSB.word8 op_drop
- <> push_cltv expiry
- <> BSB.word8 op_checklocktimeverify
- <> BSB.word8 op_drop
- <> BSB.word8 op_checksig
- -- OP_ENDIF
- <> BSB.word8 op_endif
- -- CSV suffix for anchors
- <> csv_suffix
- -- OP_ENDIF
- <> BSB.word8 op_endif
-
--- | Witness for remote node to timeout received HTLC.
---
--- With option_anchors, input nSequence must be 1.
---
--- Witness: @<remotehtlcsig> <>@
---
--- >>> received_htlc_witness_timeout sig
--- Witness [sig, ""]
-received_htlc_witness_timeout :: BS.ByteString -> Witness
-received_htlc_witness_timeout !sig = Witness [sig, BS.empty]
-
--- | Witness for revocation spend of received HTLC.
---
--- Witness: @<revocation_sig> <revocationpubkey>@
---
--- >>> received_htlc_witness_revoke sig revpk
--- Witness [sig, revpk]
-received_htlc_witness_revoke :: BS.ByteString -> Pubkey -> Witness
-received_htlc_witness_revoke !sig (Pubkey !revpk) = Witness [sig, revpk]
-
--- HTLC-timeout/success output -------------------------------------------------
-
--- | HTLC output witness script (same structure as to_local).
---
--- Used for HTLC-timeout and HTLC-success transaction outputs.
---
--- Script:
---
--- @
--- OP_IF
--- <revocationpubkey>
--- OP_ELSE
--- <to_self_delay>
--- OP_CHECKSEQUENCEVERIFY
--- OP_DROP
--- <local_delayedpubkey>
--- OP_ENDIF
--- OP_CHECKSIG
--- @
-htlc_output_script
- :: RevocationPubkey
- -> ToSelfDelay
- -> LocalDelayedPubkey
- -> Script
-htlc_output_script = to_local_script
-
--- | Witness for delayed spend of HTLC output.
---
--- Input nSequence must be set to to_self_delay.
---
--- Witness: @<local_delayedsig> 0@
-htlc_output_witness_spend :: BS.ByteString -> Witness
-htlc_output_witness_spend = to_local_witness_spend
-
--- | Witness for revocation spend of HTLC output.
---
--- Witness: @<revocationsig> 1@
-htlc_output_witness_revoke :: BS.ByteString -> Witness
-htlc_output_witness_revoke = to_local_witness_revoke
+ (RevocationPubkey rev)
+ (RemoteHtlcPubkey remote)
+ (LocalHtlcPubkey local)
+ ph
+ (CltvExpiry expiry)
+ fmt = script $
+ op op_dup <> op op_hash160
+ <> push (hash160 (BOLT1.un_point rev))
+ <> op op_equal
+ <> op op_if
+ <> op op_checksig
+ <> op op_else
+ <> push_point remote <> op op_swap <> op op_size
+ <> push (BS.singleton 32) <> op op_equal
+ <> op op_if
+ <> op op_hash160
+ <> push (RIPEMD160.hash (BOLT1.un_payment_hash ph))
+ <> op op_equalverify
+ <> op op_2 <> op op_swap <> push_point local
+ <> op op_2 <> op op_checkmultisig
+ <> op op_else
+ <> op op_drop <> push_num expiry
+ <> op op_checklocktimeverify <> op op_drop
+ <> op op_checksig
+ <> op op_endif
+ <> htlc_csv fmt
+ <> op op_endif
+
+-- | The witness for the remote party to time out a received HTLC
+-- output, given its witness script:
+--
+-- @\<remotehtlcsig\> \<\> \<script\>@
+--
+-- Under 'Anchors' the spending input's @nSequence@ must be 1.
+received_htlc_witness_timeout :: BS.ByteString -> Script -> Witness
+received_htlc_witness_timeout sig = with_script [sig, BS.empty]
+
+-- | The witness for the revocation spend of a received HTLC output,
+-- given its witness script:
+--
+-- @\<revocation_sig\> \<revocationpubkey\> \<script\>@
+received_htlc_witness_revoke
+ :: BS.ByteString -> RevocationPubkey -> Script -> Witness
+received_htlc_witness_revoke sig (RevocationPubkey rev) =
+ with_script [sig, BOLT1.un_point rev]
+
+-- HTLC transaction inputs ----------------------------------------------------
+
+-- | The witness for an HTLC-success transaction's input, given both
+-- HTLC signatures, the payment preimage and the received HTLC
+-- output's witness script:
+--
+-- @0 \<remotehtlcsig\> \<localhtlcsig\> \<payment_preimage\> \<script\>@
+--
+-- See 'remote_htlc_sighash' for the signatures' sighash types.
+htlc_success_witness
+ :: BS.ByteString -- ^ remotehtlcsig
+ -> BS.ByteString -- ^ localhtlcsig
+ -> PaymentPreimage
+ -> Script -- ^ the received HTLC output's witness script
+ -> Witness
+htlc_success_witness remote local pre =
+ with_script [BS.empty, remote, local, BOLT1.un_payment_preimage pre]
+
+-- | The witness for an HTLC-timeout transaction's input, given both
+-- HTLC signatures and the offered HTLC output's witness script:
+--
+-- @0 \<remotehtlcsig\> \<localhtlcsig\> \<\> \<script\>@
+--
+-- See 'remote_htlc_sighash' for the signatures' sighash types.
+htlc_timeout_witness
+ :: BS.ByteString -- ^ remotehtlcsig
+ -> BS.ByteString -- ^ localhtlcsig
+ -> Script -- ^ the offered HTLC output's witness script
+ -> Witness
+htlc_timeout_witness remote local =
+ with_script [BS.empty, remote, local, BS.empty]
+
+-- | The sighash type of @remotehtlcsig@: the signature on an
+-- HTLC-success or HTLC-timeout transaction that the commitment's
+-- non-owner sends in @commitment_signed@.
+--
+-- Under 'Anchors' it is @SIGHASH_SINGLE|SIGHASH_ANYONECANPAY@, so
+-- that the owner can add inputs and outputs to pay the (otherwise
+-- zero) fee; under 'StaticRemotekey' it is @SIGHASH_ALL@. The
+-- owner's own signature, @localhtlcsig@, always uses @SIGHASH_ALL@.
+--
+-- >>> remote_htlc_sighash Anchors
+-- SIGHASH_SINGLE_ANYONECANPAY
+remote_htlc_sighash :: CommitmentFormat -> SighashType
+remote_htlc_sighash fmt = case fmt of
+ StaticRemotekey -> SIGHASH_ALL
+ Anchors -> SIGHASH_SINGLE_ANYONECANPAY
diff --git a/lib/Lightning/Protocol/BOLT3/Tx.hs b/lib/Lightning/Protocol/BOLT3/Tx.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -8,667 +8,562 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Transaction assembly for BOLT #3.
---
--- Constructs:
---
--- * Commitment transactions
--- * HTLC-timeout transactions
--- * HTLC-success transactions
--- * Closing transactions
+-- Commitment, HTLC and closing transactions, per BOLT #3.
module Lightning.Protocol.BOLT3.Tx (
- -- * Commitment transaction
- CommitmentTx(..)
- , CommitmentContext(..)
- , CommitmentKeys(..)
+ -- * Commitment transactions
+ CommitmentContext(..)
+ , CommitmentTx(..)
+ , CommitmentOutput(..)
+ , OutputType(..)
, build_commitment_tx
-- * HTLC transactions
- , HTLCTx(..)
, HTLCContext(..)
- , build_htlc_timeout_tx
- , build_htlc_success_tx
+ , HTLCTx(..)
+ , build_htlc_tx
- -- * Closing transaction
+ -- * Closing transactions
, ClosingTx(..)
+ , ClosingOutput(..)
, ClosingContext(..)
+ , ClosingOutputs(..)
, build_closing_tx
+ , LegacyClosingContext(..)
, build_legacy_closing_tx
- -- * Conversion to ppad-tx
- , commitment_to_tx
- , htlc_to_tx
- , closing_to_tx
-
- -- * Transaction outputs
- , TxOutput(..)
- , OutputType(..)
-
- -- * Fee calculation
+ -- * Fees
, commitment_fee
, htlc_timeout_fee
, htlc_success_fee
- , commitment_weight
-- * Trimming
- , is_trimmed
- , trimmed_htlcs
- , untrimmed_htlcs
, htlc_trim_threshold
+ , is_trimmed
- -- * Output ordering
- , sort_outputs
+ -- * Serialization
+ , commitment_to_tx
+ , htlc_to_tx
+ , closing_to_tx
+ , encode_commitment_tx
+ , encode_htlc_tx
+ , encode_closing_tx
) where
+import Bitcoin.Prim.Tx (OutPoint(..), TxId)
import qualified Bitcoin.Prim.Tx as BT
-import Data.Bits ((.&.), (.|.), shiftL, shiftR)
+import Control.DeepSeq (NFData)
+import Data.Bits ((.&.), (.|.), shiftR)
import qualified Data.ByteString as BS
import Data.List (sortBy)
-import Data.List.NonEmpty (NonEmpty(..), nonEmpty)
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NE
+import Data.Maybe (fromMaybe)
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
+import Lightning.Protocol.BOLT1 (Satoshi, MilliSatoshi)
+import qualified Lightning.Protocol.BOLT1 as BOLT1
import Lightning.Protocol.BOLT3.Keys
import Lightning.Protocol.BOLT3.Scripts
import Lightning.Protocol.BOLT3.Types
--- transaction outputs ---------------------------------------------------------
+-- commitment transactions ----------------------------------------------------
--- | Type of output in a commitment transaction.
+-- | What a commitment transaction output pays.
data OutputType
= OutputToLocal
| OutputToRemote
| OutputLocalAnchor
| OutputRemoteAnchor
- | OutputOfferedHTLC {-# UNPACK #-} !CltvExpiry
- | OutputReceivedHTLC {-# UNPACK #-} !CltvExpiry
+ | OutputHTLC !HTLC
+ -- ^ an offered or received HTLC (per its 'htlc_direction')
deriving (Eq, Show, Generic)
--- | A transaction output with value, script, and type information.
-data TxOutput = TxOutput
- { txout_value :: {-# UNPACK #-} !Satoshi
- , txout_script :: !Script
- , txout_type :: !OutputType
- } deriving (Eq, Show, Generic)
+instance NFData OutputType
--- commitment transaction ------------------------------------------------------
-
--- | Derived keys needed for commitment transaction outputs.
-data CommitmentKeys = CommitmentKeys
- { ck_revocation_pubkey :: !RevocationPubkey
- , ck_local_delayed :: !LocalDelayedPubkey
- , ck_local_htlc :: !LocalHtlcPubkey
- , ck_remote_htlc :: !RemoteHtlcPubkey
- , ck_local_payment :: !LocalPubkey
- , ck_remote_payment :: !RemotePubkey
- , ck_local_funding :: !FundingPubkey
- , ck_remote_funding :: !FundingPubkey
+-- | A commitment transaction output.
+data CommitmentOutput = CommitmentOutput
+ { co_value :: {-# UNPACK #-} !Satoshi
+ , co_script :: !Script -- ^ scriptPubKey
+ , co_type :: !OutputType
} deriving (Eq, Show, Generic)
--- | Context for building a commitment transaction.
+instance NFData CommitmentOutput
+
+-- | The parameters of a commitment transaction, from the point of view
+-- of its owner (the "local" party, whose outputs are delayed).
data CommitmentContext = CommitmentContext
- { cc_funding_outpoint :: !OutPoint
- , cc_commitment_number :: !CommitmentNumber
- , cc_local_payment_bp :: !PaymentBasepoint
- , cc_remote_payment_bp :: !PaymentBasepoint
- , cc_to_self_delay :: !ToSelfDelay
- , cc_dust_limit :: !DustLimit
- , cc_feerate :: !FeeratePerKw
- , cc_features :: !ChannelFeatures
- , cc_is_funder :: !Bool
- , cc_to_local_msat :: !MilliSatoshi
- , cc_to_remote_msat :: !MilliSatoshi
- , cc_htlcs :: ![HTLC]
- , cc_keys :: !CommitmentKeys
+ { cc_funding_outpoint :: {-# UNPACK #-} !OutPoint
+ , cc_commitment_number :: {-# UNPACK #-} !CommitmentNumber
+ , cc_local_payment_bp :: !PaymentBasepoint
+ -- ^ the owner's @payment_basepoint@
+ , cc_remote_payment_bp :: !PaymentBasepoint
+ -- ^ the other party's @payment_basepoint@
+ , cc_to_self_delay :: {-# UNPACK #-} !ToSelfDelay
+ -- ^ the delay on the owner's outputs (set by the other party)
+ , cc_dust_limit :: {-# UNPACK #-} !DustLimit
+ -- ^ the owner's @dust_limit_satoshis@
+ , cc_feerate :: {-# UNPACK #-} !FeeratePerKw
+ , cc_format :: !CommitmentFormat
+ , cc_is_funder :: !Bool
+ -- ^ whether the owner opened the channel, and so pays the fee
+ , cc_to_local_msat :: {-# UNPACK #-} !MilliSatoshi
+ , cc_to_remote_msat :: {-# UNPACK #-} !MilliSatoshi
+ , cc_htlcs :: ![HTLC]
+ , cc_keys :: !CommitmentKeys
} deriving (Eq, Show, Generic)
--- | A commitment transaction.
+instance NFData CommitmentContext
+
+-- | An unsigned commitment transaction.
data CommitmentTx = CommitmentTx
- { ctx_version :: {-# UNPACK #-} !Word32
- , ctx_locktime :: !Locktime
- , ctx_input_outpoint :: !OutPoint
- , ctx_input_sequence :: !Sequence
- , ctx_outputs :: ![TxOutput]
- , ctx_funding_script :: !Script
+ { ctx_version :: {-# UNPACK #-} !Word32
+ , ctx_locktime :: {-# UNPACK #-} !Locktime
+ , ctx_input_outpoint :: {-# UNPACK #-} !OutPoint
+ , ctx_input_sequence :: {-# UNPACK #-} !Sequence
+ , ctx_outputs :: !(NonEmpty CommitmentOutput)
+ -- ^ in BIP69+CLTV order
+ , ctx_funding_script :: !Script
+ -- ^ the funding output's witness script, which signatures commit
+ -- to
} deriving (Eq, Show, Generic)
--- | Build a commitment transaction.
+instance NFData CommitmentTx
+
+-- | Build a commitment transaction, per BOLT #3's "Commitment
+-- Transaction Construction":
--
--- Follows the algorithm from BOLT #3:
+-- * the locktime and input sequence encode the obscured commitment
+-- number (the payment basepoints are ordered by 'cc_is_funder');
+-- * HTLCs whose amount, less the HTLC transaction fee, is below the
+-- dust limit are trimmed;
+-- * the base fee (and under 'Anchors', both anchors) are taken from
+-- the funder's output, which is left at zero if it can't cover
+-- them;
+-- * @to_local@ and @to_remote@ outputs below the dust limit are
+-- omitted, and under 'Anchors' each party's anchor is added if its
+-- output, or any HTLC output, exists;
+-- * outputs are sorted by value, scriptPubKey and CLTV expiry.
--
--- 1. Initialize input and locktime with obscured commitment number
--- 2. Calculate which HTLCs are trimmed
--- 3. Calculate base fee and subtract from funder
--- 4. Add untrimmed HTLC outputs
--- 5. Add to_local output if above dust
--- 6. Add to_remote output if above dust
--- 7. Add anchor outputs if option_anchors
--- 8. Sort outputs per BIP69+CLTV
-build_commitment_tx :: CommitmentContext -> CommitmentTx
-build_commitment_tx ctx =
- let !obscured = obscured_commitment_number
- (cc_local_payment_bp ctx)
- (cc_remote_payment_bp ctx)
- (cc_commitment_number ctx)
-
- -- Locktime: upper 8 bits are 0x20, lower 24 bits are lower 24 of obscured
- !locktime = Locktime $
- (0x20 `shiftL` 24) .|. (fromIntegral obscured .&. 0x00FFFFFF)
-
- -- Sequence: upper 8 bits are 0x80, lower 24 bits are upper 24 of obscured
- !inputSeq = Sequence $
- (0x80 `shiftL` 24) .|.
- (fromIntegral (obscured `shiftR` 24) .&. 0x00FFFFFF)
-
- -- Funding script for witness
- !fundingScript = funding_script
- (ck_local_funding $ cc_keys ctx)
- (ck_remote_funding $ cc_keys ctx)
-
- -- Calculate untrimmed HTLCs
- !untrimmedHtlcs = untrimmed_htlcs
- (cc_dust_limit ctx)
- (cc_feerate ctx)
- (cc_features ctx)
- (cc_htlcs ctx)
-
- -- Calculate base fee
- !baseFee = commitment_fee
- (cc_feerate ctx)
- (cc_features ctx)
- (fromIntegral $ length untrimmedHtlcs)
-
- -- Anchor cost if applicable
- !anchorCost = if has_anchors (cc_features ctx)
- then 2 * anchor_output_value
- else Satoshi 0
-
- -- Subtract fees and anchors from funder
- !totalDeduction = baseFee + anchorCost
- !(toLocalSat, toRemoteSat) = if cc_is_funder ctx
- then
- let !local = msatToSat (cc_to_local_msat ctx)
- !deducted = if unSatoshi local >= unSatoshi totalDeduction
- then Satoshi (unSatoshi local - unSatoshi totalDeduction)
- else Satoshi 0
- in (deducted, msatToSat (cc_to_remote_msat ctx))
- else
- let !remote = msatToSat (cc_to_remote_msat ctx)
- !deducted = if unSatoshi remote >= unSatoshi totalDeduction
- then Satoshi (unSatoshi remote - unSatoshi totalDeduction)
- else Satoshi 0
- in (msatToSat (cc_to_local_msat ctx), deducted)
-
- !dustLimit = unDustLimit (cc_dust_limit ctx)
-
- -- Build HTLC outputs
- !htlcOutputs = map (htlcOutput ctx) untrimmedHtlcs
-
- -- Build to_local output if above dust
- !toLocalOutput =
- if unSatoshi toLocalSat >= unSatoshi dustLimit
- then
- let !script = to_p2wsh $ to_local_script
- (ck_revocation_pubkey $ cc_keys ctx)
- (cc_to_self_delay ctx)
- (ck_local_delayed $ cc_keys ctx)
- in [TxOutput toLocalSat script OutputToLocal]
- else []
-
- -- Build to_remote output if above dust
- !toRemoteOutput =
- if unSatoshi toRemoteSat >= unSatoshi dustLimit
- then
- let !script = if has_anchors (cc_features ctx)
- then to_p2wsh $ to_remote_script
- (ck_remote_payment $ cc_keys ctx)
- (cc_features ctx)
- else to_remote_script
- (ck_remote_payment $ cc_keys ctx)
- (cc_features ctx)
- in [TxOutput toRemoteSat script OutputToRemote]
- else []
-
- -- Build anchor outputs if option_anchors
- !hasUntrimmedHtlcs = not (null untrimmedHtlcs)
- !toLocalExists = not (null toLocalOutput)
- !toRemoteExists = not (null toRemoteOutput)
-
- !localAnchorOutput =
- if has_anchors (cc_features ctx) &&
- (toLocalExists || hasUntrimmedHtlcs)
- then
- let !script = to_p2wsh $ anchor_script
- (ck_local_funding $ cc_keys ctx)
- in [TxOutput anchor_output_value script OutputLocalAnchor]
- else []
-
- !remoteAnchorOutput =
- if has_anchors (cc_features ctx) &&
- (toRemoteExists || hasUntrimmedHtlcs)
- then
- let !script = to_p2wsh $ anchor_script
- (ck_remote_funding $ cc_keys ctx)
- in [TxOutput anchor_output_value script OutputRemoteAnchor]
- else []
-
- -- Combine and sort all outputs
- !allOutputs = toLocalOutput ++ toRemoteOutput ++
- localAnchorOutput ++ remoteAnchorOutput ++
- htlcOutputs
- !sortedOutputs = sort_outputs allOutputs
-
- in CommitmentTx
- { ctx_version = 2
- , ctx_locktime = locktime
- , ctx_input_outpoint = cc_funding_outpoint ctx
- , ctx_input_sequence = inputSeq
- , ctx_outputs = sortedOutputs
- , ctx_funding_script = fundingScript
- }
-{-# INLINE build_commitment_tx #-}
-
--- | Build an HTLC output for commitment transaction.
-htlcOutput :: CommitmentContext -> HTLC -> TxOutput
-htlcOutput ctx htlc =
- let !amountSat = msatToSat (htlc_amount_msat htlc)
- !keys = cc_keys ctx
- !features = cc_features ctx
- !expiry = htlc_cltv_expiry htlc
- in case htlc_direction htlc of
- HTLCOffered ->
- let !script = to_p2wsh $ offered_htlc_script
- (ck_revocation_pubkey keys)
- (ck_remote_htlc keys)
- (ck_local_htlc keys)
- (htlc_payment_hash htlc)
- features
- in TxOutput amountSat script (OutputOfferedHTLC expiry)
- HTLCReceived ->
- let !script = to_p2wsh $ received_htlc_script
- (ck_revocation_pubkey keys)
- (ck_remote_htlc keys)
- (ck_local_htlc keys)
- (htlc_payment_hash htlc)
- expiry
- features
- in TxOutput amountSat script (OutputReceivedHTLC expiry)
-{-# INLINE htlcOutput #-}
-
--- HTLC transactions -----------------------------------------------------------
-
--- | Context for building HTLC transactions.
+-- Fails if the transaction would have no outputs.
+build_commitment_tx :: CommitmentContext -> Maybe CommitmentTx
+build_commitment_tx ctx = do
+ outputs <- NE.nonEmpty . sort_outputs $
+ to_local <> to_remote <> local_anchor <> remote_anchor <> htlcs
+ pure CommitmentTx
+ { ctx_version = 2
+ , ctx_locktime =
+ Locktime (0x20000000 .|. (fromIntegral obscured .&. 0xFFFFFF))
+ , ctx_input_outpoint = cc_funding_outpoint ctx
+ , ctx_input_sequence =
+ Sequence
+ (0x80000000 .|. (fromIntegral (obscured `shiftR` 24) .&. 0xFFFFFF))
+ , ctx_outputs = outputs
+ , ctx_funding_script =
+ funding_script (ck_local_funding keys) (ck_remote_funding keys)
+ }
+ where
+ !keys = cc_keys ctx
+ !fmt = cc_format ctx
+ !rate = cc_feerate ctx
+ !dust = cc_dust_limit ctx
+ DustLimit dust_sat = dust
+
+ (!opener, !accepter)
+ | cc_is_funder ctx = (cc_local_payment_bp ctx, cc_remote_payment_bp ctx)
+ | otherwise = (cc_remote_payment_bp ctx, cc_local_payment_bp ctx)
+ !obscured =
+ obscured_commitment_number opener accepter (cc_commitment_number ctx)
+
+ untrimmed = filter (not . is_trimmed dust rate fmt) (cc_htlcs ctx)
+
+ !fee = commitment_fee rate fmt (fromIntegral (length untrimmed))
+ !deduction = case fmt of
+ StaticRemotekey -> fee
+ Anchors ->
+ fromMaybe BOLT1.max_satoshi (BOLT1.add_sat fee (sat 660))
+ deduct s = fromMaybe (sat 0) (BOLT1.sub_sat s deduction)
+
+ !local_sat = BOLT1.msat_to_sat (cc_to_local_msat ctx)
+ !remote_sat = BOLT1.msat_to_sat (cc_to_remote_msat ctx)
+ (!to_local_sat, !to_remote_sat)
+ | cc_is_funder ctx = (deduct local_sat, remote_sat)
+ | otherwise = (local_sat, deduct remote_sat)
+
+ to_local =
+ [ CommitmentOutput to_local_sat
+ (to_p2wsh (to_local_script (ck_revocation_pubkey keys)
+ (cc_to_self_delay ctx) (ck_local_delayed keys)))
+ OutputToLocal
+ | to_local_sat >= dust_sat ]
+
+ to_remote =
+ [ CommitmentOutput to_remote_sat
+ (to_remote_script_pubkey (ck_remote_payment keys) fmt)
+ OutputToRemote
+ | to_remote_sat >= dust_sat ]
+
+ has_htlcs = not (null untrimmed)
+ anchor pk ty = CommitmentOutput anchor_output_value
+ (to_p2wsh (anchor_script pk)) ty
+
+ local_anchor = case fmt of
+ Anchors | not (null to_local) || has_htlcs ->
+ [anchor (ck_local_funding keys) OutputLocalAnchor]
+ _ -> []
+
+ remote_anchor = case fmt of
+ Anchors | not (null to_remote) || has_htlcs ->
+ [anchor (ck_remote_funding keys) OutputRemoteAnchor]
+ _ -> []
+
+ htlcs = fmap htlc_output untrimmed
+
+ htlc_output h =
+ let !script = 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
+ in CommitmentOutput (BOLT1.msat_to_sat (htlc_amount_msat h))
+ (to_p2wsh script) (OutputHTLC h)
+
+-- BIP69+CLTV order: value, then scriptPubKey, then (for HTLCs) CLTV
+-- expiry.
+sort_outputs :: [CommitmentOutput] -> [CommitmentOutput]
+sort_outputs = sortBy cmp where
+ cmp a b = compare (co_value a) (co_value b)
+ <> compare (co_script a) (co_script b)
+ <> compare (cltv (co_type a)) (cltv (co_type b))
+ cltv t = case t of
+ OutputHTLC h -> Just (htlc_cltv_expiry h)
+ _ -> Nothing
+
+-- HTLC transactions ----------------------------------------------------------
+
+-- | The parameters of an HTLC-success or HTLC-timeout transaction,
+-- spending an HTLC output of the owner's commitment transaction.
data HTLCContext = HTLCContext
- { hc_commitment_txid :: !TxId
- , hc_output_index :: {-# UNPACK #-} !Word32
- , hc_htlc :: !HTLC
- , hc_to_self_delay :: !ToSelfDelay
- , hc_feerate :: !FeeratePerKw
- , hc_features :: !ChannelFeatures
- , hc_revocation_pubkey :: !RevocationPubkey
- , hc_local_delayed :: !LocalDelayedPubkey
+ { hc_commitment_txid :: !TxId
+ , hc_output_index :: {-# UNPACK #-} !Word32
+ , hc_htlc :: !HTLC
+ , hc_to_self_delay :: {-# UNPACK #-} !ToSelfDelay
+ , hc_feerate :: {-# UNPACK #-} !FeeratePerKw
+ , hc_format :: !CommitmentFormat
+ , hc_revocation_pubkey :: !RevocationPubkey
+ , hc_local_delayed :: !LocalDelayedPubkey
} deriving (Eq, Show, Generic)
--- | An HTLC transaction (timeout or success).
+instance NFData HTLCContext
+
+-- | An unsigned HTLC-success or HTLC-timeout transaction.
data HTLCTx = HTLCTx
- { htx_version :: {-# UNPACK #-} !Word32
- , htx_locktime :: !Locktime
- , htx_input_outpoint :: !OutPoint
- , htx_input_sequence :: !Sequence
- , htx_output_value :: !Satoshi
- , htx_output_script :: !Script
+ { htx_version :: {-# UNPACK #-} !Word32
+ , htx_locktime :: {-# UNPACK #-} !Locktime
+ , htx_input_outpoint :: {-# UNPACK #-} !OutPoint
+ , htx_input_sequence :: {-# UNPACK #-} !Sequence
+ , htx_output_value :: {-# UNPACK #-} !Satoshi
+ , htx_output_script :: !Script
} deriving (Eq, Show, Generic)
--- | Internal helper for HTLC transaction construction.
---
--- Both HTLC-timeout and HTLC-success transactions share the same
--- structure, differing only in locktime and fee calculation.
-build_htlc_tx_common
- :: HTLCContext
- -> Locktime -- ^ Transaction locktime
- -> Satoshi -- ^ Fee to subtract from output
- -> HTLCTx
-build_htlc_tx_common ctx locktime fee =
- let !amountSat = msatToSat (htlc_amount_msat $ hc_htlc ctx)
- !outputValue = if unSatoshi amountSat >= unSatoshi fee
- then Satoshi (unSatoshi amountSat - unSatoshi fee)
- else Satoshi 0
- !inputSeq = if has_anchors (hc_features ctx)
- then Sequence 1
- else Sequence 0
- !outpoint = OutPoint (hc_commitment_txid ctx) (hc_output_index ctx)
- !outputScript = to_p2wsh $ htlc_output_script
- (hc_revocation_pubkey ctx)
- (hc_to_self_delay ctx)
- (hc_local_delayed ctx)
- in HTLCTx
- { htx_version = 2
- , htx_locktime = locktime
- , htx_input_outpoint = outpoint
- , htx_input_sequence = inputSeq
- , htx_output_value = outputValue
- , htx_output_script = outputScript
- }
-{-# INLINE build_htlc_tx_common #-}
-
--- | Build an HTLC-timeout transaction.
---
--- * locktime: cltv_expiry
--- * sequence: 0 (or 1 with option_anchors)
--- * output: to_local style script with revocation and delayed paths
-build_htlc_timeout_tx :: HTLCContext -> HTLCTx
-build_htlc_timeout_tx ctx =
- let !fee = htlc_timeout_fee (hc_feerate ctx) (hc_features ctx)
- !locktime = Locktime (unCltvExpiry $ htlc_cltv_expiry $ hc_htlc ctx)
- in build_htlc_tx_common ctx locktime fee
-{-# INLINE build_htlc_timeout_tx #-}
-
--- | Build an HTLC-success transaction.
+instance NFData HTLCTx
+
+-- | Build the second-stage transaction for an HTLC output of the
+-- owner's commitment transaction: HTLC-timeout (locktime
+-- @cltv_expiry@) for an offered HTLC, and HTLC-success (locktime 0)
+-- for a received one.
--
--- * locktime: 0
--- * sequence: 0 (or 1 with option_anchors)
--- * output: to_local style script with revocation and delayed paths
-build_htlc_success_tx :: HTLCContext -> HTLCTx
-build_htlc_success_tx ctx =
- let !fee = htlc_success_fee (hc_feerate ctx) (hc_features ctx)
- in build_htlc_tx_common ctx (Locktime 0) fee
-{-# INLINE build_htlc_success_tx #-}
-
--- closing transaction ---------------------------------------------------------
-
--- | Context for building closing transactions.
-data ClosingContext = ClosingContext
- { clc_funding_outpoint :: !OutPoint
- , clc_local_amount :: !Satoshi
- , clc_remote_amount :: !Satoshi
- , clc_local_script :: !Script
- , clc_remote_script :: !Script
- , clc_local_dust_limit :: !DustLimit
- , clc_remote_dust_limit :: !DustLimit
- , clc_fee :: !Satoshi
- , clc_is_funder :: !Bool
- , clc_locktime :: !Locktime
- , clc_funding_script :: !Script
+-- The output pays the HTLC amount, less the HTLC transaction fee
+-- (zero under 'Anchors'), to the 'to_local_script' of the owner's
+-- keys. Fails if the fee exceeds the amount (such an HTLC is always
+-- trimmed).
+build_htlc_tx :: HTLCContext -> Maybe HTLCTx
+build_htlc_tx ctx = do
+ value <- BOLT1.sub_sat (BOLT1.msat_to_sat (htlc_amount_msat h)) fee
+ pure HTLCTx
+ { htx_version = 2
+ , htx_locktime = locktime
+ , htx_input_outpoint =
+ OutPoint (hc_commitment_txid ctx) (hc_output_index ctx)
+ , htx_input_sequence = case fmt of
+ StaticRemotekey -> Sequence 0
+ Anchors -> Sequence 1
+ , htx_output_value = value
+ , htx_output_script = to_p2wsh $ to_local_script
+ (hc_revocation_pubkey ctx) (hc_to_self_delay ctx)
+ (hc_local_delayed ctx)
+ }
+ where
+ !h = hc_htlc ctx
+ !fmt = hc_format ctx
+ (!fee, !locktime) = case htlc_direction h of
+ HTLCOffered ->
+ let CltvExpiry e = htlc_cltv_expiry h
+ in (htlc_timeout_fee (hc_feerate ctx) fmt, Locktime e)
+ HTLCReceived ->
+ (htlc_success_fee (hc_feerate ctx) fmt, Locktime 0)
+
+-- closing transactions -------------------------------------------------------
+
+-- | A closing transaction output.
+data ClosingOutput = ClosingOutput
+ { clo_value :: {-# UNPACK #-} !Satoshi
+ , clo_script :: !Script -- ^ scriptPubKey
} deriving (Eq, Show, Generic)
--- | A closing transaction.
+instance NFData ClosingOutput
+
+-- | An unsigned closing transaction.
data ClosingTx = ClosingTx
- { cltx_version :: {-# UNPACK #-} !Word32
- , cltx_locktime :: !Locktime
- , cltx_input_outpoint :: !OutPoint
- , cltx_input_sequence :: !Sequence
- , cltx_outputs :: ![TxOutput]
- , cltx_funding_script :: !Script
+ { cltx_version :: {-# UNPACK #-} !Word32
+ , cltx_locktime :: {-# UNPACK #-} !Locktime
+ , cltx_input_outpoint :: {-# UNPACK #-} !OutPoint
+ , cltx_input_sequence :: {-# UNPACK #-} !Sequence
+ , cltx_outputs :: !(NonEmpty ClosingOutput)
+ -- ^ in BIP69 order
+ } deriving (Eq, Show, Generic)
+
+instance NFData ClosingTx
+
+-- | Which outputs an @option_simple_close@ closing transaction has,
+-- matching the signature fields of @closing_complete@.
+data ClosingOutputs
+ = CloserOutputOnly
+ | CloseeOutputOnly
+ | CloserAndCloseeOutputs
+ deriving (Eq, Show, Generic)
+
+instance NFData ClosingOutputs
+
+-- | The parameters of an @option_simple_close@ closing transaction,
+-- as given by a @closing_complete@ message.
+data ClosingContext = ClosingContext
+ { clc_funding_outpoint :: {-# UNPACK #-} !OutPoint
+ , clc_closer_msat :: {-# UNPACK #-} !MilliSatoshi
+ -- ^ the closer's final balance
+ , clc_closee_msat :: {-# UNPACK #-} !MilliSatoshi
+ -- ^ the closee's final balance
+ , clc_closer_script :: !Script
+ , clc_closee_script :: !Script
+ , clc_fee :: {-# UNPACK #-} !Satoshi
+ , clc_locktime :: {-# UNPACK #-} !Locktime
+ , clc_outputs :: !ClosingOutputs
} deriving (Eq, Show, Generic)
--- | Build a closing transaction (option_simple_close).
+instance NFData ClosingContext
+
+-- | Build an @option_simple_close@ closing transaction (BOLT #3's
+-- "Closing Transaction"), for @closing_complete@ and @closing_sig@.
--
--- * locktime: from closing_complete message
--- * sequence: 0xFFFFFFFD
--- * outputs: sorted per BIP69
-build_closing_tx :: ClosingContext -> ClosingTx
-build_closing_tx ctx =
- let -- Subtract fee from closer
- !(localAmt, remoteAmt) = if clc_is_funder ctx
- then
- let !deducted = if unSatoshi (clc_local_amount ctx) >=
- unSatoshi (clc_fee ctx)
- then Satoshi (unSatoshi (clc_local_amount ctx) -
- unSatoshi (clc_fee ctx))
- else Satoshi 0
- in (deducted, clc_remote_amount ctx)
- else
- let !deducted = if unSatoshi (clc_remote_amount ctx) >=
- unSatoshi (clc_fee ctx)
- then Satoshi (unSatoshi (clc_remote_amount ctx) -
- unSatoshi (clc_fee ctx))
- else Satoshi 0
- in (clc_local_amount ctx, deducted)
-
- -- Build outputs, omitting dust
- !localOutput =
- if unSatoshi localAmt >= unSatoshi (unDustLimit $ clc_local_dust_limit ctx)
- then [TxOutput localAmt (clc_local_script ctx) OutputToLocal]
- else []
-
- !remoteOutput =
- if unSatoshi remoteAmt >= unSatoshi (unDustLimit $ clc_remote_dust_limit ctx)
- then [TxOutput remoteAmt (clc_remote_script ctx) OutputToRemote]
- else []
-
- !allOutputs = localOutput ++ remoteOutput
- !sortedOutputs = sort_outputs allOutputs
-
- in ClosingTx
- { cltx_version = 2
- , cltx_locktime = clc_locktime ctx
- , cltx_input_outpoint = clc_funding_outpoint ctx
- , cltx_input_sequence = Sequence 0xFFFFFFFD
- , cltx_outputs = sortedOutputs
- , cltx_funding_script = clc_funding_script ctx
- }
-{-# INLINE build_closing_tx #-}
-
--- | Build a legacy closing transaction (closing_signed).
+-- The closer pays the fee: its output is its balance, rounded down
+-- to whole satoshis, less the fee. An output whose scriptPubKey
+-- starts with @OP_RETURN@ has amount 0. Only the chosen outputs are
+-- included, and none is trimmed. Fails if the fee exceeds the
+-- closer's balance.
+build_closing_tx :: ClosingContext -> Maybe ClosingTx
+build_closing_tx ctx = do
+ closer_sat <-
+ BOLT1.sub_sat (BOLT1.msat_to_sat (clc_closer_msat ctx)) (clc_fee ctx)
+ let !closer = output closer_sat (clc_closer_script ctx)
+ !closee = output (BOLT1.msat_to_sat (clc_closee_msat ctx))
+ (clc_closee_script ctx)
+ pure ClosingTx
+ { cltx_version = 2
+ , cltx_locktime = clc_locktime ctx
+ , cltx_input_outpoint = clc_funding_outpoint ctx
+ , cltx_input_sequence = Sequence 0xFFFFFFFD
+ , cltx_outputs = case clc_outputs ctx of
+ CloserOutputOnly -> closer :| []
+ CloseeOutputOnly -> closee :| []
+ CloserAndCloseeOutputs -> sort_closing (closer :| [closee])
+ }
+ where
+ output amt spk@(Script s) = case BS.uncons s of
+ Just (0x6a, _) -> ClosingOutput (sat 0) spk
+ _ -> ClosingOutput amt spk
+
+-- | The parameters of a legacy closing transaction (for
+-- @closing_signed@), from the point of view of the node producing
+-- the signature (the "local" party).
+data LegacyClosingContext = LegacyClosingContext
+ { lcc_funding_outpoint :: {-# UNPACK #-} !OutPoint
+ , lcc_local_msat :: {-# UNPACK #-} !MilliSatoshi
+ , lcc_remote_msat :: {-# UNPACK #-} !MilliSatoshi
+ , lcc_local_script :: !Script
+ , lcc_remote_script :: !Script
+ , lcc_dust_limit :: {-# UNPACK #-} !DustLimit
+ -- ^ the signer's @dust_limit_satoshis@
+ , lcc_fee :: {-# UNPACK #-} !Satoshi
+ , lcc_is_funder :: !Bool
+ -- ^ whether the signer funded the channel, and so pays the fee
+ , lcc_omit_local :: !Bool
+ -- ^ whether the signer eliminates its own output
+ } deriving (Eq, Show, Generic)
+
+instance NFData LegacyClosingContext
+
+-- | Build a legacy closing transaction (BOLT #3's "Legacy Closing
+-- Transaction"), for @closing_signed@.
--
--- * locktime: 0
--- * sequence: 0xFFFFFFFF
--- * outputs: sorted per BIP69
-build_legacy_closing_tx :: ClosingContext -> ClosingTx
-build_legacy_closing_tx ctx =
- let !result = build_closing_tx ctx
- { clc_locktime = Locktime 0 }
- in result { cltx_input_sequence = Sequence 0xFFFFFFFF }
-{-# INLINE build_legacy_closing_tx #-}
-
--- fee calculation -------------------------------------------------------------
-
--- | Calculate the base commitment transaction fee.
+-- Balances are rounded down to whole satoshis and the fee is taken
+-- from the funder's output. Outputs below the signer's dust limit
+-- are removed, as is the signer's own output if 'lcc_omit_local' is
+-- set. Fails if the fee exceeds the funder's balance, or if no
+-- output remains.
+build_legacy_closing_tx :: LegacyClosingContext -> Maybe ClosingTx
+build_legacy_closing_tx ctx = do
+ let !local_sat = BOLT1.msat_to_sat (lcc_local_msat ctx)
+ !remote_sat = BOLT1.msat_to_sat (lcc_remote_msat ctx)
+ DustLimit dust = lcc_dust_limit ctx
+ (l, r) <-
+ if lcc_is_funder ctx
+ then fmap (\x -> (x, remote_sat)) (BOLT1.sub_sat local_sat fee)
+ else fmap (\x -> (local_sat, x)) (BOLT1.sub_sat remote_sat fee)
+ outputs <- NE.nonEmpty $
+ [ ClosingOutput l (lcc_local_script ctx)
+ | not (lcc_omit_local ctx), l >= dust ]
+ <> [ ClosingOutput r (lcc_remote_script ctx) | r >= dust ]
+ pure ClosingTx
+ { cltx_version = 2
+ , cltx_locktime = Locktime 0
+ , cltx_input_outpoint = lcc_funding_outpoint ctx
+ , cltx_input_sequence = Sequence 0xFFFFFFFF
+ , cltx_outputs = sort_closing outputs
+ }
+ where
+ !fee = lcc_fee ctx
+
+-- BIP69 order: value, then scriptPubKey.
+sort_closing :: NonEmpty ClosingOutput -> NonEmpty ClosingOutput
+sort_closing = NE.sortBy $ \a b ->
+ compare (clo_value a) (clo_value b) <> compare (clo_script a) (clo_script b)
+
+-- fees -----------------------------------------------------------------------
+
+-- feerate * weight / 1000, saturating at 21 million BTC.
+weight_fee :: FeeratePerKw -> Integer -> Satoshi
+weight_fee (FeeratePerKw rate) weight =
+ let !f = toInteger rate * weight `quot` 1000
+ in if f > toInteger (BOLT1.un_satoshi BOLT1.max_satoshi)
+ then BOLT1.max_satoshi
+ else sat (fromInteger f)
+
+-- | The base fee of a commitment transaction with a given number of
+-- untrimmed HTLC outputs:
--
--- @fee = feerate_per_kw * weight / 1000@
+-- @feerate_per_kw * (724 + 172 * num_htlcs) / 1000@
--
--- where @weight = base_weight + 172 * num_htlcs@
-commitment_fee :: FeeratePerKw -> ChannelFeatures -> Word64 -> Satoshi
-commitment_fee feerate features numHtlcs =
- let !weight = commitment_weight features numHtlcs
- !fee = (fromIntegral (unFeeratePerKw feerate) * weight) `div` 1000
- in Satoshi fee
-{-# INLINE commitment_fee #-}
-
--- | Calculate commitment transaction weight.
+-- with a base weight of 1124 rather than 724 under 'Anchors'.
--
--- @weight = base + 172 * num_htlcs@
-commitment_weight :: ChannelFeatures -> Word64 -> Word64
-commitment_weight features numHtlcs =
- let !base = if has_anchors features
- then commitment_weight_anchors
- else commitment_weight_no_anchors
- in base + htlc_output_weight * numHtlcs
-{-# INLINE commitment_weight #-}
-
--- | Calculate HTLC-timeout transaction fee.
+-- >>> commitment_fee (FeeratePerKw 5000) StaticRemotekey 2
+-- Satoshi 5340
+commitment_fee :: FeeratePerKw -> CommitmentFormat -> Word64 -> Satoshi
+commitment_fee rate fmt n = weight_fee rate (base + 172 * toInteger n) where
+ base = case fmt of
+ StaticRemotekey -> 724
+ Anchors -> 1124
+
+-- | The fee of an HTLC-timeout transaction: @feerate_per_kw * 663 /
+-- 1000@, or zero under 'Anchors'.
--
--- With option_anchors, fee is 0 (CPFP).
--- Otherwise, @fee = feerate_per_kw * 663 / 1000@
-htlc_timeout_fee :: FeeratePerKw -> ChannelFeatures -> Satoshi
-htlc_timeout_fee feerate features
- | has_anchors features = Satoshi 0
- | otherwise =
- let !weight = htlc_timeout_weight_no_anchors
- !fee = (fromIntegral (unFeeratePerKw feerate) * weight) `div` 1000
- in Satoshi fee
-{-# INLINE htlc_timeout_fee #-}
-
--- | Calculate HTLC-success transaction fee.
+-- >>> htlc_timeout_fee (FeeratePerKw 5000) StaticRemotekey
+-- Satoshi 3315
+htlc_timeout_fee :: FeeratePerKw -> CommitmentFormat -> Satoshi
+htlc_timeout_fee rate fmt = case fmt of
+ StaticRemotekey -> weight_fee rate 663
+ Anchors -> sat 0
+
+-- | The fee of an HTLC-success transaction: @feerate_per_kw * 703 /
+-- 1000@, or zero under 'Anchors'.
--
--- With option_anchors, fee is 0 (CPFP).
--- Otherwise, @fee = feerate_per_kw * 703 / 1000@
-htlc_success_fee :: FeeratePerKw -> ChannelFeatures -> Satoshi
-htlc_success_fee feerate features
- | has_anchors features = Satoshi 0
- | otherwise =
- let !weight = htlc_success_weight_no_anchors
- !fee = (fromIntegral (unFeeratePerKw feerate) * weight) `div` 1000
- in Satoshi fee
-{-# INLINE htlc_success_fee #-}
-
--- trimming --------------------------------------------------------------------
-
--- | Calculate the trim threshold for an HTLC.
+-- >>> htlc_success_fee (FeeratePerKw 5000) StaticRemotekey
+-- Satoshi 3515
+htlc_success_fee :: FeeratePerKw -> CommitmentFormat -> Satoshi
+htlc_success_fee rate fmt = case fmt of
+ StaticRemotekey -> weight_fee rate 703
+ Anchors -> sat 0
+
+-- trimming -------------------------------------------------------------------
+
+-- | The amount below which an HTLC in a given direction is trimmed:
+-- the dust limit plus the fee of its HTLC transaction.
--
--- An HTLC is trimmed if:
--- @amount < dust_limit + htlc_tx_fee@
+-- >>> let Just d = fmap DustLimit (BOLT1.satoshi 546)
+-- >>> htlc_trim_threshold d (FeeratePerKw 5000) StaticRemotekey HTLCOffered
+-- Satoshi 3861
htlc_trim_threshold
:: DustLimit
-> FeeratePerKw
- -> ChannelFeatures
+ -> CommitmentFormat
-> HTLCDirection
-> Satoshi
-htlc_trim_threshold dust feerate features direction =
- let !dustVal = unDustLimit dust
- !htlcFee = case direction of
- HTLCOffered -> htlc_timeout_fee feerate features
- HTLCReceived -> htlc_success_fee feerate features
- in Satoshi (unSatoshi dustVal + unSatoshi htlcFee)
-{-# INLINE htlc_trim_threshold #-}
-
--- | Check if an HTLC should be trimmed.
---
--- An HTLC is trimmed if its amount minus the HTLC tx fee is below
--- the dust limit.
-is_trimmed :: DustLimit -> FeeratePerKw -> ChannelFeatures -> HTLC -> Bool
-is_trimmed dust feerate features htlc =
- let !threshold = htlc_trim_threshold dust feerate features
- (htlc_direction htlc)
- !amountSat = msatToSat (htlc_amount_msat htlc)
- in unSatoshi amountSat < unSatoshi threshold
-{-# INLINE is_trimmed #-}
-
--- | Filter HTLCs that are trimmed.
-trimmed_htlcs
- :: DustLimit
- -> FeeratePerKw
- -> ChannelFeatures
- -> [HTLC]
- -> [HTLC]
-trimmed_htlcs dust feerate features =
- filter (is_trimmed dust feerate features)
-{-# INLINE trimmed_htlcs #-}
-
--- | Filter HTLCs that are not trimmed.
-untrimmed_htlcs
- :: DustLimit
- -> FeeratePerKw
- -> ChannelFeatures
- -> [HTLC]
- -> [HTLC]
-untrimmed_htlcs dust feerate features =
- filter (not . is_trimmed dust feerate features)
-{-# INLINE untrimmed_htlcs #-}
-
--- conversion to ppad-tx -------------------------------------------------------
-
--- | Convert a 'TxOutput' to a ppad-tx 'BT.TxOut'.
-toTxOut :: TxOutput -> BT.TxOut
-toTxOut o = BT.TxOut
- { BT.txout_value =
- unSatoshi (txout_value o)
- , BT.txout_script_pubkey =
- unScript (txout_script o)
+htlc_trim_threshold (DustLimit dust) rate fmt dir =
+ let !fee = case dir of
+ HTLCOffered -> htlc_timeout_fee rate fmt
+ HTLCReceived -> htlc_success_fee rate fmt
+ in fromMaybe BOLT1.max_satoshi (BOLT1.add_sat dust fee)
+
+-- | Whether an HTLC is trimmed from a commitment transaction: whether
+-- its amount, rounded down to whole satoshis, is below
+-- 'htlc_trim_threshold'.
+is_trimmed :: DustLimit -> FeeratePerKw -> CommitmentFormat -> HTLC -> Bool
+is_trimmed dust rate fmt h =
+ BOLT1.msat_to_sat (htlc_amount_msat h)
+ < htlc_trim_threshold dust rate fmt (htlc_direction h)
+
+-- serialization --------------------------------------------------------------
+
+unsigned_tx
+ :: Word32 -> Locktime -> OutPoint -> Sequence -> NonEmpty BT.TxOut
+ -> BT.Tx
+unsigned_tx version (Locktime lt) prevout (Sequence sq) outs = BT.Tx
+ { BT.tx_version = version
+ , BT.tx_inputs = BT.TxIn prevout BS.empty sq :| []
+ , BT.tx_outputs = outs
+ , BT.tx_witnesses = []
+ , BT.tx_locktime = lt
}
-{-# INLINE toTxOut #-}
--- | Convert a commitment transaction to a ppad-tx 'BT.Tx'.
---
--- Returns 'Nothing' if the transaction has no outputs.
-commitment_to_tx :: CommitmentTx -> Maybe BT.Tx
-commitment_to_tx ctx = do
- outs <- nonEmpty (map toTxOut (ctx_outputs ctx))
- let !input = BT.TxIn
- { BT.txin_prevout = ctx_input_outpoint ctx
- , BT.txin_script_sig = BS.empty
- , BT.txin_sequence =
- unSequence (ctx_input_sequence ctx)
- }
- pure $! BT.Tx
- { BT.tx_version = ctx_version ctx
- , BT.tx_inputs = input :| []
- , BT.tx_outputs = outs
- , BT.tx_witnesses = []
- , BT.tx_locktime = unLocktime (ctx_locktime ctx)
- }
-
--- | Convert an HTLC transaction to a ppad-tx 'BT.Tx'.
+txout :: Satoshi -> Script -> BT.TxOut
+txout v (Script s) = BT.TxOut (BOLT1.un_satoshi v) s
+{-# INLINE txout #-}
+
+-- | The unsigned commitment transaction as a ppad-tx 'BT.Tx' (with no
+-- witnesses), e.g. for computing its txid or sighashes.
+commitment_to_tx :: CommitmentTx -> BT.Tx
+commitment_to_tx c = unsigned_tx (ctx_version c) (ctx_locktime c)
+ (ctx_input_outpoint c) (ctx_input_sequence c)
+ (fmap (\o -> txout (co_value o) (co_script o)) (ctx_outputs c))
+
+-- | The unsigned HTLC transaction as a ppad-tx 'BT.Tx'.
htlc_to_tx :: HTLCTx -> BT.Tx
-htlc_to_tx htx =
- let !input = BT.TxIn
- { BT.txin_prevout = htx_input_outpoint htx
- , BT.txin_script_sig = BS.empty
- , BT.txin_sequence =
- unSequence (htx_input_sequence htx)
- }
- !output = BT.TxOut
- { BT.txout_value =
- unSatoshi (htx_output_value htx)
- , BT.txout_script_pubkey =
- unScript (htx_output_script htx)
- }
- in BT.Tx
- { BT.tx_version = htx_version htx
- , BT.tx_inputs = input :| []
- , BT.tx_outputs = output :| []
- , BT.tx_witnesses = []
- , BT.tx_locktime = unLocktime (htx_locktime htx)
- }
-
--- | Convert a closing transaction to a ppad-tx 'BT.Tx'.
---
--- Returns 'Nothing' if the transaction has no outputs.
-closing_to_tx :: ClosingTx -> Maybe BT.Tx
-closing_to_tx ctx = do
- outs <- nonEmpty (map toTxOut (cltx_outputs ctx))
- let !input = BT.TxIn
- { BT.txin_prevout = cltx_input_outpoint ctx
- , BT.txin_script_sig = BS.empty
- , BT.txin_sequence =
- unSequence (cltx_input_sequence ctx)
- }
- pure $! BT.Tx
- { BT.tx_version = cltx_version ctx
- , BT.tx_inputs = input :| []
- , BT.tx_outputs = outs
- , BT.tx_witnesses = []
- , BT.tx_locktime = unLocktime (cltx_locktime ctx)
- }
-
--- output ordering -------------------------------------------------------------
-
--- | Sort outputs per BOLT #3 ordering.
---
--- Outputs are sorted by:
--- 1. Value (smallest first)
--- 2. ScriptPubKey (lexicographic)
--- 3. CLTV expiry (for HTLCs)
-sort_outputs :: [TxOutput] -> [TxOutput]
-sort_outputs = sortBy compareOutputs
-{-# INLINE sort_outputs #-}
-
--- | Compare two outputs for ordering.
-compareOutputs :: TxOutput -> TxOutput -> Ordering
-compareOutputs o1 o2 =
- case compare (txout_value o1) (txout_value o2) of
- EQ -> case compare (unScript $ txout_script o1)
- (unScript $ txout_script o2) of
- EQ -> compareCltvExpiry (txout_type o1) (txout_type o2)
- other -> other
- other -> other
-{-# INLINE compareOutputs #-}
-
--- | Compare CLTV expiry for HTLC outputs.
-compareCltvExpiry :: OutputType -> OutputType -> Ordering
-compareCltvExpiry (OutputOfferedHTLC e1) (OutputOfferedHTLC e2) = compare e1 e2
-compareCltvExpiry (OutputReceivedHTLC e1) (OutputReceivedHTLC e2) = compare e1 e2
-compareCltvExpiry (OutputOfferedHTLC e1) (OutputReceivedHTLC e2) = compare e1 e2
-compareCltvExpiry (OutputReceivedHTLC e1) (OutputOfferedHTLC e2) = compare e1 e2
-compareCltvExpiry _ _ = EQ
-{-# INLINE compareCltvExpiry #-}
+htlc_to_tx h = unsigned_tx (htx_version h) (htx_locktime h)
+ (htx_input_outpoint h) (htx_input_sequence h)
+ (txout (htx_output_value h) (htx_output_script h) :| [])
+
+-- | The unsigned closing transaction as a ppad-tx 'BT.Tx'.
+closing_to_tx :: ClosingTx -> BT.Tx
+closing_to_tx c = unsigned_tx (cltx_version c) (cltx_locktime c)
+ (cltx_input_outpoint c) (cltx_input_sequence c)
+ (fmap (\o -> txout (clo_value o) (clo_script o)) (cltx_outputs c))
+
+-- | Serialize an unsigned commitment transaction, without witness
+-- data. This is the form whose double-SHA256 is the txid; it is not
+-- what segwit signatures commit to (see ppad-tx's
+-- @Bitcoin.Prim.Tx.Sighash@). To broadcast, attach the witness to
+-- 'commitment_to_tx' and serialize with ppad-tx.
+encode_commitment_tx :: CommitmentTx -> BS.ByteString
+encode_commitment_tx = BT.to_bytes_legacy . commitment_to_tx
+
+-- | Serialize an unsigned HTLC transaction, without witness data (cf.
+-- 'encode_commitment_tx').
+encode_htlc_tx :: HTLCTx -> BS.ByteString
+encode_htlc_tx = BT.to_bytes_legacy . htlc_to_tx
+
+-- | Serialize an unsigned closing transaction, without witness data
+-- (cf. 'encode_commitment_tx').
+encode_closing_tx :: ClosingTx -> BS.ByteString
+encode_closing_tx = BT.to_bytes_legacy . closing_to_tx
diff --git a/lib/Lightning/Protocol/BOLT3/Types.hs b/lib/Lightning/Protocol/BOLT3/Types.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_HADDOCK prune #-}
+{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
@@ -8,366 +8,404 @@
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
--- Core types for BOLT #3 transaction and script formats.
+-- Types for BOLT #3 transaction and script formats.
module Lightning.Protocol.BOLT3.Types (
- -- * Monetary amounts (re-exported from BOLT1)
- Satoshi(..)
- , MilliSatoshi(..)
- , msatToSat
- , satToMsat
-
- -- * Keys and points
- , Pubkey(..)
- , pubkey
+ -- * Points and keys
+ PerCommitmentPoint(..)
+ , RevocationBasepoint(..)
+ , PaymentBasepoint(..)
+ , DelayedPaymentBasepoint(..)
+ , HtlcBasepoint(..)
+ , Basepoints(..)
+ , RevocationPubkey(..)
+ , LocalDelayedPubkey(..)
+ , LocalHtlcPubkey(..)
+ , RemoteHtlcPubkey(..)
+ , RemotePubkey(..)
+ , FundingPubkey(..)
, Seckey(..)
, seckey
- , Point(..)
- , point
- , unPoint
-
- -- * Hashes (re-exported from BOLT1)
- , PaymentHash(..)
- , paymentHash
- , unPaymentHash
- , PaymentPreimage(..)
- , paymentPreimage
- , unPaymentPreimage
-
- -- * Transaction primitives
- , TxId(..)
- , mkTxId
- , OutPoint(..)
- , Sequence(..)
- , Locktime(..)
+ , un_seckey
+
+ -- * Per-commitment secrets
+ , Seed(..)
+ , seed
+ , un_seed
+ , SecretIndex(..)
+ , secret_index
+ , un_secret_index
+ , commitment_secret_index
-- * Channel parameters
, CommitmentNumber(..)
, commitment_number
+ , un_commitment_number
, next_commitment_number
, ToSelfDelay(..)
, CltvExpiry(..)
, DustLimit(..)
, FeeratePerKw(..)
+ , Locktime(..)
+ , Sequence(..)
+ , CommitmentFormat(..)
- -- * HTLC types
+ -- * HTLCs
, HTLC(..)
, HTLCDirection(..)
- -- * Basepoints
- , Basepoints(..)
- , PerCommitmentPoint(..)
- , PerCommitmentSecret(..)
- , perCommitmentSecret
- , unPerCommitmentSecret
- , RevocationBasepoint(..)
- , PaymentBasepoint(..)
- , DelayedPaymentBasepoint(..)
- , HtlcBasepoint(..)
-
- -- * Derived keys
- , LocalPubkey(..)
- , RemotePubkey(..)
- , LocalDelayedPubkey(..)
- , RemoteDelayedPubkey(..)
- , LocalHtlcPubkey(..)
- , RemoteHtlcPubkey(..)
- , RevocationPubkey(..)
- , FundingPubkey(..)
-
- -- * Script
+ -- * Scripts
, Script(..)
- -- * Witness (re-exported from ppad-tx)
- , Witness(..)
-
- -- * Channel options
- , ChannelFeatures(..)
- , has_anchors
-
- -- * Transaction weights (constants)
- , commitment_weight_no_anchors
- , commitment_weight_anchors
- , htlc_timeout_weight_no_anchors
- , htlc_timeout_weight_anchors
- , htlc_success_weight_no_anchors
- , htlc_success_weight_anchors
- , htlc_output_weight
-
- -- * Dust thresholds (constants)
+ -- * Dust thresholds
, dust_p2pkh
, dust_p2sh
, dust_p2wpkh
, dust_p2wsh
, anchor_output_value
+
+ -- * Internal
+ , sat
+ , internal_error
) where
-import Bitcoin.Prim.Tx (TxId(..), mkTxId, OutPoint(..), Witness(..))
-import Data.Word (Word16, Word32, Word64)
+import Control.DeepSeq (NFData(..))
+import qualified Crypto.Curve.Secp256k1 as S
import qualified Data.ByteString as BS
+import Data.Word (Word16, Word32, Word64)
import GHC.Generics (Generic)
-import Lightning.Protocol.BOLT1.Prim
- ( Satoshi(..), MilliSatoshi(..)
- , satToMsat, msatToSat
- , Point(..), point, unPoint
- , PaymentHash(..), paymentHash, unPaymentHash
- , PaymentPreimage(..), paymentPreimage, unPaymentPreimage
- , PerCommitmentSecret(..), perCommitmentSecret
- , unPerCommitmentSecret
- )
-
--- keys and points -------------------------------------------------------------
-
--- | Compressed public key (33 bytes).
-newtype Pubkey = Pubkey { unPubkey :: BS.ByteString }
- deriving (Eq, Ord, Show, Generic)
+import Lightning.Protocol.BOLT1 (Point, Satoshi, MilliSatoshi, PaymentHash)
+import qualified Lightning.Protocol.BOLT1 as BOLT1
--- | Parse a 33-byte compressed public key.
---
--- Returns Nothing if the input is not exactly 33 bytes.
---
--- >>> pubkey (BS.replicate 33 0x02)
--- Just (Pubkey ...)
--- >>> pubkey (BS.replicate 32 0x02)
--- Nothing
-pubkey :: BS.ByteString -> Maybe Pubkey
-pubkey bs
- | BS.length bs == 33 = Just (Pubkey bs)
- | otherwise = Nothing
-{-# INLINE pubkey #-}
-
--- | Secret key (32 bytes).
-newtype Seckey = Seckey { unSeckey :: BS.ByteString }
- deriving (Eq, Generic)
-
--- Don't show secret keys
-instance Show Seckey where
- show _ = "Seckey <redacted>"
+-- internal ------------------------------------------------------------------
--- | Parse a 32-byte secret key.
---
--- Returns Nothing if the input is not exactly 32 bytes.
-seckey :: BS.ByteString -> Maybe Seckey
-seckey bs
- | BS.length bs == 32 = Just (Seckey bs)
- | otherwise = Nothing
-{-# INLINE seckey #-}
+-- Abort on a state that the surrounding code rules out.
+internal_error :: a
+internal_error = error "ppad-bolt3: internal error, please report a bug!"
+{-# NOINLINE internal_error #-}
--- transaction primitives ------------------------------------------------------
+-- A 'Satoshi' amount known to be at most 21 million BTC (a constant,
+-- or a value bounded by construction).
+sat :: Word64 -> Satoshi
+sat w = case BOLT1.satoshi w of
+ Just s -> s
+ Nothing -> internal_error
+{-# INLINE sat #-}
--- | Transaction input sequence number.
-newtype Sequence = Sequence { unSequence :: Word32 }
- deriving (Eq, Ord, Show, Generic)
+-- points and keys ------------------------------------------------------------
--- | Transaction locktime.
-newtype Locktime = Locktime { unLocktime :: Word32 }
+-- | A per-commitment point, from which a commitment's keys are
+-- derived.
+newtype PerCommitmentPoint = PerCommitmentPoint Point
deriving (Eq, Ord, Show, Generic)
--- channel parameters ----------------------------------------------------------
+instance NFData PerCommitmentPoint
--- | 48-bit commitment number.
-newtype CommitmentNumber = CommitmentNumber
- { unCommitmentNumber :: Word64 }
+-- | A @revocation_basepoint@.
+newtype RevocationBasepoint = RevocationBasepoint Point
deriving (Eq, Ord, Show, Generic)
--- | Parse a 48-bit commitment number.
---
--- Returns Nothing if the value exceeds 2^48 - 1.
-commitment_number :: Word64 -> Maybe CommitmentNumber
-commitment_number n
- | n <= 281474976710655 = Just (CommitmentNumber n)
- | otherwise = Nothing
-{-# INLINE commitment_number #-}
+instance NFData RevocationBasepoint
--- | Increment a commitment number by one.
---
--- Returns Nothing if the result would exceed 2^48 - 1.
---
--- >>> fmap next_commitment_number (commitment_number 0)
--- Just (Just (CommitmentNumber {unCommitmentNumber = 1}))
--- >>> fmap next_commitment_number (commitment_number 281474976710655)
--- Just Nothing
-next_commitment_number
- :: CommitmentNumber -> Maybe CommitmentNumber
-next_commitment_number (CommitmentNumber n)
- | n < 281474976710655 = Just (CommitmentNumber (n + 1))
- | otherwise = Nothing
-{-# INLINE next_commitment_number #-}
-
--- | CSV delay for to_local outputs.
-newtype ToSelfDelay = ToSelfDelay { unToSelfDelay :: Word16 }
+-- | A @payment_basepoint@.
+newtype PaymentBasepoint = PaymentBasepoint Point
deriving (Eq, Ord, Show, Generic)
--- | CLTV expiry for HTLCs.
-newtype CltvExpiry = CltvExpiry { unCltvExpiry :: Word32 }
- deriving (Eq, Ord, Show, Generic)
-
--- | Dust limit threshold.
-newtype DustLimit = DustLimit { unDustLimit :: Satoshi }
- deriving (Eq, Ord, Show, Generic)
+instance NFData PaymentBasepoint
--- | Fee rate in satoshis per 1000 weight units.
-newtype FeeratePerKw = FeeratePerKw { unFeeratePerKw :: Word32 }
+-- | A @delayed_payment_basepoint@.
+newtype DelayedPaymentBasepoint = DelayedPaymentBasepoint Point
deriving (Eq, Ord, Show, Generic)
--- HTLC types ------------------------------------------------------------------
+instance NFData DelayedPaymentBasepoint
--- | Direction of an HTLC from the commitment tx owner's perspective.
-data HTLCDirection
- = HTLCOffered -- ^ We offered this HTLC (outgoing)
- | HTLCReceived -- ^ We received this HTLC (incoming)
+-- | An @htlc_basepoint@.
+newtype HtlcBasepoint = HtlcBasepoint Point
deriving (Eq, Ord, Show, Generic)
--- | HTLC output details.
-data HTLC = HTLC
- { htlc_direction :: !HTLCDirection
- , htlc_amount_msat :: {-# UNPACK #-} !MilliSatoshi
- , htlc_payment_hash :: {-# UNPACK #-} !PaymentHash
- , htlc_cltv_expiry :: {-# UNPACK #-} !CltvExpiry
+instance NFData HtlcBasepoint
+
+-- | The four basepoints a party announces in @open_channel@ or
+-- @accept_channel@.
+data Basepoints = Basepoints
+ { bp_revocation :: !RevocationBasepoint
+ , bp_payment :: !PaymentBasepoint
+ , bp_delayed_payment :: !DelayedPaymentBasepoint
+ , bp_htlc :: !HtlcBasepoint
} deriving (Eq, Show, Generic)
--- basepoints ------------------------------------------------------------------
+instance NFData Basepoints
--- | Per-commitment point (used to derive keys).
-newtype PerCommitmentPoint = PerCommitmentPoint
- { unPerCommitmentPoint :: Point }
+-- | A commitment's @revocationpubkey@.
+newtype RevocationPubkey = RevocationPubkey Point
deriving (Eq, Ord, Show, Generic)
--- | Revocation basepoint.
-newtype RevocationBasepoint = RevocationBasepoint
- { unRevocationBasepoint :: Point }
- deriving (Eq, Ord, Show, Generic)
+instance NFData RevocationPubkey
--- | Payment basepoint.
-newtype PaymentBasepoint = PaymentBasepoint
- { unPaymentBasepoint :: Point }
+-- | A commitment's @local_delayedpubkey@: the owner's key for its
+-- delayed outputs.
+newtype LocalDelayedPubkey = LocalDelayedPubkey Point
deriving (Eq, Ord, Show, Generic)
--- | Delayed payment basepoint.
-newtype DelayedPaymentBasepoint = DelayedPaymentBasepoint
- { unDelayedPaymentBasepoint :: Point }
- deriving (Eq, Ord, Show, Generic)
+instance NFData LocalDelayedPubkey
--- | HTLC basepoint.
-newtype HtlcBasepoint = HtlcBasepoint
- { unHtlcBasepoint :: Point }
+-- | A commitment's @local_htlcpubkey@: the owner's HTLC key.
+newtype LocalHtlcPubkey = LocalHtlcPubkey Point
deriving (Eq, Ord, Show, Generic)
--- | Collection of all basepoints for one party.
-data Basepoints = Basepoints
- { bp_revocation :: !RevocationBasepoint
- , bp_payment :: !PaymentBasepoint
- , bp_delayed_payment :: !DelayedPaymentBasepoint
- , bp_htlc :: !HtlcBasepoint
- } deriving (Eq, Show, Generic)
+instance NFData LocalHtlcPubkey
+
+-- | A commitment's @remote_htlcpubkey@: the other party's HTLC key.
+newtype RemoteHtlcPubkey = RemoteHtlcPubkey Point
+ deriving (Eq, Ord, Show, Generic)
--- derived keys ----------------------------------------------------------------
+instance NFData RemoteHtlcPubkey
--- | Local pubkey.
-newtype LocalPubkey = LocalPubkey { unLocalPubkey :: Pubkey }
+-- | A commitment's @remotepubkey@: the other party's
+-- @payment_basepoint@, which its @to_remote@ output pays.
+newtype RemotePubkey = RemotePubkey Point
deriving (Eq, Ord, Show, Generic)
--- | Remote pubkey.
-newtype RemotePubkey = RemotePubkey
- { unRemotePubkey :: Pubkey }
+instance NFData RemotePubkey
+
+-- | A @funding_pubkey@.
+newtype FundingPubkey = FundingPubkey Point
deriving (Eq, Ord, Show, Generic)
--- | Local delayed pubkey.
-newtype LocalDelayedPubkey = LocalDelayedPubkey
- { unLocalDelayedPubkey :: Pubkey }
+instance NFData FundingPubkey
+
+-- | A secp256k1 secret key: 32 bytes encoding an integer in
+-- [1, n), for n the group order.
+--
+-- This is secret material: its 'Show' instance is redacted, and it
+-- has no 'Eq' instance.
+newtype Seckey = Seckey BS.ByteString
+
+instance Show Seckey where
+ showsPrec d _ = showParen (d > 10) $ showString "Seckey <redacted>"
+
+instance NFData Seckey where
+ rnf (Seckey bs) = rnf bs
+
+-- | Construct a 'Seckey' from 32 big-endian bytes. Fails unless the
+-- bytes encode an integer in [1, n).
+--
+-- >>> fmap (BS.length . un_seckey) (seckey (BS.replicate 32 0x01))
+-- Just 32
+-- >>> seckey (BS.replicate 32 0x00)
+-- Nothing
+-- >>> seckey (BS.replicate 32 0xff)
+-- Nothing
+seckey :: BS.ByteString -> Maybe Seckey
+seckey bs = do
+ w <- S.parse_int256 bs
+ if S.ge w
+ then Just (Seckey bs)
+ else Nothing
+
+-- | The bytes of a 'Seckey'.
+un_seckey :: Seckey -> BS.ByteString
+un_seckey (Seckey bs) = bs
+{-# INLINE un_seckey #-}
+
+-- per-commitment secrets -----------------------------------------------------
+
+-- | The 32-byte seed from which a party generates its per-commitment
+-- secrets.
+--
+-- This is secret material: its 'Show' instance is redacted, and it
+-- has no 'Eq' instance.
+newtype Seed = Seed BS.ByteString
+
+instance Show Seed where
+ showsPrec d _ = showParen (d > 10) $ showString "Seed <redacted>"
+
+instance NFData Seed where
+ rnf (Seed bs) = rnf bs
+
+-- | Construct a 'Seed' from exactly 32 bytes.
+--
+-- >>> fmap (BS.length . un_seed) (seed (BS.replicate 32 0xff))
+-- Just 32
+-- >>> seed (BS.replicate 31 0xff)
+-- Nothing
+seed :: BS.ByteString -> Maybe Seed
+seed bs
+ | BS.length bs == 32 = Just (Seed bs)
+ | otherwise = Nothing
+{-# INLINE seed #-}
+
+-- | The bytes of a 'Seed'.
+un_seed :: Seed -> BS.ByteString
+un_seed (Seed bs) = bs
+{-# INLINE un_seed #-}
+
+-- | The 48-bit index /I/ of a per-commitment secret. Secrets are
+-- used from index 2^48 - 1 downwards.
+newtype SecretIndex = SecretIndex Word64
deriving (Eq, Ord, Show, Generic)
--- | Remote delayed pubkey.
-newtype RemoteDelayedPubkey = RemoteDelayedPubkey
- { unRemoteDelayedPubkey :: Pubkey }
+instance NFData SecretIndex
+
+-- | Construct a 'SecretIndex'. Fails at or above 2^48.
+--
+-- >>> secret_index 281474976710655
+-- Just (SecretIndex 281474976710655)
+-- >>> secret_index 281474976710656
+-- Nothing
+secret_index :: Word64 -> Maybe SecretIndex
+secret_index w
+ | w <= 0xFFFFFFFFFFFF = Just (SecretIndex w)
+ | otherwise = Nothing
+{-# INLINE secret_index #-}
+
+-- | The value of a 'SecretIndex'.
+un_secret_index :: SecretIndex -> Word64
+un_secret_index (SecretIndex w) = w
+{-# INLINE un_secret_index #-}
+
+-- | The index of the per-commitment secret for a commitment number:
+-- 2^48 - 1 - n.
+--
+-- >>> fmap commitment_secret_index (commitment_number 0)
+-- Just (SecretIndex 281474976710655)
+commitment_secret_index :: CommitmentNumber -> SecretIndex
+commitment_secret_index (CommitmentNumber n) = SecretIndex (0xFFFFFFFFFFFF - n)
+{-# INLINE commitment_secret_index #-}
+
+-- channel parameters ---------------------------------------------------------
+
+-- | A 48-bit commitment number.
+newtype CommitmentNumber = CommitmentNumber Word64
deriving (Eq, Ord, Show, Generic)
--- | Local HTLC pubkey.
-newtype LocalHtlcPubkey = LocalHtlcPubkey
- { unLocalHtlcPubkey :: Pubkey }
+instance NFData CommitmentNumber
+
+-- | Construct a 'CommitmentNumber'. Fails at or above 2^48.
+--
+-- >>> commitment_number 42
+-- Just (CommitmentNumber 42)
+-- >>> commitment_number 281474976710656
+-- Nothing
+commitment_number :: Word64 -> Maybe CommitmentNumber
+commitment_number n
+ | n <= 0xFFFFFFFFFFFF = Just (CommitmentNumber n)
+ | otherwise = Nothing
+{-# INLINE commitment_number #-}
+
+-- | The value of a 'CommitmentNumber'.
+un_commitment_number :: CommitmentNumber -> Word64
+un_commitment_number (CommitmentNumber n) = n
+{-# INLINE un_commitment_number #-}
+
+-- | The next commitment number. Fails past 2^48 - 1.
+--
+-- >>> commitment_number 0 >>= next_commitment_number
+-- Just (CommitmentNumber 1)
+-- >>> commitment_number 281474976710655 >>= next_commitment_number
+-- Nothing
+next_commitment_number :: CommitmentNumber -> Maybe CommitmentNumber
+next_commitment_number (CommitmentNumber n)
+ | n < 0xFFFFFFFFFFFF = Just (CommitmentNumber (n + 1))
+ | otherwise = Nothing
+{-# INLINE next_commitment_number #-}
+
+-- | The CSV delay (@to_self_delay@) on a commitment owner's outputs.
+newtype ToSelfDelay = ToSelfDelay Word16
deriving (Eq, Ord, Show, Generic)
--- | Remote HTLC pubkey.
-newtype RemoteHtlcPubkey = RemoteHtlcPubkey
- { unRemoteHtlcPubkey :: Pubkey }
+instance NFData ToSelfDelay
+
+-- | An HTLC's absolute CLTV expiry.
+newtype CltvExpiry = CltvExpiry Word32
deriving (Eq, Ord, Show, Generic)
--- | Revocation pubkey.
-newtype RevocationPubkey = RevocationPubkey
- { unRevocationPubkey :: Pubkey }
+instance NFData CltvExpiry
+
+-- | A @dust_limit_satoshis@ threshold.
+newtype DustLimit = DustLimit Satoshi
deriving (Eq, Ord, Show, Generic)
--- | Funding pubkey (used in 2-of-2 multisig).
-newtype FundingPubkey = FundingPubkey
- { unFundingPubkey :: Pubkey }
+instance NFData DustLimit
+
+-- | A fee rate, in satoshis per 1000 weight units.
+newtype FeeratePerKw = FeeratePerKw Word32
deriving (Eq, Ord, Show, Generic)
--- script ----------------------------------------------------------------------
+instance NFData FeeratePerKw
--- | Bitcoin script (serialized).
-newtype Script = Script { unScript :: BS.ByteString }
+-- | A transaction locktime.
+newtype Locktime = Locktime Word32
deriving (Eq, Ord, Show, Generic)
--- channel options -------------------------------------------------------------
+instance NFData Locktime
--- | Channel feature flags relevant to BOLT #3.
-data ChannelFeatures = ChannelFeatures
- { cf_option_anchors :: !Bool
- } deriving (Eq, Show, Generic)
+-- | A transaction input's sequence number.
+newtype Sequence = Sequence Word32
+ deriving (Eq, Ord, Show, Generic)
--- | Check if option_anchors is enabled.
-has_anchors :: ChannelFeatures -> Bool
-has_anchors = cf_option_anchors
-{-# INLINE has_anchors #-}
+instance NFData Sequence
+
+-- | The commitment format a channel uses, as fixed by its
+-- @channel_type@.
+data CommitmentFormat
+ = StaticRemotekey
+ -- ^ @option_static_remotekey@ without anchors: @to_remote@ is
+ -- P2WPKH and HTLC transactions pay their own fees.
+ | Anchors
+ -- ^ @option_anchors@: two anchor outputs, a CSV-locked
+ -- @to_remote@, and zero-fee HTLC transactions.
+ deriving (Eq, Ord, Show, Generic)
--- transaction weights (constants from spec) -----------------------------------
+instance NFData CommitmentFormat
--- | Base commitment tx weight without option_anchors.
-commitment_weight_no_anchors :: Word64
-commitment_weight_no_anchors = 724
+-- HTLCs ----------------------------------------------------------------------
--- | Base commitment tx weight with option_anchors.
-commitment_weight_anchors :: Word64
-commitment_weight_anchors = 1124
+-- | The direction of an HTLC, from the commitment owner's point of
+-- view.
+data HTLCDirection
+ = HTLCOffered -- ^ offered by the owner
+ | HTLCReceived -- ^ received by the owner
+ deriving (Eq, Ord, Show, Generic)
--- | HTLC-timeout tx weight without option_anchors.
-htlc_timeout_weight_no_anchors :: Word64
-htlc_timeout_weight_no_anchors = 663
+instance NFData HTLCDirection
--- | HTLC-timeout tx weight with option_anchors.
-htlc_timeout_weight_anchors :: Word64
-htlc_timeout_weight_anchors = 666
+-- | An HTLC committed to a commitment transaction.
+data HTLC = HTLC
+ { htlc_direction :: !HTLCDirection
+ , htlc_amount_msat :: {-# UNPACK #-} !MilliSatoshi
+ , htlc_payment_hash :: !PaymentHash
+ , htlc_cltv_expiry :: {-# UNPACK #-} !CltvExpiry
+ } deriving (Eq, Show, Generic)
+
+instance NFData HTLC
--- | HTLC-success tx weight without option_anchors.
-htlc_success_weight_no_anchors :: Word64
-htlc_success_weight_no_anchors = 703
+-- scripts --------------------------------------------------------------------
--- | HTLC-success tx weight with option_anchors.
-htlc_success_weight_anchors :: Word64
-htlc_success_weight_anchors = 706
+-- | A serialized Bitcoin script.
+newtype Script = Script BS.ByteString
+ deriving (Eq, Ord, Show, Generic)
--- | Weight added per HTLC output in commitment tx.
-htlc_output_weight :: Word64
-htlc_output_weight = 172
+instance NFData Script
--- dust thresholds (constants from Bitcoin Core) -------------------------------
+-- dust thresholds ------------------------------------------------------------
--- | P2PKH dust threshold (546 satoshis).
+-- | Bitcoin Core's P2PKH dust threshold (546 satoshis).
dust_p2pkh :: Satoshi
-dust_p2pkh = Satoshi 546
+dust_p2pkh = sat 546
--- | P2SH dust threshold (540 satoshis).
+-- | Bitcoin Core's P2SH dust threshold (540 satoshis).
dust_p2sh :: Satoshi
-dust_p2sh = Satoshi 540
+dust_p2sh = sat 540
--- | P2WPKH dust threshold (294 satoshis).
+-- | Bitcoin Core's P2WPKH dust threshold (294 satoshis).
dust_p2wpkh :: Satoshi
-dust_p2wpkh = Satoshi 294
+dust_p2wpkh = sat 294
--- | P2WSH dust threshold (330 satoshis).
+-- | Bitcoin Core's P2WSH dust threshold (330 satoshis).
dust_p2wsh :: Satoshi
-dust_p2wsh = Satoshi 330
+dust_p2wsh = sat 330
--- | Fixed anchor output value (330 satoshis).
+-- | The value of each anchor output (330 satoshis).
anchor_output_value :: Satoshi
-anchor_output_value = Satoshi 330
+anchor_output_value = sat 330
diff --git a/lib/Lightning/Protocol/BOLT3/Validate.hs b/lib/Lightning/Protocol/BOLT3/Validate.hs
@@ -1,359 +0,0 @@
-{-# OPTIONS_HADDOCK prune #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveGeneric #-}
-
--- |
--- Module: Lightning.Protocol.BOLT3.Validate
--- Copyright: (c) 2025 Jared Tobin
--- License: MIT
--- Maintainer: Jared Tobin <jared@ppad.tech>
---
--- Stateless validation for BOLT #3 transactions.
---
--- Provides validation for:
---
--- * Commitment transaction structure and outputs
--- * HTLC transaction structure
--- * Closing transaction structure
--- * Output ordering per BIP69+CLTV
--- * Dust limit compliance
-
-module Lightning.Protocol.BOLT3.Validate (
- -- * Validation errors
- ValidationError(..)
-
- -- * Commitment transaction validation
- , validate_commitment_tx
- , validate_commitment_locktime
- , validate_commitment_sequence
-
- -- * HTLC transaction validation
- , validate_htlc_tx
- , validate_htlc_timeout_tx
- , validate_htlc_success_tx
-
- -- * Closing transaction validation
- , validate_closing_tx
- , validate_legacy_closing_tx
-
- -- * Output validation
- , validate_output_ordering
- , validate_dust_limits
- , validate_anchor_outputs
-
- -- * Fee validation
- , validate_commitment_fee
- , validate_htlc_fee
- ) where
-
-import Data.Bits ((.&.), shiftR)
-import Data.Word (Word32, Word64)
-import GHC.Generics (Generic)
-import Lightning.Protocol.BOLT3.Types
-import Lightning.Protocol.BOLT3.Tx
-
--- validation errors -----------------------------------------------------------
-
--- | Errors that can occur during validation.
-data ValidationError
- = InvalidVersion {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32
- -- ^ Expected version, actual version
- | InvalidLocktime {-# UNPACK #-} !Word32
- -- ^ Invalid locktime format
- | InvalidSequence {-# UNPACK #-} !Word32
- -- ^ Invalid sequence format
- | InvalidOutputOrdering
- -- ^ Outputs not in BIP69+CLTV order
- | DustLimitViolation {-# UNPACK #-} !Int !Satoshi !Satoshi
- -- ^ Output index, actual value, dust limit
- | MissingAnchorOutput
- -- ^ Expected anchor output not present
- | InvalidAnchorValue {-# UNPACK #-} !Satoshi
- -- ^ Anchor value not 330 satoshis
- | InvalidFee {-# UNPACK #-} !Satoshi {-# UNPACK #-} !Satoshi
- -- ^ Expected fee, actual fee
- | InvalidHTLCLocktime {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32
- -- ^ Expected locktime, actual locktime
- | InvalidHTLCSequence {-# UNPACK #-} !Word32 {-# UNPACK #-} !Word32
- -- ^ Expected sequence, actual sequence
- | NoOutputs
- -- ^ Transaction has no outputs
- | TooManyOutputs {-# UNPACK #-} !Int
- -- ^ More outputs than expected
- deriving (Eq, Show, Generic)
-
--- commitment transaction validation -------------------------------------------
-
--- | Validate a commitment transaction.
---
--- Checks:
---
--- * Version is 2
--- * Locktime format (upper 8 bits = 0x20)
--- * Sequence format (upper 8 bits = 0x80)
--- * Output ordering per BIP69+CLTV
--- * Dust limit compliance
--- * Anchor outputs if option_anchors
-validate_commitment_tx
- :: DustLimit
- -> ChannelFeatures
- -> CommitmentTx
- -> Either ValidationError ()
-validate_commitment_tx dust features tx = do
- -- Version must be 2
- validateVersion 2 (ctx_version tx)
- -- Locktime format
- validate_commitment_locktime (ctx_locktime tx)
- -- Sequence format
- validate_commitment_sequence (ctx_input_sequence tx)
- -- Output ordering
- validate_output_ordering (ctx_outputs tx)
- -- Dust limits
- validate_dust_limits dust (ctx_outputs tx)
- -- Anchors if applicable
- if has_anchors features
- then validate_anchor_outputs (ctx_outputs tx)
- else pure ()
-{-# INLINE validate_commitment_tx #-}
-
--- | Validate commitment transaction locktime format.
---
--- Upper 8 bits must be 0x20.
-validate_commitment_locktime :: Locktime -> Either ValidationError ()
-validate_commitment_locktime (Locktime lt) =
- let !upper = (lt `shiftR` 24) .&. 0xFF
- in if upper == 0x20
- then Right ()
- else Left (InvalidLocktime lt)
-{-# INLINE validate_commitment_locktime #-}
-
--- | Validate commitment transaction sequence format.
---
--- Upper 8 bits must be 0x80.
-validate_commitment_sequence :: Sequence -> Either ValidationError ()
-validate_commitment_sequence (Sequence sq) =
- let !upper = (sq `shiftR` 24) .&. 0xFF
- in if upper == 0x80
- then Right ()
- else Left (InvalidSequence sq)
-{-# INLINE validate_commitment_sequence #-}
-
--- HTLC transaction validation -------------------------------------------------
-
--- | Validate an HTLC transaction (timeout or success).
---
--- Checks:
---
--- * Version is 2
--- * Single output
-validate_htlc_tx :: HTLCTx -> Either ValidationError ()
-validate_htlc_tx tx = do
- validateVersion 2 (htx_version tx)
- pure ()
-{-# INLINE validate_htlc_tx #-}
-
--- | Validate an HTLC-timeout transaction.
---
--- Checks:
---
--- * Base HTLC validation
--- * Locktime equals HTLC cltv_expiry
--- * Sequence is 0 (or 1 with option_anchors)
-validate_htlc_timeout_tx
- :: ChannelFeatures
- -> CltvExpiry
- -> HTLCTx
- -> Either ValidationError ()
-validate_htlc_timeout_tx features expiry tx = do
- validate_htlc_tx tx
- -- Locktime must be cltv_expiry
- let !expectedLt = unCltvExpiry expiry
- !actualLt = unLocktime (htx_locktime tx)
- if expectedLt == actualLt
- then pure ()
- else Left (InvalidHTLCLocktime expectedLt actualLt)
- -- Sequence
- let !expectedSeq = if has_anchors features then 1 else 0
- !actualSeq = unSequence (htx_input_sequence tx)
- if expectedSeq == actualSeq
- then pure ()
- else Left (InvalidHTLCSequence expectedSeq actualSeq)
-{-# INLINE validate_htlc_timeout_tx #-}
-
--- | Validate an HTLC-success transaction.
---
--- Checks:
---
--- * Base HTLC validation
--- * Locktime is 0
--- * Sequence is 0 (or 1 with option_anchors)
-validate_htlc_success_tx
- :: ChannelFeatures
- -> HTLCTx
- -> Either ValidationError ()
-validate_htlc_success_tx features tx = do
- validate_htlc_tx tx
- -- Locktime must be 0
- let !actualLt = unLocktime (htx_locktime tx)
- if actualLt == 0
- then pure ()
- else Left (InvalidHTLCLocktime 0 actualLt)
- -- Sequence
- let !expectedSeq = if has_anchors features then 1 else 0
- !actualSeq = unSequence (htx_input_sequence tx)
- if expectedSeq == actualSeq
- then pure ()
- else Left (InvalidHTLCSequence expectedSeq actualSeq)
-{-# INLINE validate_htlc_success_tx #-}
-
--- closing transaction validation ----------------------------------------------
-
--- | Validate a closing transaction (option_simple_close).
---
--- Checks:
---
--- * Version is 2
--- * Sequence is 0xFFFFFFFD
--- * At least one output
--- * Output ordering per BIP69
-validate_closing_tx :: ClosingTx -> Either ValidationError ()
-validate_closing_tx tx = do
- validateVersion 2 (cltx_version tx)
- let !actualSeq = unSequence (cltx_input_sequence tx)
- if actualSeq == 0xFFFFFFFD
- then pure ()
- else Left (InvalidSequence actualSeq)
- validateOutputCount (cltx_outputs tx)
- validate_output_ordering (cltx_outputs tx)
-{-# INLINE validate_closing_tx #-}
-
--- | Validate a legacy closing transaction (closing_signed).
---
--- Checks:
---
--- * Version is 2
--- * Locktime is 0
--- * Sequence is 0xFFFFFFFF
--- * At least one output
--- * Output ordering per BIP69
-validate_legacy_closing_tx :: ClosingTx -> Either ValidationError ()
-validate_legacy_closing_tx tx = do
- validateVersion 2 (cltx_version tx)
- let !actualLt = unLocktime (cltx_locktime tx)
- if actualLt == 0
- then pure ()
- else Left (InvalidLocktime actualLt)
- let !actualSeq = unSequence (cltx_input_sequence tx)
- if actualSeq == 0xFFFFFFFF
- then pure ()
- else Left (InvalidSequence actualSeq)
- validateOutputCount (cltx_outputs tx)
- validate_output_ordering (cltx_outputs tx)
-{-# INLINE validate_legacy_closing_tx #-}
-
--- output validation -----------------------------------------------------------
-
--- | Validate output ordering per BIP69+CLTV.
---
--- Outputs must be sorted by:
--- 1. Value (smallest first)
--- 2. ScriptPubKey (lexicographic)
--- 3. CLTV expiry (for HTLC outputs)
-validate_output_ordering :: [TxOutput] -> Either ValidationError ()
-validate_output_ordering outputs =
- let !sorted = sort_outputs outputs
- in if outputs == sorted
- then Right ()
- else Left InvalidOutputOrdering
-{-# INLINE validate_output_ordering #-}
-
--- | Validate that no output violates dust limits.
-validate_dust_limits
- :: DustLimit
- -> [TxOutput]
- -> Either ValidationError ()
-validate_dust_limits dust = go 0 where
- !limit = unDustLimit dust
- go !_ [] = Right ()
- go !idx (out:rest) =
- let !val = txout_value out
- in case txout_type out of
- -- Anchors have fixed value, don't check against dust limit
- OutputLocalAnchor -> go (idx + 1) rest
- OutputRemoteAnchor -> go (idx + 1) rest
- -- All other outputs must be above dust
- _ -> if unSatoshi val >= unSatoshi limit
- then go (idx + 1) rest
- else Left (DustLimitViolation idx val limit)
-{-# INLINE validate_dust_limits #-}
-
--- | Validate anchor outputs are present and correctly valued.
-validate_anchor_outputs :: [TxOutput] -> Either ValidationError ()
-validate_anchor_outputs outputs =
- let !anchors = filter isAnchor outputs
- in if null anchors
- then Left MissingAnchorOutput
- else validateAnchorValues anchors
- where
- isAnchor out = case txout_type out of
- OutputLocalAnchor -> True
- OutputRemoteAnchor -> True
- _ -> False
-
- validateAnchorValues [] = Right ()
- validateAnchorValues (a:as) =
- let !val = txout_value a
- in if val == anchor_output_value
- then validateAnchorValues as
- else Left (InvalidAnchorValue val)
-{-# INLINE validate_anchor_outputs #-}
-
--- fee validation --------------------------------------------------------------
-
--- | Validate commitment transaction fee.
---
--- Checks that the fee matches the expected calculation.
-validate_commitment_fee
- :: FeeratePerKw
- -> ChannelFeatures
- -> Word64 -- ^ Number of untrimmed HTLCs
- -> Satoshi -- ^ Actual fee
- -> Either ValidationError ()
-validate_commitment_fee feerate features numHtlcs actualFee =
- let !expectedFee = commitment_fee feerate features numHtlcs
- in if actualFee == expectedFee
- then Right ()
- else Left (InvalidFee expectedFee actualFee)
-{-# INLINE validate_commitment_fee #-}
-
--- | Validate HTLC transaction fee.
-validate_htlc_fee
- :: FeeratePerKw
- -> ChannelFeatures
- -> HTLCDirection
- -> Satoshi -- ^ Actual fee
- -> Either ValidationError ()
-validate_htlc_fee feerate features direction actualFee =
- let !expectedFee = case direction of
- HTLCOffered -> htlc_timeout_fee feerate features
- HTLCReceived -> htlc_success_fee feerate features
- in if actualFee == expectedFee
- then Right ()
- else Left (InvalidFee expectedFee actualFee)
-{-# INLINE validate_htlc_fee #-}
-
--- helpers ---------------------------------------------------------------------
-
--- | Validate transaction version.
-validateVersion :: Word32 -> Word32 -> Either ValidationError ()
-validateVersion expected actual =
- if expected == actual
- then Right ()
- else Left (InvalidVersion expected actual)
-{-# INLINE validateVersion #-}
-
--- | Validate that transaction has at least one output.
-validateOutputCount :: [TxOutput] -> Either ValidationError ()
-validateOutputCount [] = Left NoOutputs
-validateOutputCount _ = Right ()
-{-# INLINE validateOutputCount #-}
diff --git a/ppad-bolt3.cabal b/ppad-bolt3.cabal
@@ -25,22 +25,20 @@ library
-Wall
exposed-modules:
Lightning.Protocol.BOLT3
- Lightning.Protocol.BOLT3.Decode
- Lightning.Protocol.BOLT3.Encode
- Lightning.Protocol.BOLT3.Internal
+ other-modules:
Lightning.Protocol.BOLT3.Keys
Lightning.Protocol.BOLT3.Scripts
Lightning.Protocol.BOLT3.Tx
Lightning.Protocol.BOLT3.Types
- Lightning.Protocol.BOLT3.Validate
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
- , ppad-bolt1 >= 0.0.1 && < 0.1
+ , deepseq >= 1.4 && < 1.6
+ , ppad-bolt1 >= 0.1 && < 0.2
, ppad-ripemd160 >= 0.1.4 && < 0.2
- , ppad-secp256k1 >= 0.5.4 && < 0.6
+ , ppad-secp256k1 >= 0.5.7 && < 0.6
, ppad-sha256 >= 0.3.2 && < 0.4
- , ppad-tx >= 0.1 && < 0.2
+ , ppad-tx >= 0.2 && < 0.3
test-suite bolt3-tests
type: exitcode-stdio-1.0
