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 #-}