Main.hs (9065B)
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 import Data.Word (Word64) 11 12 import Bitcoin.Prim.Tx 13 import Bitcoin.Prim.Tx.Sighash 14 15 -- NFData instances ------------------------------------------------------------ 16 17 instance NFData SighashType 18 19 -- sample data ----------------------------------------------------------------- 20 21 -- | Sample outpoint (references a dummy txid). 22 sampleOutPoint :: OutPoint 23 sampleOutPoint = OutPoint (TxId (BS.replicate 32 0xab)) 0 24 25 -- | Sample input with typical P2PKH signature (~107 bytes). 26 sampleInput :: TxIn 27 sampleInput = TxIn 28 { txin_prevout = sampleOutPoint 29 , txin_script_sig = BS.replicate 107 0x00 -- typical P2PKH sig 30 , txin_sequence = 0xffffffff 31 } 32 33 -- | Sample input for segwit (empty scriptSig). 34 sampleSegwitInput :: TxIn 35 sampleSegwitInput = TxIn 36 { txin_prevout = sampleOutPoint 37 , txin_script_sig = BS.empty 38 , txin_sequence = 0xffffffff 39 } 40 41 -- | Sample output with typical P2PKH script (25 bytes). 42 sampleOutput :: TxOut 43 sampleOutput = TxOut 44 { txout_value = 50000000 45 , txout_script_pubkey = BS.replicate 25 0x00 -- typical P2PKH script 46 } 47 48 -- | Sample witness stack (signature + pubkey for P2WPKH). 49 sampleWitness :: Witness 50 sampleWitness = Witness 51 [ BS.replicate 72 0x00 -- DER signature 52 , BS.replicate 33 0x00 -- compressed pubkey 53 ] 54 55 -- | Create a legacy transaction with n inputs and m outputs. 56 -- Requires n >= 1 and m >= 1. 57 mkLegacyTx :: Int -> Int -> Tx 58 mkLegacyTx !numInputs !numOutputs = Tx 59 { tx_version = 1 60 , tx_inputs = sampleInput :| replicate (numInputs - 1) sampleInput 61 , tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput 62 , tx_witnesses = [] 63 , tx_locktime = 0 64 } 65 66 -- | Create a segwit transaction with n inputs and m outputs. 67 -- Requires n >= 1 and m >= 1. 68 mkSegwitTx :: Int -> Int -> Tx 69 mkSegwitTx !numInputs !numOutputs = Tx 70 { tx_version = 2 71 , tx_inputs = sampleSegwitInput :| replicate (numInputs - 1) sampleSegwitInput 72 , tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput 73 , tx_witnesses = replicate numInputs sampleWitness 74 , tx_locktime = 0 75 } 76 77 -- sample transactions --------------------------------------------------------- 78 79 smallLegacyTx, mediumLegacyTx, largeLegacyTx :: Tx 80 smallLegacyTx = mkLegacyTx 1 1 81 mediumLegacyTx = mkLegacyTx 5 5 82 largeLegacyTx = mkLegacyTx 20 20 83 84 smallSegwitTx, mediumSegwitTx, largeSegwitTx :: Tx 85 smallSegwitTx = mkSegwitTx 1 1 86 mediumSegwitTx = mkSegwitTx 5 5 87 largeSegwitTx = mkSegwitTx 20 20 88 89 -- serialised bytes ------------------------------------------------------------ 90 91 smallLegacyBytes, mediumLegacyBytes, largeLegacyBytes :: BS.ByteString 92 smallLegacyBytes = to_bytes smallLegacyTx 93 mediumLegacyBytes = to_bytes mediumLegacyTx 94 largeLegacyBytes = to_bytes largeLegacyTx 95 96 smallSegwitBytes, mediumSegwitBytes, largeSegwitBytes :: BS.ByteString 97 smallSegwitBytes = to_bytes smallSegwitTx 98 mediumSegwitBytes = to_bytes mediumSegwitTx 99 largeSegwitBytes = to_bytes largeSegwitTx 100 101 -- sighash inputs -------------------------------------------------------------- 102 103 -- | Typical P2PKH scriptPubKey (25 bytes). 104 sampleScriptPubKey :: BS.ByteString 105 sampleScriptPubKey = BS.replicate 25 0x00 106 107 -- | Typical P2WPKH scriptCode (26 bytes). 108 sampleScriptCode :: BS.ByteString 109 sampleScriptCode = BS.replicate 26 0x00 110 111 -- | Sample input value (1 BTC in satoshis). 112 sampleValue :: Word64 113 sampleValue = 100000000 114 115 -- | Typical P2TR scriptPubKey (34 bytes): OP_1 || 0x20 || 32-byte 116 -- x-only pubkey. 117 sampleTaprootSpk :: BS.ByteString 118 sampleTaprootSpk = BS.cons 0x51 (BS.cons 0x20 (BS.replicate 32 0x00)) 119 120 -- | Amounts/scriptPubKeys lists sized to a tx's input count. 121 taprootAmts :: Int -> [Word64] 122 taprootAmts n = replicate n sampleValue 123 124 taprootSpks :: Int -> [BS.ByteString] 125 taprootSpks n = replicate n sampleTaprootSpk 126 127 -- | 32-byte placeholder tap leaf hash for script-path benches. 128 sampleTapLeaf :: BS.ByteString 129 sampleTapLeaf = BS.replicate 32 0x00 130 131 -- benchmarks ------------------------------------------------------------------ 132 133 main :: IO () 134 main = defaultMain 135 [ bgroup "serialisation" 136 [ bgroup "to_bytes" 137 [ bench "small-legacy" $ nf to_bytes smallLegacyTx 138 , bench "small-segwit" $ nf to_bytes smallSegwitTx 139 , bench "medium-legacy" $ nf to_bytes mediumLegacyTx 140 , bench "medium-segwit" $ nf to_bytes mediumSegwitTx 141 , bench "large-legacy" $ nf to_bytes largeLegacyTx 142 , bench "large-segwit" $ nf to_bytes largeSegwitTx 143 ] 144 , bgroup "from_bytes" 145 [ bench "small-legacy" $ nf from_bytes smallLegacyBytes 146 , bench "small-segwit" $ nf from_bytes smallSegwitBytes 147 , bench "medium-legacy" $ nf from_bytes mediumLegacyBytes 148 , bench "medium-segwit" $ nf from_bytes mediumSegwitBytes 149 , bench "large-legacy" $ nf from_bytes largeLegacyBytes 150 , bench "large-segwit" $ nf from_bytes largeSegwitBytes 151 ] 152 , bgroup "to_bytes_legacy" 153 [ bench "small-legacy" $ nf to_bytes_legacy smallLegacyTx 154 , bench "small-segwit" $ nf to_bytes_legacy smallSegwitTx 155 , bench "medium-legacy" $ nf to_bytes_legacy mediumLegacyTx 156 , bench "medium-segwit" $ nf to_bytes_legacy mediumSegwitTx 157 , bench "large-legacy" $ nf to_bytes_legacy largeLegacyTx 158 , bench "large-segwit" $ nf to_bytes_legacy largeSegwitTx 159 ] 160 ] 161 , bgroup "txid" 162 [ bench "small-legacy" $ nf txid smallLegacyTx 163 , bench "small-segwit" $ nf txid smallSegwitTx 164 , bench "medium-legacy" $ nf txid mediumLegacyTx 165 , bench "medium-segwit" $ nf txid mediumSegwitTx 166 , bench "large-legacy" $ nf txid largeLegacyTx 167 , bench "large-segwit" $ nf txid largeSegwitTx 168 ] 169 , bgroup "sighash" 170 [ bgroup "sighash_legacy" 171 [ bench "small / SIGHASH_ALL" $ 172 nf (sighashLegacy smallLegacyTx SIGHASH_ALL) 0 173 , bench "medium / SIGHASH_ALL" $ 174 nf (sighashLegacy mediumLegacyTx SIGHASH_ALL) 0 175 , bench "large / SIGHASH_ALL" $ 176 nf (sighashLegacy largeLegacyTx SIGHASH_ALL) 0 177 , bench "medium / SIGHASH_NONE" $ 178 nf (sighashLegacy mediumLegacyTx SIGHASH_NONE) 0 179 , bench "medium / SIGHASH_SINGLE" $ 180 nf (sighashLegacy mediumLegacyTx SIGHASH_SINGLE) 0 181 , bench "medium / SIGHASH_ALL|ACP" $ 182 nf (sighashLegacy mediumLegacyTx 183 SIGHASH_ALL_ANYONECANPAY) 0 184 ] 185 , bgroup "sighash_segwit" 186 [ bench "small / SIGHASH_ALL" $ 187 nf (sighashSegwit smallSegwitTx SIGHASH_ALL) 0 188 , bench "medium / SIGHASH_ALL" $ 189 nf (sighashSegwit mediumSegwitTx SIGHASH_ALL) 0 190 , bench "large / SIGHASH_ALL" $ 191 nf (sighashSegwit largeSegwitTx SIGHASH_ALL) 0 192 , bench "medium / SIGHASH_NONE" $ 193 nf (sighashSegwit mediumSegwitTx SIGHASH_NONE) 0 194 , bench "medium / SIGHASH_SINGLE" $ 195 nf (sighashSegwit mediumSegwitTx SIGHASH_SINGLE) 0 196 , bench "medium / SIGHASH_ALL|ACP" $ 197 nf (sighashSegwit mediumSegwitTx 198 SIGHASH_ALL_ANYONECANPAY) 0 199 ] 200 , bgroup "sighash_taproot_keypath" 201 [ bench "small / DEFAULT" $ nf (taprootKp smallSegwitTx 0x00) 0 202 , bench "medium / DEFAULT" $ nf (taprootKp mediumSegwitTx 0x00) 0 203 , bench "large / DEFAULT" $ nf (taprootKp largeSegwitTx 0x00) 0 204 , bench "medium / ALL" $ nf (taprootKp mediumSegwitTx 0x01) 0 205 , bench "medium / NONE" $ nf (taprootKp mediumSegwitTx 0x02) 0 206 , bench "medium / SINGLE" $ nf (taprootKp mediumSegwitTx 0x03) 0 207 , bench "medium / ALL|ACP" $ nf (taprootKp mediumSegwitTx 0x81) 0 208 ] 209 , bgroup "sighash_taproot_scriptpath" 210 [ bench "small / DEFAULT" $ nf (taprootSp smallSegwitTx 0x00) 0 211 , bench "medium / DEFAULT" $ nf (taprootSp mediumSegwitTx 0x00) 0 212 , bench "large / DEFAULT" $ nf (taprootSp largeSegwitTx 0x00) 0 213 ] 214 ] 215 ] 216 where 217 sighashLegacy tx st i = 218 sighash_legacy tx i sampleScriptPubKey (encode_sighash st) 219 sighashSegwit tx st i = 220 sighash_segwit tx i sampleScriptCode sampleValue (encode_sighash st) 221 taprootKp tx ht i = 222 let n = length (tx_inputs tx) 223 in sighash_taproot_keypath tx i 224 (taprootAmts n) (taprootSpks n) Nothing ht 225 taprootSp tx ht i = 226 let n = length (tx_inputs tx) 227 in sighash_taproot_scriptpath tx i 228 (taprootAmts n) (taprootSpks n) Nothing 229 sampleTapLeaf 0xffffffff ht