Weight.hs (8346B)
1 {-# OPTIONS_GHC -fno-warn-orphans #-} 2 {-# LANGUAGE BangPatterns #-} 3 4 module Main where 5 6 import Control.DeepSeq 7 import qualified Data.ByteString as BS 8 import Data.List.NonEmpty (NonEmpty(..)) 9 import Data.Word (Word64) 10 import qualified Weigh as W 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 sampleScriptPubKey :: BS.ByteString 104 sampleScriptPubKey = BS.replicate 25 0x00 105 106 sampleScriptCode :: BS.ByteString 107 sampleScriptCode = BS.replicate 26 0x00 108 109 sampleValue :: Word64 110 sampleValue = 100000000 111 112 sampleTaprootSpk :: BS.ByteString 113 sampleTaprootSpk = BS.cons 0x51 (BS.cons 0x20 (BS.replicate 32 0x00)) 114 115 taprootAmts :: Int -> [Word64] 116 taprootAmts n = replicate n sampleValue 117 118 taprootSpks :: Int -> [BS.ByteString] 119 taprootSpks n = replicate n sampleTaprootSpk 120 121 sampleTapLeaf :: BS.ByteString 122 sampleTapLeaf = BS.replicate 32 0x00 123 124 -- allocation benchmarks ------------------------------------------------------- 125 126 main :: IO () 127 main = W.mainWith $ do 128 -- to_bytes 129 W.func "to_bytes/small-legacy" to_bytes smallLegacyTx 130 W.func "to_bytes/small-segwit" to_bytes smallSegwitTx 131 W.func "to_bytes/medium-legacy" to_bytes mediumLegacyTx 132 W.func "to_bytes/medium-segwit" to_bytes mediumSegwitTx 133 W.func "to_bytes/large-legacy" to_bytes largeLegacyTx 134 W.func "to_bytes/large-segwit" to_bytes largeSegwitTx 135 136 -- from_bytes 137 W.func "from_bytes/small-legacy" from_bytes smallLegacyBytes 138 W.func "from_bytes/small-segwit" from_bytes smallSegwitBytes 139 W.func "from_bytes/medium-legacy" from_bytes mediumLegacyBytes 140 W.func "from_bytes/medium-segwit" from_bytes mediumSegwitBytes 141 W.func "from_bytes/large-legacy" from_bytes largeLegacyBytes 142 W.func "from_bytes/large-segwit" from_bytes largeSegwitBytes 143 144 -- to_bytes_legacy 145 W.func "to_bytes_legacy/small-legacy" to_bytes_legacy smallLegacyTx 146 W.func "to_bytes_legacy/small-segwit" to_bytes_legacy smallSegwitTx 147 W.func "to_bytes_legacy/medium-legacy" to_bytes_legacy mediumLegacyTx 148 W.func "to_bytes_legacy/medium-segwit" to_bytes_legacy mediumSegwitTx 149 W.func "to_bytes_legacy/large-legacy" to_bytes_legacy largeLegacyTx 150 W.func "to_bytes_legacy/large-segwit" to_bytes_legacy largeSegwitTx 151 152 -- txid 153 W.func "txid/small-legacy" txid smallLegacyTx 154 W.func "txid/small-segwit" txid smallSegwitTx 155 W.func "txid/medium-legacy" txid mediumLegacyTx 156 W.func "txid/medium-segwit" txid mediumSegwitTx 157 W.func "txid/large-legacy" txid largeLegacyTx 158 W.func "txid/large-segwit" txid largeSegwitTx 159 160 -- sighash_legacy 161 W.func "sighash_legacy/small / SIGHASH_ALL" 162 (sighashLegacy smallLegacyTx SIGHASH_ALL) 0 163 W.func "sighash_legacy/medium / SIGHASH_ALL" 164 (sighashLegacy mediumLegacyTx SIGHASH_ALL) 0 165 W.func "sighash_legacy/large / SIGHASH_ALL" 166 (sighashLegacy largeLegacyTx SIGHASH_ALL) 0 167 W.func "sighash_legacy/medium / SIGHASH_NONE" 168 (sighashLegacy mediumLegacyTx SIGHASH_NONE) 0 169 W.func "sighash_legacy/medium / SIGHASH_SINGLE" 170 (sighashLegacy mediumLegacyTx SIGHASH_SINGLE) 0 171 W.func "sighash_legacy/medium / SIGHASH_ALL|ACP" 172 (sighashLegacy mediumLegacyTx SIGHASH_ALL_ANYONECANPAY) 0 173 174 -- sighash_segwit 175 W.func "sighash_segwit/small / SIGHASH_ALL" 176 (sighashSegwit smallSegwitTx SIGHASH_ALL) 0 177 W.func "sighash_segwit/medium / SIGHASH_ALL" 178 (sighashSegwit mediumSegwitTx SIGHASH_ALL) 0 179 W.func "sighash_segwit/large / SIGHASH_ALL" 180 (sighashSegwit largeSegwitTx SIGHASH_ALL) 0 181 W.func "sighash_segwit/medium / SIGHASH_NONE" 182 (sighashSegwit mediumSegwitTx SIGHASH_NONE) 0 183 W.func "sighash_segwit/medium / SIGHASH_SINGLE" 184 (sighashSegwit mediumSegwitTx SIGHASH_SINGLE) 0 185 W.func "sighash_segwit/medium / SIGHASH_ALL|ACP" 186 (sighashSegwit mediumSegwitTx SIGHASH_ALL_ANYONECANPAY) 0 187 188 -- sighash_taproot_keypath 189 W.func "sighash_taproot_keypath/small / DEFAULT" 190 (taprootKp smallSegwitTx 0x00) 0 191 W.func "sighash_taproot_keypath/medium / DEFAULT" 192 (taprootKp mediumSegwitTx 0x00) 0 193 W.func "sighash_taproot_keypath/large / DEFAULT" 194 (taprootKp largeSegwitTx 0x00) 0 195 W.func "sighash_taproot_keypath/medium / ALL" 196 (taprootKp mediumSegwitTx 0x01) 0 197 W.func "sighash_taproot_keypath/medium / NONE" 198 (taprootKp mediumSegwitTx 0x02) 0 199 W.func "sighash_taproot_keypath/medium / SINGLE" 200 (taprootKp mediumSegwitTx 0x03) 0 201 W.func "sighash_taproot_keypath/medium / ALL|ACP" 202 (taprootKp mediumSegwitTx 0x81) 0 203 204 -- sighash_taproot_scriptpath 205 W.func "sighash_taproot_scriptpath/small / DEFAULT" 206 (taprootSp smallSegwitTx 0x00) 0 207 W.func "sighash_taproot_scriptpath/medium / DEFAULT" 208 (taprootSp mediumSegwitTx 0x00) 0 209 W.func "sighash_taproot_scriptpath/large / DEFAULT" 210 (taprootSp largeSegwitTx 0x00) 0 211 where 212 sighashLegacy tx st i = 213 sighash_legacy tx i sampleScriptPubKey (encode_sighash st) 214 sighashSegwit tx st i = 215 sighash_segwit tx i sampleScriptCode sampleValue (encode_sighash st) 216 taprootKp tx ht i = 217 let n = length (tx_inputs tx) 218 in sighash_taproot_keypath tx i 219 (taprootAmts n) (taprootSpks n) Nothing ht 220 taprootSp tx ht i = 221 let n = length (tx_inputs tx) 222 in sighash_taproot_scriptpath tx i 223 (taprootAmts n) (taprootSpks n) Nothing 224 sampleTapLeaf 0xffffffff ht