{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}

-- |
-- Module: Lightning.Protocol.BOLT5.Spend
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Spending transaction construction for BOLT #5 on-chain
-- transaction handling.
--
-- All functions produce unsigned 'SpendingTx' values. The caller
-- is responsible for signing (using the sighash metadata
-- provided) and assembling final witnesses via bolt3 witness
-- constructors.

module Lightning.Protocol.BOLT5.Spend (
    -- * Local commitment spends
    spend_to_local
  , spend_htlc_timeout
  , spend_htlc_success
  , spend_htlc_output

    -- * Remote commitment spends
  , spend_remote_htlc_timeout
  , spend_remote_htlc_preimage

    -- * Revoked commitment spends
  , spend_revoked_to_local
  , spend_revoked_htlc
  , spend_revoked_htlc_output
  , spend_revoked_batch

    -- * Anchor spends
  , spend_anchor_owner
  , spend_anchor_anyone
  ) where

import Bitcoin.Prim.Tx (TxOut(..))
import Bitcoin.Prim.Tx.Sighash (SighashType(..))
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Word (Word32)
import qualified Data.ByteString as BS
import Lightning.Protocol.BOLT3 hiding
  (txout_value, txout_script)
import Lightning.Protocol.BOLT5.Types

-- local commitment spends --------------------------------------------

-- | Spend the to_local output of our local commitment tx.
--
-- Requires waiting for the CSV delay (to_self_delay) before
-- broadcasting. The caller signs with the local delayed privkey
-- and uses 'to_local_witness_spend' from bolt3.
--
-- Returns 'Nothing' if the fee would exceed the output value.
--
-- The input nSequence is set to the to_self_delay value.
spend_to_local
  :: OutPoint
  -- ^ Outpoint of the to_local output.
  -> Satoshi
  -- ^ Value of the to_local output.
  -> RevocationPubkey
  -> ToSelfDelay
  -> LocalDelayedPubkey
  -> Script
  -- ^ Destination scriptPubKey.
  -> FeeratePerKw
  -> Maybe SpendingTx
spend_to_local :: OutPoint
-> Satoshi
-> RevocationPubkey
-> ToSelfDelay
-> LocalDelayedPubkey
-> Script
-> FeeratePerKw
-> Maybe SpendingTx
spend_to_local !OutPoint
op !Satoshi
value !RevocationPubkey
revpk !ToSelfDelay
delay !LocalDelayedPubkey
delayedpk
    !Script
destScript !FeeratePerKw
feerate =
  let !witnessScript :: Script
witnessScript =
        RevocationPubkey -> ToSelfDelay -> LocalDelayedPubkey -> Script
to_local_script RevocationPubkey
revpk ToSelfDelay
delay LocalDelayedPubkey
delayedpk
      !weight :: Word64
weight = Word64
to_local_penalty_input_weight
              Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
penalty_tx_base_weight
      !fee :: Satoshi
fee = FeeratePerKw -> Word64 -> Satoshi
spending_fee FeeratePerKw
feerate Word64
weight
  in if Satoshi -> Word64
unSatoshi Satoshi
fee Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
value
     then Maybe SpendingTx
forall a. Maybe a
Nothing
     else
       let !outputValue :: Satoshi
outputValue =
             Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi Satoshi
value Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
fee)
           !tx :: Tx
tx = OutPoint -> Word32 -> Script -> Satoshi -> Word32 -> Tx
mk_spending_tx OutPoint
op
                   (Word16 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ToSelfDelay -> Word16
unToSelfDelay ToSelfDelay
delay))
                   Script
destScript Satoshi
outputValue Word32
0
       in SpendingTx -> Maybe SpendingTx
forall a. a -> Maybe a
Just (Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
value
                  SighashType
SIGHASH_ALL)

-- | Construct an HTLC-timeout second-stage transaction.
--
-- Used when we offered an HTLC on our local commitment and it
-- has timed out. The bolt3 'build_htlc_timeout_tx' function
-- constructs the HTLC-timeout tx; this wraps it as a
-- 'SpendingTx' with the witness script and sighash metadata.
spend_htlc_timeout
  :: HTLCContext
  -> CommitmentKeys
  -- ^ Full commitment keys (needed for witness script).
  -> SpendingTx
spend_htlc_timeout :: HTLCContext -> CommitmentKeys -> SpendingTx
spend_htlc_timeout !HTLCContext
ctx !CommitmentKeys
keys =
  let !htlcTx :: HTLCTx
htlcTx = HTLCContext -> HTLCTx
build_htlc_timeout_tx HTLCContext
ctx
      !htlc :: HTLC
htlc = HTLCContext -> HTLC
hc_htlc HTLCContext
ctx
      !features :: ChannelFeatures
features = HTLCContext -> ChannelFeatures
hc_features HTLCContext
ctx
      !witnessScript :: Script
witnessScript = RevocationPubkey
-> RemoteHtlcPubkey
-> LocalHtlcPubkey
-> PaymentHash
-> ChannelFeatures
-> Script
offered_htlc_script
        (CommitmentKeys -> RevocationPubkey
ck_revocation_pubkey CommitmentKeys
keys)
        (CommitmentKeys -> RemoteHtlcPubkey
ck_remote_htlc CommitmentKeys
keys)
        (CommitmentKeys -> LocalHtlcPubkey
ck_local_htlc CommitmentKeys
keys)
        (HTLC -> PaymentHash
htlc_payment_hash HTLC
htlc)
        ChannelFeatures
features
      !inputValue :: Satoshi
inputValue =
        MilliSatoshi -> Satoshi
msatToSat (HTLC -> MilliSatoshi
htlc_amount_msat HTLC
htlc)
      !sighashType :: SighashType
sighashType = if ChannelFeatures -> Bool
has_anchors ChannelFeatures
features
        then SighashType
SIGHASH_SINGLE_ANYONECANPAY
        else SighashType
SIGHASH_ALL
      !tx :: Tx
tx = HTLCTx -> Tx
htlc_tx_to_tx HTLCTx
htlcTx
  in Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
inputValue SighashType
sighashType

-- | Construct an HTLC-success second-stage transaction.
--
-- Used when we received an HTLC on our local commitment and
-- have the preimage. The bolt3 'build_htlc_success_tx' function
-- constructs the HTLC-success tx; this wraps it as a
-- 'SpendingTx'.
spend_htlc_success
  :: HTLCContext
  -> CommitmentKeys
  -- ^ Full commitment keys (needed for witness script).
  -> SpendingTx
spend_htlc_success :: HTLCContext -> CommitmentKeys -> SpendingTx
spend_htlc_success !HTLCContext
ctx !CommitmentKeys
keys =
  let !htlcTx :: HTLCTx
htlcTx = HTLCContext -> HTLCTx
build_htlc_success_tx HTLCContext
ctx
      !htlc :: HTLC
htlc = HTLCContext -> HTLC
hc_htlc HTLCContext
ctx
      !features :: ChannelFeatures
features = HTLCContext -> ChannelFeatures
hc_features HTLCContext
ctx
      !witnessScript :: Script
witnessScript = RevocationPubkey
-> RemoteHtlcPubkey
-> LocalHtlcPubkey
-> PaymentHash
-> CltvExpiry
-> ChannelFeatures
-> Script
received_htlc_script
        (CommitmentKeys -> RevocationPubkey
ck_revocation_pubkey CommitmentKeys
keys)
        (CommitmentKeys -> RemoteHtlcPubkey
ck_remote_htlc CommitmentKeys
keys)
        (CommitmentKeys -> LocalHtlcPubkey
ck_local_htlc CommitmentKeys
keys)
        (HTLC -> PaymentHash
htlc_payment_hash HTLC
htlc)
        (HTLC -> CltvExpiry
htlc_cltv_expiry HTLC
htlc)
        ChannelFeatures
features
      !inputValue :: Satoshi
inputValue =
        MilliSatoshi -> Satoshi
msatToSat (HTLC -> MilliSatoshi
htlc_amount_msat HTLC
htlc)
      !sighashType :: SighashType
sighashType = if ChannelFeatures -> Bool
has_anchors ChannelFeatures
features
        then SighashType
SIGHASH_SINGLE_ANYONECANPAY
        else SighashType
SIGHASH_ALL
      !tx :: Tx
tx = HTLCTx -> Tx
htlc_tx_to_tx HTLCTx
htlcTx
  in Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
inputValue SighashType
sighashType

-- | Spend a second-stage HTLC output (HTLC-timeout or
--   HTLC-success output) after the CSV delay.
--
-- The output of an HTLC-timeout or HTLC-success tx uses the
-- same to_local script. The caller signs with the local
-- delayed privkey and uses 'htlc_output_witness_spend'.
--
-- Returns 'Nothing' if the fee would exceed the output value.
spend_htlc_output
  :: OutPoint
  -- ^ Outpoint of the second-stage output.
  -> Satoshi
  -- ^ Value of the second-stage output.
  -> RevocationPubkey
  -> ToSelfDelay
  -> LocalDelayedPubkey
  -> Script
  -- ^ Destination scriptPubKey.
  -> FeeratePerKw
  -> Maybe SpendingTx
spend_htlc_output :: OutPoint
-> Satoshi
-> RevocationPubkey
-> ToSelfDelay
-> LocalDelayedPubkey
-> Script
-> FeeratePerKw
-> Maybe SpendingTx
spend_htlc_output = OutPoint
-> Satoshi
-> RevocationPubkey
-> ToSelfDelay
-> LocalDelayedPubkey
-> Script
-> FeeratePerKw
-> Maybe SpendingTx
spend_to_local

-- remote commitment spends -------------------------------------------

-- | Spend an offered HTLC directly after timeout on the remote
--   commitment.
--
-- On the remote commitment, their received HTLCs (our offered)
-- have timed out and we can sweep them directly.
--
-- Returns 'Nothing' if the fee would exceed the output value.
spend_remote_htlc_timeout
  :: OutPoint
  -- ^ Outpoint of the HTLC output.
  -> Satoshi
  -- ^ Value of the HTLC output.
  -> HTLC
  -- ^ The HTLC being spent.
  -> CommitmentKeys
  -- ^ Keys for the remote commitment.
  -> ChannelFeatures
  -> Script
  -- ^ Destination scriptPubKey.
  -> FeeratePerKw
  -> Maybe SpendingTx
spend_remote_htlc_timeout :: OutPoint
-> Satoshi
-> HTLC
-> CommitmentKeys
-> ChannelFeatures
-> Script
-> FeeratePerKw
-> Maybe SpendingTx
spend_remote_htlc_timeout !OutPoint
op !Satoshi
value !HTLC
htlc !CommitmentKeys
keys
    !ChannelFeatures
features !Script
destScript !FeeratePerKw
feerate =
  let !witnessScript :: Script
witnessScript = RevocationPubkey
-> RemoteHtlcPubkey
-> LocalHtlcPubkey
-> PaymentHash
-> CltvExpiry
-> ChannelFeatures
-> Script
received_htlc_script
        (CommitmentKeys -> RevocationPubkey
ck_revocation_pubkey CommitmentKeys
keys)
        (CommitmentKeys -> RemoteHtlcPubkey
ck_remote_htlc CommitmentKeys
keys)
        (CommitmentKeys -> LocalHtlcPubkey
ck_local_htlc CommitmentKeys
keys)
        (HTLC -> PaymentHash
htlc_payment_hash HTLC
htlc)
        (HTLC -> CltvExpiry
htlc_cltv_expiry HTLC
htlc)
        ChannelFeatures
features
      !weight :: Word64
weight = Word64
accepted_htlc_penalty_input_weight
              Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
penalty_tx_base_weight
      !fee :: Satoshi
fee = FeeratePerKw -> Word64 -> Satoshi
spending_fee FeeratePerKw
feerate Word64
weight
  in if Satoshi -> Word64
unSatoshi Satoshi
fee Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
value
     then Maybe SpendingTx
forall a. Maybe a
Nothing
     else
       let !outputValue :: Satoshi
outputValue =
             Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi Satoshi
value Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
fee)
           !locktime :: Word32
locktime =
             CltvExpiry -> Word32
unCltvExpiry (HTLC -> CltvExpiry
htlc_cltv_expiry HTLC
htlc)
           !seqNo :: Word32
seqNo =
             if ChannelFeatures -> Bool
has_anchors ChannelFeatures
features then Word32
1 else Word32
0
           !tx :: Tx
tx = OutPoint -> Word32 -> Script -> Satoshi -> Word32 -> Tx
mk_spending_tx OutPoint
op Word32
seqNo Script
destScript
                   Satoshi
outputValue Word32
locktime
       in SpendingTx -> Maybe SpendingTx
forall a. a -> Maybe a
Just (Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
value
                  SighashType
SIGHASH_ALL)

-- | Spend a received HTLC directly with preimage on the remote
--   commitment.
--
-- On the remote commitment, their offered HTLCs (our received)
-- can be claimed with the payment preimage.
--
-- Returns 'Nothing' if the fee would exceed the output value.
spend_remote_htlc_preimage
  :: OutPoint
  -- ^ Outpoint of the HTLC output.
  -> Satoshi
  -- ^ Value of the HTLC output.
  -> HTLC
  -- ^ The HTLC being spent.
  -> CommitmentKeys
  -- ^ Keys for the remote commitment.
  -> ChannelFeatures
  -> Script
  -- ^ Destination scriptPubKey.
  -> FeeratePerKw
  -> Maybe SpendingTx
spend_remote_htlc_preimage :: OutPoint
-> Satoshi
-> HTLC
-> CommitmentKeys
-> ChannelFeatures
-> Script
-> FeeratePerKw
-> Maybe SpendingTx
spend_remote_htlc_preimage !OutPoint
op !Satoshi
value !HTLC
htlc !CommitmentKeys
keys
    !ChannelFeatures
features !Script
destScript !FeeratePerKw
feerate =
  let !witnessScript :: Script
witnessScript = RevocationPubkey
-> RemoteHtlcPubkey
-> LocalHtlcPubkey
-> PaymentHash
-> ChannelFeatures
-> Script
offered_htlc_script
        (CommitmentKeys -> RevocationPubkey
ck_revocation_pubkey CommitmentKeys
keys)
        (CommitmentKeys -> RemoteHtlcPubkey
ck_remote_htlc CommitmentKeys
keys)
        (CommitmentKeys -> LocalHtlcPubkey
ck_local_htlc CommitmentKeys
keys)
        (HTLC -> PaymentHash
htlc_payment_hash HTLC
htlc)
        ChannelFeatures
features
      !weight :: Word64
weight = Word64
offered_htlc_penalty_input_weight
              Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
penalty_tx_base_weight
      !fee :: Satoshi
fee = FeeratePerKw -> Word64 -> Satoshi
spending_fee FeeratePerKw
feerate Word64
weight
  in if Satoshi -> Word64
unSatoshi Satoshi
fee Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
value
     then Maybe SpendingTx
forall a. Maybe a
Nothing
     else
       let !outputValue :: Satoshi
outputValue =
             Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi Satoshi
value Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
fee)
           !seqNo :: Word32
seqNo =
             if ChannelFeatures -> Bool
has_anchors ChannelFeatures
features then Word32
1 else Word32
0
           !tx :: Tx
tx = OutPoint -> Word32 -> Script -> Satoshi -> Word32 -> Tx
mk_spending_tx OutPoint
op Word32
seqNo Script
destScript
                   Satoshi
outputValue Word32
0
       in SpendingTx -> Maybe SpendingTx
forall a. a -> Maybe a
Just (Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
value
                  SighashType
SIGHASH_ALL)

-- revoked commitment spends ------------------------------------------

-- | Spend a revoked to_local output using the revocation key.
--
-- The caller signs with the revocation privkey and uses
-- 'to_local_witness_revoke' from bolt3.
--
-- Returns 'Nothing' if the fee would exceed the output value.
spend_revoked_to_local
  :: OutPoint
  -- ^ Outpoint of the to_local output.
  -> Satoshi
  -- ^ Value of the to_local output.
  -> RevocationPubkey
  -> ToSelfDelay
  -> LocalDelayedPubkey
  -> Script
  -- ^ Destination scriptPubKey.
  -> FeeratePerKw
  -> Maybe SpendingTx
spend_revoked_to_local :: OutPoint
-> Satoshi
-> RevocationPubkey
-> ToSelfDelay
-> LocalDelayedPubkey
-> Script
-> FeeratePerKw
-> Maybe SpendingTx
spend_revoked_to_local !OutPoint
op !Satoshi
value !RevocationPubkey
revpk !ToSelfDelay
delay
    !LocalDelayedPubkey
delayedpk !Script
destScript !FeeratePerKw
feerate =
  let !witnessScript :: Script
witnessScript =
        RevocationPubkey -> ToSelfDelay -> LocalDelayedPubkey -> Script
to_local_script RevocationPubkey
revpk ToSelfDelay
delay LocalDelayedPubkey
delayedpk
      !weight :: Word64
weight = Word64
to_local_penalty_input_weight
              Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
penalty_tx_base_weight
      !fee :: Satoshi
fee = FeeratePerKw -> Word64 -> Satoshi
spending_fee FeeratePerKw
feerate Word64
weight
  in if Satoshi -> Word64
unSatoshi Satoshi
fee Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
value
     then Maybe SpendingTx
forall a. Maybe a
Nothing
     else
       let !outputValue :: Satoshi
outputValue =
             Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi Satoshi
value Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
fee)
           !tx :: Tx
tx = OutPoint -> Word32 -> Script -> Satoshi -> Word32 -> Tx
mk_spending_tx OutPoint
op Word32
0xFFFFFFFF Script
destScript
                   Satoshi
outputValue Word32
0
       in SpendingTx -> Maybe SpendingTx
forall a. a -> Maybe a
Just (Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
value
                  SighashType
SIGHASH_ALL)

-- | Spend a revoked HTLC output using the revocation key.
--
-- The caller signs with the revocation privkey and uses
-- 'offered_htlc_witness_revoke' or
-- 'received_htlc_witness_revoke' from bolt3, depending on
-- the output type.
--
-- Returns 'Nothing' if the output type is not an HTLC, or
-- if the fee would exceed the output value.
spend_revoked_htlc
  :: OutPoint
  -- ^ Outpoint of the HTLC output.
  -> Satoshi
  -- ^ Value of the HTLC output.
  -> OutputType
  -- ^ Whether offered or received HTLC.
  -> RevocationPubkey
  -> CommitmentKeys
  -> ChannelFeatures
  -> PaymentHash
  -> Script
  -- ^ Destination scriptPubKey.
  -> FeeratePerKw
  -> Maybe SpendingTx
spend_revoked_htlc :: OutPoint
-> Satoshi
-> OutputType
-> RevocationPubkey
-> CommitmentKeys
-> ChannelFeatures
-> PaymentHash
-> Script
-> FeeratePerKw
-> Maybe SpendingTx
spend_revoked_htlc !OutPoint
op !Satoshi
value !OutputType
otype !RevocationPubkey
revpk !CommitmentKeys
keys
    !ChannelFeatures
features !PaymentHash
ph !Script
destScript !FeeratePerKw
feerate =
  case OutputType
otype of
    OutputOfferedHTLC CltvExpiry
_ ->
      let !witnessScript :: Script
witnessScript = RevocationPubkey
-> RemoteHtlcPubkey
-> LocalHtlcPubkey
-> PaymentHash
-> ChannelFeatures
-> Script
offered_htlc_script
            RevocationPubkey
revpk
            (CommitmentKeys -> RemoteHtlcPubkey
ck_remote_htlc CommitmentKeys
keys)
            (CommitmentKeys -> LocalHtlcPubkey
ck_local_htlc CommitmentKeys
keys)
            PaymentHash
ph
            ChannelFeatures
features
          !weight :: Word64
weight = Word64
offered_htlc_penalty_input_weight
                  Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
penalty_tx_base_weight
          !fee :: Satoshi
fee = FeeratePerKw -> Word64 -> Satoshi
spending_fee FeeratePerKw
feerate Word64
weight
      in if Satoshi -> Word64
unSatoshi Satoshi
fee Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
value
         then Maybe SpendingTx
forall a. Maybe a
Nothing
         else
           let !outputValue :: Satoshi
outputValue =
                 Word64 -> Satoshi
Satoshi
                   (Satoshi -> Word64
unSatoshi Satoshi
value Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
fee)
               !tx :: Tx
tx = OutPoint -> Word32 -> Script -> Satoshi -> Word32 -> Tx
mk_spending_tx OutPoint
op Word32
0xFFFFFFFF
                       Script
destScript Satoshi
outputValue Word32
0
           in SpendingTx -> Maybe SpendingTx
forall a. a -> Maybe a
Just (Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
value
                      SighashType
SIGHASH_ALL)
    OutputReceivedHTLC CltvExpiry
expiry ->
      let !witnessScript :: Script
witnessScript = RevocationPubkey
-> RemoteHtlcPubkey
-> LocalHtlcPubkey
-> PaymentHash
-> CltvExpiry
-> ChannelFeatures
-> Script
received_htlc_script
            RevocationPubkey
revpk
            (CommitmentKeys -> RemoteHtlcPubkey
ck_remote_htlc CommitmentKeys
keys)
            (CommitmentKeys -> LocalHtlcPubkey
ck_local_htlc CommitmentKeys
keys)
            PaymentHash
ph
            CltvExpiry
expiry
            ChannelFeatures
features
          !weight :: Word64
weight = Word64
accepted_htlc_penalty_input_weight
                  Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
penalty_tx_base_weight
          !fee :: Satoshi
fee = FeeratePerKw -> Word64 -> Satoshi
spending_fee FeeratePerKw
feerate Word64
weight
      in if Satoshi -> Word64
unSatoshi Satoshi
fee Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
value
         then Maybe SpendingTx
forall a. Maybe a
Nothing
         else
           let !outputValue :: Satoshi
outputValue =
                 Word64 -> Satoshi
Satoshi
                   (Satoshi -> Word64
unSatoshi Satoshi
value Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
fee)
               !tx :: Tx
tx = OutPoint -> Word32 -> Script -> Satoshi -> Word32 -> Tx
mk_spending_tx OutPoint
op Word32
0xFFFFFFFF
                       Script
destScript Satoshi
outputValue Word32
0
           in SpendingTx -> Maybe SpendingTx
forall a. a -> Maybe a
Just (Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
value
                      SighashType
SIGHASH_ALL)
    OutputType
_ -> Maybe SpendingTx
forall a. Maybe a
Nothing

-- | Spend a revoked second-stage HTLC output (HTLC-timeout or
--   HTLC-success output) using the revocation key.
--
-- The output of a revoked HTLC-timeout/success tx uses the
-- to_local script. The caller signs with the revocation privkey
-- and uses 'htlc_output_witness_revoke'.
--
-- Returns 'Nothing' if the fee would exceed the output value.
spend_revoked_htlc_output
  :: OutPoint
  -- ^ Outpoint of the second-stage output.
  -> Satoshi
  -- ^ Value of the second-stage output.
  -> RevocationPubkey
  -> ToSelfDelay
  -> LocalDelayedPubkey
  -> Script
  -- ^ Destination scriptPubKey.
  -> FeeratePerKw
  -> Maybe SpendingTx
spend_revoked_htlc_output :: OutPoint
-> Satoshi
-> RevocationPubkey
-> ToSelfDelay
-> LocalDelayedPubkey
-> Script
-> FeeratePerKw
-> Maybe SpendingTx
spend_revoked_htlc_output !OutPoint
op !Satoshi
value !RevocationPubkey
revpk !ToSelfDelay
delay
    !LocalDelayedPubkey
delayedpk !Script
destScript !FeeratePerKw
feerate =
  let !witnessScript :: Script
witnessScript =
        RevocationPubkey -> ToSelfDelay -> LocalDelayedPubkey -> Script
to_local_script RevocationPubkey
revpk ToSelfDelay
delay LocalDelayedPubkey
delayedpk
      !weight :: Word64
weight = Word64
to_local_penalty_input_weight
              Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
penalty_tx_base_weight
      !fee :: Satoshi
fee = FeeratePerKw -> Word64 -> Satoshi
spending_fee FeeratePerKw
feerate Word64
weight
  in if Satoshi -> Word64
unSatoshi Satoshi
fee Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
value
     then Maybe SpendingTx
forall a. Maybe a
Nothing
     else
       let !outputValue :: Satoshi
outputValue =
             Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi Satoshi
value Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
fee)
           !tx :: Tx
tx = OutPoint -> Word32 -> Script -> Satoshi -> Word32 -> Tx
mk_spending_tx OutPoint
op Word32
0xFFFFFFFF Script
destScript
                   Satoshi
outputValue Word32
0
       in SpendingTx -> Maybe SpendingTx
forall a. a -> Maybe a
Just (Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
value
                  SighashType
SIGHASH_ALL)

-- | Construct a batched penalty transaction spending multiple
--   revoked outputs.
--
-- Per BOLT #5, up to 483 bidirectional HTLCs plus to_local can
-- be resolved in a single penalty transaction (within the
-- 400,000 weight limit). The caller signs each input with the
-- revocation privkey.
-- | Returns 'Nothing' if the total fee would exceed the
--   total input value.
spend_revoked_batch :: PenaltyContext -> Maybe SpendingTx
spend_revoked_batch :: PenaltyContext -> Maybe SpendingTx
spend_revoked_batch !PenaltyContext
ctx =
  let !outs :: NonEmpty UnresolvedOutput
outs = PenaltyContext -> NonEmpty UnresolvedOutput
pc_outputs PenaltyContext
ctx
      !destScript :: Script
destScript = PenaltyContext -> Script
pc_destination PenaltyContext
ctx
      !feerate :: FeeratePerKw
feerate = PenaltyContext -> FeeratePerKw
pc_feerate PenaltyContext
ctx

      -- Calculate total input value and weight
      !(Satoshi
totalValue, Word64
totalWeight) =
        Satoshi -> Word64 -> [UnresolvedOutput] -> (Satoshi, Word64)
go (Word64 -> Satoshi
Satoshi Word64
0) Word64
penalty_tx_base_weight
          (NonEmpty UnresolvedOutput -> [UnresolvedOutput]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty UnresolvedOutput
outs)

      !fee :: Satoshi
fee = FeeratePerKw -> Word64 -> Satoshi
spending_fee FeeratePerKw
feerate Word64
totalWeight
  in if Satoshi -> Word64
unSatoshi Satoshi
fee Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
totalValue
     then Maybe SpendingTx
forall a. Maybe a
Nothing
     else
       let !outputValue :: Satoshi
outputValue =
             Word64 -> Satoshi
Satoshi
               (Satoshi -> Word64
unSatoshi Satoshi
totalValue Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
fee)

           -- Build inputs
           !txInputs :: NonEmpty TxIn
txInputs = (UnresolvedOutput -> TxIn)
-> NonEmpty UnresolvedOutput -> NonEmpty TxIn
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnresolvedOutput -> TxIn
mkPenaltyInput NonEmpty UnresolvedOutput
outs

           -- Single output
           !txOutput :: TxOut
txOutput = Word64 -> ByteString -> TxOut
TxOut
             (Satoshi -> Word64
unSatoshi Satoshi
outputValue)
             (Script -> ByteString
unScript Script
destScript)

           !tx :: Tx
tx = Tx
             { tx_version :: Word32
tx_version   = Word32
2
             , tx_inputs :: NonEmpty TxIn
tx_inputs    = NonEmpty TxIn
txInputs
             , tx_outputs :: NonEmpty TxOut
tx_outputs   = TxOut
txOutput TxOut -> [TxOut] -> NonEmpty TxOut
forall a. a -> [a] -> NonEmpty a
:| []
             , tx_witnesses :: [Witness]
tx_witnesses = []
             , tx_locktime :: Word32
tx_locktime  = Word32
0
             }

           !witnessScript :: Script
witnessScript = ByteString -> Script
Script ByteString
BS.empty
       in SpendingTx -> Maybe SpendingTx
forall a. a -> Maybe a
Just (Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
totalValue
                  SighashType
SIGHASH_ALL)
  where
    go :: Satoshi -> Word64 -> [UnresolvedOutput] -> (Satoshi, Word64)
go !Satoshi
totalVal !Word64
totalWt [] = (Satoshi
totalVal, Word64
totalWt)
    go !Satoshi
totalVal !Word64
totalWt (UnresolvedOutput
uo:[UnresolvedOutput]
rest) =
      let !w :: Word64
w = case UnresolvedOutput -> OutputResolution
uo_type UnresolvedOutput
uo of
            Revoke RevocationPubkey
_ ->
              Word64
to_local_penalty_input_weight
            RevokeHTLC RevocationPubkey
_ (OutputOfferedHTLC CltvExpiry
_) ->
              Word64
offered_htlc_penalty_input_weight
            RevokeHTLC RevocationPubkey
_ (OutputReceivedHTLC CltvExpiry
_) ->
              Word64
accepted_htlc_penalty_input_weight
            OutputResolution
_ -> Word64
0
          !v :: Satoshi
v = Word64 -> Satoshi
Satoshi
            (Satoshi -> Word64
unSatoshi Satoshi
totalVal Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Satoshi -> Word64
unSatoshi (UnresolvedOutput -> Satoshi
uo_value UnresolvedOutput
uo))
      in Satoshi -> Word64 -> [UnresolvedOutput] -> (Satoshi, Word64)
go Satoshi
v (Word64
totalWt Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
w) [UnresolvedOutput]
rest

    mkPenaltyInput :: UnresolvedOutput -> TxIn
mkPenaltyInput !UnresolvedOutput
uo =
      TxIn
        { txin_prevout :: OutPoint
txin_prevout = UnresolvedOutput -> OutPoint
uo_outpoint UnresolvedOutput
uo
        , txin_script_sig :: ByteString
txin_script_sig = ByteString
BS.empty
        , txin_sequence :: Word32
txin_sequence = Word32
0xFFFFFFFF
        }

-- anchor spends ------------------------------------------------------

-- | Spend an anchor output as the owner (immediately).
--
-- The caller signs with the funding privkey and uses
-- 'anchor_witness_owner' from bolt3.
spend_anchor_owner
  :: OutPoint
  -- ^ Outpoint of the anchor output.
  -> Satoshi
  -- ^ Value of the anchor output (330 sats).
  -> FundingPubkey
  -> Script
  -- ^ Destination scriptPubKey.
  -> SpendingTx
spend_anchor_owner :: OutPoint -> Satoshi -> FundingPubkey -> Script -> SpendingTx
spend_anchor_owner !OutPoint
op !Satoshi
value !FundingPubkey
fundpk !Script
destScript =
  let !witnessScript :: Script
witnessScript = FundingPubkey -> Script
anchor_script FundingPubkey
fundpk
      !tx :: Tx
tx = OutPoint -> Word32 -> Script -> Satoshi -> Word32 -> Tx
mk_spending_tx OutPoint
op Word32
0xFFFFFFFE Script
destScript
              Satoshi
value Word32
0
  in Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
value SighashType
SIGHASH_ALL

-- | Spend an anchor output as anyone (after 16 blocks).
--
-- Uses 'anchor_witness_anyone' from bolt3 (empty signature).
spend_anchor_anyone
  :: OutPoint
  -- ^ Outpoint of the anchor output.
  -> Satoshi
  -- ^ Value of the anchor output (330 sats).
  -> FundingPubkey
  -> Script
  -- ^ Destination scriptPubKey.
  -> SpendingTx
spend_anchor_anyone :: OutPoint -> Satoshi -> FundingPubkey -> Script -> SpendingTx
spend_anchor_anyone !OutPoint
op !Satoshi
value !FundingPubkey
fundpk !Script
destScript =
  let !witnessScript :: Script
witnessScript = FundingPubkey -> Script
anchor_script FundingPubkey
fundpk
      !tx :: Tx
tx = OutPoint -> Word32 -> Script -> Satoshi -> Word32 -> Tx
mk_spending_tx OutPoint
op Word32
16 Script
destScript Satoshi
value Word32
0
  in Tx -> Script -> Satoshi -> SighashType -> SpendingTx
SpendingTx Tx
tx Script
witnessScript Satoshi
value SighashType
SIGHASH_ALL

-- internal helpers ---------------------------------------------------

-- | Build a simple single-input single-output spending tx.
mk_spending_tx
  :: OutPoint     -- ^ Input outpoint
  -> Word32       -- ^ Input nSequence
  -> Script       -- ^ Output scriptPubKey
  -> Satoshi      -- ^ Output value
  -> Word32       -- ^ Locktime
  -> Tx
mk_spending_tx :: OutPoint -> Word32 -> Script -> Satoshi -> Word32 -> Tx
mk_spending_tx !OutPoint
op !Word32
seqNo !Script
destScript !Satoshi
outputValue
    !Word32
locktime =
  let !txIn :: TxIn
txIn = TxIn
        { txin_prevout :: OutPoint
txin_prevout = OutPoint
op
        , txin_script_sig :: ByteString
txin_script_sig = ByteString
BS.empty
        , txin_sequence :: Word32
txin_sequence = Word32
seqNo
        }
      !txOut :: TxOut
txOut = TxOut
        { txout_value :: Word64
txout_value = Satoshi -> Word64
unSatoshi Satoshi
outputValue
        , txout_script_pubkey :: ByteString
txout_script_pubkey = Script -> ByteString
unScript Script
destScript
        }
  in Tx
       { tx_version :: Word32
tx_version   = Word32
2
       , tx_inputs :: NonEmpty TxIn
tx_inputs    = TxIn
txIn TxIn -> [TxIn] -> NonEmpty TxIn
forall a. a -> [a] -> NonEmpty a
:| []
       , tx_outputs :: NonEmpty TxOut
tx_outputs   = TxOut
txOut TxOut -> [TxOut] -> NonEmpty TxOut
forall a. a -> [a] -> NonEmpty a
:| []
       , tx_witnesses :: [Witness]
tx_witnesses = []
       , tx_locktime :: Word32
tx_locktime  = Word32
locktime
       }

-- | Convert a bolt3 HTLCTx to a ppad-tx Tx.
htlc_tx_to_tx :: HTLCTx -> Tx
htlc_tx_to_tx :: HTLCTx -> Tx
htlc_tx_to_tx !HTLCTx
htx =
  let !txIn :: TxIn
txIn = TxIn
        { txin_prevout :: OutPoint
txin_prevout = HTLCTx -> OutPoint
htx_input_outpoint HTLCTx
htx
        , txin_script_sig :: ByteString
txin_script_sig = ByteString
BS.empty
        , txin_sequence :: Word32
txin_sequence =
            Sequence -> Word32
unSequence (HTLCTx -> Sequence
htx_input_sequence HTLCTx
htx)
        }
      !txOut :: TxOut
txOut = TxOut
        { txout_value :: Word64
txout_value =
            Satoshi -> Word64
unSatoshi (HTLCTx -> Satoshi
htx_output_value HTLCTx
htx)
        , txout_script_pubkey :: ByteString
txout_script_pubkey =
            Script -> ByteString
unScript (HTLCTx -> Script
htx_output_script HTLCTx
htx)
        }
  in Tx
       { tx_version :: Word32
tx_version = HTLCTx -> Word32
htx_version HTLCTx
htx
       , tx_inputs :: NonEmpty TxIn
tx_inputs = TxIn
txIn TxIn -> [TxIn] -> NonEmpty TxIn
forall a. a -> [a] -> NonEmpty a
:| []
       , tx_outputs :: NonEmpty TxOut
tx_outputs = TxOut
txOut TxOut -> [TxOut] -> NonEmpty TxOut
forall a. a -> [a] -> NonEmpty a
:| []
       , tx_witnesses :: [Witness]
tx_witnesses = []
       , tx_locktime :: Word32
tx_locktime =
           Locktime -> Word32
unLocktime (HTLCTx -> Locktime
htx_locktime HTLCTx
htx)
       }