{-# 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 :: CommitmentTx -> Maybe ByteString
encode_tx = (Tx -> ByteString) -> Maybe Tx -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tx -> ByteString
BT.to_bytes (Maybe Tx -> Maybe ByteString)
-> (CommitmentTx -> Maybe Tx) -> CommitmentTx -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommitmentTx -> Maybe Tx
commitment_to_tx

-- | Encode an HTLC transaction (SegWit format).
encode_htlc_tx :: HTLCTx -> BS.ByteString
encode_htlc_tx :: HTLCTx -> ByteString
encode_htlc_tx = Tx -> ByteString
BT.to_bytes (Tx -> ByteString) -> (HTLCTx -> Tx) -> HTLCTx -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HTLCTx -> Tx
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 :: ClosingTx -> Maybe ByteString
encode_closing_tx = (Tx -> ByteString) -> Maybe Tx -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tx -> ByteString
BT.to_bytes (Maybe Tx -> Maybe ByteString)
-> (ClosingTx -> Maybe Tx) -> ClosingTx -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClosingTx -> Maybe Tx
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 :: CommitmentTx -> Maybe ByteString
encode_tx_for_signing =
  (Tx -> ByteString) -> Maybe Tx -> Maybe ByteString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tx -> ByteString
BT.to_bytes_legacy (Maybe Tx -> Maybe ByteString)
-> (CommitmentTx -> Maybe Tx) -> CommitmentTx -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommitmentTx -> Maybe Tx
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 -> ByteString
encode_witness (Witness ![ByteString]
items) =
  Builder -> ByteString
BT.to_strict (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$
       Word64 -> Builder
put_varint (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
items))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Builder) -> [ByteString] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ByteString -> Builder
put_item [ByteString]
items
  where
    put_item :: BS.ByteString -> BSB.Builder
    put_item :: ByteString -> Builder
put_item !ByteString
bs =
         Word64 -> Builder
put_varint (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs))
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
BSB.byteString ByteString
bs

-- | Encode a varint to a 'BSB.Builder'.
put_varint :: Word64 -> BSB.Builder
put_varint :: Word64 -> Builder
put_varint !Word64
n
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
0xFD  = Word8 -> Builder
BSB.word8 (Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xFFFF =
      Word8 -> Builder
BSB.word8 Word8
0xFD Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
BSB.word16LE (Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
  | Word64
n Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
0xFFFFFFFF =
      Word8 -> Builder
BSB.word8 Word8
0xFE Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
BSB.word32LE (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)
  | Bool
otherwise =
      Word8 -> Builder
BSB.word8 Word8
0xFF Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BSB.word64LE Word64
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 :: ByteString -> ByteString -> Script -> ByteString
encode_funding_witness !ByteString
sig1 !ByteString
sig2 (Script !ByteString
ws) =
  Witness -> ByteString
encode_witness
    ([ByteString] -> Witness
Witness [ByteString
BS.empty, ByteString
sig1, ByteString
sig2, ByteString
ws])