commit 25defad8bbaddc05c969872947968e2de35be3fe
parent 65a561493940b59c5415b4b1409b4e32dae5c08f
Author: Jared Tobin <jared@jtobin.io>
Date: Sat, 10 Oct 2026 18:41:01 +0400
Merge fix/parse-hardening: parser fixes and release tidy-up
- from_bytes no longer throws on compactSize lengths of 2^63 or more,
and rejects counts exceeding the remaining input.
- Segwit-flagged transactions without witness data are rejected, and
all-empty witnesses serialise in the legacy format (as in Bitcoin
Core).
- Ord for TxId and OutPoint; NFData for SighashType.
- README example fixed for the 0.2.0 sighash API; cabal metadata,
CHANGELOG and Haddock examples brought up to date; tests made total
and warning-free, with regression tests for the parser fixes.
Diffstat:
10 files changed, 229 insertions(+), 113 deletions(-)
diff --git a/AGENTS.md b/AGENTS.md
@@ -4,7 +4,7 @@ Minimal Bitcoin transaction primitives for ppad libraries.
## Project Structure
-- `lib/` - library source (Bitcoin.Prim.Tx)
+- `lib/` - library source (Bitcoin.Prim.Tx, Bitcoin.Prim.Tx.Sighash)
- `test/` - tests (tasty + tasty-hunit)
- `bench/` - benchmarks (criterion for timing, weigh for allocations)
- `flake.nix` - nix flake for dependency and build management
diff --git a/CHANGELOG b/CHANGELOG
@@ -9,7 +9,14 @@
* Strips OP_CODESEPARATOR from the script code in legacy sighashes.
* Adds BIP341 taproot sighashes (sighash_taproot_keypath,
sighash_taproot_scriptpath).
- * Adds NFData instances for all transaction types.
+ * Adds NFData instances for all transaction types, an NFData
+ instance for SighashType, and Ord instances for TxId and OutPoint.
+ * Fixes from_bytes, which threw an exception on compactSize lengths
+ of 2^63 or more, and now rejects counts exceeding the remaining
+ input.
+ * Rejects segwit-flagged transactions carrying no witness data, and
+ serialises transactions whose witnesses are all empty in the legacy
+ format, as Bitcoin Core does.
- 0.1.0 (2026-04-18)
* Initial release.
diff --git a/CLAUDE.md b/CLAUDE.md
@@ -4,7 +4,7 @@ Minimal Bitcoin transaction primitives for ppad libraries.
## Project Structure
-- `lib/` - library source (Bitcoin.Prim.Tx)
+- `lib/` - library source (Bitcoin.Prim.Tx, Bitcoin.Prim.Tx.Sighash)
- `test/` - tests (tasty + tasty-hunit)
- `bench/` - benchmarks (criterion for timing, weigh for allocations)
- `flake.nix` - nix flake for dependency and build management
diff --git a/README.md b/README.md
@@ -4,9 +4,10 @@
[](https://docs.ppad.tech/tx)
-Minimal Bitcoin transaction primitives, including raw transaction
-types, serialisation to/from bytes, txid computation, and sighash
-calculation (legacy and BIP143 segwit).
+Minimal Bitcoin transaction primitives in pure Haskell: raw transaction
+types, serialisation to and from bytes (legacy and BIP144 segwit),
+txid computation, and sighash calculation (legacy, [BIP143][bp143]
+segwit and [BIP341][bp341] taproot).
## Usage
@@ -16,42 +17,74 @@ A sample GHCi session:
> :set -XOverloadedStrings
> import qualified Data.ByteString as BS
> import qualified Data.ByteString.Base16 as B16
+ > import qualified Data.List.NonEmpty as NE
> import Bitcoin.Prim.Tx
> import Bitcoin.Prim.Tx.Sighash
>
- > -- parse a raw transaction from hex
- > let raw = "0100000001c997a5e56e104102fa209c6a852dd90660a20b2d9c352423edce25857fcd3704000000004847304402204e45e16932b8af514961a1d3a1a25fdf3f4f7732e9d624c6c61548ab5fb8cd410220181522ec8eca07de4860a4acdd12909d831cc56cbbac4622082221a8768d1d0901ffffffff0200ca9a3b00000000434104ae1a62fe09c5f51b13905f07f06b99a2f7159b2225f374cd378d71302fa28414e7aab37397f554a7df5f142c21c1b7303b8a0626f1baded5c72a704f7e6cd84cac00286bee0000000043410411db93e1dcdb8a016b49840f8c53bc1eb68a382e97b1482ecad7b148a6909a5cb2e0eaddfb84ccf9744464f82e160bfa9b8b64f9d4c03f999b8643f656b412a3ac00000000"
+ > -- the Satoshi -> Hal transaction from block 170
+ > :{
+ > let raw = mconcat
+ > [ "0100000001c997a5e56e104102fa209c6a852dd90660a20b2d9c352423edce25"
+ > , "857fcd3704000000004847304402204e45e16932b8af514961a1d3a1a25fdf3f"
+ > , "4f7732e9d624c6c61548ab5fb8cd410220181522ec8eca07de4860a4acdd1290"
+ > , "9d831cc56cbbac4622082221a8768d1d0901ffffffff0200ca9a3b0000000043"
+ > , "4104ae1a62fe09c5f51b13905f07f06b99a2f7159b2225f374cd378d71302fa2"
+ > , "8414e7aab37397f554a7df5f142c21c1b7303b8a0626f1baded5c72a704f7e6c"
+ > , "d84cac00286bee0000000043410411db93e1dcdb8a016b49840f8c53bc1eb68a"
+ > , "382e97b1482ecad7b148a6909a5cb2e0eaddfb84ccf9744464f82e160bfa9b8b"
+ > , "64f9d4c03f999b8643f656b412a3ac00000000"
+ > ]
+ > :}
> let Just tx = from_base16 raw
>
- > -- compute the txid
+ > -- txids are displayed byte-reversed
> let TxId tid = txid tx
> B16.encode (BS.reverse tid)
"f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16"
>
- > -- round-trip serialisation
> from_bytes (to_bytes tx) == Just tx
True
>
- > -- compute a legacy sighash
- > let scriptPubKey = BS.pack [0x76, 0xa9, 0x14]
- > let hash = sighash_legacy tx 0 scriptPubKey SIGHASH_ALL
- > BS.length hash
- 32
+ > -- the legacy sighash Satoshi signed: input 0 spends a P2PK output
+ > -- whose scriptPubKey is the same as this tx's change output
+ > let spk = txout_script_pubkey (NE.last (tx_outputs tx))
+ > B16.encode (sighash_legacy tx 0 spk (encode_sighash SIGHASH_ALL))
+ "7a05c6145f10101e9d6325494245adf1297d80f8f38d4d576d57cdba220bcb19"
+ >
+ > -- segwit and taproot sighashes validate their arguments
+ > sighash_segwit tx 1 spk 1000000000 (encode_sighash SIGHASH_ALL)
+ Nothing
```
## Documentation
-Haddocks are hosted at [docs.ppad.tech/tx][hadoc].
+Haddocks (API documentation, etc.) are hosted at
+[docs.ppad.tech/tx][hadoc].
+
+## Performance
+
+The aim is best-in-class performance for pure Haskell code. Run the
+benchmarks (criterion for wall time, weigh for allocation) with:
+
+```
+$ cabal bench
+```
## Security
-This is a pre-release library that, at present, claims no security
-properties whatsoever.
+This library handles no secret material. Parsing is total and
+rejects malformed, non-minimal or trailing-byte encodings, matching
+Bitcoin Core's serialisation rules; it doesn't validate transactions
+against consensus or policy rules (amounts, script validity, etc.).
+Sighash computation follows Bitcoin Core, including its legacy quirks
+(the SIGHASH_SINGLE "bug" value, OP_CODESEPARATOR removal, raw 32-bit
+hashTypes), and is tested against Bitcoin Core's `sighash.json` and
+the BIP143 and BIP341 vectors.
## Development
-You'll require [Nix][nixos] with [flake][flake] support enabled.
-Enter a development shell with:
+You'll require [Nix][nixos] with [flake][flake] support enabled. Enter a
+development shell with:
```
$ nix develop
@@ -60,11 +93,13 @@ $ nix develop
Then do e.g.:
```
-$ cabal build
-$ cabal test
-$ cabal bench
+$ cabal repl ppad-tx
```
+to get a REPL for the main library.
+
+[bp143]: https://github.com/bitcoin/bips/blob/master/bip-0143.mediawiki
+[bp341]: https://github.com/bitcoin/bips/blob/master/bip-0341.mediawiki
[nixos]: https://nixos.org/
[flake]: https://nixos.org/manual/nix/unstable/command-ref/new-cli/nix3-flake.html
[hadoc]: https://docs.ppad.tech/tx
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -3,7 +3,6 @@
module Main where
-import Control.DeepSeq
import Criterion.Main
import qualified Data.ByteString as BS
import Data.List.NonEmpty (NonEmpty(..))
@@ -14,8 +13,6 @@ import Bitcoin.Prim.Tx.Sighash
-- NFData instances ------------------------------------------------------------
-instance NFData SighashType
-
-- sample data -----------------------------------------------------------------
-- | Sample outpoint (references a dummy txid).
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -3,7 +3,6 @@
module Main where
-import Control.DeepSeq
import qualified Data.ByteString as BS
import Data.List.NonEmpty (NonEmpty(..))
import Data.Word (Word64)
@@ -14,8 +13,6 @@ import Bitcoin.Prim.Tx.Sighash
-- NFData instances ------------------------------------------------------------
-instance NFData SighashType
-
-- sample data -----------------------------------------------------------------
-- | Sample outpoint (references a dummy txid).
diff --git a/lib/Bitcoin/Prim/Tx.hs b/lib/Bitcoin/Prim/Tx.hs
@@ -56,18 +56,19 @@ import GHC.Generics (Generic)
-- | Transaction ID (32 bytes, little-endian double-SHA256).
newtype TxId = TxId BS.ByteString
- deriving (Eq, Show, Generic)
+ deriving (Eq, Ord, Show, Generic)
instance NFData TxId
--- | Construct a TxId from a 32-byte ByteString.
+-- | Construct a TxId from a 32-byte ByteString (in internal byte
+-- order, i.e. the reverse of the usual hex display).
--
-- Returns 'Nothing' if the input is not exactly 32 bytes.
--
--- @
--- mkTxId (BS.replicate 32 0x00) == Just (TxId ...)
--- mkTxId (BS.replicate 31 0x00) == Nothing
--- @
+-- >>> fmap (\(TxId b) -> BS.length b) (mkTxId (BS.replicate 32 0x00))
+-- Just 32
+-- >>> mkTxId (BS.replicate 31 0x00)
+-- Nothing
mkTxId :: BS.ByteString -> Maybe TxId
mkTxId bs
| BS.length bs == 32 = Just (TxId bs)
@@ -77,7 +78,7 @@ mkTxId bs
data OutPoint = OutPoint
{ op_txid :: {-# UNPACK #-} !TxId
, op_vout :: {-# UNPACK #-} !Word32
- } deriving (Eq, Show, Generic)
+ } deriving (Eq, Ord, Show, Generic)
instance NFData OutPoint
@@ -118,11 +119,12 @@ data Tx = Tx
instance NFData Tx
--- serialisation ---------------------------------------------------------------
+-- serialisation --------------------------------------------------------------
-- | Serialise a transaction to bytes.
--
--- Uses segwit format if witnesses are present, legacy otherwise.
+-- Uses the segwit format if any input has a non-empty witness, and
+-- the legacy format otherwise (as Bitcoin Core does).
--
-- @
-- -- round-trip
@@ -130,7 +132,7 @@ instance NFData Tx
-- @
to_bytes :: Tx -> BS.ByteString
to_bytes tx@Tx {..}
- | null tx_witnesses = to_bytes_legacy tx
+ | not (has_witness tx_witnesses) = to_bytes_legacy tx
| otherwise = to_strict $
put_word32_le tx_version
<> BSB.word8 0x00 -- marker
@@ -142,6 +144,11 @@ to_bytes tx@Tx {..}
<> foldMap put_witness tx_witnesses
<> put_word32_le tx_locktime
+-- whether any witness stack is non-empty
+has_witness :: [Witness] -> Bool
+has_witness = any (\(Witness items) -> not (null items))
+{-# INLINE has_witness #-}
+
-- | Serialise a transaction to legacy format (no witness data).
--
-- Used for txid computation. Excludes witness data even if present.
@@ -181,7 +188,7 @@ from_base16 b16 = do
bs <- B16.decode b16
from_bytes bs
--- internal: builders ----------------------------------------------------------
+-- internal: builders ---------------------------------------------------------
-- | Convert a Builder to a strict ByteString.
to_strict :: BSB.Builder -> BS.ByteString
@@ -249,7 +256,7 @@ put_witness (Witness items) =
<> BSB.byteString item
{-# INLINE put_witness #-}
--- decoding --------------------------------------------------------------------
+-- decoding -------------------------------------------------------------------
-- | Parse a transaction from bytes.
--
@@ -281,12 +288,12 @@ 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_list, off2) <- get_many get_txin bs off1 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_list, off4) <- get_many get_txout bs off3 output_count
outputs <- NE.nonEmpty outputs_list
-- locktime (4 bytes)
guard (BS.length bs >= off4 + 4)
@@ -302,15 +309,18 @@ 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_list, off2) <- get_many get_txin bs off1 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_list, off4) <- get_many get_txout bs off3 output_count
outputs <- NE.nonEmpty outputs_list
-- witnesses (one per input)
- (witnesses, off5) <- get_many get_witness bs off4 (fromIntegral input_count)
+ (witnesses, off5) <- get_many get_witness bs off4 input_count
+ -- a marker and flag with no witness data is invalid (Bitcoin Core:
+ -- "superfluous witness record")
+ guard (has_witness witnesses)
-- locktime (4 bytes)
guard (BS.length bs >= off5 + 4)
let !locktime = get_word32_le bs off5
@@ -319,7 +329,7 @@ parse_segwit !bs !version !off0 = do
guard (off6 == BS.length bs)
pure $! Tx version inputs outputs witnesses locktime
--- internal helpers ------------------------------------------------------------
+-- internal helpers -----------------------------------------------------------
-- | Guard for Maybe monad.
guard :: Bool -> Maybe ()
@@ -423,12 +433,8 @@ 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
+ -- scriptSig
+ (script_sig, off3) <- get_bytes bs off1
-- sequence: 4 bytes
guard (BS.length bs >= off3 + 4)
let !seqn = get_word32_le bs off3
@@ -443,13 +449,9 @@ get_txout !bs !off0 = do
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)
+ -- scriptPubKey
+ (script_pk, off2) <- get_bytes bs off1
+ pure (TxOut value script_pk, off2)
-- | Decode a witness stack for one input.
-- Returns (Witness, new_offset).
@@ -458,23 +460,28 @@ 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)
+ (items, off2) <- get_many get_bytes bs off1 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.
+-- | Decode compactSize-length-prefixed bytes.
+-- Returns (bytes, new_offset).
+get_bytes :: BS.ByteString -> Int -> Maybe (BS.ByteString, Int)
+get_bytes !bs !off0 = do
+ (len, off1) <- get_compact bs off0
+ -- compare in Word64, so that huge lengths can't wrap negative
+ guard (len <= fromIntegral (BS.length bs - off1))
+ let !n = fromIntegral len
+ pure (BS.take n (BS.drop off1 bs), off1 + n)
+
+-- | Decode a counted sequence of 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 []
+ -> BS.ByteString -> Int -> Word64 -> Maybe ([a], Int)
+get_many getter !bs !off0 !count
+ -- every item occupies at least one byte, so a larger count is
+ -- malformed (and might not fit in an Int)
+ | count > fromIntegral (BS.length bs - off0) = Nothing
+ | otherwise = go [] off0 (fromIntegral count :: Int)
where
go !acc !off !n
| n <= 0 = Just (reverse acc, off)
@@ -483,17 +490,19 @@ get_many getter !bs = go []
go (item : acc) off' (n - 1)
{-# INLINE get_many #-}
--- txid ------------------------------------------------------------------------
+-- 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.
+-- transactions have the same txid regardless of witness data. It is
+-- in internal byte order; reverse it for the usual hex display.
--
-- @
-- -- Satoshi->Hal tx (block 170)
--- txid satoshiHalTx ==
--- TxId "f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16"
+-- let TxId t = txid satoshi_hal_tx
+-- B16.encode (BS.reverse t)
+-- == "f4184fc596403b9d638783cf57adfe4c75c605f6356fbc91338530e9831e9e16"
-- @
txid :: Tx -> TxId
txid tx = TxId (SHA256.hash (SHA256.hash (to_bytes_legacy tx)))
diff --git a/lib/Bitcoin/Prim/Tx/Sighash.hs b/lib/Bitcoin/Prim/Tx/Sighash.hs
@@ -43,6 +43,7 @@ import Bitcoin.Prim.Tx
, put_txout
, to_strict
)
+import Control.DeepSeq (NFData)
import Control.Monad (guard)
import qualified Crypto.Hash.SHA256 as SHA256
import Data.Bits ((.&.))
@@ -69,6 +70,8 @@ data SighashType
| SIGHASH_SINGLE_ANYONECANPAY
deriving (Eq, Show, Generic)
+instance NFData SighashType
+
-- | Encode a canonical 'SighashType' to its 32-bit hashType value.
--
-- @
@@ -304,7 +307,7 @@ put_txin_legacy TxIn{..} =
<> put_word32_le txin_sequence
{-# INLINE put_txin_legacy #-}
--- BIP143 segwit sighash -------------------------------------------------------
+-- BIP143 segwit sighash ------------------------------------------------------
-- | Compute BIP143 segwit sighash.
--
diff --git a/ppad-tx.cabal b/ppad-tx.cabal
@@ -1,19 +1,19 @@
cabal-version: 3.0
name: ppad-tx
version: 0.2.0
-synopsis: Minimal Bitcoin transaction primitives.
+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
+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.
+ Minimal Bitcoin transaction primitives: raw transaction types,
+ serialisation, txid computation, and legacy, BIP143 segwit and BIP341
+ taproot sighash calculation.
flag llvm
description: Use GHC's LLVM backend.
@@ -37,7 +37,7 @@ library
build-depends:
base >= 4.9 && < 5
, bytestring >= 0.9 && < 0.13
- , deepseq >= 1.4 && < 2
+ , deepseq >= 1.4 && < 1.6
, ppad-base16 >= 0.3 && < 0.4
, ppad-sha256 >= 0.3 && < 0.4
@@ -48,7 +48,7 @@ test-suite tx-tests
main-is: Main.hs
ghc-options:
- -rtsopts -Wall
+ -rtsopts -Wall -fno-warn-orphans
build-depends:
base
@@ -73,7 +73,6 @@ benchmark tx-bench
base
, bytestring
, criterion
- , deepseq
, ppad-tx
benchmark tx-weigh
@@ -88,6 +87,5 @@ benchmark tx-weigh
build-depends:
base
, bytestring
- , deepseq
, ppad-tx
, weigh
diff --git a/test/Main.hs b/test/Main.hs
@@ -13,8 +13,6 @@ import Data.Word (Word8, Word32, 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, resize, (==>) )
-- main ------------------------------------------------------------------------
@@ -57,6 +55,11 @@ main = defaultMain $
, test_from_bytes_garbage
, test_from_base16_invalid_hex
, test_sighash_segwit_oob
+ , test_from_bytes_huge_length
+ , test_from_bytes_huge_count
+ , test_from_bytes_superfluous_witness
+ , test_to_bytes_empty_witnesses
+ , test_fixtures_parse
]
, testGroup "sighash" [
testGroup "legacy" [
@@ -150,11 +153,13 @@ main = defaultMain $
-- helpers ---------------------------------------------------------------------
--- | Decode hex, failing the test on invalid input.
+-- | Decode a hex literal. Total: an invalid literal decodes to empty
+-- bytes, which no vector expects, and the "fixtures parse" test
+-- checks the transaction fixtures explicitly.
hex :: BS.ByteString -> BS.ByteString
hex h = case B16.decode h of
Just bs -> bs
- Nothing -> error "test error: invalid hex literal"
+ Nothing -> BS.empty
-- | Assert round-trip: from_bytes (to_bytes tx) == Just tx
assertRoundtrip :: Tx -> H.Assertion
@@ -207,7 +212,7 @@ roundtrip_segwit = H.testCase "segwit tx with witnesses" $
{ tx_version = 2
, tx_inputs = txin :| []
, tx_outputs = txout :| []
- , tx_witnesses = [witness]
+ , tx_witnesses = [wit]
, tx_locktime = 500000
}
txin = TxIn
@@ -222,7 +227,7 @@ roundtrip_segwit = H.testCase "segwit tx with witnesses" $
{ txout_value = 100000000
, txout_script_pubkey = hex "0014abcdef1234567890"
}
- witness = Witness
+ wit = Witness
[ hex "304402201234"
, hex "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798"
]
@@ -329,7 +334,7 @@ edge_empty_scriptsig = H.testCase "empty scriptSig" $
{ tx_version = 2
, tx_inputs = txin :| []
, tx_outputs = txout :| []
- , tx_witnesses = [witness]
+ , tx_witnesses = [wit]
, tx_locktime = 0
}
txin = TxIn
@@ -344,7 +349,7 @@ edge_empty_scriptsig = H.testCase "empty scriptSig" $
{ txout_value = 1000
, txout_script_pubkey = hex "0014abcdef"
}
- witness = Witness [hex "3044", hex "02"]
+ wit = Witness [hex "3044", hex "02"]
-- Maximum sequence number (0xffffffff)
edge_max_sequence :: TestTree
@@ -494,6 +499,63 @@ test_from_bytes_garbage =
H.assertEqual "should be Nothing"
Nothing (from_bytes (BS.pack [0xde, 0xad]))
+-- from_bytes: a compactSize length >= 2^63 is rejected (it used to wrap
+-- to a negative Int and crash with a negative index)
+test_from_bytes_huge_length :: TestTree
+test_from_bytes_huge_length =
+ H.testCase "from_bytes rejects huge lengths without crashing" $ do
+ let prefix = hex "0100000001" <> BS.replicate 36 0x00
+ script_len = hex "ff0000000000000080"
+ H.assertEqual "scriptSig" Nothing
+ (from_bytes (prefix <> script_len <> hex "ffffffff"))
+ H.assertEqual "maximal" Nothing
+ (from_bytes (prefix <> hex "ffffffffffffffffff" <> hex "ffffffff"))
+
+-- from_bytes: a count exceeding the remaining input is rejected (a huge
+-- witness item count used to wrap negative and parse as zero items)
+test_from_bytes_huge_count :: TestTree
+test_from_bytes_huge_count =
+ H.testCase "from_bytes rejects counts exceeding the input" $ do
+ let tx = mconcat
+ [ hex "0100000000010100", BS.replicate 35 0x00, hex "00ffffffff"
+ , hex "01", BS.replicate 8 0x00, hex "00"
+ , hex "ff0000000000000080" -- witness item count 2^63
+ , hex "00000000"
+ ]
+ H.assertEqual "witness item count" Nothing (from_bytes tx)
+ H.assertEqual "input count" Nothing
+ (from_bytes (hex "01000000ffffffffffffffffff00000000"))
+
+-- from_bytes: a segwit marker and flag with only empty witnesses is
+-- invalid (Bitcoin Core: "superfluous witness record")
+test_from_bytes_superfluous_witness :: TestTree
+test_from_bytes_superfluous_witness =
+ H.testCase "from_bytes rejects a segwit tx with no witness data" $ do
+ let tx = mconcat
+ [ hex "0100000000010100", BS.replicate 35 0x00, hex "00ffffffff"
+ , hex "01", BS.replicate 8 0x00, hex "00"
+ , hex "00" -- empty witness stack
+ , hex "00000000"
+ ]
+ H.assertEqual "should be Nothing" Nothing (from_bytes tx)
+
+-- to_bytes: all-empty witnesses serialise in the legacy format
+test_to_bytes_empty_witnesses :: TestTree
+test_to_bytes_empty_witnesses =
+ H.testCase "to_bytes uses the legacy format for empty witnesses" $ do
+ let tx = legacyTx1 { tx_witnesses = map (const (Witness []))
+ (NE.toList (tx_inputs legacyTx1)) }
+ H.assertEqual "legacy" (to_bytes_legacy tx) (to_bytes tx)
+
+-- every transaction fixture literal parses
+test_fixtures_parse :: TestTree
+test_fixtures_parse =
+ H.testCase "fixtures parse" $ do
+ H.assertBool "BIP143 P2SH-P2WSH" (is_just (from_base16 p2shP2wshTxHex))
+ H.assertBool "BIP341" (is_just (from_base16 bip341TxHex))
+ where
+ is_just = maybe False (const True)
+
-- from_base16: invalid hex rejected
test_from_base16_invalid_hex :: TestTree
test_from_base16_invalid_hex =
@@ -695,11 +757,13 @@ genSegwitTx = do
ver <- arbitrary
ins <- arbitraryNonEmpty
outs <- arbitraryNonEmpty
- -- One witness per input
+ -- One witness per input, at least one of them non-empty (a segwit
+ -- serialisation requires witness data)
let numInputs = NE.length ins
- wits <- vectorOf numInputs arbitrary
+ w0 <- Witness <$> listOf1 arbitraryScript
+ ws <- vectorOf (numInputs - 1) arbitrary
lt <- arbitrary
- pure $ Tx ver ins outs wits lt
+ pure $ Tx ver ins outs (w0 : ws) lt
-- | Generate any valid transaction.
instance Arbitrary Tx where
@@ -914,16 +978,22 @@ txid_first_segwit = H.testCase "txid of first-segwit fixture" $
-- Shared fixture: unsigned tx, scriptCode, input index, value.
-- Source: https://github.com/bitcoin/bips/blob/master/bip-0143.mediawiki
p2shP2wshTx :: Tx
-p2shP2wshTx =
- let raw = mconcat
- [ "010000000136641869ca081e70f394c6948e8af409e18b619df2ed74aa106c"
- , "1ca29787b96e0100000000ffffffff0200e9a435000000001976a914389ffc"
- , "e9cd9ae88dcc0631e88a821ffdbe9bfe2688acc0832f05000000001976a914"
- , "7480a33f950689af511e6e84c138dbbd3c3ee41588ac00000000"
- ]
- in case from_base16 raw of
- Just t -> t
- Nothing -> error "BIP143 P2SH-P2WSH fixture failed to parse"
+p2shP2wshTx = maybe placeholder_tx id (from_base16 p2shP2wshTxHex)
+
+p2shP2wshTxHex :: BS.ByteString
+p2shP2wshTxHex = mconcat
+ [ "010000000136641869ca081e70f394c6948e8af409e18b619df2ed74aa106c"
+ , "1ca29787b96e0100000000ffffffff0200e9a435000000001976a914389ffc"
+ , "e9cd9ae88dcc0631e88a821ffdbe9bfe2688acc0832f05000000001976a914"
+ , "7480a33f950689af511e6e84c138dbbd3c3ee41588ac00000000"
+ ]
+
+-- | A minimal transaction standing in for a fixture that fails to parse
+-- (which the "fixtures parse" test reports).
+placeholder_tx :: Tx
+placeholder_tx = Tx 1
+ (TxIn (OutPoint (TxId (BS.replicate 32 0x00)) 0) BS.empty 0 :| [])
+ (TxOut 0 BS.empty :| []) [] 0
p2shP2wshScriptCode :: BS.ByteString
p2shP2wshScriptCode = hex $ mconcat
@@ -1161,11 +1231,11 @@ prop_strip_codesep_no_0xab_unchanged =
-- Shared fixture: 9-input / 2-output transaction from BIP341
-- wallet-test-vectors.json (keyPathSpending[0]).
bip341Tx :: Tx
-bip341Tx = case from_base16 bip341TxHex of
- Just t -> t
- Nothing -> error "BIP341 tx fixture failed to parse"
- where
- bip341TxHex = "020000000001097de20cbff686da83a54981d2b9bab3586f4ca7e48f57f5b55963115f3b334e9c010000000000000000d7b7cab57b1393ace2d064f4d4a2cb8af6def61273e127517d44759b6dafdd990000000000fffffffff8e1f583384333689228c5d28eac13366be082dc57441760d957275419a41842000000006b4830450221008f3b8f8f0537c420654d2283673a761b7ee2ea3c130753103e08ce79201cf32a022079e7ab904a1980ef1c5890b648c8783f4d10103dd62f740d13daa79e298d50c201210279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798fffffffff0689180aa63b30cb162a73c6d2a38b7eeda2a83ece74310fda0843ad604853b0100000000feffffffaa5202bdf6d8ccd2ee0f0202afbbb7461d9264a25e5bfd3c5a52ee1239e0ba6c0000000000feffffff956149bdc66faa968eb2be2d2faa29718acbfe3941215893a2a3446d32acd050000000000000000000e664b9773b88c09c32cb70a2a3e4da0ced63b7ba3b22f848531bbb1d5d5f4c94010000000000000000e9aa6b8e6c9de67619e6a3924ae25696bb7b694bb677a632a74ef7eadfd4eabf0000000000ffffffffa778eb6a263dc090464cd125c466b5a99667720b1c110468831d058aa1b82af10100000000ffffffff0200ca9a3b000000001976a91406afd46bcdfd22ef94ac122aa11f241244a37ecc88ac807840cb0000000020ac9a87f5594be208f8532db38cff670c450ed2fea8fcdefcc9a663f78bab962b0141ed7c1647cb97379e76892be0cacff57ec4a7102aa24296ca39af7541246d8ff14d38958d4cc1e2e478e4d4a764bbfd835b16d4e314b72937b29833060b87276c030141052aedffc554b41f52b521071793a6b88d6dbca9dba94cf34c83696de0c1ec35ca9c5ed4ab28059bd606a4f3a657eec0bb96661d42921b5f50a95ad33675b54f83000141ff45f742a876139946a149ab4d9185574b98dc919d2eb6754f8abaa59d18b025637a3aa043b91817739554f4ed2026cf8022dbd83e351ce1fabc272841d2510a010140b4010dd48a617db09926f729e79c33ae0b4e94b79f04a1ae93ede6315eb3669de185a17d2b0ac9ee09fd4c64b678a0b61a0a86fa888a273c8511be83bfd6810f0247304402202b795e4de72646d76eab3f0ab27dfa30b810e856ff3a46c9a702df53bb0d8cc302203ccc4d822edab5f35caddb10af1be93583526ccfbade4b4ead350781e2f8adcd012102f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f90141a3785919a2ce3c4ce26f298c3d51619bc474ae24014bcdd31328cd8cfbab2eff3395fa0a16fe5f486d12f22a9cedded5ae74feb4bbe5351346508c5405bcfee0020141ea0c6ba90763c2d3a296ad82ba45881abb4f426b3f87af162dd24d5109edc1cdd11915095ba47c3a9963dc1e6c432939872bc49212fe34c632cd3ab9fed429c4820141bbc9584a11074e83bc8c6759ec55401f0ae7b03ef290c3139814f545b58a9f8127258000874f44bc46db7646322107d4d86aec8e73b8719a61fff761d75b5dd9810065cd1d"
+bip341Tx = maybe placeholder_tx id (from_base16 bip341TxHex)
+
+bip341TxHex :: BS.ByteString
+bip341TxHex =
+ "020000000001097de20cbff686da83a54981d2b9bab3586f4ca7e48f57f5b55963115f3b334e9c010000000000000000d7b7cab57b1393ace2d064f4d4a2cb8af6def61273e127517d44759b6dafdd990000000000fffffffff8e1f583384333689228c5d28eac13366be082dc57441760d957275419a41842000000006b4830450221008f3b8f8f0537c420654d2283673a761b7ee2ea3c130753103e08ce79201cf32a022079e7ab904a1980ef1c5890b648c8783f4d10103dd62f740d13daa79e298d50c201210279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798fffffffff0689180aa63b30cb162a73c6d2a38b7eeda2a83ece74310fda0843ad604853b0100000000feffffffaa5202bdf6d8ccd2ee0f0202afbbb7461d9264a25e5bfd3c5a52ee1239e0ba6c0000000000feffffff956149bdc66faa968eb2be2d2faa29718acbfe3941215893a2a3446d32acd050000000000000000000e664b9773b88c09c32cb70a2a3e4da0ced63b7ba3b22f848531bbb1d5d5f4c94010000000000000000e9aa6b8e6c9de67619e6a3924ae25696bb7b694bb677a632a74ef7eadfd4eabf0000000000ffffffffa778eb6a263dc090464cd125c466b5a99667720b1c110468831d058aa1b82af10100000000ffffffff0200ca9a3b000000001976a91406afd46bcdfd22ef94ac122aa11f241244a37ecc88ac807840cb0000000020ac9a87f5594be208f8532db38cff670c450ed2fea8fcdefcc9a663f78bab962b0141ed7c1647cb97379e76892be0cacff57ec4a7102aa24296ca39af7541246d8ff14d38958d4cc1e2e478e4d4a764bbfd835b16d4e314b72937b29833060b87276c030141052aedffc554b41f52b521071793a6b88d6dbca9dba94cf34c83696de0c1ec35ca9c5ed4ab28059bd606a4f3a657eec0bb96661d42921b5f50a95ad33675b54f83000141ff45f742a876139946a149ab4d9185574b98dc919d2eb6754f8abaa59d18b025637a3aa043b91817739554f4ed2026cf8022dbd83e351ce1fabc272841d2510a010140b4010dd48a617db09926f729e79c33ae0b4e94b79f04a1ae93ede6315eb3669de185a17d2b0ac9ee09fd4c64b678a0b61a0a86fa888a273c8511be83bfd6810f0247304402202b795e4de72646d76eab3f0ab27dfa30b810e856ff3a46c9a702df53bb0d8cc302203ccc4d822edab5f35caddb10af1be93583526ccfbade4b4ead350781e2f8adcd012102f9308a019258c31049344f85f89d5229b531c845836f99b08601f113bce036f90141a3785919a2ce3c4ce26f298c3d51619bc474ae24014bcdd31328cd8cfbab2eff3395fa0a16fe5f486d12f22a9cedded5ae74feb4bbe5351346508c5405bcfee0020141ea0c6ba90763c2d3a296ad82ba45881abb4f426b3f87af162dd24d5109edc1cdd11915095ba47c3a9963dc1e6c432939872bc49212fe34c632cd3ab9fed429c4820141bbc9584a11074e83bc8c6759ec55401f0ae7b03ef290c3139814f545b58a9f8127258000874f44bc46db7646322107d4d86aec8e73b8719a61fff761d75b5dd9810065cd1d"
-- Amounts and scriptPubKeys for the 9 prevouts, in order.
bip341Amounts :: [Word64]
