Main.hs (5023B)
1 {-# OPTIONS_GHC -fno-warn-orphans #-} 2 {-# LANGUAGE BangPatterns #-} 3 4 module Main where 5 6 import Control.DeepSeq 7 import Criterion.Main 8 import qualified Data.ByteString as BS 9 import Data.List.NonEmpty (NonEmpty(..)) 10 11 import Bitcoin.Prim.Tx 12 import Bitcoin.Prim.Tx.Sighash 13 14 -- NFData instances ------------------------------------------------------------ 15 16 instance NFData SighashType 17 18 -- sample data ----------------------------------------------------------------- 19 20 -- | Sample outpoint (references a dummy txid). 21 sampleOutPoint :: OutPoint 22 sampleOutPoint = OutPoint (TxId (BS.replicate 32 0xab)) 0 23 24 -- | Sample input with typical P2PKH signature (~107 bytes). 25 sampleInput :: TxIn 26 sampleInput = TxIn 27 { txin_prevout = sampleOutPoint 28 , txin_script_sig = BS.replicate 107 0x00 -- typical P2PKH sig 29 , txin_sequence = 0xffffffff 30 } 31 32 -- | Sample input for segwit (empty scriptSig). 33 sampleSegwitInput :: TxIn 34 sampleSegwitInput = TxIn 35 { txin_prevout = sampleOutPoint 36 , txin_script_sig = BS.empty 37 , txin_sequence = 0xffffffff 38 } 39 40 -- | Sample output with typical P2PKH script (25 bytes). 41 sampleOutput :: TxOut 42 sampleOutput = TxOut 43 { txout_value = 50000000 44 , txout_script_pubkey = BS.replicate 25 0x00 -- typical P2PKH script 45 } 46 47 -- | Sample witness stack (signature + pubkey for P2WPKH). 48 sampleWitness :: Witness 49 sampleWitness = Witness 50 [ BS.replicate 72 0x00 -- DER signature 51 , BS.replicate 33 0x00 -- compressed pubkey 52 ] 53 54 -- | Create a legacy transaction with n inputs and m outputs. 55 -- Requires n >= 1 and m >= 1. 56 mkLegacyTx :: Int -> Int -> Tx 57 mkLegacyTx !numInputs !numOutputs = Tx 58 { tx_version = 1 59 , tx_inputs = sampleInput :| replicate (numInputs - 1) sampleInput 60 , tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput 61 , tx_witnesses = [] 62 , tx_locktime = 0 63 } 64 65 -- | Create a segwit transaction with n inputs and m outputs. 66 -- Requires n >= 1 and m >= 1. 67 mkSegwitTx :: Int -> Int -> Tx 68 mkSegwitTx !numInputs !numOutputs = Tx 69 { tx_version = 2 70 , tx_inputs = sampleSegwitInput :| replicate (numInputs - 1) sampleSegwitInput 71 , tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput 72 , tx_witnesses = replicate numInputs sampleWitness 73 , tx_locktime = 0 74 } 75 76 -- sample transactions --------------------------------------------------------- 77 78 smallLegacyTx, mediumLegacyTx, largeLegacyTx :: Tx 79 smallLegacyTx = mkLegacyTx 1 1 80 mediumLegacyTx = mkLegacyTx 5 5 81 largeLegacyTx = mkLegacyTx 20 20 82 83 smallSegwitTx, mediumSegwitTx, largeSegwitTx :: Tx 84 smallSegwitTx = mkSegwitTx 1 1 85 mediumSegwitTx = mkSegwitTx 5 5 86 largeSegwitTx = mkSegwitTx 20 20 87 88 -- serialised bytes ------------------------------------------------------------ 89 90 smallLegacyBytes, mediumLegacyBytes, largeLegacyBytes :: BS.ByteString 91 smallLegacyBytes = to_bytes smallLegacyTx 92 mediumLegacyBytes = to_bytes mediumLegacyTx 93 largeLegacyBytes = to_bytes largeLegacyTx 94 95 smallSegwitBytes, mediumSegwitBytes, largeSegwitBytes :: BS.ByteString 96 smallSegwitBytes = to_bytes smallSegwitTx 97 mediumSegwitBytes = to_bytes mediumSegwitTx 98 largeSegwitBytes = to_bytes largeSegwitTx 99 100 -- benchmarks ------------------------------------------------------------------ 101 102 main :: IO () 103 main = defaultMain 104 [ bgroup "serialisation" 105 [ bgroup "to_bytes" 106 [ bench "small-legacy" $ nf to_bytes smallLegacyTx 107 , bench "small-segwit" $ nf to_bytes smallSegwitTx 108 , bench "medium-legacy" $ nf to_bytes mediumLegacyTx 109 , bench "medium-segwit" $ nf to_bytes mediumSegwitTx 110 , bench "large-legacy" $ nf to_bytes largeLegacyTx 111 , bench "large-segwit" $ nf to_bytes largeSegwitTx 112 ] 113 , bgroup "from_bytes" 114 [ bench "small-legacy" $ nf from_bytes smallLegacyBytes 115 , bench "small-segwit" $ nf from_bytes smallSegwitBytes 116 , bench "medium-legacy" $ nf from_bytes mediumLegacyBytes 117 , bench "medium-segwit" $ nf from_bytes mediumSegwitBytes 118 , bench "large-legacy" $ nf from_bytes largeLegacyBytes 119 , bench "large-segwit" $ nf from_bytes largeSegwitBytes 120 ] 121 , bgroup "to_bytes_legacy" 122 [ bench "small-legacy" $ nf to_bytes_legacy smallLegacyTx 123 , bench "small-segwit" $ nf to_bytes_legacy smallSegwitTx 124 , bench "medium-legacy" $ nf to_bytes_legacy mediumLegacyTx 125 , bench "medium-segwit" $ nf to_bytes_legacy mediumSegwitTx 126 , bench "large-legacy" $ nf to_bytes_legacy largeLegacyTx 127 , bench "large-segwit" $ nf to_bytes_legacy largeSegwitTx 128 ] 129 ] 130 , bgroup "txid" 131 [ bench "small-legacy" $ nf txid smallLegacyTx 132 , bench "small-segwit" $ nf txid smallSegwitTx 133 , bench "medium-legacy" $ nf txid mediumLegacyTx 134 , bench "medium-segwit" $ nf txid mediumSegwitTx 135 , bench "large-legacy" $ nf txid largeLegacyTx 136 , bench "large-segwit" $ nf txid largeSegwitTx 137 ] 138 ]