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