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

-- |
-- Module: Lightning.Protocol.BOLT3.Tx
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Transaction assembly for BOLT #3.
--
-- Constructs:
--
-- * Commitment transactions
-- * HTLC-timeout transactions
-- * HTLC-success transactions
-- * Closing transactions

module Lightning.Protocol.BOLT3.Tx (
    -- * Commitment transaction
    CommitmentTx(..)
  , CommitmentContext(..)
  , CommitmentKeys(..)
  , build_commitment_tx

    -- * HTLC transactions
  , HTLCTx(..)
  , HTLCContext(..)
  , build_htlc_timeout_tx
  , build_htlc_success_tx

    -- * Closing transaction
  , ClosingTx(..)
  , ClosingContext(..)
  , build_closing_tx
  , build_legacy_closing_tx

    -- * Transaction outputs
  , TxOutput(..)
  , OutputType(..)

    -- * Fee calculation
  , commitment_fee
  , htlc_timeout_fee
  , htlc_success_fee
  , commitment_weight

    -- * Trimming
  , is_trimmed
  , trimmed_htlcs
  , untrimmed_htlcs
  , htlc_trim_threshold

    -- * Output ordering
  , sort_outputs
  ) where

import Data.Bits ((.&.), (.|.), shiftL, shiftR)
import Data.List (sortBy)
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)
import Lightning.Protocol.BOLT3.Keys
import Lightning.Protocol.BOLT3.Scripts
import Lightning.Protocol.BOLT3.Types

-- transaction outputs ---------------------------------------------------------

-- | Type of output in a commitment transaction.
data OutputType
  = OutputToLocal
  | OutputToRemote
  | OutputLocalAnchor
  | OutputRemoteAnchor
  | OutputOfferedHTLC  {-# UNPACK #-} !CltvExpiry
  | OutputReceivedHTLC {-# UNPACK #-} !CltvExpiry
  deriving (OutputType -> OutputType -> Bool
(OutputType -> OutputType -> Bool)
-> (OutputType -> OutputType -> Bool) -> Eq OutputType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OutputType -> OutputType -> Bool
== :: OutputType -> OutputType -> Bool
$c/= :: OutputType -> OutputType -> Bool
/= :: OutputType -> OutputType -> Bool
Eq, Int -> OutputType -> ShowS
[OutputType] -> ShowS
OutputType -> String
(Int -> OutputType -> ShowS)
-> (OutputType -> String)
-> ([OutputType] -> ShowS)
-> Show OutputType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OutputType -> ShowS
showsPrec :: Int -> OutputType -> ShowS
$cshow :: OutputType -> String
show :: OutputType -> String
$cshowList :: [OutputType] -> ShowS
showList :: [OutputType] -> ShowS
Show, (forall x. OutputType -> Rep OutputType x)
-> (forall x. Rep OutputType x -> OutputType) -> Generic OutputType
forall x. Rep OutputType x -> OutputType
forall x. OutputType -> Rep OutputType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. OutputType -> Rep OutputType x
from :: forall x. OutputType -> Rep OutputType x
$cto :: forall x. Rep OutputType x -> OutputType
to :: forall x. Rep OutputType x -> OutputType
Generic)

-- | A transaction output with value, script, and type information.
data TxOutput = TxOutput
  { TxOutput -> Satoshi
txout_value     :: {-# UNPACK #-} !Satoshi
  , TxOutput -> Script
txout_script    :: !Script
  , TxOutput -> OutputType
txout_type      :: !OutputType
  } deriving (TxOutput -> TxOutput -> Bool
(TxOutput -> TxOutput -> Bool)
-> (TxOutput -> TxOutput -> Bool) -> Eq TxOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxOutput -> TxOutput -> Bool
== :: TxOutput -> TxOutput -> Bool
$c/= :: TxOutput -> TxOutput -> Bool
/= :: TxOutput -> TxOutput -> Bool
Eq, Int -> TxOutput -> ShowS
[TxOutput] -> ShowS
TxOutput -> String
(Int -> TxOutput -> ShowS)
-> (TxOutput -> String) -> ([TxOutput] -> ShowS) -> Show TxOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxOutput -> ShowS
showsPrec :: Int -> TxOutput -> ShowS
$cshow :: TxOutput -> String
show :: TxOutput -> String
$cshowList :: [TxOutput] -> ShowS
showList :: [TxOutput] -> ShowS
Show, (forall x. TxOutput -> Rep TxOutput x)
-> (forall x. Rep TxOutput x -> TxOutput) -> Generic TxOutput
forall x. Rep TxOutput x -> TxOutput
forall x. TxOutput -> Rep TxOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxOutput -> Rep TxOutput x
from :: forall x. TxOutput -> Rep TxOutput x
$cto :: forall x. Rep TxOutput x -> TxOutput
to :: forall x. Rep TxOutput x -> TxOutput
Generic)

-- commitment transaction ------------------------------------------------------

-- | Derived keys needed for commitment transaction outputs.
data CommitmentKeys = CommitmentKeys
  { CommitmentKeys -> RevocationPubkey
ck_revocation_pubkey   :: !RevocationPubkey
  , CommitmentKeys -> LocalDelayedPubkey
ck_local_delayed       :: !LocalDelayedPubkey
  , CommitmentKeys -> LocalHtlcPubkey
ck_local_htlc          :: !LocalHtlcPubkey
  , CommitmentKeys -> RemoteHtlcPubkey
ck_remote_htlc         :: !RemoteHtlcPubkey
  , CommitmentKeys -> LocalPubkey
ck_local_payment       :: !LocalPubkey
  , CommitmentKeys -> RemotePubkey
ck_remote_payment      :: !RemotePubkey
  , CommitmentKeys -> FundingPubkey
ck_local_funding       :: !FundingPubkey
  , CommitmentKeys -> FundingPubkey
ck_remote_funding      :: !FundingPubkey
  } deriving (CommitmentKeys -> CommitmentKeys -> Bool
(CommitmentKeys -> CommitmentKeys -> Bool)
-> (CommitmentKeys -> CommitmentKeys -> Bool) -> Eq CommitmentKeys
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitmentKeys -> CommitmentKeys -> Bool
== :: CommitmentKeys -> CommitmentKeys -> Bool
$c/= :: CommitmentKeys -> CommitmentKeys -> Bool
/= :: CommitmentKeys -> CommitmentKeys -> Bool
Eq, Int -> CommitmentKeys -> ShowS
[CommitmentKeys] -> ShowS
CommitmentKeys -> String
(Int -> CommitmentKeys -> ShowS)
-> (CommitmentKeys -> String)
-> ([CommitmentKeys] -> ShowS)
-> Show CommitmentKeys
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitmentKeys -> ShowS
showsPrec :: Int -> CommitmentKeys -> ShowS
$cshow :: CommitmentKeys -> String
show :: CommitmentKeys -> String
$cshowList :: [CommitmentKeys] -> ShowS
showList :: [CommitmentKeys] -> ShowS
Show, (forall x. CommitmentKeys -> Rep CommitmentKeys x)
-> (forall x. Rep CommitmentKeys x -> CommitmentKeys)
-> Generic CommitmentKeys
forall x. Rep CommitmentKeys x -> CommitmentKeys
forall x. CommitmentKeys -> Rep CommitmentKeys x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommitmentKeys -> Rep CommitmentKeys x
from :: forall x. CommitmentKeys -> Rep CommitmentKeys x
$cto :: forall x. Rep CommitmentKeys x -> CommitmentKeys
to :: forall x. Rep CommitmentKeys x -> CommitmentKeys
Generic)

-- | Context for building a commitment transaction.
data CommitmentContext = CommitmentContext
  { CommitmentContext -> Outpoint
cc_funding_outpoint    :: !Outpoint
  , CommitmentContext -> CommitmentNumber
cc_commitment_number   :: !CommitmentNumber
  , CommitmentContext -> PaymentBasepoint
cc_local_payment_bp    :: !PaymentBasepoint
  , CommitmentContext -> PaymentBasepoint
cc_remote_payment_bp   :: !PaymentBasepoint
  , CommitmentContext -> ToSelfDelay
cc_to_self_delay       :: !ToSelfDelay
  , CommitmentContext -> DustLimit
cc_dust_limit          :: !DustLimit
  , CommitmentContext -> FeeratePerKw
cc_feerate             :: !FeeratePerKw
  , CommitmentContext -> ChannelFeatures
cc_features            :: !ChannelFeatures
  , CommitmentContext -> Bool
cc_is_funder           :: !Bool
  , CommitmentContext -> MilliSatoshi
cc_to_local_msat       :: !MilliSatoshi
  , CommitmentContext -> MilliSatoshi
cc_to_remote_msat      :: !MilliSatoshi
  , CommitmentContext -> [HTLC]
cc_htlcs               :: ![HTLC]
  , CommitmentContext -> CommitmentKeys
cc_keys                :: !CommitmentKeys
  } deriving (CommitmentContext -> CommitmentContext -> Bool
(CommitmentContext -> CommitmentContext -> Bool)
-> (CommitmentContext -> CommitmentContext -> Bool)
-> Eq CommitmentContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitmentContext -> CommitmentContext -> Bool
== :: CommitmentContext -> CommitmentContext -> Bool
$c/= :: CommitmentContext -> CommitmentContext -> Bool
/= :: CommitmentContext -> CommitmentContext -> Bool
Eq, Int -> CommitmentContext -> ShowS
[CommitmentContext] -> ShowS
CommitmentContext -> String
(Int -> CommitmentContext -> ShowS)
-> (CommitmentContext -> String)
-> ([CommitmentContext] -> ShowS)
-> Show CommitmentContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitmentContext -> ShowS
showsPrec :: Int -> CommitmentContext -> ShowS
$cshow :: CommitmentContext -> String
show :: CommitmentContext -> String
$cshowList :: [CommitmentContext] -> ShowS
showList :: [CommitmentContext] -> ShowS
Show, (forall x. CommitmentContext -> Rep CommitmentContext x)
-> (forall x. Rep CommitmentContext x -> CommitmentContext)
-> Generic CommitmentContext
forall x. Rep CommitmentContext x -> CommitmentContext
forall x. CommitmentContext -> Rep CommitmentContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommitmentContext -> Rep CommitmentContext x
from :: forall x. CommitmentContext -> Rep CommitmentContext x
$cto :: forall x. Rep CommitmentContext x -> CommitmentContext
to :: forall x. Rep CommitmentContext x -> CommitmentContext
Generic)

-- | A commitment transaction.
data CommitmentTx = CommitmentTx
  { CommitmentTx -> Word32
ctx_version            :: {-# UNPACK #-} !Word32
  , CommitmentTx -> Locktime
ctx_locktime           :: !Locktime
  , CommitmentTx -> Outpoint
ctx_input_outpoint     :: !Outpoint
  , CommitmentTx -> Sequence
ctx_input_sequence     :: !Sequence
  , CommitmentTx -> [TxOutput]
ctx_outputs            :: ![TxOutput]
  , CommitmentTx -> Script
ctx_funding_script     :: !Script
  } deriving (CommitmentTx -> CommitmentTx -> Bool
(CommitmentTx -> CommitmentTx -> Bool)
-> (CommitmentTx -> CommitmentTx -> Bool) -> Eq CommitmentTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitmentTx -> CommitmentTx -> Bool
== :: CommitmentTx -> CommitmentTx -> Bool
$c/= :: CommitmentTx -> CommitmentTx -> Bool
/= :: CommitmentTx -> CommitmentTx -> Bool
Eq, Int -> CommitmentTx -> ShowS
[CommitmentTx] -> ShowS
CommitmentTx -> String
(Int -> CommitmentTx -> ShowS)
-> (CommitmentTx -> String)
-> ([CommitmentTx] -> ShowS)
-> Show CommitmentTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitmentTx -> ShowS
showsPrec :: Int -> CommitmentTx -> ShowS
$cshow :: CommitmentTx -> String
show :: CommitmentTx -> String
$cshowList :: [CommitmentTx] -> ShowS
showList :: [CommitmentTx] -> ShowS
Show, (forall x. CommitmentTx -> Rep CommitmentTx x)
-> (forall x. Rep CommitmentTx x -> CommitmentTx)
-> Generic CommitmentTx
forall x. Rep CommitmentTx x -> CommitmentTx
forall x. CommitmentTx -> Rep CommitmentTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CommitmentTx -> Rep CommitmentTx x
from :: forall x. CommitmentTx -> Rep CommitmentTx x
$cto :: forall x. Rep CommitmentTx x -> CommitmentTx
to :: forall x. Rep CommitmentTx x -> CommitmentTx
Generic)

-- | Build a commitment transaction.
--
-- Follows the algorithm from BOLT #3:
--
-- 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 :: CommitmentContext -> CommitmentTx
build_commitment_tx CommitmentContext
ctx =
  let !obscured :: Word64
obscured = PaymentBasepoint -> PaymentBasepoint -> CommitmentNumber -> Word64
obscured_commitment_number
        (CommitmentContext -> PaymentBasepoint
cc_local_payment_bp CommitmentContext
ctx)
        (CommitmentContext -> PaymentBasepoint
cc_remote_payment_bp CommitmentContext
ctx)
        (CommitmentContext -> CommitmentNumber
cc_commitment_number CommitmentContext
ctx)

      -- Locktime: upper 8 bits are 0x20, lower 24 bits are lower 24 of obscured
      !locktime :: Locktime
locktime = Word32 -> Locktime
Locktime (Word32 -> Locktime) -> Word32 -> Locktime
forall a b. (a -> b) -> a -> b
$
        (Word32
0x20 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
obscured Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x00FFFFFF)

      -- Sequence: upper 8 bits are 0x80, lower 24 bits are upper 24 of obscured
      !inputSeq :: Sequence
inputSeq = Word32 -> Sequence
Sequence (Word32 -> Sequence) -> Word32 -> Sequence
forall a b. (a -> b) -> a -> b
$
        (Word32
0x80 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|.
        (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
obscured Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0x00FFFFFF)

      -- Funding script for witness
      !fundingScript :: Script
fundingScript = FundingPubkey -> FundingPubkey -> Script
funding_script
        (CommitmentKeys -> FundingPubkey
ck_local_funding (CommitmentKeys -> FundingPubkey)
-> CommitmentKeys -> FundingPubkey
forall a b. (a -> b) -> a -> b
$ CommitmentContext -> CommitmentKeys
cc_keys CommitmentContext
ctx)
        (CommitmentKeys -> FundingPubkey
ck_remote_funding (CommitmentKeys -> FundingPubkey)
-> CommitmentKeys -> FundingPubkey
forall a b. (a -> b) -> a -> b
$ CommitmentContext -> CommitmentKeys
cc_keys CommitmentContext
ctx)

      -- Calculate untrimmed HTLCs
      !untrimmedHtlcs :: [HTLC]
untrimmedHtlcs = DustLimit -> FeeratePerKw -> ChannelFeatures -> [HTLC] -> [HTLC]
untrimmed_htlcs
        (CommitmentContext -> DustLimit
cc_dust_limit CommitmentContext
ctx)
        (CommitmentContext -> FeeratePerKw
cc_feerate CommitmentContext
ctx)
        (CommitmentContext -> ChannelFeatures
cc_features CommitmentContext
ctx)
        (CommitmentContext -> [HTLC]
cc_htlcs CommitmentContext
ctx)

      -- Calculate base fee
      !baseFee :: Satoshi
baseFee = FeeratePerKw -> ChannelFeatures -> Word64 -> Satoshi
commitment_fee
        (CommitmentContext -> FeeratePerKw
cc_feerate CommitmentContext
ctx)
        (CommitmentContext -> ChannelFeatures
cc_features CommitmentContext
ctx)
        (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [HTLC] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [HTLC]
untrimmedHtlcs)

      -- Anchor cost if applicable
      !anchorCost :: Satoshi
anchorCost = if ChannelFeatures -> Bool
has_anchors (CommitmentContext -> ChannelFeatures
cc_features CommitmentContext
ctx)
        then Satoshi
2 Satoshi -> Satoshi -> Satoshi
forall a. Num a => a -> a -> a
* Satoshi
anchor_output_value
        else Word64 -> Satoshi
Satoshi Word64
0

      -- Subtract fees and anchors from funder
      !totalDeduction :: Satoshi
totalDeduction = Satoshi
baseFee Satoshi -> Satoshi -> Satoshi
forall a. Num a => a -> a -> a
+ Satoshi
anchorCost
      !(Satoshi
toLocalSat, Satoshi
toRemoteSat) = if CommitmentContext -> Bool
cc_is_funder CommitmentContext
ctx
        then
          let !local :: Satoshi
local = MilliSatoshi -> Satoshi
msat_to_sat (CommitmentContext -> MilliSatoshi
cc_to_local_msat CommitmentContext
ctx)
              !deducted :: Satoshi
deducted = if Satoshi -> Word64
unSatoshi Satoshi
local Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
totalDeduction
                          then Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi Satoshi
local Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
totalDeduction)
                          else Word64 -> Satoshi
Satoshi Word64
0
          in (Satoshi
deducted, MilliSatoshi -> Satoshi
msat_to_sat (CommitmentContext -> MilliSatoshi
cc_to_remote_msat CommitmentContext
ctx))
        else
          let !remote :: Satoshi
remote = MilliSatoshi -> Satoshi
msat_to_sat (CommitmentContext -> MilliSatoshi
cc_to_remote_msat CommitmentContext
ctx)
              !deducted :: Satoshi
deducted = if Satoshi -> Word64
unSatoshi Satoshi
remote Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
totalDeduction
                          then Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi Satoshi
remote Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
totalDeduction)
                          else Word64 -> Satoshi
Satoshi Word64
0
          in (MilliSatoshi -> Satoshi
msat_to_sat (CommitmentContext -> MilliSatoshi
cc_to_local_msat CommitmentContext
ctx), Satoshi
deducted)

      !dustLimit :: Satoshi
dustLimit = DustLimit -> Satoshi
unDustLimit (CommitmentContext -> DustLimit
cc_dust_limit CommitmentContext
ctx)

      -- Build HTLC outputs
      !htlcOutputs :: [TxOutput]
htlcOutputs = (HTLC -> TxOutput) -> [HTLC] -> [TxOutput]
forall a b. (a -> b) -> [a] -> [b]
map (CommitmentContext -> HTLC -> TxOutput
htlcOutput CommitmentContext
ctx) [HTLC]
untrimmedHtlcs

      -- Build to_local output if above dust
      !toLocalOutput :: [TxOutput]
toLocalOutput =
        if Satoshi -> Word64
unSatoshi Satoshi
toLocalSat Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
dustLimit
        then
          let !script :: Script
script = Script -> Script
to_p2wsh (Script -> Script) -> Script -> Script
forall a b. (a -> b) -> a -> b
$ RevocationPubkey -> ToSelfDelay -> LocalDelayedPubkey -> Script
to_local_script
                (CommitmentKeys -> RevocationPubkey
ck_revocation_pubkey (CommitmentKeys -> RevocationPubkey)
-> CommitmentKeys -> RevocationPubkey
forall a b. (a -> b) -> a -> b
$ CommitmentContext -> CommitmentKeys
cc_keys CommitmentContext
ctx)
                (CommitmentContext -> ToSelfDelay
cc_to_self_delay CommitmentContext
ctx)
                (CommitmentKeys -> LocalDelayedPubkey
ck_local_delayed (CommitmentKeys -> LocalDelayedPubkey)
-> CommitmentKeys -> LocalDelayedPubkey
forall a b. (a -> b) -> a -> b
$ CommitmentContext -> CommitmentKeys
cc_keys CommitmentContext
ctx)
          in [Satoshi -> Script -> OutputType -> TxOutput
TxOutput Satoshi
toLocalSat Script
script OutputType
OutputToLocal]
        else []

      -- Build to_remote output if above dust
      !toRemoteOutput :: [TxOutput]
toRemoteOutput =
        if Satoshi -> Word64
unSatoshi Satoshi
toRemoteSat Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
dustLimit
        then
          let !script :: Script
script = if ChannelFeatures -> Bool
has_anchors (CommitmentContext -> ChannelFeatures
cc_features CommitmentContext
ctx)
                then Script -> Script
to_p2wsh (Script -> Script) -> Script -> Script
forall a b. (a -> b) -> a -> b
$ RemotePubkey -> ChannelFeatures -> Script
to_remote_script
                       (CommitmentKeys -> RemotePubkey
ck_remote_payment (CommitmentKeys -> RemotePubkey) -> CommitmentKeys -> RemotePubkey
forall a b. (a -> b) -> a -> b
$ CommitmentContext -> CommitmentKeys
cc_keys CommitmentContext
ctx)
                       (CommitmentContext -> ChannelFeatures
cc_features CommitmentContext
ctx)
                else RemotePubkey -> ChannelFeatures -> Script
to_remote_script
                       (CommitmentKeys -> RemotePubkey
ck_remote_payment (CommitmentKeys -> RemotePubkey) -> CommitmentKeys -> RemotePubkey
forall a b. (a -> b) -> a -> b
$ CommitmentContext -> CommitmentKeys
cc_keys CommitmentContext
ctx)
                       (CommitmentContext -> ChannelFeatures
cc_features CommitmentContext
ctx)
          in [Satoshi -> Script -> OutputType -> TxOutput
TxOutput Satoshi
toRemoteSat Script
script OutputType
OutputToRemote]
        else []

      -- Build anchor outputs if option_anchors
      !hasUntrimmedHtlcs :: Bool
hasUntrimmedHtlcs = Bool -> Bool
not ([HTLC] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [HTLC]
untrimmedHtlcs)
      !toLocalExists :: Bool
toLocalExists = Bool -> Bool
not ([TxOutput] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxOutput]
toLocalOutput)
      !toRemoteExists :: Bool
toRemoteExists = Bool -> Bool
not ([TxOutput] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxOutput]
toRemoteOutput)

      !localAnchorOutput :: [TxOutput]
localAnchorOutput =
        if ChannelFeatures -> Bool
has_anchors (CommitmentContext -> ChannelFeatures
cc_features CommitmentContext
ctx) Bool -> Bool -> Bool
&&
           (Bool
toLocalExists Bool -> Bool -> Bool
|| Bool
hasUntrimmedHtlcs)
        then
          let !script :: Script
script = Script -> Script
to_p2wsh (Script -> Script) -> Script -> Script
forall a b. (a -> b) -> a -> b
$ FundingPubkey -> Script
anchor_script
                (CommitmentKeys -> FundingPubkey
ck_local_funding (CommitmentKeys -> FundingPubkey)
-> CommitmentKeys -> FundingPubkey
forall a b. (a -> b) -> a -> b
$ CommitmentContext -> CommitmentKeys
cc_keys CommitmentContext
ctx)
          in [Satoshi -> Script -> OutputType -> TxOutput
TxOutput Satoshi
anchor_output_value Script
script OutputType
OutputLocalAnchor]
        else []

      !remoteAnchorOutput :: [TxOutput]
remoteAnchorOutput =
        if ChannelFeatures -> Bool
has_anchors (CommitmentContext -> ChannelFeatures
cc_features CommitmentContext
ctx) Bool -> Bool -> Bool
&&
           (Bool
toRemoteExists Bool -> Bool -> Bool
|| Bool
hasUntrimmedHtlcs)
        then
          let !script :: Script
script = Script -> Script
to_p2wsh (Script -> Script) -> Script -> Script
forall a b. (a -> b) -> a -> b
$ FundingPubkey -> Script
anchor_script
                (CommitmentKeys -> FundingPubkey
ck_remote_funding (CommitmentKeys -> FundingPubkey)
-> CommitmentKeys -> FundingPubkey
forall a b. (a -> b) -> a -> b
$ CommitmentContext -> CommitmentKeys
cc_keys CommitmentContext
ctx)
          in [Satoshi -> Script -> OutputType -> TxOutput
TxOutput Satoshi
anchor_output_value Script
script OutputType
OutputRemoteAnchor]
        else []

      -- Combine and sort all outputs
      !allOutputs :: [TxOutput]
allOutputs = [TxOutput]
toLocalOutput [TxOutput] -> [TxOutput] -> [TxOutput]
forall a. [a] -> [a] -> [a]
++ [TxOutput]
toRemoteOutput [TxOutput] -> [TxOutput] -> [TxOutput]
forall a. [a] -> [a] -> [a]
++
                    [TxOutput]
localAnchorOutput [TxOutput] -> [TxOutput] -> [TxOutput]
forall a. [a] -> [a] -> [a]
++ [TxOutput]
remoteAnchorOutput [TxOutput] -> [TxOutput] -> [TxOutput]
forall a. [a] -> [a] -> [a]
++
                    [TxOutput]
htlcOutputs
      !sortedOutputs :: [TxOutput]
sortedOutputs = [TxOutput] -> [TxOutput]
sort_outputs [TxOutput]
allOutputs

  in CommitmentTx
       { ctx_version :: Word32
ctx_version = Word32
2
       , ctx_locktime :: Locktime
ctx_locktime = Locktime
locktime
       , ctx_input_outpoint :: Outpoint
ctx_input_outpoint = CommitmentContext -> Outpoint
cc_funding_outpoint CommitmentContext
ctx
       , ctx_input_sequence :: Sequence
ctx_input_sequence = Sequence
inputSeq
       , ctx_outputs :: [TxOutput]
ctx_outputs = [TxOutput]
sortedOutputs
       , ctx_funding_script :: Script
ctx_funding_script = Script
fundingScript
       }
{-# INLINE build_commitment_tx #-}

-- | Build an HTLC output for commitment transaction.
htlcOutput :: CommitmentContext -> HTLC -> TxOutput
htlcOutput :: CommitmentContext -> HTLC -> TxOutput
htlcOutput CommitmentContext
ctx HTLC
htlc =
  let !amountSat :: Satoshi
amountSat = MilliSatoshi -> Satoshi
msat_to_sat (HTLC -> MilliSatoshi
htlc_amount_msat HTLC
htlc)
      !keys :: CommitmentKeys
keys = CommitmentContext -> CommitmentKeys
cc_keys CommitmentContext
ctx
      !features :: ChannelFeatures
features = CommitmentContext -> ChannelFeatures
cc_features CommitmentContext
ctx
      !expiry :: CltvExpiry
expiry = HTLC -> CltvExpiry
htlc_cltv_expiry HTLC
htlc
  in case HTLC -> HTLCDirection
htlc_direction HTLC
htlc of
       HTLCDirection
HTLCOffered ->
         let !script :: Script
script = Script -> Script
to_p2wsh (Script -> Script) -> Script -> Script
forall a b. (a -> b) -> a -> b
$ 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
         in Satoshi -> Script -> OutputType -> TxOutput
TxOutput Satoshi
amountSat Script
script (CltvExpiry -> OutputType
OutputOfferedHTLC CltvExpiry
expiry)
       HTLCDirection
HTLCReceived ->
         let !script :: Script
script = Script -> Script
to_p2wsh (Script -> Script) -> Script -> Script
forall a b. (a -> b) -> a -> b
$ 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)
               CltvExpiry
expiry
               ChannelFeatures
features
         in Satoshi -> Script -> OutputType -> TxOutput
TxOutput Satoshi
amountSat Script
script (CltvExpiry -> OutputType
OutputReceivedHTLC CltvExpiry
expiry)
{-# INLINE htlcOutput #-}

-- HTLC transactions -----------------------------------------------------------

-- | Context for building HTLC transactions.
data HTLCContext = HTLCContext
  { HTLCContext -> TxId
hc_commitment_txid     :: !TxId
  , HTLCContext -> Word32
hc_output_index        :: {-# UNPACK #-} !Word32
  , HTLCContext -> HTLC
hc_htlc                :: !HTLC
  , HTLCContext -> ToSelfDelay
hc_to_self_delay       :: !ToSelfDelay
  , HTLCContext -> FeeratePerKw
hc_feerate             :: !FeeratePerKw
  , HTLCContext -> ChannelFeatures
hc_features            :: !ChannelFeatures
  , HTLCContext -> RevocationPubkey
hc_revocation_pubkey   :: !RevocationPubkey
  , HTLCContext -> LocalDelayedPubkey
hc_local_delayed       :: !LocalDelayedPubkey
  } deriving (HTLCContext -> HTLCContext -> Bool
(HTLCContext -> HTLCContext -> Bool)
-> (HTLCContext -> HTLCContext -> Bool) -> Eq HTLCContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HTLCContext -> HTLCContext -> Bool
== :: HTLCContext -> HTLCContext -> Bool
$c/= :: HTLCContext -> HTLCContext -> Bool
/= :: HTLCContext -> HTLCContext -> Bool
Eq, Int -> HTLCContext -> ShowS
[HTLCContext] -> ShowS
HTLCContext -> String
(Int -> HTLCContext -> ShowS)
-> (HTLCContext -> String)
-> ([HTLCContext] -> ShowS)
-> Show HTLCContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HTLCContext -> ShowS
showsPrec :: Int -> HTLCContext -> ShowS
$cshow :: HTLCContext -> String
show :: HTLCContext -> String
$cshowList :: [HTLCContext] -> ShowS
showList :: [HTLCContext] -> ShowS
Show, (forall x. HTLCContext -> Rep HTLCContext x)
-> (forall x. Rep HTLCContext x -> HTLCContext)
-> Generic HTLCContext
forall x. Rep HTLCContext x -> HTLCContext
forall x. HTLCContext -> Rep HTLCContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HTLCContext -> Rep HTLCContext x
from :: forall x. HTLCContext -> Rep HTLCContext x
$cto :: forall x. Rep HTLCContext x -> HTLCContext
to :: forall x. Rep HTLCContext x -> HTLCContext
Generic)

-- | An HTLC transaction (timeout or success).
data HTLCTx = HTLCTx
  { HTLCTx -> Word32
htx_version            :: {-# UNPACK #-} !Word32
  , HTLCTx -> Locktime
htx_locktime           :: !Locktime
  , HTLCTx -> Outpoint
htx_input_outpoint     :: !Outpoint
  , HTLCTx -> Sequence
htx_input_sequence     :: !Sequence
  , HTLCTx -> Satoshi
htx_output_value       :: !Satoshi
  , HTLCTx -> Script
htx_output_script      :: !Script
  } deriving (HTLCTx -> HTLCTx -> Bool
(HTLCTx -> HTLCTx -> Bool)
-> (HTLCTx -> HTLCTx -> Bool) -> Eq HTLCTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HTLCTx -> HTLCTx -> Bool
== :: HTLCTx -> HTLCTx -> Bool
$c/= :: HTLCTx -> HTLCTx -> Bool
/= :: HTLCTx -> HTLCTx -> Bool
Eq, Int -> HTLCTx -> ShowS
[HTLCTx] -> ShowS
HTLCTx -> String
(Int -> HTLCTx -> ShowS)
-> (HTLCTx -> String) -> ([HTLCTx] -> ShowS) -> Show HTLCTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HTLCTx -> ShowS
showsPrec :: Int -> HTLCTx -> ShowS
$cshow :: HTLCTx -> String
show :: HTLCTx -> String
$cshowList :: [HTLCTx] -> ShowS
showList :: [HTLCTx] -> ShowS
Show, (forall x. HTLCTx -> Rep HTLCTx x)
-> (forall x. Rep HTLCTx x -> HTLCTx) -> Generic HTLCTx
forall x. Rep HTLCTx x -> HTLCTx
forall x. HTLCTx -> Rep HTLCTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HTLCTx -> Rep HTLCTx x
from :: forall x. HTLCTx -> Rep HTLCTx x
$cto :: forall x. Rep HTLCTx x -> HTLCTx
to :: forall x. Rep HTLCTx x -> HTLCTx
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 :: HTLCContext -> Locktime -> Satoshi -> HTLCTx
build_htlc_tx_common HTLCContext
ctx Locktime
locktime Satoshi
fee =
  let !amountSat :: Satoshi
amountSat = MilliSatoshi -> Satoshi
msat_to_sat (HTLC -> MilliSatoshi
htlc_amount_msat (HTLC -> MilliSatoshi) -> HTLC -> MilliSatoshi
forall a b. (a -> b) -> a -> b
$ HTLCContext -> HTLC
hc_htlc HTLCContext
ctx)
      !outputValue :: Satoshi
outputValue = if Satoshi -> Word64
unSatoshi Satoshi
amountSat Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi Satoshi
fee
                     then Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi Satoshi
amountSat Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Satoshi -> Word64
unSatoshi Satoshi
fee)
                     else Word64 -> Satoshi
Satoshi Word64
0
      !inputSeq :: Sequence
inputSeq = if ChannelFeatures -> Bool
has_anchors (HTLCContext -> ChannelFeatures
hc_features HTLCContext
ctx)
                   then Word32 -> Sequence
Sequence Word32
1
                   else Word32 -> Sequence
Sequence Word32
0
      !outpoint :: Outpoint
outpoint = TxId -> Word32 -> Outpoint
Outpoint (HTLCContext -> TxId
hc_commitment_txid HTLCContext
ctx) (HTLCContext -> Word32
hc_output_index HTLCContext
ctx)
      !outputScript :: Script
outputScript = Script -> Script
to_p2wsh (Script -> Script) -> Script -> Script
forall a b. (a -> b) -> a -> b
$ RevocationPubkey -> ToSelfDelay -> LocalDelayedPubkey -> Script
htlc_output_script
        (HTLCContext -> RevocationPubkey
hc_revocation_pubkey HTLCContext
ctx)
        (HTLCContext -> ToSelfDelay
hc_to_self_delay HTLCContext
ctx)
        (HTLCContext -> LocalDelayedPubkey
hc_local_delayed HTLCContext
ctx)
  in HTLCTx
       { htx_version :: Word32
htx_version = Word32
2
       , htx_locktime :: Locktime
htx_locktime = Locktime
locktime
       , htx_input_outpoint :: Outpoint
htx_input_outpoint = Outpoint
outpoint
       , htx_input_sequence :: Sequence
htx_input_sequence = Sequence
inputSeq
       , htx_output_value :: Satoshi
htx_output_value = Satoshi
outputValue
       , htx_output_script :: Script
htx_output_script = 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 :: HTLCContext -> HTLCTx
build_htlc_timeout_tx HTLCContext
ctx =
  let !fee :: Satoshi
fee = FeeratePerKw -> ChannelFeatures -> Satoshi
htlc_timeout_fee (HTLCContext -> FeeratePerKw
hc_feerate HTLCContext
ctx) (HTLCContext -> ChannelFeatures
hc_features HTLCContext
ctx)
      !locktime :: Locktime
locktime = Word32 -> Locktime
Locktime (CltvExpiry -> Word32
unCltvExpiry (CltvExpiry -> Word32) -> CltvExpiry -> Word32
forall a b. (a -> b) -> a -> b
$ HTLC -> CltvExpiry
htlc_cltv_expiry (HTLC -> CltvExpiry) -> HTLC -> CltvExpiry
forall a b. (a -> b) -> a -> b
$ HTLCContext -> HTLC
hc_htlc HTLCContext
ctx)
  in HTLCContext -> Locktime -> Satoshi -> HTLCTx
build_htlc_tx_common HTLCContext
ctx Locktime
locktime Satoshi
fee
{-# INLINE build_htlc_timeout_tx #-}

-- | Build an HTLC-success transaction.
--
-- * 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 :: HTLCContext -> HTLCTx
build_htlc_success_tx HTLCContext
ctx =
  let !fee :: Satoshi
fee = FeeratePerKw -> ChannelFeatures -> Satoshi
htlc_success_fee (HTLCContext -> FeeratePerKw
hc_feerate HTLCContext
ctx) (HTLCContext -> ChannelFeatures
hc_features HTLCContext
ctx)
  in HTLCContext -> Locktime -> Satoshi -> HTLCTx
build_htlc_tx_common HTLCContext
ctx (Word32 -> Locktime
Locktime Word32
0) Satoshi
fee
{-# INLINE build_htlc_success_tx #-}

-- closing transaction ---------------------------------------------------------

-- | Context for building closing transactions.
data ClosingContext = ClosingContext
  { ClosingContext -> Outpoint
clc_funding_outpoint   :: !Outpoint
  , ClosingContext -> Satoshi
clc_local_amount       :: !Satoshi
  , ClosingContext -> Satoshi
clc_remote_amount      :: !Satoshi
  , ClosingContext -> Script
clc_local_script       :: !Script
  , ClosingContext -> Script
clc_remote_script      :: !Script
  , ClosingContext -> DustLimit
clc_local_dust_limit   :: !DustLimit
  , ClosingContext -> DustLimit
clc_remote_dust_limit  :: !DustLimit
  , ClosingContext -> Satoshi
clc_fee                :: !Satoshi
  , ClosingContext -> Bool
clc_is_funder          :: !Bool
  , ClosingContext -> Locktime
clc_locktime           :: !Locktime
  , ClosingContext -> Script
clc_funding_script     :: !Script
  } deriving (ClosingContext -> ClosingContext -> Bool
(ClosingContext -> ClosingContext -> Bool)
-> (ClosingContext -> ClosingContext -> Bool) -> Eq ClosingContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClosingContext -> ClosingContext -> Bool
== :: ClosingContext -> ClosingContext -> Bool
$c/= :: ClosingContext -> ClosingContext -> Bool
/= :: ClosingContext -> ClosingContext -> Bool
Eq, Int -> ClosingContext -> ShowS
[ClosingContext] -> ShowS
ClosingContext -> String
(Int -> ClosingContext -> ShowS)
-> (ClosingContext -> String)
-> ([ClosingContext] -> ShowS)
-> Show ClosingContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClosingContext -> ShowS
showsPrec :: Int -> ClosingContext -> ShowS
$cshow :: ClosingContext -> String
show :: ClosingContext -> String
$cshowList :: [ClosingContext] -> ShowS
showList :: [ClosingContext] -> ShowS
Show, (forall x. ClosingContext -> Rep ClosingContext x)
-> (forall x. Rep ClosingContext x -> ClosingContext)
-> Generic ClosingContext
forall x. Rep ClosingContext x -> ClosingContext
forall x. ClosingContext -> Rep ClosingContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClosingContext -> Rep ClosingContext x
from :: forall x. ClosingContext -> Rep ClosingContext x
$cto :: forall x. Rep ClosingContext x -> ClosingContext
to :: forall x. Rep ClosingContext x -> ClosingContext
Generic)

-- | A closing transaction.
data ClosingTx = ClosingTx
  { ClosingTx -> Word32
cltx_version           :: {-# UNPACK #-} !Word32
  , ClosingTx -> Locktime
cltx_locktime          :: !Locktime
  , ClosingTx -> Outpoint
cltx_input_outpoint    :: !Outpoint
  , ClosingTx -> Sequence
cltx_input_sequence    :: !Sequence
  , ClosingTx -> [TxOutput]
cltx_outputs           :: ![TxOutput]
  , ClosingTx -> Script
cltx_funding_script    :: !Script
  } deriving (ClosingTx -> ClosingTx -> Bool
(ClosingTx -> ClosingTx -> Bool)
-> (ClosingTx -> ClosingTx -> Bool) -> Eq ClosingTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ClosingTx -> ClosingTx -> Bool
== :: ClosingTx -> ClosingTx -> Bool
$c/= :: ClosingTx -> ClosingTx -> Bool
/= :: ClosingTx -> ClosingTx -> Bool
Eq, Int -> ClosingTx -> ShowS
[ClosingTx] -> ShowS
ClosingTx -> String
(Int -> ClosingTx -> ShowS)
-> (ClosingTx -> String)
-> ([ClosingTx] -> ShowS)
-> Show ClosingTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ClosingTx -> ShowS
showsPrec :: Int -> ClosingTx -> ShowS
$cshow :: ClosingTx -> String
show :: ClosingTx -> String
$cshowList :: [ClosingTx] -> ShowS
showList :: [ClosingTx] -> ShowS
Show, (forall x. ClosingTx -> Rep ClosingTx x)
-> (forall x. Rep ClosingTx x -> ClosingTx) -> Generic ClosingTx
forall x. Rep ClosingTx x -> ClosingTx
forall x. ClosingTx -> Rep ClosingTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ClosingTx -> Rep ClosingTx x
from :: forall x. ClosingTx -> Rep ClosingTx x
$cto :: forall x. Rep ClosingTx x -> ClosingTx
to :: forall x. Rep ClosingTx x -> ClosingTx
Generic)

-- | Build a closing transaction (option_simple_close).
--
-- * locktime: from closing_complete message
-- * sequence: 0xFFFFFFFD
-- * outputs: sorted per BIP69
build_closing_tx :: ClosingContext -> ClosingTx
build_closing_tx :: ClosingContext -> ClosingTx
build_closing_tx ClosingContext
ctx =
  let -- Subtract fee from closer
      !(Satoshi
localAmt, Satoshi
remoteAmt) = if ClosingContext -> Bool
clc_is_funder ClosingContext
ctx
        then
          let !deducted :: Satoshi
deducted = if Satoshi -> Word64
unSatoshi (ClosingContext -> Satoshi
clc_local_amount ClosingContext
ctx) Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>=
                             Satoshi -> Word64
unSatoshi (ClosingContext -> Satoshi
clc_fee ClosingContext
ctx)
                          then Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi (ClosingContext -> Satoshi
clc_local_amount ClosingContext
ctx) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-
                                        Satoshi -> Word64
unSatoshi (ClosingContext -> Satoshi
clc_fee ClosingContext
ctx))
                          else Word64 -> Satoshi
Satoshi Word64
0
          in (Satoshi
deducted, ClosingContext -> Satoshi
clc_remote_amount ClosingContext
ctx)
        else
          let !deducted :: Satoshi
deducted = if Satoshi -> Word64
unSatoshi (ClosingContext -> Satoshi
clc_remote_amount ClosingContext
ctx) Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>=
                             Satoshi -> Word64
unSatoshi (ClosingContext -> Satoshi
clc_fee ClosingContext
ctx)
                          then Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi (ClosingContext -> Satoshi
clc_remote_amount ClosingContext
ctx) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
-
                                        Satoshi -> Word64
unSatoshi (ClosingContext -> Satoshi
clc_fee ClosingContext
ctx))
                          else Word64 -> Satoshi
Satoshi Word64
0
          in (ClosingContext -> Satoshi
clc_local_amount ClosingContext
ctx, Satoshi
deducted)

      -- Build outputs, omitting dust
      !localOutput :: [TxOutput]
localOutput =
        if Satoshi -> Word64
unSatoshi Satoshi
localAmt Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi (DustLimit -> Satoshi
unDustLimit (DustLimit -> Satoshi) -> DustLimit -> Satoshi
forall a b. (a -> b) -> a -> b
$ ClosingContext -> DustLimit
clc_local_dust_limit ClosingContext
ctx)
        then [Satoshi -> Script -> OutputType -> TxOutput
TxOutput Satoshi
localAmt (ClosingContext -> Script
clc_local_script ClosingContext
ctx) OutputType
OutputToLocal]
        else []

      !remoteOutput :: [TxOutput]
remoteOutput =
        if Satoshi -> Word64
unSatoshi Satoshi
remoteAmt Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Satoshi -> Word64
unSatoshi (DustLimit -> Satoshi
unDustLimit (DustLimit -> Satoshi) -> DustLimit -> Satoshi
forall a b. (a -> b) -> a -> b
$ ClosingContext -> DustLimit
clc_remote_dust_limit ClosingContext
ctx)
        then [Satoshi -> Script -> OutputType -> TxOutput
TxOutput Satoshi
remoteAmt (ClosingContext -> Script
clc_remote_script ClosingContext
ctx) OutputType
OutputToRemote]
        else []

      !allOutputs :: [TxOutput]
allOutputs = [TxOutput]
localOutput [TxOutput] -> [TxOutput] -> [TxOutput]
forall a. [a] -> [a] -> [a]
++ [TxOutput]
remoteOutput
      !sortedOutputs :: [TxOutput]
sortedOutputs = [TxOutput] -> [TxOutput]
sort_outputs [TxOutput]
allOutputs

  in ClosingTx
       { cltx_version :: Word32
cltx_version = Word32
2
       , cltx_locktime :: Locktime
cltx_locktime = ClosingContext -> Locktime
clc_locktime ClosingContext
ctx
       , cltx_input_outpoint :: Outpoint
cltx_input_outpoint = ClosingContext -> Outpoint
clc_funding_outpoint ClosingContext
ctx
       , cltx_input_sequence :: Sequence
cltx_input_sequence = Word32 -> Sequence
Sequence Word32
0xFFFFFFFD
       , cltx_outputs :: [TxOutput]
cltx_outputs = [TxOutput]
sortedOutputs
       , cltx_funding_script :: Script
cltx_funding_script = ClosingContext -> Script
clc_funding_script ClosingContext
ctx
       }
{-# INLINE build_closing_tx #-}

-- | Build a legacy closing transaction (closing_signed).
--
-- * locktime: 0
-- * sequence: 0xFFFFFFFF
-- * outputs: sorted per BIP69
build_legacy_closing_tx :: ClosingContext -> ClosingTx
build_legacy_closing_tx :: ClosingContext -> ClosingTx
build_legacy_closing_tx ClosingContext
ctx =
  let !result :: ClosingTx
result = ClosingContext -> ClosingTx
build_closing_tx ClosingContext
ctx
        { clc_locktime = Locktime 0 }
  in ClosingTx
result { cltx_input_sequence = Sequence 0xFFFFFFFF }
{-# INLINE build_legacy_closing_tx #-}

-- fee calculation -------------------------------------------------------------

-- | Calculate the base commitment transaction fee.
--
-- @fee = feerate_per_kw * weight / 1000@
--
-- where @weight = base_weight + 172 * num_htlcs@
commitment_fee :: FeeratePerKw -> ChannelFeatures -> Word64 -> Satoshi
commitment_fee :: FeeratePerKw -> ChannelFeatures -> Word64 -> Satoshi
commitment_fee FeeratePerKw
feerate ChannelFeatures
features Word64
numHtlcs =
  let !weight :: Word64
weight = ChannelFeatures -> Word64 -> Word64
commitment_weight ChannelFeatures
features Word64
numHtlcs
      !fee :: Word64
fee = (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FeeratePerKw -> Word32
unFeeratePerKw FeeratePerKw
feerate) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
weight) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
1000
  in Word64 -> Satoshi
Satoshi Word64
fee
{-# INLINE commitment_fee #-}

-- | Calculate commitment transaction weight.
--
-- @weight = base + 172 * num_htlcs@
commitment_weight :: ChannelFeatures -> Word64 -> Word64
commitment_weight :: ChannelFeatures -> Word64 -> Word64
commitment_weight ChannelFeatures
features Word64
numHtlcs =
  let !base :: Word64
base = if ChannelFeatures -> Bool
has_anchors ChannelFeatures
features
              then Word64
commitment_weight_anchors
              else Word64
commitment_weight_no_anchors
  in Word64
base Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
htlc_output_weight Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
numHtlcs
{-# INLINE commitment_weight #-}

-- | Calculate HTLC-timeout transaction fee.
--
-- With option_anchors, fee is 0 (CPFP).
-- Otherwise, @fee = feerate_per_kw * 663 / 1000@
htlc_timeout_fee :: FeeratePerKw -> ChannelFeatures -> Satoshi
htlc_timeout_fee :: FeeratePerKw -> ChannelFeatures -> Satoshi
htlc_timeout_fee FeeratePerKw
feerate ChannelFeatures
features
  | ChannelFeatures -> Bool
has_anchors ChannelFeatures
features = Word64 -> Satoshi
Satoshi Word64
0
  | Bool
otherwise =
      let !weight :: Word64
weight = Word64
htlc_timeout_weight_no_anchors
          !fee :: Word64
fee = (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FeeratePerKw -> Word32
unFeeratePerKw FeeratePerKw
feerate) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
weight) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
1000
      in Word64 -> Satoshi
Satoshi Word64
fee
{-# INLINE htlc_timeout_fee #-}

-- | Calculate HTLC-success transaction fee.
--
-- With option_anchors, fee is 0 (CPFP).
-- Otherwise, @fee = feerate_per_kw * 703 / 1000@
htlc_success_fee :: FeeratePerKw -> ChannelFeatures -> Satoshi
htlc_success_fee :: FeeratePerKw -> ChannelFeatures -> Satoshi
htlc_success_fee FeeratePerKw
feerate ChannelFeatures
features
  | ChannelFeatures -> Bool
has_anchors ChannelFeatures
features = Word64 -> Satoshi
Satoshi Word64
0
  | Bool
otherwise =
      let !weight :: Word64
weight = Word64
htlc_success_weight_no_anchors
          !fee :: Word64
fee = (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (FeeratePerKw -> Word32
unFeeratePerKw FeeratePerKw
feerate) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
weight) Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
1000
      in Word64 -> Satoshi
Satoshi Word64
fee
{-# INLINE htlc_success_fee #-}

-- trimming --------------------------------------------------------------------

-- | Calculate the trim threshold for an HTLC.
--
-- An HTLC is trimmed if:
-- @amount < dust_limit + htlc_tx_fee@
htlc_trim_threshold
  :: DustLimit
  -> FeeratePerKw
  -> ChannelFeatures
  -> HTLCDirection
  -> Satoshi
htlc_trim_threshold :: DustLimit
-> FeeratePerKw -> ChannelFeatures -> HTLCDirection -> Satoshi
htlc_trim_threshold DustLimit
dust FeeratePerKw
feerate ChannelFeatures
features HTLCDirection
direction =
  let !dustVal :: Satoshi
dustVal = DustLimit -> Satoshi
unDustLimit DustLimit
dust
      !htlcFee :: Satoshi
htlcFee = case HTLCDirection
direction of
        HTLCDirection
HTLCOffered  -> FeeratePerKw -> ChannelFeatures -> Satoshi
htlc_timeout_fee FeeratePerKw
feerate ChannelFeatures
features
        HTLCDirection
HTLCReceived -> FeeratePerKw -> ChannelFeatures -> Satoshi
htlc_success_fee FeeratePerKw
feerate ChannelFeatures
features
  in Word64 -> Satoshi
Satoshi (Satoshi -> Word64
unSatoshi Satoshi
dustVal Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Satoshi -> Word64
unSatoshi Satoshi
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 :: DustLimit -> FeeratePerKw -> ChannelFeatures -> HTLC -> Bool
is_trimmed DustLimit
dust FeeratePerKw
feerate ChannelFeatures
features HTLC
htlc =
  let !threshold :: Satoshi
threshold = DustLimit
-> FeeratePerKw -> ChannelFeatures -> HTLCDirection -> Satoshi
htlc_trim_threshold DustLimit
dust FeeratePerKw
feerate ChannelFeatures
features
                     (HTLC -> HTLCDirection
htlc_direction HTLC
htlc)
      !amountSat :: Satoshi
amountSat = MilliSatoshi -> Satoshi
msat_to_sat (HTLC -> MilliSatoshi
htlc_amount_msat HTLC
htlc)
  in Satoshi -> Word64
unSatoshi Satoshi
amountSat Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Satoshi -> Word64
unSatoshi Satoshi
threshold
{-# INLINE is_trimmed #-}

-- | Filter HTLCs that are trimmed.
trimmed_htlcs
  :: DustLimit
  -> FeeratePerKw
  -> ChannelFeatures
  -> [HTLC]
  -> [HTLC]
trimmed_htlcs :: DustLimit -> FeeratePerKw -> ChannelFeatures -> [HTLC] -> [HTLC]
trimmed_htlcs DustLimit
dust FeeratePerKw
feerate ChannelFeatures
features =
  (HTLC -> Bool) -> [HTLC] -> [HTLC]
forall a. (a -> Bool) -> [a] -> [a]
filter (DustLimit -> FeeratePerKw -> ChannelFeatures -> HTLC -> Bool
is_trimmed DustLimit
dust FeeratePerKw
feerate ChannelFeatures
features)
{-# INLINE trimmed_htlcs #-}

-- | Filter HTLCs that are not trimmed.
untrimmed_htlcs
  :: DustLimit
  -> FeeratePerKw
  -> ChannelFeatures
  -> [HTLC]
  -> [HTLC]
untrimmed_htlcs :: DustLimit -> FeeratePerKw -> ChannelFeatures -> [HTLC] -> [HTLC]
untrimmed_htlcs DustLimit
dust FeeratePerKw
feerate ChannelFeatures
features =
  (HTLC -> Bool) -> [HTLC] -> [HTLC]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (HTLC -> Bool) -> HTLC -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DustLimit -> FeeratePerKw -> ChannelFeatures -> HTLC -> Bool
is_trimmed DustLimit
dust FeeratePerKw
feerate ChannelFeatures
features)
{-# INLINE untrimmed_htlcs #-}

-- 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 :: [TxOutput] -> [TxOutput]
sort_outputs = (TxOutput -> TxOutput -> Ordering) -> [TxOutput] -> [TxOutput]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy TxOutput -> TxOutput -> Ordering
compareOutputs
{-# INLINE sort_outputs #-}

-- | Compare two outputs for ordering.
compareOutputs :: TxOutput -> TxOutput -> Ordering
compareOutputs :: TxOutput -> TxOutput -> Ordering
compareOutputs TxOutput
o1 TxOutput
o2 =
  case Satoshi -> Satoshi -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (TxOutput -> Satoshi
txout_value TxOutput
o1) (TxOutput -> Satoshi
txout_value TxOutput
o2) of
    Ordering
EQ -> case ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Script -> ByteString
unScript (Script -> ByteString) -> Script -> ByteString
forall a b. (a -> b) -> a -> b
$ TxOutput -> Script
txout_script TxOutput
o1)
                       (Script -> ByteString
unScript (Script -> ByteString) -> Script -> ByteString
forall a b. (a -> b) -> a -> b
$ TxOutput -> Script
txout_script TxOutput
o2) of
            Ordering
EQ -> OutputType -> OutputType -> Ordering
compareCltvExpiry (TxOutput -> OutputType
txout_type TxOutput
o1) (TxOutput -> OutputType
txout_type TxOutput
o2)
            Ordering
other -> Ordering
other
    Ordering
other -> Ordering
other
{-# INLINE compareOutputs #-}

-- | Compare CLTV expiry for HTLC outputs.
compareCltvExpiry :: OutputType -> OutputType -> Ordering
compareCltvExpiry :: OutputType -> OutputType -> Ordering
compareCltvExpiry (OutputOfferedHTLC CltvExpiry
e1)  (OutputOfferedHTLC CltvExpiry
e2)  = CltvExpiry -> CltvExpiry -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CltvExpiry
e1 CltvExpiry
e2
compareCltvExpiry (OutputReceivedHTLC CltvExpiry
e1) (OutputReceivedHTLC CltvExpiry
e2) = CltvExpiry -> CltvExpiry -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CltvExpiry
e1 CltvExpiry
e2
compareCltvExpiry (OutputOfferedHTLC CltvExpiry
e1)  (OutputReceivedHTLC CltvExpiry
e2) = CltvExpiry -> CltvExpiry -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CltvExpiry
e1 CltvExpiry
e2
compareCltvExpiry (OutputReceivedHTLC CltvExpiry
e1) (OutputOfferedHTLC CltvExpiry
e2)  = CltvExpiry -> CltvExpiry -> Ordering
forall a. Ord a => a -> a -> Ordering
compare CltvExpiry
e1 CltvExpiry
e2
compareCltvExpiry OutputType
_ OutputType
_ = Ordering
EQ
{-# INLINE compareCltvExpiry #-}