ppad-tx-0.2.0: bench/Main.hs
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import Criterion.Main
import qualified Data.ByteString as BS
import Data.List.NonEmpty (NonEmpty(..))
import Data.Word (Word64)
import Bitcoin.Prim.Tx
import Bitcoin.Prim.Tx.Sighash
-- NFData instances -----------------------------------------------------------
-- sample data ----------------------------------------------------------------
-- | Sample outpoint (references a dummy txid).
sampleOutPoint :: OutPoint
sampleOutPoint =
OutPoint (maybe null_txid id (mk_txid (BS.replicate 32 0xab))) 0
-- | Sample input with typical P2PKH signature (~107 bytes).
sampleInput :: TxIn
sampleInput = TxIn
{ txin_prevout = sampleOutPoint
, txin_script_sig = BS.replicate 107 0x00 -- typical P2PKH sig
, txin_sequence = 0xffffffff
, txin_witness = Witness []
}
-- | Sample input for segwit (empty scriptSig, P2WPKH-style witness).
sampleSegwitInput :: TxIn
sampleSegwitInput = TxIn
{ txin_prevout = sampleOutPoint
, txin_script_sig = BS.empty
, txin_sequence = 0xffffffff
, txin_witness = sampleWitness
}
-- | Sample output with typical P2PKH script (25 bytes).
sampleOutput :: TxOut
sampleOutput = TxOut
{ txout_value = 50000000
, txout_script_pubkey = BS.replicate 25 0x00 -- typical P2PKH script
}
-- | Sample witness stack (signature + pubkey for P2WPKH).
sampleWitness :: Witness
sampleWitness = Witness
[ BS.replicate 72 0x00 -- DER signature
, BS.replicate 33 0x00 -- compressed pubkey
]
-- | Create a legacy transaction with n inputs and m outputs.
-- Requires n >= 1 and m >= 1.
mkLegacyTx :: Int -> Int -> Tx
mkLegacyTx !numInputs !numOutputs = Tx
{ tx_version = 1
, tx_inputs = sampleInput :| replicate (numInputs - 1) sampleInput
, tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput
, tx_locktime = 0
}
-- | Create a segwit transaction with n inputs and m outputs.
-- Requires n >= 1 and m >= 1.
mkSegwitTx :: Int -> Int -> Tx
mkSegwitTx !numInputs !numOutputs = Tx
{ tx_version = 2
, tx_inputs =
sampleSegwitInput :| replicate (numInputs - 1) sampleSegwitInput
, tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput
, tx_locktime = 0
}
-- sample transactions --------------------------------------------------------
smallLegacyTx, mediumLegacyTx, largeLegacyTx :: Tx
smallLegacyTx = mkLegacyTx 1 1
mediumLegacyTx = mkLegacyTx 5 5
largeLegacyTx = mkLegacyTx 20 20
smallSegwitTx, mediumSegwitTx, largeSegwitTx :: Tx
smallSegwitTx = mkSegwitTx 1 1
mediumSegwitTx = mkSegwitTx 5 5
largeSegwitTx = mkSegwitTx 20 20
-- serialised bytes -----------------------------------------------------------
smallLegacyBytes, mediumLegacyBytes, largeLegacyBytes :: BS.ByteString
smallLegacyBytes = to_bytes smallLegacyTx
mediumLegacyBytes = to_bytes mediumLegacyTx
largeLegacyBytes = to_bytes largeLegacyTx
smallSegwitBytes, mediumSegwitBytes, largeSegwitBytes :: BS.ByteString
smallSegwitBytes = to_bytes smallSegwitTx
mediumSegwitBytes = to_bytes mediumSegwitTx
largeSegwitBytes = to_bytes largeSegwitTx
-- sighash inputs -------------------------------------------------------------
-- | Typical P2PKH scriptPubKey (25 bytes).
sampleScriptPubKey :: BS.ByteString
sampleScriptPubKey = BS.replicate 25 0x00
-- | Typical P2WPKH scriptCode (26 bytes).
sampleScriptCode :: BS.ByteString
sampleScriptCode = BS.replicate 26 0x00
-- | Sample input value (1 BTC in satoshis).
sampleValue :: Word64
sampleValue = 100000000
-- | Typical P2TR scriptPubKey (34 bytes): OP_1 || 0x20 || 32-byte
-- x-only pubkey.
sampleTaprootSpk :: BS.ByteString
sampleTaprootSpk = BS.cons 0x51 (BS.cons 0x20 (BS.replicate 32 0x00))
-- | Amounts/scriptPubKeys lists sized to a tx's input count.
taprootAmts :: Int -> [Word64]
taprootAmts n = replicate n sampleValue
taprootSpks :: Int -> [BS.ByteString]
taprootSpks n = replicate n sampleTaprootSpk
-- | 32-byte placeholder tap leaf hash for script-path benches.
sampleTapLeaf :: BS.ByteString
sampleTapLeaf = BS.replicate 32 0x00
-- benchmarks -----------------------------------------------------------------
main :: IO ()
main = defaultMain
[ bgroup "serialisation"
[ bgroup "to_bytes"
[ bench "small-legacy" $ nf to_bytes smallLegacyTx
, bench "small-segwit" $ nf to_bytes smallSegwitTx
, bench "medium-legacy" $ nf to_bytes mediumLegacyTx
, bench "medium-segwit" $ nf to_bytes mediumSegwitTx
, bench "large-legacy" $ nf to_bytes largeLegacyTx
, bench "large-segwit" $ nf to_bytes largeSegwitTx
]
, bgroup "from_bytes"
[ bench "small-legacy" $ nf from_bytes smallLegacyBytes
, bench "small-segwit" $ nf from_bytes smallSegwitBytes
, bench "medium-legacy" $ nf from_bytes mediumLegacyBytes
, bench "medium-segwit" $ nf from_bytes mediumSegwitBytes
, bench "large-legacy" $ nf from_bytes largeLegacyBytes
, bench "large-segwit" $ nf from_bytes largeSegwitBytes
]
, bgroup "to_bytes_legacy"
[ bench "small-legacy" $ nf to_bytes_legacy smallLegacyTx
, bench "small-segwit" $ nf to_bytes_legacy smallSegwitTx
, bench "medium-legacy" $ nf to_bytes_legacy mediumLegacyTx
, bench "medium-segwit" $ nf to_bytes_legacy mediumSegwitTx
, bench "large-legacy" $ nf to_bytes_legacy largeLegacyTx
, bench "large-segwit" $ nf to_bytes_legacy largeSegwitTx
]
]
, bgroup "txid"
[ bench "small-legacy" $ nf txid smallLegacyTx
, bench "small-segwit" $ nf txid smallSegwitTx
, bench "medium-legacy" $ nf txid mediumLegacyTx
, bench "medium-segwit" $ nf txid mediumSegwitTx
, bench "large-legacy" $ nf txid largeLegacyTx
, bench "large-segwit" $ nf txid largeSegwitTx
]
, bgroup "sighash"
[ bgroup "sighash_legacy"
[ bench "small / SIGHASH_ALL" $
nf (sighashLegacy smallLegacyTx SIGHASH_ALL) 0
, bench "medium / SIGHASH_ALL" $
nf (sighashLegacy mediumLegacyTx SIGHASH_ALL) 0
, bench "large / SIGHASH_ALL" $
nf (sighashLegacy largeLegacyTx SIGHASH_ALL) 0
, bench "medium / SIGHASH_NONE" $
nf (sighashLegacy mediumLegacyTx SIGHASH_NONE) 0
, bench "medium / SIGHASH_SINGLE" $
nf (sighashLegacy mediumLegacyTx SIGHASH_SINGLE) 0
, bench "medium / SIGHASH_ALL|ACP" $
nf (sighashLegacy mediumLegacyTx
SIGHASH_ALL_ANYONECANPAY) 0
]
, bgroup "sighash_segwit"
[ bench "small / SIGHASH_ALL" $
nf (sighashSegwit smallSegwitTx SIGHASH_ALL) 0
, bench "medium / SIGHASH_ALL" $
nf (sighashSegwit mediumSegwitTx SIGHASH_ALL) 0
, bench "large / SIGHASH_ALL" $
nf (sighashSegwit largeSegwitTx SIGHASH_ALL) 0
, bench "medium / SIGHASH_NONE" $
nf (sighashSegwit mediumSegwitTx SIGHASH_NONE) 0
, bench "medium / SIGHASH_SINGLE" $
nf (sighashSegwit mediumSegwitTx SIGHASH_SINGLE) 0
, bench "medium / SIGHASH_ALL|ACP" $
nf (sighashSegwit mediumSegwitTx
SIGHASH_ALL_ANYONECANPAY) 0
]
, bgroup "sighash_taproot_keypath"
[ bench "small / DEFAULT" $ nf (taprootKp smallSegwitTx 0x00) 0
, bench "medium / DEFAULT" $ nf (taprootKp mediumSegwitTx 0x00) 0
, bench "large / DEFAULT" $ nf (taprootKp largeSegwitTx 0x00) 0
, bench "medium / ALL" $ nf (taprootKp mediumSegwitTx 0x01) 0
, bench "medium / NONE" $ nf (taprootKp mediumSegwitTx 0x02) 0
, bench "medium / SINGLE" $ nf (taprootKp mediumSegwitTx 0x03) 0
, bench "medium / ALL|ACP" $ nf (taprootKp mediumSegwitTx 0x81) 0
]
, bgroup "sighash_taproot_scriptpath"
[ bench "small / DEFAULT" $ nf (taprootSp smallSegwitTx 0x00) 0
, bench "medium / DEFAULT" $ nf (taprootSp mediumSegwitTx 0x00) 0
, bench "large / DEFAULT" $ nf (taprootSp largeSegwitTx 0x00) 0
]
]
]
where
sighashLegacy tx st i =
sighash_legacy tx i sampleScriptPubKey (encode_sighash st)
sighashSegwit tx st i =
sighash_segwit tx i sampleScriptCode sampleValue (encode_sighash st)
taprootKp tx ht i =
let n = length (tx_inputs tx)
in sighash_taproot_keypath tx i
(taprootAmts n) (taprootSpks n) Nothing ht
taprootSp tx ht i =
let n = length (tx_inputs tx)
in sighash_taproot_scriptpath tx i
(taprootAmts n) (taprootSpks n) Nothing
sampleTapLeaf 0xffffffff ht