packages feed

ppad-tx-0.2.0: lib/Bitcoin/Prim/Tx/Internal.hs

{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module: Bitcoin.Prim.Tx.Internal
-- Copyright: (c) 2025 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Transaction types and serialisation builders, shared by the public
-- modules.

module Bitcoin.Prim.Tx.Internal (
    -- * Transaction types
    TxId(..)
  , OutPoint(..)
  , TxIn(..)
  , TxOut(..)
  , Witness(..)
  , Tx(..)

    -- * Builders
  , to_strict
  , put_word32_le
  , put_word64_le
  , put_compact
  , put_bytes
  , put_outpoint
  , put_txin
  , put_txout
  , put_witness
  ) where

import Control.DeepSeq (NFData(..))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy as BL
import Data.List.NonEmpty (NonEmpty(..))
import Data.Word (Word32, Word64)
import GHC.Generics (Generic)

-- types ----------------------------------------------------------------------

-- | Transaction ID: 32 bytes, the double-SHA256 of the transaction's
--   legacy serialisation, in internal byte order (the reverse of the
--   usual hex display).
newtype TxId = TxId BS.ByteString
  deriving (Eq, Ord, Show, Generic)

instance NFData TxId

-- | Transaction outpoint (txid + output index).
data OutPoint = OutPoint
  { op_txid  :: {-# UNPACK #-} !TxId
  , op_vout  :: {-# UNPACK #-} !Word32
  } deriving (Eq, Ord, Show, Generic)

instance NFData OutPoint

-- | Witness stack for a single input (empty for a non-witness input).
newtype Witness = Witness [BS.ByteString]
  deriving (Eq, Show, Generic)

instance NFData Witness

-- | Transaction input.
data TxIn = TxIn
  { txin_prevout    :: {-# UNPACK #-} !OutPoint
  , txin_script_sig :: !BS.ByteString
  , txin_sequence   :: {-# UNPACK #-} !Word32
  , txin_witness    :: !Witness
  } deriving (Eq, Show, Generic)

instance NFData TxIn

-- | Transaction output.
data TxOut = TxOut
  { txout_value         :: {-# UNPACK #-} !Word64  -- ^ satoshis
  , txout_script_pubkey :: !BS.ByteString
  } deriving (Eq, Show, Generic)

instance NFData TxOut

-- | Complete transaction.
--
--   Bitcoin requires at least one input and one output, enforced here
--   via 'NonEmpty' lists. Each input carries its own witness, so a
--   transaction is serialised in the segwit format exactly when some
--   input's witness is non-empty.
data Tx = Tx
  { tx_version   :: {-# UNPACK #-} !Word32
  , tx_inputs    :: !(NonEmpty TxIn)
  , tx_outputs   :: !(NonEmpty TxOut)
  , tx_locktime  :: {-# UNPACK #-} !Word32
  } deriving (Eq, Show, Generic)

instance NFData Tx

-- builders -------------------------------------------------------------------

-- | Convert a Builder to a strict ByteString.
to_strict :: BSB.Builder -> BS.ByteString
to_strict = BL.toStrict . BSB.toLazyByteString
{-# INLINE to_strict #-}

-- | Encode a Word32 as little-endian bytes.
put_word32_le :: Word32 -> BSB.Builder
put_word32_le = BSB.word32LE
{-# INLINE put_word32_le #-}

-- | Encode a Word64 as little-endian bytes.
put_word64_le :: Word64 -> BSB.Builder
put_word64_le = BSB.word64LE
{-# INLINE put_word64_le #-}

-- | Encode a Word64 as Bitcoin compactSize (varint).
--
--   Encoding:
--   - 0x00-0xfc: 1 byte (value itself)
--   - 0xfd-0xffff: 0xfd ++ 2 bytes LE
--   - 0x10000-0xffffffff: 0xfe ++ 4 bytes LE
--   - larger: 0xff ++ 8 bytes LE
put_compact :: Word64 -> BSB.Builder
put_compact !n
    | n <= 0xfc       = 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_compact #-}

-- | Encode compactSize-length-prefixed bytes (Bitcoin @ser_string@).
put_bytes :: BS.ByteString -> BSB.Builder
put_bytes !bs =
     put_compact (fromIntegral (BS.length bs))
  <> BSB.byteString bs
{-# INLINE put_bytes #-}

-- | Encode an OutPoint (txid + vout).
put_outpoint :: OutPoint -> BSB.Builder
put_outpoint OutPoint {..} =
    let !(TxId !txid_bs) = op_txid
    in  BSB.byteString txid_bs <> put_word32_le op_vout
{-# INLINE put_outpoint #-}

-- | Encode a TxIn (without its witness, which is serialised
--   separately).
put_txin :: TxIn -> BSB.Builder
put_txin TxIn {..} =
       put_outpoint txin_prevout
    <> put_bytes txin_script_sig
    <> put_word32_le txin_sequence
{-# INLINE put_txin #-}

-- | Encode a TxOut.
put_txout :: TxOut -> BSB.Builder
put_txout TxOut {..} =
       put_word64_le txout_value
    <> put_bytes txout_script_pubkey
{-# INLINE put_txout #-}

-- | Encode a Witness stack.
put_witness :: Witness -> BSB.Builder
put_witness (Witness items) =
       put_compact (fromIntegral (length items))
    <> foldMap put_bytes items
{-# INLINE put_witness #-}