Main.hs (9055B)
1 {-# OPTIONS_GHC -fno-warn-orphans #-} 2 {-# LANGUAGE BangPatterns #-} 3 4 module Main where 5 6 import Criterion.Main 7 import qualified Data.ByteString as BS 8 import Data.List.NonEmpty (NonEmpty(..)) 9 import Data.Word (Word64) 10 11 import Bitcoin.Prim.Tx 12 import Bitcoin.Prim.Tx.Sighash 13 14 -- NFData instances ----------------------------------------------------------- 15 16 -- sample data ---------------------------------------------------------------- 17 18 -- | Sample outpoint (references a dummy txid). 19 sampleOutPoint :: OutPoint 20 sampleOutPoint = 21 OutPoint (maybe null_txid id (mk_txid (BS.replicate 32 0xab))) 0 22 23 -- | Sample input with typical P2PKH signature (~107 bytes). 24 sampleInput :: TxIn 25 sampleInput = TxIn 26 { txin_prevout = sampleOutPoint 27 , txin_script_sig = BS.replicate 107 0x00 -- typical P2PKH sig 28 , txin_sequence = 0xffffffff 29 , txin_witness = Witness [] 30 } 31 32 -- | Sample input for segwit (empty scriptSig, P2WPKH-style witness). 33 sampleSegwitInput :: TxIn 34 sampleSegwitInput = TxIn 35 { txin_prevout = sampleOutPoint 36 , txin_script_sig = BS.empty 37 , txin_sequence = 0xffffffff 38 , txin_witness = sampleWitness 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_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 = 71 sampleSegwitInput :| replicate (numInputs - 1) sampleSegwitInput 72 , tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput 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 -- sighash inputs ------------------------------------------------------------- 101 102 -- | Typical P2PKH scriptPubKey (25 bytes). 103 sampleScriptPubKey :: BS.ByteString 104 sampleScriptPubKey = BS.replicate 25 0x00 105 106 -- | Typical P2WPKH scriptCode (26 bytes). 107 sampleScriptCode :: BS.ByteString 108 sampleScriptCode = BS.replicate 26 0x00 109 110 -- | Sample input value (1 BTC in satoshis). 111 sampleValue :: Word64 112 sampleValue = 100000000 113 114 -- | Typical P2TR scriptPubKey (34 bytes): OP_1 || 0x20 || 32-byte 115 -- x-only pubkey. 116 sampleTaprootSpk :: BS.ByteString 117 sampleTaprootSpk = BS.cons 0x51 (BS.cons 0x20 (BS.replicate 32 0x00)) 118 119 -- | Amounts/scriptPubKeys lists sized to a tx's input count. 120 taprootAmts :: Int -> [Word64] 121 taprootAmts n = replicate n sampleValue 122 123 taprootSpks :: Int -> [BS.ByteString] 124 taprootSpks n = replicate n sampleTaprootSpk 125 126 -- | 32-byte placeholder tap leaf hash for script-path benches. 127 sampleTapLeaf :: BS.ByteString 128 sampleTapLeaf = BS.replicate 32 0x00 129 130 -- benchmarks ----------------------------------------------------------------- 131 132 main :: IO () 133 main = defaultMain 134 [ bgroup "serialisation" 135 [ bgroup "to_bytes" 136 [ bench "small-legacy" $ nf to_bytes smallLegacyTx 137 , bench "small-segwit" $ nf to_bytes smallSegwitTx 138 , bench "medium-legacy" $ nf to_bytes mediumLegacyTx 139 , bench "medium-segwit" $ nf to_bytes mediumSegwitTx 140 , bench "large-legacy" $ nf to_bytes largeLegacyTx 141 , bench "large-segwit" $ nf to_bytes largeSegwitTx 142 ] 143 , bgroup "from_bytes" 144 [ bench "small-legacy" $ nf from_bytes smallLegacyBytes 145 , bench "small-segwit" $ nf from_bytes smallSegwitBytes 146 , bench "medium-legacy" $ nf from_bytes mediumLegacyBytes 147 , bench "medium-segwit" $ nf from_bytes mediumSegwitBytes 148 , bench "large-legacy" $ nf from_bytes largeLegacyBytes 149 , bench "large-segwit" $ nf from_bytes largeSegwitBytes 150 ] 151 , bgroup "to_bytes_legacy" 152 [ bench "small-legacy" $ nf to_bytes_legacy smallLegacyTx 153 , bench "small-segwit" $ nf to_bytes_legacy smallSegwitTx 154 , bench "medium-legacy" $ nf to_bytes_legacy mediumLegacyTx 155 , bench "medium-segwit" $ nf to_bytes_legacy mediumSegwitTx 156 , bench "large-legacy" $ nf to_bytes_legacy largeLegacyTx 157 , bench "large-segwit" $ nf to_bytes_legacy largeSegwitTx 158 ] 159 ] 160 , bgroup "txid" 161 [ bench "small-legacy" $ nf txid smallLegacyTx 162 , bench "small-segwit" $ nf txid smallSegwitTx 163 , bench "medium-legacy" $ nf txid mediumLegacyTx 164 , bench "medium-segwit" $ nf txid mediumSegwitTx 165 , bench "large-legacy" $ nf txid largeLegacyTx 166 , bench "large-segwit" $ nf txid largeSegwitTx 167 ] 168 , bgroup "sighash" 169 [ bgroup "sighash_legacy" 170 [ bench "small / SIGHASH_ALL" $ 171 nf (sighashLegacy smallLegacyTx SIGHASH_ALL) 0 172 , bench "medium / SIGHASH_ALL" $ 173 nf (sighashLegacy mediumLegacyTx SIGHASH_ALL) 0 174 , bench "large / SIGHASH_ALL" $ 175 nf (sighashLegacy largeLegacyTx SIGHASH_ALL) 0 176 , bench "medium / SIGHASH_NONE" $ 177 nf (sighashLegacy mediumLegacyTx SIGHASH_NONE) 0 178 , bench "medium / SIGHASH_SINGLE" $ 179 nf (sighashLegacy mediumLegacyTx SIGHASH_SINGLE) 0 180 , bench "medium / SIGHASH_ALL|ACP" $ 181 nf (sighashLegacy mediumLegacyTx 182 SIGHASH_ALL_ANYONECANPAY) 0 183 ] 184 , bgroup "sighash_segwit" 185 [ bench "small / SIGHASH_ALL" $ 186 nf (sighashSegwit smallSegwitTx SIGHASH_ALL) 0 187 , bench "medium / SIGHASH_ALL" $ 188 nf (sighashSegwit mediumSegwitTx SIGHASH_ALL) 0 189 , bench "large / SIGHASH_ALL" $ 190 nf (sighashSegwit largeSegwitTx SIGHASH_ALL) 0 191 , bench "medium / SIGHASH_NONE" $ 192 nf (sighashSegwit mediumSegwitTx SIGHASH_NONE) 0 193 , bench "medium / SIGHASH_SINGLE" $ 194 nf (sighashSegwit mediumSegwitTx SIGHASH_SINGLE) 0 195 , bench "medium / SIGHASH_ALL|ACP" $ 196 nf (sighashSegwit mediumSegwitTx 197 SIGHASH_ALL_ANYONECANPAY) 0 198 ] 199 , bgroup "sighash_taproot_keypath" 200 [ bench "small / DEFAULT" $ nf (taprootKp smallSegwitTx 0x00) 0 201 , bench "medium / DEFAULT" $ nf (taprootKp mediumSegwitTx 0x00) 0 202 , bench "large / DEFAULT" $ nf (taprootKp largeSegwitTx 0x00) 0 203 , bench "medium / ALL" $ nf (taprootKp mediumSegwitTx 0x01) 0 204 , bench "medium / NONE" $ nf (taprootKp mediumSegwitTx 0x02) 0 205 , bench "medium / SINGLE" $ nf (taprootKp mediumSegwitTx 0x03) 0 206 , bench "medium / ALL|ACP" $ nf (taprootKp mediumSegwitTx 0x81) 0 207 ] 208 , bgroup "sighash_taproot_scriptpath" 209 [ bench "small / DEFAULT" $ nf (taprootSp smallSegwitTx 0x00) 0 210 , bench "medium / DEFAULT" $ nf (taprootSp mediumSegwitTx 0x00) 0 211 , bench "large / DEFAULT" $ nf (taprootSp largeSegwitTx 0x00) 0 212 ] 213 ] 214 ] 215 where 216 sighashLegacy tx st i = 217 sighash_legacy tx i sampleScriptPubKey (encode_sighash st) 218 sighashSegwit tx st i = 219 sighash_segwit tx i sampleScriptCode sampleValue (encode_sighash st) 220 taprootKp tx ht i = 221 let n = length (tx_inputs tx) 222 in sighash_taproot_keypath tx i 223 (taprootAmts n) (taprootSpks n) Nothing ht 224 taprootSp tx ht i = 225 let n = length (tx_inputs tx) 226 in sighash_taproot_scriptpath tx i 227 (taprootAmts n) (taprootSpks n) Nothing 228 sampleTapLeaf 0xffffffff ht