ppad-tx (empty) → 0.1.0
raw patch · 8 files changed
+1899/−0 lines, 8 filesdep +QuickCheckdep +basedep +bytestring
Dependencies added: QuickCheck, base, bytestring, criterion, deepseq, ppad-base16, ppad-sha256, ppad-tx, tasty, tasty-hunit, tasty-quickcheck, weigh
Files
- CHANGELOG +4/−0
- LICENSE +20/−0
- bench/Main.hs +144/−0
- bench/Weight.hs +140/−0
- lib/Bitcoin/Prim/Tx.hs +486/−0
- lib/Bitcoin/Prim/Tx/Sighash.hs +306/−0
- ppad-tx.cabal +92/−0
- test/Main.hs +707/−0
+ CHANGELOG view
@@ -0,0 +1,4 @@+# Changelog++- 0.1.0 (UNRELEASED)+ * Initial release.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2025 Jared Tobin++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ bench/Main.hs view
@@ -0,0 +1,144 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns #-}++module Main where++import Control.DeepSeq+import Criterion.Main+import qualified Data.ByteString as BS+import Data.List.NonEmpty (NonEmpty(..))++import Bitcoin.Prim.Tx+import Bitcoin.Prim.Tx.Sighash++-- NFData instances ------------------------------------------------------------++instance NFData TxId+instance NFData OutPoint+instance NFData TxIn+instance NFData TxOut+instance NFData Witness+instance NFData Tx+instance NFData SighashType++-- sample data -----------------------------------------------------------------++-- | Sample outpoint (references a dummy txid).+sampleOutPoint :: OutPoint+sampleOutPoint = OutPoint (TxId (BS.replicate 32 0xab)) 0++-- | Sample input with typical P2PKH signature (~107 bytes).+sampleInput :: TxIn+sampleInput = TxIn+ { txin_prevout = sampleOutPoint+ , txin_script_sig = BS.replicate 107 0x00 -- typical P2PKH sig+ , txin_sequence = 0xffffffff+ }++-- | Sample input for segwit (empty scriptSig).+sampleSegwitInput :: TxIn+sampleSegwitInput = TxIn+ { txin_prevout = sampleOutPoint+ , txin_script_sig = BS.empty+ , txin_sequence = 0xffffffff+ }++-- | Sample output with typical P2PKH script (25 bytes).+sampleOutput :: TxOut+sampleOutput = TxOut+ { txout_value = 50000000+ , txout_script_pubkey = BS.replicate 25 0x00 -- typical P2PKH script+ }++-- | Sample witness stack (signature + pubkey for P2WPKH).+sampleWitness :: Witness+sampleWitness = Witness+ [ BS.replicate 72 0x00 -- DER signature+ , BS.replicate 33 0x00 -- compressed pubkey+ ]++-- | Create a legacy transaction with n inputs and m outputs.+-- Requires n >= 1 and m >= 1.+mkLegacyTx :: Int -> Int -> Tx+mkLegacyTx !numInputs !numOutputs = Tx+ { tx_version = 1+ , tx_inputs = sampleInput :| replicate (numInputs - 1) sampleInput+ , tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput+ , tx_witnesses = []+ , tx_locktime = 0+ }++-- | Create a segwit transaction with n inputs and m outputs.+-- Requires n >= 1 and m >= 1.+mkSegwitTx :: Int -> Int -> Tx+mkSegwitTx !numInputs !numOutputs = Tx+ { tx_version = 2+ , tx_inputs = sampleSegwitInput :| replicate (numInputs - 1) sampleSegwitInput+ , tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput+ , tx_witnesses = replicate numInputs sampleWitness+ , tx_locktime = 0+ }++-- sample transactions ---------------------------------------------------------++smallLegacyTx, mediumLegacyTx, largeLegacyTx :: Tx+smallLegacyTx = mkLegacyTx 1 1+mediumLegacyTx = mkLegacyTx 5 5+largeLegacyTx = mkLegacyTx 20 20++smallSegwitTx, mediumSegwitTx, largeSegwitTx :: Tx+smallSegwitTx = mkSegwitTx 1 1+mediumSegwitTx = mkSegwitTx 5 5+largeSegwitTx = mkSegwitTx 20 20++-- serialised bytes ------------------------------------------------------------++smallLegacyBytes, mediumLegacyBytes, largeLegacyBytes :: BS.ByteString+smallLegacyBytes = to_bytes smallLegacyTx+mediumLegacyBytes = to_bytes mediumLegacyTx+largeLegacyBytes = to_bytes largeLegacyTx++smallSegwitBytes, mediumSegwitBytes, largeSegwitBytes :: BS.ByteString+smallSegwitBytes = to_bytes smallSegwitTx+mediumSegwitBytes = to_bytes mediumSegwitTx+largeSegwitBytes = to_bytes largeSegwitTx++-- benchmarks ------------------------------------------------------------------++main :: IO ()+main = defaultMain+ [ bgroup "serialisation"+ [ bgroup "to_bytes"+ [ bench "small-legacy" $ nf to_bytes smallLegacyTx+ , bench "small-segwit" $ nf to_bytes smallSegwitTx+ , bench "medium-legacy" $ nf to_bytes mediumLegacyTx+ , bench "medium-segwit" $ nf to_bytes mediumSegwitTx+ , bench "large-legacy" $ nf to_bytes largeLegacyTx+ , bench "large-segwit" $ nf to_bytes largeSegwitTx+ ]+ , bgroup "from_bytes"+ [ bench "small-legacy" $ nf from_bytes smallLegacyBytes+ , bench "small-segwit" $ nf from_bytes smallSegwitBytes+ , bench "medium-legacy" $ nf from_bytes mediumLegacyBytes+ , bench "medium-segwit" $ nf from_bytes mediumSegwitBytes+ , bench "large-legacy" $ nf from_bytes largeLegacyBytes+ , bench "large-segwit" $ nf from_bytes largeSegwitBytes+ ]+ , bgroup "to_bytes_legacy"+ [ bench "small-legacy" $ nf to_bytes_legacy smallLegacyTx+ , bench "small-segwit" $ nf to_bytes_legacy smallSegwitTx+ , bench "medium-legacy" $ nf to_bytes_legacy mediumLegacyTx+ , bench "medium-segwit" $ nf to_bytes_legacy mediumSegwitTx+ , bench "large-legacy" $ nf to_bytes_legacy largeLegacyTx+ , bench "large-segwit" $ nf to_bytes_legacy largeSegwitTx+ ]+ ]+ , bgroup "txid"+ [ bench "small-legacy" $ nf txid smallLegacyTx+ , bench "small-segwit" $ nf txid smallSegwitTx+ , bench "medium-legacy" $ nf txid mediumLegacyTx+ , bench "medium-segwit" $ nf txid mediumSegwitTx+ , bench "large-legacy" $ nf txid largeLegacyTx+ , bench "large-segwit" $ nf txid largeSegwitTx+ ]+ ]
+ bench/Weight.hs view
@@ -0,0 +1,140 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns #-}++module Main where++import Control.DeepSeq+import qualified Data.ByteString as BS+import Data.List.NonEmpty (NonEmpty(..))+import qualified Weigh as W++import Bitcoin.Prim.Tx+import Bitcoin.Prim.Tx.Sighash++-- NFData instances ------------------------------------------------------------++instance NFData TxId+instance NFData OutPoint+instance NFData TxIn+instance NFData TxOut+instance NFData Witness+instance NFData Tx+instance NFData SighashType++-- sample data -----------------------------------------------------------------++-- | Sample outpoint (references a dummy txid).+sampleOutPoint :: OutPoint+sampleOutPoint = OutPoint (TxId (BS.replicate 32 0xab)) 0++-- | Sample input with typical P2PKH signature (~107 bytes).+sampleInput :: TxIn+sampleInput = TxIn+ { txin_prevout = sampleOutPoint+ , txin_script_sig = BS.replicate 107 0x00 -- typical P2PKH sig+ , txin_sequence = 0xffffffff+ }++-- | Sample input for segwit (empty scriptSig).+sampleSegwitInput :: TxIn+sampleSegwitInput = TxIn+ { txin_prevout = sampleOutPoint+ , txin_script_sig = BS.empty+ , txin_sequence = 0xffffffff+ }++-- | Sample output with typical P2PKH script (25 bytes).+sampleOutput :: TxOut+sampleOutput = TxOut+ { txout_value = 50000000+ , txout_script_pubkey = BS.replicate 25 0x00 -- typical P2PKH script+ }++-- | Sample witness stack (signature + pubkey for P2WPKH).+sampleWitness :: Witness+sampleWitness = Witness+ [ BS.replicate 72 0x00 -- DER signature+ , BS.replicate 33 0x00 -- compressed pubkey+ ]++-- | Create a legacy transaction with n inputs and m outputs.+-- Requires n >= 1 and m >= 1.+mkLegacyTx :: Int -> Int -> Tx+mkLegacyTx !numInputs !numOutputs = Tx+ { tx_version = 1+ , tx_inputs = sampleInput :| replicate (numInputs - 1) sampleInput+ , tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput+ , tx_witnesses = []+ , tx_locktime = 0+ }++-- | Create a segwit transaction with n inputs and m outputs.+-- Requires n >= 1 and m >= 1.+mkSegwitTx :: Int -> Int -> Tx+mkSegwitTx !numInputs !numOutputs = Tx+ { tx_version = 2+ , tx_inputs = sampleSegwitInput :| replicate (numInputs - 1) sampleSegwitInput+ , tx_outputs = sampleOutput :| replicate (numOutputs - 1) sampleOutput+ , tx_witnesses = replicate numInputs sampleWitness+ , tx_locktime = 0+ }++-- sample transactions ---------------------------------------------------------++smallLegacyTx, mediumLegacyTx, largeLegacyTx :: Tx+smallLegacyTx = mkLegacyTx 1 1+mediumLegacyTx = mkLegacyTx 5 5+largeLegacyTx = mkLegacyTx 20 20++smallSegwitTx, mediumSegwitTx, largeSegwitTx :: Tx+smallSegwitTx = mkSegwitTx 1 1+mediumSegwitTx = mkSegwitTx 5 5+largeSegwitTx = mkSegwitTx 20 20++-- serialised bytes ------------------------------------------------------------++smallLegacyBytes, mediumLegacyBytes, largeLegacyBytes :: BS.ByteString+smallLegacyBytes = to_bytes smallLegacyTx+mediumLegacyBytes = to_bytes mediumLegacyTx+largeLegacyBytes = to_bytes largeLegacyTx++smallSegwitBytes, mediumSegwitBytes, largeSegwitBytes :: BS.ByteString+smallSegwitBytes = to_bytes smallSegwitTx+mediumSegwitBytes = to_bytes mediumSegwitTx+largeSegwitBytes = to_bytes largeSegwitTx++-- allocation benchmarks -------------------------------------------------------++main :: IO ()+main = W.mainWith $ do+ -- to_bytes+ W.func "to_bytes/small-legacy" to_bytes smallLegacyTx+ W.func "to_bytes/small-segwit" to_bytes smallSegwitTx+ W.func "to_bytes/medium-legacy" to_bytes mediumLegacyTx+ W.func "to_bytes/medium-segwit" to_bytes mediumSegwitTx+ W.func "to_bytes/large-legacy" to_bytes largeLegacyTx+ W.func "to_bytes/large-segwit" to_bytes largeSegwitTx++ -- from_bytes+ W.func "from_bytes/small-legacy" from_bytes smallLegacyBytes+ W.func "from_bytes/small-segwit" from_bytes smallSegwitBytes+ W.func "from_bytes/medium-legacy" from_bytes mediumLegacyBytes+ W.func "from_bytes/medium-segwit" from_bytes mediumSegwitBytes+ W.func "from_bytes/large-legacy" from_bytes largeLegacyBytes+ W.func "from_bytes/large-segwit" from_bytes largeSegwitBytes++ -- to_bytes_legacy+ W.func "to_bytes_legacy/small-legacy" to_bytes_legacy smallLegacyTx+ W.func "to_bytes_legacy/small-segwit" to_bytes_legacy smallSegwitTx+ W.func "to_bytes_legacy/medium-legacy" to_bytes_legacy mediumLegacyTx+ W.func "to_bytes_legacy/medium-segwit" to_bytes_legacy mediumSegwitTx+ W.func "to_bytes_legacy/large-legacy" to_bytes_legacy largeLegacyTx+ W.func "to_bytes_legacy/large-segwit" to_bytes_legacy largeSegwitTx++ -- txid+ W.func "txid/small-legacy" txid smallLegacyTx+ W.func "txid/small-segwit" txid smallSegwitTx+ W.func "txid/medium-legacy" txid mediumLegacyTx+ W.func "txid/medium-segwit" txid mediumSegwitTx+ W.func "txid/large-legacy" txid largeLegacyTx+ W.func "txid/large-segwit" txid largeSegwitTx
+ lib/Bitcoin/Prim/Tx.hs view
@@ -0,0 +1,486 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module: Bitcoin.Prim.Tx+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Minimal Bitcoin transaction primitives, including raw transaction+-- types, serialisation to/from bytes, and txid computation.++module Bitcoin.Prim.Tx (+ -- * Transaction Types+ Tx(..)+ , TxIn(..)+ , TxOut(..)+ , OutPoint(..)+ , Witness(..)+ , TxId(..)+ , mkTxId++ -- * Serialisation+ , to_bytes+ , from_bytes+ , to_bytes_legacy+ , to_base16+ , from_base16++ -- * TxId+ , txid++ -- * Internal (for Sighash)+ , put_word32_le+ , put_word64_le+ , put_compact+ , put_outpoint+ , put_txout+ , to_strict+ ) where++import qualified Crypto.Hash.SHA256 as SHA256+import Data.Bits ((.|.), shiftL)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import qualified Data.ByteString.Builder as BSB+import qualified Data.ByteString.Lazy as BL+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE+import Data.Word (Word32, Word64)+import GHC.Generics (Generic)++-- | Transaction ID (32 bytes, little-endian double-SHA256).+newtype TxId = TxId BS.ByteString+ deriving (Eq, Show, Generic)++-- | Construct a TxId from a 32-byte ByteString.+--+-- Returns 'Nothing' if the input is not exactly 32 bytes.+--+-- @+-- mkTxId (BS.replicate 32 0x00) == Just (TxId ...)+-- mkTxId (BS.replicate 31 0x00) == Nothing+-- @+mkTxId :: BS.ByteString -> Maybe TxId+mkTxId bs+ | BS.length bs == 32 = Just (TxId bs)+ | otherwise = Nothing++-- | Transaction outpoint (txid + output index).+data OutPoint = OutPoint+ { op_txid :: {-# UNPACK #-} !TxId+ , op_vout :: {-# UNPACK #-} !Word32+ } deriving (Eq, Show, Generic)++-- | Transaction input.+data TxIn = TxIn+ { txin_prevout :: {-# UNPACK #-} !OutPoint+ , txin_script_sig :: !BS.ByteString+ , txin_sequence :: {-# UNPACK #-} !Word32+ } deriving (Eq, Show, Generic)++-- | Transaction output.+data TxOut = TxOut+ { txout_value :: {-# UNPACK #-} !Word64 -- ^ satoshis+ , txout_script_pubkey :: !BS.ByteString+ } deriving (Eq, Show, Generic)++-- | Witness stack for a single input.+newtype Witness = Witness [BS.ByteString]+ deriving (Eq, Show, Generic)++-- | Complete transaction.+--+-- Bitcoin requires at least one input and one output, enforced here+-- via 'NonEmpty' lists.+data Tx = Tx+ { tx_version :: {-# UNPACK #-} !Word32+ , tx_inputs :: !(NonEmpty TxIn)+ , tx_outputs :: !(NonEmpty TxOut)+ , tx_witnesses :: ![Witness] -- ^ empty list for legacy tx+ , tx_locktime :: {-# UNPACK #-} !Word32+ } deriving (Eq, Show, Generic)++-- serialisation ---------------------------------------------------------------++-- | Serialise a transaction to bytes.+--+-- Uses segwit format if witnesses are present, legacy otherwise.+--+-- @+-- -- round-trip+-- from_bytes (to_bytes tx) == Just tx+-- @+to_bytes :: Tx -> BS.ByteString+to_bytes tx@Tx {..}+ | null tx_witnesses = to_bytes_legacy tx+ | otherwise = to_strict $+ put_word32_le tx_version+ <> BSB.word8 0x00 -- marker+ <> BSB.word8 0x01 -- flag+ <> put_compact (fromIntegral (NE.length tx_inputs))+ <> foldMap put_txin tx_inputs+ <> put_compact (fromIntegral (NE.length tx_outputs))+ <> foldMap put_txout tx_outputs+ <> foldMap put_witness tx_witnesses+ <> put_word32_le tx_locktime++-- | Serialise a transaction to legacy format (no witness data).+--+-- Used for txid computation. Excludes witness data even if present.+--+-- @+-- -- for legacy tx (no witnesses), same as to_bytes+-- to_bytes_legacy legacyTx == to_bytes legacyTx+--+-- -- for segwit tx, strips witnesses+-- BS.length (to_bytes_legacy segwitTx) < BS.length (to_bytes segwitTx)+-- @+to_bytes_legacy :: Tx -> BS.ByteString+to_bytes_legacy Tx {..} = to_strict $+ put_word32_le tx_version+ <> put_compact (fromIntegral (NE.length tx_inputs))+ <> foldMap put_txin tx_inputs+ <> put_compact (fromIntegral (NE.length tx_outputs))+ <> foldMap put_txout tx_outputs+ <> put_word32_le tx_locktime++-- | Serialise a transaction to base16 (hex).+--+-- @+-- to_base16 tx = B16.encode (to_bytes tx)+-- @+to_base16 :: Tx -> BS.ByteString+to_base16 tx = B16.encode (to_bytes tx)++-- | Parse a transaction from base16 (hex).+--+-- @+-- -- round-trip+-- from_base16 (to_base16 tx) == Just tx+-- @+from_base16 :: BS.ByteString -> Maybe Tx+from_base16 b16 = do+ bs <- B16.decode b16+ from_bytes bs++-- internal: builders ----------------------------------------------------------++-- | Convert a Builder to a strict ByteString.+to_strict :: BSB.Builder -> BS.ByteString+to_strict = BL.toStrict . BSB.toLazyByteString+{-# INLINE to_strict #-}++-- | Encode a Word32 as little-endian bytes.+put_word32_le :: Word32 -> BSB.Builder+put_word32_le = BSB.word32LE+{-# INLINE put_word32_le #-}++-- | Encode a Word64 as little-endian bytes.+put_word64_le :: Word64 -> BSB.Builder+put_word64_le = BSB.word64LE+{-# INLINE put_word64_le #-}++-- | Encode a Word64 as Bitcoin compactSize (varint).+--+-- Encoding:+-- - 0x00-0xfc: 1 byte (value itself)+-- - 0xfd-0xffff: 0xfd ++ 2 bytes LE+-- - 0x10000-0xffffffff: 0xfe ++ 4 bytes LE+-- - larger: 0xff ++ 8 bytes LE+put_compact :: Word64 -> BSB.Builder+put_compact !n+ | n <= 0xfc = BSB.word8 (fromIntegral n)+ | n <= 0xffff = BSB.word8 0xfd <> BSB.word16LE (fromIntegral n)+ | n <= 0xffffffff = BSB.word8 0xfe <> BSB.word32LE (fromIntegral n)+ | otherwise = BSB.word8 0xff <> BSB.word64LE n+{-# INLINE put_compact #-}++-- | Encode an OutPoint (txid + vout).+put_outpoint :: OutPoint -> BSB.Builder+put_outpoint OutPoint {..} =+ let !(TxId !txid_bs) = op_txid+ in BSB.byteString txid_bs <> put_word32_le op_vout+{-# INLINE put_outpoint #-}++-- | Encode a TxIn.+put_txin :: TxIn -> BSB.Builder+put_txin TxIn {..} =+ put_outpoint txin_prevout+ <> put_compact (fromIntegral (BS.length txin_script_sig))+ <> BSB.byteString txin_script_sig+ <> put_word32_le txin_sequence+{-# INLINE put_txin #-}++-- | Encode a TxOut.+put_txout :: TxOut -> BSB.Builder+put_txout TxOut {..} =+ put_word64_le txout_value+ <> put_compact (fromIntegral (BS.length txout_script_pubkey))+ <> BSB.byteString txout_script_pubkey+{-# INLINE put_txout #-}++-- | Encode a Witness stack.+put_witness :: Witness -> BSB.Builder+put_witness (Witness items) =+ put_compact (fromIntegral (length items))+ <> foldMap put_witness_item items+ where+ put_witness_item :: BS.ByteString -> BSB.Builder+ put_witness_item !item =+ put_compact (fromIntegral (BS.length item))+ <> BSB.byteString item+{-# INLINE put_witness #-}++-- decoding --------------------------------------------------------------------++-- | Parse a transaction from bytes.+--+-- Automatically detects segwit vs legacy format by checking for+-- marker byte 0x00 followed by flag 0x01 after the version field.+--+-- Returns 'Nothing' on invalid or truncated input.+--+-- @+-- -- round-trip+-- from_bytes (to_bytes tx) == Just tx+-- @+from_bytes :: BS.ByteString -> Maybe Tx+from_bytes !bs = do+ -- need at least 4 bytes for version+ guard (BS.length bs >= 4)+ let !version = get_word32_le bs 0+ !off0 = 4+ -- check for segwit marker (0x00) and flag (0x01)+ if BS.length bs > off0 + 1+ && BS.index bs off0 == 0x00+ && BS.index bs (off0 + 1) == 0x01+ then parse_segwit bs version (off0 + 2)+ else parse_legacy bs version off0++-- Parse legacy transaction (no witness data)+parse_legacy :: BS.ByteString -> Word32 -> Int -> Maybe Tx+parse_legacy !bs !version !off0 = do+ -- input count+ (input_count, off1) <- get_compact bs off0+ -- inputs (must have at least one)+ (inputs_list, off2) <- get_many get_txin bs off1 (fromIntegral input_count)+ inputs <- NE.nonEmpty inputs_list+ -- output count+ (output_count, off3) <- get_compact bs off2+ -- outputs (must have at least one)+ (outputs_list, off4) <- get_many get_txout bs off3 (fromIntegral output_count)+ outputs <- NE.nonEmpty outputs_list+ -- locktime (4 bytes)+ guard (BS.length bs >= off4 + 4)+ let !locktime = get_word32_le bs off4+ !off5 = off4 + 4+ -- should have consumed all bytes+ guard (off5 == BS.length bs)+ pure $! Tx version inputs outputs [] locktime++-- Parse segwit transaction (with witness data)+parse_segwit :: BS.ByteString -> Word32 -> Int -> Maybe Tx+parse_segwit !bs !version !off0 = do+ -- input count+ (input_count, off1) <- get_compact bs off0+ -- inputs (must have at least one)+ (inputs_list, off2) <- get_many get_txin bs off1 (fromIntegral input_count)+ inputs <- NE.nonEmpty inputs_list+ -- output count+ (output_count, off3) <- get_compact bs off2+ -- outputs (must have at least one)+ (outputs_list, off4) <- get_many get_txout bs off3 (fromIntegral output_count)+ outputs <- NE.nonEmpty outputs_list+ -- witnesses (one per input)+ (witnesses, off5) <- get_many get_witness bs off4 (fromIntegral input_count)+ -- locktime (4 bytes)+ guard (BS.length bs >= off5 + 4)+ let !locktime = get_word32_le bs off5+ !off6 = off5 + 4+ -- should have consumed all bytes+ guard (off6 == BS.length bs)+ pure $! Tx version inputs outputs witnesses locktime++-- internal helpers ------------------------------------------------------------++-- | Guard for Maybe monad.+guard :: Bool -> Maybe ()+guard True = Just ()+guard False = Nothing+{-# INLINE guard #-}++-- | Decode a 32-bit little-endian word at the given offset.+-- Does not bounds-check; caller must ensure sufficient bytes.+get_word32_le :: BS.ByteString -> Int -> Word32+get_word32_le !bs !off =+ let !b0 = fromIntegral (BS.index bs off) :: Word32+ !b1 = fromIntegral (BS.index bs (off + 1)) :: Word32+ !b2 = fromIntegral (BS.index bs (off + 2)) :: Word32+ !b3 = fromIntegral (BS.index bs (off + 3)) :: Word32+ in b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16) .|. (b3 `shiftL` 24)+{-# INLINE get_word32_le #-}++-- | Decode a 64-bit little-endian word at the given offset.+-- Does not bounds-check; caller must ensure sufficient bytes.+get_word64_le :: BS.ByteString -> Int -> Word64+get_word64_le !bs !off =+ let !b0 = fromIntegral (BS.index bs off) :: Word64+ !b1 = fromIntegral (BS.index bs (off + 1)) :: Word64+ !b2 = fromIntegral (BS.index bs (off + 2)) :: Word64+ !b3 = fromIntegral (BS.index bs (off + 3)) :: Word64+ !b4 = fromIntegral (BS.index bs (off + 4)) :: Word64+ !b5 = fromIntegral (BS.index bs (off + 5)) :: Word64+ !b6 = fromIntegral (BS.index bs (off + 6)) :: Word64+ !b7 = fromIntegral (BS.index bs (off + 7)) :: Word64+ in b0 .|. (b1 `shiftL` 8) .|. (b2 `shiftL` 16) .|. (b3 `shiftL` 24)+ .|. (b4 `shiftL` 32) .|. (b5 `shiftL` 40)+ .|. (b6 `shiftL` 48) .|. (b7 `shiftL` 56)+{-# INLINE get_word64_le #-}++-- | Decode a 16-bit little-endian word at the given offset.+-- Does not bounds-check; caller must ensure sufficient bytes.+get_word16_le :: BS.ByteString -> Int -> Word64+get_word16_le !bs !off =+ let !b0 = fromIntegral (BS.index bs off) :: Word64+ !b1 = fromIntegral (BS.index bs (off + 1)) :: Word64+ in b0 .|. (b1 `shiftL` 8)+{-# INLINE get_word16_le #-}++-- | Decode compactSize (Bitcoin's variable-length integer).+-- Returns (value, new_offset).+-- Enforces minimal encoding: rejects non-minimal representations.+get_compact :: BS.ByteString -> Int -> Maybe (Word64, Int)+get_compact !bs !off+ | off >= BS.length bs = Nothing+ | otherwise = case BS.index bs off of+ tag | tag <= 0xfc ->+ -- Single byte: value is the tag itself+ Just (fromIntegral tag, off + 1)++ 0xfd ->+ -- 2-byte value follows+ if BS.length bs < off + 3+ then Nothing+ else+ let !val = get_word16_le bs (off + 1)+ in if val < 0xfd+ then Nothing -- non-minimal encoding+ else Just (val, off + 3)++ 0xfe ->+ -- 4-byte value follows+ if BS.length bs < off + 5+ then Nothing+ else+ let !val = fromIntegral (get_word32_le bs (off + 1)) :: Word64+ in if val <= 0xffff+ then Nothing -- non-minimal encoding+ else Just (val, off + 5)++ _ -> -- 0xff+ -- 8-byte value follows+ if BS.length bs < off + 9+ then Nothing+ else+ let !val = get_word64_le bs (off + 1)+ in if val <= 0xffffffff+ then Nothing -- non-minimal encoding+ else Just (val, off + 9)+{-# INLINE get_compact #-}++-- | Decode an outpoint (txid + vout).+-- Returns (OutPoint, new_offset).+get_outpoint :: BS.ByteString -> Int -> Maybe (OutPoint, Int)+get_outpoint !bs !off+ | BS.length bs < off + 36 = Nothing+ | otherwise =+ let !txid_bytes = BS.take 32 (BS.drop off bs)+ !vout = get_word32_le bs (off + 32)+ in Just (OutPoint (TxId txid_bytes) vout, off + 36)+{-# INLINE get_outpoint #-}++-- | Decode a transaction input.+-- Returns (TxIn, new_offset).+get_txin :: BS.ByteString -> Int -> Maybe (TxIn, Int)+get_txin !bs !off0 = do+ -- outpoint: 36 bytes+ (outpoint, off1) <- get_outpoint bs off0+ -- scriptSig length + bytes+ (script_len, off2) <- get_compact bs off1+ let !slen = fromIntegral script_len+ guard (BS.length bs >= off2 + slen)+ let !script_sig = BS.take slen (BS.drop off2 bs)+ !off3 = off2 + slen+ -- sequence: 4 bytes+ guard (BS.length bs >= off3 + 4)+ let !seqn = get_word32_le bs off3+ !off4 = off3 + 4+ pure (TxIn outpoint script_sig seqn, off4)++-- | Decode a transaction output.+-- Returns (TxOut, new_offset).+get_txout :: BS.ByteString -> Int -> Maybe (TxOut, Int)+get_txout !bs !off0 = do+ -- value: 8 bytes+ guard (BS.length bs >= off0 + 8)+ let !value = get_word64_le bs off0+ !off1 = off0 + 8+ -- scriptPubKey length + bytes+ (script_len, off2) <- get_compact bs off1+ let !slen = fromIntegral script_len+ guard (BS.length bs >= off2 + slen)+ let !script_pk = BS.take slen (BS.drop off2 bs)+ !off3 = off2 + slen+ pure (TxOut value script_pk, off3)++-- | Decode a witness stack for one input.+-- Returns (Witness, new_offset).+get_witness :: BS.ByteString -> Int -> Maybe (Witness, Int)+get_witness !bs !off0 = do+ -- stack item count+ (item_count, off1) <- get_compact bs off0+ -- each item: length + bytes+ (items, off2) <- get_many get_witness_item bs off1 (fromIntegral item_count)+ pure (Witness items, off2)++-- | Decode a single witness stack item (length-prefixed bytes).+get_witness_item :: BS.ByteString -> Int -> Maybe (BS.ByteString, Int)+get_witness_item !bs !off0 = do+ (item_len, off1) <- get_compact bs off0+ let !ilen = fromIntegral item_len+ guard (BS.length bs >= off1 + ilen)+ let !item = BS.take ilen (BS.drop off1 bs)+ pure (item, off1 + ilen)++-- | Decode multiple items using a decoder function.+-- Returns (list of items, new_offset).+get_many :: (BS.ByteString -> Int -> Maybe (a, Int))+ -> BS.ByteString -> Int -> Int -> Maybe ([a], Int)+get_many getter !bs = go []+ where+ go !acc !off !n+ | n <= 0 = Just (reverse acc, off)+ | otherwise = do+ (item, off') <- getter bs off+ go (item : acc) off' (n - 1)+{-# INLINE get_many #-}++-- txid ------------------------------------------------------------------------++-- | Compute the transaction ID (double SHA256 of legacy serialisation).+--+-- The txid is computed from the legacy serialisation, so segwit+-- transactions have the same txid regardless of witness data.+--+-- @+-- -- Satoshi->Hal tx (block 170)+-- txid satoshiHalTx ==+-- TxId "f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16"+-- @+txid :: Tx -> TxId+txid tx = TxId (SHA256.hash (SHA256.hash (to_bytes_legacy tx)))
+ lib/Bitcoin/Prim/Tx/Sighash.hs view
@@ -0,0 +1,306 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module: Bitcoin.Prim.Tx.Sighash+-- Copyright: (c) 2025 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Sighash computation for legacy and BIP143 segwit transactions.++module Bitcoin.Prim.Tx.Sighash (+ -- * Sighash Types+ SighashType(..)++ -- * Legacy Sighash+ , sighash_legacy++ -- * BIP143 Segwit Sighash+ , sighash_segwit+ ) where++import Bitcoin.Prim.Tx+ ( Tx(..)+ , TxIn(..)+ , TxOut(..)+ , put_word32_le+ , put_word64_le+ , put_compact+ , put_outpoint+ , put_txout+ , to_strict+ )+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as BSB+import qualified Data.List.NonEmpty as NE+import Data.Word (Word8, Word64)+import GHC.Generics (Generic)++-- | Sighash type flags.+data SighashType+ = SIGHASH_ALL+ | SIGHASH_NONE+ | SIGHASH_SINGLE+ | SIGHASH_ALL_ANYONECANPAY+ | SIGHASH_NONE_ANYONECANPAY+ | SIGHASH_SINGLE_ANYONECANPAY+ deriving (Eq, Show, Generic)++-- | Encode sighash type to byte value.+sighash_byte :: SighashType -> Word8+sighash_byte !st = case st of+ SIGHASH_ALL -> 0x01+ SIGHASH_NONE -> 0x02+ SIGHASH_SINGLE -> 0x03+ SIGHASH_ALL_ANYONECANPAY -> 0x81+ SIGHASH_NONE_ANYONECANPAY -> 0x82+ SIGHASH_SINGLE_ANYONECANPAY -> 0x83+{-# INLINE sighash_byte #-}++-- | Check if ANYONECANPAY flag is set.+is_anyonecanpay :: SighashType -> Bool+is_anyonecanpay !st = case st of+ SIGHASH_ALL_ANYONECANPAY -> True+ SIGHASH_NONE_ANYONECANPAY -> True+ SIGHASH_SINGLE_ANYONECANPAY -> True+ _ -> False+{-# INLINE is_anyonecanpay #-}++-- | Get base sighash type (without ANYONECANPAY).+base_type :: SighashType -> SighashType+base_type !st = case st of+ SIGHASH_ALL_ANYONECANPAY -> SIGHASH_ALL+ SIGHASH_NONE_ANYONECANPAY -> SIGHASH_NONE+ SIGHASH_SINGLE_ANYONECANPAY -> SIGHASH_SINGLE+ other -> other+{-# INLINE base_type #-}++-- | 32 zero bytes.+zero32 :: BS.ByteString+zero32 = BS.replicate 32 0x00+{-# NOINLINE zero32 #-}++-- | Hash of 0x01 followed by 31 zero bytes (SIGHASH_SINGLE edge case).+sighash_single_bug :: BS.ByteString+sighash_single_bug = BS.cons 0x01 (BS.replicate 31 0x00)+{-# NOINLINE sighash_single_bug #-}++-- | Double SHA256.+hash256 :: BS.ByteString -> BS.ByteString+hash256 = SHA256.hash . SHA256.hash+{-# INLINE hash256 #-}++-- legacy sighash -------------------------------------------------------------++-- | Compute legacy sighash for P2PKH/P2SH inputs.+--+-- Modifies a copy of the transaction based on sighash flags, appends+-- the sighash type as 4-byte little-endian, and double SHA256s.+--+-- @+-- -- sign input 0 with SIGHASH_ALL+-- let hash = sighash_legacy tx 0 scriptPubKey SIGHASH_ALL+-- -- use hash with ECDSA signing+-- @+--+-- For SIGHASH_SINGLE with input index >= output count, returns the+-- special \"sighash single bug\" value (0x01 followed by 31 zero bytes).+sighash_legacy+ :: Tx+ -> Int -- ^ input index+ -> BS.ByteString -- ^ scriptPubKey being spent+ -> SighashType+ -> BS.ByteString -- ^ 32-byte hash+sighash_legacy !tx !idx !script_pubkey !sighash_type+ -- SIGHASH_SINGLE edge case: index >= number of outputs+ | base == SIGHASH_SINGLE && idx >= NE.length (tx_outputs tx) =+ sighash_single_bug+ | otherwise =+ let !serialized = serialize_legacy_sighash tx idx script_pubkey sighash_type+ in hash256 serialized+ where+ !base = base_type sighash_type++-- | Serialize transaction for legacy sighash computation.+-- Handles all sighash flags directly without constructing intermediate Tx.+serialize_legacy_sighash+ :: Tx+ -> Int+ -> BS.ByteString+ -> SighashType+ -> BS.ByteString+serialize_legacy_sighash Tx{..} !idx !script_pubkey !sighash_type =+ let !base = base_type sighash_type+ !anyonecanpay = is_anyonecanpay sighash_type+ !inputs_list = NE.toList tx_inputs+ !outputs_list = NE.toList tx_outputs++ -- Clear all scriptSigs, set signing input's script to scriptPubKey+ clear_scripts :: Int -> [TxIn] -> [TxIn]+ clear_scripts !_ [] = []+ clear_scripts !i (inp : rest)+ | i == idx = inp { txin_script_sig = script_pubkey } : clear_rest+ | otherwise = inp { txin_script_sig = BS.empty } : clear_rest+ where+ !clear_rest = clear_scripts (i + 1) rest++ -- For NONE/SINGLE: zero out sequence numbers for other inputs+ zero_other_sequences :: Int -> [TxIn] -> [TxIn]+ zero_other_sequences !_ [] = []+ zero_other_sequences !i (inp : rest)+ | i == idx = inp : zero_other_sequences (i + 1) rest+ | otherwise =+ inp { txin_sequence = 0 } : zero_other_sequences (i + 1) rest++ -- Process inputs based on sighash type+ !inputs_cleared = clear_scripts 0 inputs_list++ !inputs_processed = case base of+ SIGHASH_NONE -> zero_other_sequences 0 inputs_cleared+ SIGHASH_SINGLE -> zero_other_sequences 0 inputs_cleared+ _ -> inputs_cleared++ -- ANYONECANPAY: keep only signing input+ !final_inputs+ | anyonecanpay = case safe_index inputs_processed idx of+ Just inp -> [inp]+ Nothing -> [] -- shouldn't happen if idx is valid+ | otherwise = inputs_processed++ -- Process outputs based on sighash type+ !final_outputs = case base of+ SIGHASH_NONE -> []+ SIGHASH_SINGLE -> build_single_outputs outputs_list idx+ _ -> outputs_list++ in to_strict $+ put_word32_le tx_version+ <> put_compact (fromIntegral (length final_inputs))+ <> foldMap put_txin_legacy final_inputs+ <> put_compact (fromIntegral (length final_outputs))+ <> foldMap put_txout final_outputs+ <> put_word32_le tx_locktime+ <> put_word32_le (fromIntegral (sighash_byte sighash_type))++-- | Build outputs for SIGHASH_SINGLE: keep only output at idx,+-- replace earlier outputs with empty/zero outputs.+build_single_outputs :: [TxOut] -> Int -> [TxOut]+build_single_outputs !outs !target_idx = go 0 outs+ where+ go :: Int -> [TxOut] -> [TxOut]+ go !_ [] = []+ go !i (o : rest)+ | i == target_idx = [o] -- keep this one and stop+ | i < target_idx = empty_output : go (i + 1) rest+ | otherwise = [] -- shouldn't reach here++ -- Empty output: -1 (0xffffffffffffffff) value, empty script+ empty_output :: TxOut+ empty_output = TxOut 0xffffffffffffffff BS.empty++-- | Safe list indexing.+safe_index :: [a] -> Int -> Maybe a+safe_index [] _ = Nothing+safe_index (x : xs) !n+ | n < 0 = Nothing+ | n == 0 = Just x+ | otherwise = safe_index xs (n - 1)+{-# INLINE safe_index #-}++-- | Encode TxIn for legacy sighash (same as normal encoding).+put_txin_legacy :: TxIn -> BSB.Builder+put_txin_legacy TxIn{..} =+ put_outpoint txin_prevout+ <> put_compact (fromIntegral (BS.length txin_script_sig))+ <> BSB.byteString txin_script_sig+ <> put_word32_le txin_sequence+{-# INLINE put_txin_legacy #-}++-- BIP143 segwit sighash -------------------------------------------------------++-- | Compute BIP143 segwit sighash.+--+-- Required for signing segwit inputs (P2WPKH, P2WSH). Unlike legacy+-- sighash, this commits to the value being spent, preventing fee+-- manipulation attacks.+--+-- Returns 'Nothing' if the input index is out of range.+--+-- @+-- -- sign P2WPKH input 0+-- let scriptCode = ... -- P2WPKH scriptCode+-- let hash = sighash_segwit tx 0 scriptCode inputValue SIGHASH_ALL+-- -- use hash with ECDSA signing (after checking Just)+-- @+sighash_segwit+ :: Tx+ -> Int -- ^ input index+ -> BS.ByteString -- ^ scriptCode+ -> Word64 -- ^ value being spent (satoshis)+ -> SighashType+ -> Maybe BS.ByteString -- ^ 32-byte hash, or Nothing if index invalid+sighash_segwit !tx !idx !script_code !value !sighash_type = do+ preimage <- build_bip143_preimage tx idx script_code value sighash_type+ pure $! hash256 preimage++-- | Build BIP143 preimage for signing.+-- Returns Nothing if the input index is out of range.+build_bip143_preimage+ :: Tx+ -> Int+ -> BS.ByteString+ -> Word64+ -> SighashType+ -> Maybe BS.ByteString+build_bip143_preimage Tx{..} !idx !script_code !value !sighash_type = do+ -- Get the input being signed; fail if index out of range+ let !inputs_list = NE.toList tx_inputs+ !outputs_list = NE.toList tx_outputs+ signing_input <- safe_index inputs_list idx++ let !base = base_type sighash_type+ !anyonecanpay = is_anyonecanpay sighash_type++ -- hashPrevouts: double SHA256 of all outpoints, or zero if ANYONECANPAY+ !hash_prevouts+ | anyonecanpay = zero32+ | otherwise = hash256 $ to_strict $+ foldMap (put_outpoint . txin_prevout) tx_inputs++ -- hashSequence: double SHA256 of all sequences, or zero if+ -- ANYONECANPAY or NONE or SINGLE+ !hash_sequence+ | anyonecanpay = zero32+ | base == SIGHASH_SINGLE = zero32+ | base == SIGHASH_NONE = zero32+ | otherwise = hash256 $ to_strict $+ foldMap (put_word32_le . txin_sequence) tx_inputs++ -- hashOutputs: depends on sighash type+ !hash_outputs = case base of+ SIGHASH_NONE -> zero32+ SIGHASH_SINGLE ->+ case safe_index outputs_list idx of+ Nothing -> zero32 -- index out of range+ Just out -> hash256 $ to_strict $ put_txout out+ _ -> hash256 $ to_strict $ foldMap put_txout tx_outputs++ !outpoint = txin_prevout signing_input+ !sequence_n = txin_sequence signing_input++ pure $! to_strict $+ put_word32_le tx_version+ <> BSB.byteString hash_prevouts+ <> BSB.byteString hash_sequence+ <> put_outpoint outpoint+ <> put_compact (fromIntegral (BS.length script_code))+ <> BSB.byteString script_code+ <> put_word64_le value+ <> put_word32_le sequence_n+ <> BSB.byteString hash_outputs+ <> put_word32_le tx_locktime+ <> put_word32_le (fromIntegral (sighash_byte sighash_type))
+ ppad-tx.cabal view
@@ -0,0 +1,92 @@+cabal-version: 3.0+name: ppad-tx+version: 0.1.0+synopsis: Minimal Bitcoin transaction primitives.+license: MIT+license-file: LICENSE+author: Jared Tobin+maintainer: jared@ppad.tech+category: Cryptography+build-type: Simple+tested-with: GHC == 9.10.3+extra-doc-files: CHANGELOG+description:+ Minimal Bitcoin transaction primitives for ppad libraries, including+ raw transaction types, serialisation, txid computation, and sighash+ calculation.++flag llvm+ description: Use GHC's LLVM backend.+ default: False+ manual: True++source-repository head+ type: git+ location: git.ppad.tech/tx.git++library+ default-language: Haskell2010+ hs-source-dirs: lib+ ghc-options:+ -Wall+ if flag(llvm)+ ghc-options: -fllvm -O2+ exposed-modules:+ Bitcoin.Prim.Tx+ Bitcoin.Prim.Tx.Sighash+ build-depends:+ base >= 4.9 && < 5+ , bytestring >= 0.9 && < 0.13+ , ppad-base16 >= 0.2.1 && < 0.3+ , ppad-sha256 >= 0.3 && < 0.4++test-suite tx-tests+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: Main.hs++ ghc-options:+ -rtsopts -Wall++ build-depends:+ base+ , bytestring+ , ppad-base16+ , ppad-tx+ , QuickCheck+ , tasty+ , tasty-hunit+ , tasty-quickcheck++benchmark tx-bench+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs++ ghc-options:+ -rtsopts -O2 -Wall++ build-depends:+ base+ , bytestring+ , criterion+ , deepseq+ , ppad-tx++benchmark tx-weigh+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Weight.hs++ ghc-options:+ -rtsopts -O2 -Wall++ build-depends:+ base+ , bytestring+ , deepseq+ , ppad-tx+ , weigh
+ test/Main.hs view
@@ -0,0 +1,707 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Bitcoin.Prim.Tx+import Bitcoin.Prim.Tx.Sighash+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as B16+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE+import Data.Word (Word64)+import Test.Tasty+import qualified Test.Tasty.HUnit as H+import Test.Tasty.QuickCheck as QC hiding (Witness)+import Test.QuickCheck+ ( Gen, Arbitrary(..), elements, oneof, chooseInt, forAll, (==>) )++-- main ------------------------------------------------------------------------++main :: IO ()+main = defaultMain $+ testGroup "ppad-tx" [+ testGroup "serialisation" [+ testGroup "round-trip" [+ roundtrip_legacy_simple+ , roundtrip_segwit+ , roundtrip_multi_io+ ]+ , testGroup "known vectors" [+ parse_satoshi_hal+ , parse_first_segwit+ ]+ ]+ , testGroup "txid" [+ txid_satoshi_hal+ ]+ , testGroup "edge cases" [+ edge_empty_scriptsig+ , edge_max_sequence+ , edge_zero_locktime+ , edge_multi_witness+ ]+ , testGroup "validation" [+ test_mkTxId_valid+ , test_mkTxId_short+ , test_mkTxId_long+ , test_mkTxId_empty+ , test_from_bytes_truncated+ , test_from_bytes_trailing+ , test_from_bytes_garbage+ , test_from_base16_invalid_hex+ , test_sighash_segwit_oob+ ]+ , testGroup "sighash" [+ testGroup "legacy" [+ sighash_legacy_minimal+ ]+ , testGroup "BIP143 segwit" [+ bip143_native_p2wpkh+ , bip143_p2sh_p2wpkh+ ]+ ]+ , testGroup "properties" [+ testGroup "round-trip" [+ prop_roundtrip_bytes+ , prop_roundtrip_base16+ ]+ , testGroup "serialisation" [+ prop_legacy_no_witnesses+ , prop_segwit_longer+ ]+ , testGroup "txid" [+ prop_txid_32_bytes+ , prop_txid_ignores_witnesses+ ]+ , testGroup "sighash" [+ prop_sighash_legacy_32_bytes+ , prop_sighash_segwit_32_bytes+ , prop_sighash_single_bug+ ]+ ]+ ]++-- helpers ---------------------------------------------------------------------++-- | Decode hex, failing the test on invalid input.+hex :: BS.ByteString -> BS.ByteString+hex h = case B16.decode h of+ Just bs -> bs+ Nothing -> error "test error: invalid hex literal"++-- | Assert round-trip: from_bytes (to_bytes tx) == Just tx+assertRoundtrip :: Tx -> H.Assertion+assertRoundtrip tx =+ let bs = to_bytes tx+ in case from_bytes bs of+ Nothing -> H.assertFailure "from_bytes returned Nothing"+ Just tx' -> H.assertEqual "round-trip mismatch" tx tx'++-- | Assert parsing from hex succeeds.+assertParses :: BS.ByteString -> H.Assertion+assertParses rawHex =+ case from_base16 rawHex of+ Nothing -> H.assertFailure "from_base16 returned Nothing"+ Just _ -> pure ()++-- round-trip tests ------------------------------------------------------------++-- Simple legacy tx: 1 input, 1 output, no witnesses+roundtrip_legacy_simple :: TestTree+roundtrip_legacy_simple = H.testCase "simple legacy tx" $+ assertRoundtrip legacyTx+ where+ legacyTx = Tx+ { tx_version = 1+ , tx_inputs = txin :| []+ , tx_outputs = txout :| []+ , tx_witnesses = []+ , tx_locktime = 0+ }+ txin = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0xab)+ , op_vout = 0+ }+ , txin_script_sig = hex "483045022100abcd"+ , txin_sequence = 0xffffffff+ }+ txout = TxOut+ { txout_value = 50000+ , txout_script_pubkey = hex "76a91489abcdef"+ }++-- Segwit tx with witnesses+roundtrip_segwit :: TestTree+roundtrip_segwit = H.testCase "segwit tx with witnesses" $+ assertRoundtrip segwitTx+ where+ segwitTx = Tx+ { tx_version = 2+ , tx_inputs = txin :| []+ , tx_outputs = txout :| []+ , tx_witnesses = [witness]+ , tx_locktime = 500000+ }+ txin = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0x12)+ , op_vout = 1+ }+ , txin_script_sig = BS.empty -- segwit: empty scriptSig+ , txin_sequence = 0xfffffffe+ }+ txout = TxOut+ { txout_value = 100000000+ , txout_script_pubkey = hex "0014abcdef1234567890"+ }+ witness = Witness+ [ hex "304402201234"+ , hex "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"+ ]++-- Multiple inputs and outputs+roundtrip_multi_io :: TestTree+roundtrip_multi_io = H.testCase "multiple inputs/outputs" $+ assertRoundtrip multiTx+ where+ multiTx = Tx+ { tx_version = 1+ , tx_inputs = txin1 :| [txin2, txin3]+ , tx_outputs = txout1 :| [txout2]+ , tx_witnesses = []+ , tx_locktime = 123456+ }+ txin1 = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0x11)+ , op_vout = 0+ }+ , txin_script_sig = hex "4730440220"+ , txin_sequence = 0xffffffff+ }+ txin2 = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0x22)+ , op_vout = 2+ }+ , txin_script_sig = hex "483045022100"+ , txin_sequence = 0xffffffff+ }+ txin3 = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0x33)+ , op_vout = 5+ }+ , txin_script_sig = hex "00"+ , txin_sequence = 0xfffffffe+ }+ txout1 = TxOut+ { txout_value = 10000000+ , txout_script_pubkey = hex "76a914"+ }+ txout2 = TxOut+ { txout_value = 5000000+ , txout_script_pubkey = hex "a914"+ }++-- known vector tests ----------------------------------------------------------++-- First Bitcoin transaction ever (block 170, Satoshi to Hal Finney)+-- TxId: f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16+satoshiHalRaw :: BS.ByteString+satoshiHalRaw =+ "0100000001c997a5e56e104102fa209c6a852dd90660a20b2d9c352423edce25857fcd37\+ \04000000004847304402204e45e16932b8af514961a1d3a1a25fdf3f4f7732e9d624c6c6\+ \1548ab5fb8cd410220181522ec8eca07de4860a4acdd12909d831cc56cbbac46220822\+ \21a8768d1d0901ffffffff0200ca9a3b00000000434104ae1a62fe09c5f51b13905f07f0\+ \6b99a2f7159b2225f374cd378d71302fa28414e7aab37397f554a7df5f142c21c1b7303\+ \b8a0626f1baded5c72a704f7e6cd84cac00286bee0000000043410411db93e1dcdb8a01\+ \6b49840f8c53bc1eb68a382e97b1482ecad7b148a6909a5cb2e0eaddfb84ccf9744464f8\+ \2e160bfa9b8b64f9d4c03f999b8643f656b412a3ac00000000"++satoshiHalTxId :: BS.ByteString+satoshiHalTxId = "f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16"++parse_satoshi_hal :: TestTree+parse_satoshi_hal = H.testCase "parse Satoshi->Hal tx (block 170)" $+ assertParses satoshiHalRaw++txid_satoshi_hal :: TestTree+txid_satoshi_hal = H.testCase "txid of Satoshi->Hal tx" $ do+ case from_base16 satoshiHalRaw of+ Nothing -> H.assertFailure "failed to parse tx"+ Just tx -> do+ let TxId computed = txid tx+ -- txid is displayed big-endian, but stored little-endian+ expected = BS.reverse (hex satoshiHalTxId)+ H.assertEqual "txid mismatch" expected computed++-- First segwit tx on mainnet (block 481824)+firstSegwitRaw :: BS.ByteString+firstSegwitRaw =+ "0200000000010140d43a99926d43eb0e619bf0b3d83b4a31f60c176beecfb9d35bf45e54\+ \d0f7420100000017160014a4b4ca48de0b3fffc15404a1acdc8dbaae226955ffffffff01\+ \00e1f5050000000017a9144a1154d50b03292b3024370901711946cb7cccc38702483045\+ \0221008604ef8f6d8afa892dee0f31259b6ce02dd70c545cfcfed8148179971f48d59202\+ \20770b9e1e5cf7f8c5d28c48abe49a3a25f1cf9e8a5b0d8f1c8f2f1c2dde88aa370121\+ \03d2e15674941bad4a996372cb87e1856d3652606d98562fe39c5e9e7e413f210500000000"++parse_first_segwit :: TestTree+parse_first_segwit = H.testCase "parse first segwit tx (block 481824)" $+ assertParses firstSegwitRaw++-- edge case tests -------------------------------------------------------------++-- Empty scriptSig (common in segwit)+edge_empty_scriptsig :: TestTree+edge_empty_scriptsig = H.testCase "empty scriptSig" $+ assertRoundtrip tx+ where+ tx = Tx+ { tx_version = 2+ , tx_inputs = txin :| []+ , tx_outputs = txout :| []+ , tx_witnesses = [witness]+ , tx_locktime = 0+ }+ txin = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0xff)+ , op_vout = 0+ }+ , txin_script_sig = BS.empty+ , txin_sequence = 0xffffffff+ }+ txout = TxOut+ { txout_value = 1000+ , txout_script_pubkey = hex "0014abcdef"+ }+ witness = Witness [hex "3044", hex "02"]++-- Maximum sequence number (0xffffffff)+edge_max_sequence :: TestTree+edge_max_sequence = H.testCase "maximum sequence (0xffffffff)" $+ assertRoundtrip tx+ where+ tx = Tx+ { tx_version = 1+ , tx_inputs = txin :| []+ , tx_outputs = txout :| []+ , tx_witnesses = []+ , tx_locktime = 0+ }+ txin = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0x00)+ , op_vout = 0xffffffff -- max vout too+ }+ , txin_script_sig = hex "00"+ , txin_sequence = 0xffffffff+ }+ txout = TxOut+ { txout_value = 0+ , txout_script_pubkey = hex "6a" -- OP_RETURN+ }++-- Zero locktime+edge_zero_locktime :: TestTree+edge_zero_locktime = H.testCase "zero locktime" $+ assertRoundtrip tx+ where+ tx = Tx+ { tx_version = 1+ , tx_inputs = txin :| []+ , tx_outputs = txout :| []+ , tx_witnesses = []+ , tx_locktime = 0+ }+ txin = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0xaa)+ , op_vout = 0+ }+ , txin_script_sig = hex "51" -- OP_1+ , txin_sequence = 0+ }+ txout = TxOut+ { txout_value = 100+ , txout_script_pubkey = hex "51"+ }++-- Multiple witness items per input+edge_multi_witness :: TestTree+edge_multi_witness = H.testCase "multiple witness items" $+ assertRoundtrip tx+ where+ tx = Tx+ { tx_version = 2+ , tx_inputs = txin1 :| [txin2]+ , tx_outputs = txout :| []+ , tx_witnesses = [witness1, witness2]+ , tx_locktime = 0+ }+ txin1 = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0x01)+ , op_vout = 0+ }+ , txin_script_sig = BS.empty+ , txin_sequence = 0xffffffff+ }+ txin2 = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0x02)+ , op_vout = 1+ }+ , txin_script_sig = BS.empty+ , txin_sequence = 0xffffffff+ }+ txout = TxOut+ { txout_value = 50000+ , txout_script_pubkey = hex "0014"+ }+ -- 5 witness items for input 1+ witness1 = Witness+ [ BS.empty -- empty item (common in multisig)+ , hex "304402201234"+ , hex "3045022100abcd"+ , hex "522102"+ , hex "ae"+ ]+ -- 2 witness items for input 2+ witness2 = Witness+ [ hex "3044"+ , hex "03"+ ]++-- validation tests -----------------------------------------------------------++-- mkTxId: valid 32-byte input accepted+test_mkTxId_valid :: TestTree+test_mkTxId_valid = H.testCase "mkTxId accepts 32 bytes" $+ case mkTxId (BS.replicate 32 0x00) of+ Nothing -> H.assertFailure "mkTxId returned Nothing"+ Just _ -> pure ()++-- mkTxId: 31 bytes rejected+test_mkTxId_short :: TestTree+test_mkTxId_short = H.testCase "mkTxId rejects 31 bytes" $+ H.assertEqual "should be Nothing"+ Nothing (mkTxId (BS.replicate 31 0x00))++-- mkTxId: 33 bytes rejected+test_mkTxId_long :: TestTree+test_mkTxId_long = H.testCase "mkTxId rejects 33 bytes" $+ H.assertEqual "should be Nothing"+ Nothing (mkTxId (BS.replicate 33 0x00))++-- mkTxId: empty input rejected+test_mkTxId_empty :: TestTree+test_mkTxId_empty = H.testCase "mkTxId rejects empty" $+ H.assertEqual "should be Nothing"+ Nothing (mkTxId BS.empty)++-- from_bytes: truncated input rejected+test_from_bytes_truncated :: TestTree+test_from_bytes_truncated =+ H.testCase "from_bytes rejects truncated input" $ do+ let full = to_bytes legacyTx1+ truncated = BS.take (BS.length full - 1) full+ H.assertEqual "should be Nothing"+ Nothing (from_bytes truncated)++-- from_bytes: trailing bytes rejected+test_from_bytes_trailing :: TestTree+test_from_bytes_trailing =+ H.testCase "from_bytes rejects trailing bytes" $ do+ let full = to_bytes legacyTx1+ padded = full <> BS.singleton 0x00+ H.assertEqual "should be Nothing"+ Nothing (from_bytes padded)++-- from_bytes: garbage rejected+test_from_bytes_garbage :: TestTree+test_from_bytes_garbage =+ H.testCase "from_bytes rejects garbage" $+ H.assertEqual "should be Nothing"+ Nothing (from_bytes (BS.pack [0xde, 0xad]))++-- from_base16: invalid hex rejected+test_from_base16_invalid_hex :: TestTree+test_from_base16_invalid_hex =+ H.testCase "from_base16 rejects invalid hex" $+ H.assertEqual "should be Nothing"+ Nothing (from_base16 "not valid hex!!!")++-- sighash_segwit: out-of-range index returns Nothing+test_sighash_segwit_oob :: TestTree+test_sighash_segwit_oob =+ H.testCase "sighash_segwit rejects out-of-range index" $ do+ let rawTx = hex $ mconcat+ [ "0100000002fff7f7881a8099afa6940d42d1e7f6362bec"+ , "38171ea3edf433541db4e4ad969f0000000000eeffffff"+ , "ef51e1b804cc89d182d279655c3aa89e815b1b309fe287"+ , "d9b2b55d57b90ec68a0100000000ffffffff02202cb206"+ , "000000001976a9148280b37df378db99f66f85c95a783a"+ , "76ac7a6d5988ac9093510d000000001976a9143bde42db"+ , "ee7e4dbe6a21b2d50ce2f0167faa815988ac11000000"+ ]+ case from_bytes rawTx of+ Nothing -> H.assertFailure "failed to parse tx"+ Just tx ->+ H.assertEqual "should be Nothing"+ Nothing+ (sighash_segwit tx 99 "script" 0 SIGHASH_ALL)++-- | A minimal legacy tx used by validation tests.+legacyTx1 :: Tx+legacyTx1 = Tx+ { tx_version = 1+ , tx_inputs = txin :| []+ , tx_outputs = txout :| []+ , tx_witnesses = []+ , tx_locktime = 0+ }+ where+ txin = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0x00)+ , op_vout = 0+ }+ , txin_script_sig = hex "00"+ , txin_sequence = 0xffffffff+ }+ txout = TxOut+ { txout_value = 0+ , txout_script_pubkey = hex "6a"+ }++-- legacy sighash vectors ----------------------------------------------------++-- Minimal tx: 1-in/1-out, signing input 0, SIGHASH_ALL,+-- scriptPubKey = OP_1 (0x51)+sighash_legacy_minimal :: TestTree+sighash_legacy_minimal =+ H.testCase "minimal tx SIGHASH_ALL" $ do+ let tx = Tx+ { tx_version = 1+ , tx_inputs = txin :| []+ , tx_outputs = txout :| []+ , tx_witnesses = []+ , tx_locktime = 0+ }+ txin = TxIn+ { txin_prevout = OutPoint+ { op_txid = TxId (BS.replicate 32 0x00)+ , op_vout = 0+ }+ , txin_script_sig = hex "00"+ , txin_sequence = 0xffffffff+ }+ txout = TxOut+ { txout_value = 0+ , txout_script_pubkey = hex "6a"+ }+ script_pubkey = hex "51"+ expected = hex+ "049b7618cbda49a0190c5eea6f97320b\+ \930aa32b64be6e71ed20041067685c45"+ result = sighash_legacy tx 0 script_pubkey SIGHASH_ALL+ H.assertEqual "sighash mismatch" expected result++-- BIP143 sighash vectors -----------------------------------------------------++-- Native P2WPKH (BIP143 example)+-- https://github.com/bitcoin/bips/blob/master/bip-0143.mediawiki+bip143_native_p2wpkh :: TestTree+bip143_native_p2wpkh = H.testCase "native P2WPKH" $ do+ let rawTx = hex $ mconcat+ [ "0100000002fff7f7881a8099afa6940d42d1e7f6362bec38171ea3edf43354"+ , "1db4e4ad969f0000000000eeffffffef51e1b804cc89d182d279655c3aa89e"+ , "815b1b309fe287d9b2b55d57b90ec68a0100000000ffffffff02202cb20600"+ , "0000001976a9148280b37df378db99f66f85c95a783a76ac7a6d5988ac9093"+ , "510d000000001976a9143bde42dbee7e4dbe6a21b2d50ce2f0167faa815988"+ , "ac11000000"+ ]+ case from_bytes rawTx of+ Nothing -> H.assertFailure "failed to parse BIP143 tx"+ Just tx -> do+ let inputIdx = 1+ -- scriptCode for P2WPKH (without length prefix)+ scriptCode = hex+ "76a9141d0f172a0ecb48aee1be1f2687d2963ae33f71a188ac"+ value = 600000000 :: Word64+ expected = hex+ "c37af31116d1b27caf68aae9e3ac82f1477929014d5b917657d0eb49478cb670"+ case sighash_segwit tx inputIdx scriptCode value SIGHASH_ALL of+ Nothing -> H.assertFailure "sighash_segwit returned Nothing"+ Just result -> H.assertEqual "sighash mismatch" expected result++-- P2SH-P2WPKH (BIP143 example)+bip143_p2sh_p2wpkh :: TestTree+bip143_p2sh_p2wpkh = H.testCase "P2SH-P2WPKH" $ do+ let rawTx = hex $ mconcat+ [ "0100000001db6b1b20aa0fd7b23880be2ecbd4a98130974cf4748fb66092ac"+ , "4d3ceb1a54770100000000feffffff02b8b4eb0b000000001976a914a457b6"+ , "84d7f0d539a46a45bbc043f35b59d0d96388ac0008af2f000000001976a914"+ , "fd270b1ee6abcaea97fea7ad0402e8bd8ad6d77c88ac92040000"+ ]+ case from_bytes rawTx of+ Nothing -> H.assertFailure "failed to parse BIP143 tx"+ Just tx -> do+ let inputIdx = 0+ -- scriptCode without length prefix+ scriptCode = hex+ "76a91479091972186c449eb1ded22b78e40d009bdf008988ac"+ value = 1000000000 :: Word64+ expected = hex+ "64f3b0f4dd2bb3aa1ce8566d220cc74dda9df97d8490cc81d89d735c92e59fb6"+ case sighash_segwit tx inputIdx scriptCode value SIGHASH_ALL of+ Nothing -> H.assertFailure "sighash_segwit returned Nothing"+ Just result -> H.assertEqual "sighash mismatch" expected result++-- Arbitrary instances --------------------------------------------------------++instance Arbitrary TxId where+ arbitrary = TxId . BS.pack <$> vectorOf 32 arbitrary++instance Arbitrary OutPoint where+ arbitrary = OutPoint <$> arbitrary <*> arbitrary++instance Arbitrary TxIn where+ arbitrary = TxIn+ <$> arbitrary+ <*> arbitraryScript+ <*> arbitrary++instance Arbitrary TxOut where+ arbitrary = TxOut+ <$> arbitrary+ <*> arbitraryScript++instance Arbitrary Witness where+ arbitrary = Witness <$> listOf arbitraryScript++instance Arbitrary SighashType where+ arbitrary = elements+ [ SIGHASH_ALL+ , SIGHASH_NONE+ , SIGHASH_SINGLE+ , SIGHASH_ALL_ANYONECANPAY+ , SIGHASH_NONE_ANYONECANPAY+ , SIGHASH_SINGLE_ANYONECANPAY+ ]++-- | Generate arbitrary script-like bytestrings (0-200 bytes).+arbitraryScript :: Gen BS.ByteString+arbitraryScript = do+ len <- chooseInt (0, 200)+ BS.pack <$> vectorOf len arbitrary++-- | Generate a NonEmpty list of 1-5 items.+arbitraryNonEmpty :: Arbitrary a => Gen (NonEmpty a)+arbitraryNonEmpty = do+ x <- arbitrary+ xs <- listOf1to4+ pure (x :| xs)+ where+ listOf1to4 = do+ n <- chooseInt (0, 4)+ vectorOf n arbitrary++-- | Generate a valid legacy transaction (no witnesses).+genLegacyTx :: Gen Tx+genLegacyTx = do+ ver <- arbitrary+ ins <- arbitraryNonEmpty+ outs <- arbitraryNonEmpty+ lt <- arbitrary+ pure $ Tx ver ins outs [] lt++-- | Generate a valid segwit transaction (with witnesses).+genSegwitTx :: Gen Tx+genSegwitTx = do+ ver <- arbitrary+ ins <- arbitraryNonEmpty+ outs <- arbitraryNonEmpty+ -- One witness per input+ let numInputs = NE.length ins+ wits <- vectorOf numInputs arbitrary+ lt <- arbitrary+ pure $ Tx ver ins outs wits lt++-- | Generate any valid transaction.+instance Arbitrary Tx where+ arbitrary = oneof [genLegacyTx, genSegwitTx]++-- property tests -------------------------------------------------------------++-- Round-trip: from_bytes (to_bytes tx) == Just tx+prop_roundtrip_bytes :: TestTree+prop_roundtrip_bytes = QC.testProperty "from_bytes . to_bytes == Just" $+ \tx -> from_bytes (to_bytes tx) === Just (tx :: Tx)++-- Round-trip: from_base16 (to_base16 tx) == Just tx+prop_roundtrip_base16 :: TestTree+prop_roundtrip_base16 = QC.testProperty "from_base16 . to_base16 == Just" $+ \tx -> from_base16 (to_base16 tx) === Just (tx :: Tx)++-- Legacy tx (no witnesses): to_bytes == to_bytes_legacy+prop_legacy_no_witnesses :: TestTree+prop_legacy_no_witnesses =+ QC.testProperty "legacy tx: to_bytes == to_bytes_legacy" $+ forAll genLegacyTx $ \tx ->+ to_bytes tx === to_bytes_legacy tx++-- Segwit tx: to_bytes is longer than to_bytes_legacy (when witnesses present)+prop_segwit_longer :: TestTree+prop_segwit_longer =+ QC.testProperty "segwit tx: to_bytes longer than to_bytes_legacy" $+ forAll genSegwitTx $ \tx ->+ not (null (tx_witnesses tx)) ==>+ BS.length (to_bytes tx) > BS.length (to_bytes_legacy tx)++-- TxId is always 32 bytes+prop_txid_32_bytes :: TestTree+prop_txid_32_bytes = QC.testProperty "txid is always 32 bytes" $+ \tx -> let TxId bs = txid tx in BS.length bs === 32++-- TxId ignores witnesses (same txid with or without witnesses)+prop_txid_ignores_witnesses :: TestTree+prop_txid_ignores_witnesses =+ QC.testProperty "txid ignores witnesses" $+ forAll genSegwitTx $ \tx ->+ let txNoWit = tx { tx_witnesses = [] }+ in txid tx === txid txNoWit++-- sighash_legacy always returns 32 bytes+prop_sighash_legacy_32_bytes :: TestTree+prop_sighash_legacy_32_bytes =+ QC.testProperty "sighash_legacy is always 32 bytes" $+ forAll genLegacyTx $ \tx ->+ forAll arbitraryScript $ \spk ->+ forAll arbitrary $ \st ->+ BS.length (sighash_legacy tx 0 spk st) === 32++-- sighash_segwit returns Just 32 bytes for valid index+prop_sighash_segwit_32_bytes :: TestTree+prop_sighash_segwit_32_bytes =+ QC.testProperty "sighash_segwit is 32 bytes for valid index" $+ forAll genSegwitTx $ \tx ->+ forAll arbitraryScript $ \sc ->+ forAll (arbitrary :: Gen Word64) $ \val ->+ forAll arbitrary $ \st ->+ case sighash_segwit tx 0 sc val st of+ Nothing -> False -- should succeed for index 0+ Just bs -> BS.length bs == 32++-- SIGHASH_SINGLE bug: returns 0x01 ++ 0x00*31 when index >= outputs+prop_sighash_single_bug :: TestTree+prop_sighash_single_bug =+ QC.testProperty "SIGHASH_SINGLE bug when index >= outputs" $+ forAll genLegacyTx $ \tx ->+ let numOutputs = NE.length (tx_outputs tx)+ bugValue = BS.cons 0x01 (BS.replicate 31 0x00)+ in forAll arbitraryScript $ \spk ->+ sighash_legacy tx numOutputs spk SIGHASH_SINGLE === bugValue