haskoin-core 1.6.1 → 1.6.2

raw patch · 8 files changed

+818/−16 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +40/−0
• README.md +8/−4
• haskoin-core.cabal +2/−1
• src/Haskoin/Crypto/Signature.hs +58/−1
• src/Haskoin/Script/SigHash.hs +95/−6
• src/Haskoin/Transaction/Builder.hs +216/−4
• test/Haskoin/Crypto/SignatureSpec.hs +111/−0
• test/Haskoin/Transaction/VerdictSpec.hs +288/−0

@@ -5,6 +5,46 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## [Unreleased]++## [1.6.2] - 2026-11-12++### Added++- `judgeInputs` says of each input of a transaction whether its+  signature verifies, is forged, or cannot be told without running a+  script (`InputVerdict`). `verifyStdTx` answers no both for a forged+  signature and for a script it does not read; to refuse a transaction+  before sending it, the two have to be told apart. "Forged" is said only+  of a coin locked to one key, spent with the items such a coin takes and+  a hash type of all.+- `verifyCashSchnorr` verifies a Schnorr signature of Bitcoin Cash, which+  is not the one of BIP 340 and has no function in libsecp256k1. It is+  held to the test vectors of Bitcoin Cash Node.+- `splitTokenPrefix` takes the token prefix off the script of an output of+  Bitcoin Cash, and `txSigHashCashToken` is the digest of a coin that holds+  tokens. `judgeInputs` uses both, and reads Schnorr signatures, so it+  verifies inputs on Bitcoin Cash that `verifyStdInput` does not. The+  tests hold it to two transactions signed by Bitcoin Cash Node 29.2.0,+  one of them spending tokens.+- `judgeInputs` verifies a multisig of Bitcoin Cash signed with Schnorr+  signatures, where a field of bits in place of the empty first item says+  which keys signed, as `OP_CHECKMULTISIG` of Bitcoin Cash Node reads it.+- `verifyStdInput`, `verifyStdTx` and `judgeInputs` verify the multisig+  of Taproot: a script path whose leaf is `multi_a` of the output+  descriptors, with `OP_CHECKSIGADD`.++### Changed++- `stack.yaml` builds against secp256k1-haskell 2.0.1. The README's Stack+  example names that version and the current haskoin-core release. The+  package and its bounds are unchanged.+- The README shows a badge with the status of CI on `master`.+- The Nix CI job deletes Stack's cached Setup programs before building. One+  restored from an older nixos-unstable cache was linked against Nix store+  paths missing on the runner, and the build failed with "posix_spawnp: does+  not exist".+ ## [1.6.1] - 2026-11-06  ### Changed

@@ -1,5 +1,6 @@ # Haskoin Core +[![CI](https://github.com/jprupp/haskoin-core/actions/workflows/ci.yml/badge.svg)](https://github.com/jprupp/haskoin-core/actions/workflows/ci.yml) [![Hackage](https://img.shields.io/hackage/v/haskoin-core.svg)](https://hackage.haskell.org/package/haskoin-core) [![License: MIT](https://img.shields.io/badge/license-MIT-blue.svg)](https://github.com/jprupp/haskoin-core/blob/master/LICENSE) @@ -54,8 +55,11 @@ - **A script interpreter.** `verifyStdTx` recognises the standard templates. It   is not a consensus check. - **Signet, output descriptors, Miniscript and MuSig2.**-- **Schnorr transaction signatures, `SIGHASH_UTXOS` and token outputs of Bitcoin-  Cash.** An input or an output that uses them does not decode or verify.+- **Signing with Schnorr signatures, `SIGHASH_UTXOS` and token outputs of+  Bitcoin Cash.** `judgeInputs` verifies a Schnorr signature, of one key+  or in a multisig, and the spend of a coin that holds tokens.+  Nothing here signs them, `verifyStdTx` does not read them, and an+  output with tokens has no address. - **BIP-324 encrypted transport.** - **BIP-39 word lists other than English.** @@ -111,9 +115,9 @@ ```yaml resolver: nightly-2026-10-28 extra-deps:-  - haskoin-core-1.6.0+  - haskoin-core-1.6.2   - base16-2.0-  - secp256k1-haskell-2.0.0+  - secp256k1-haskell-2.0.1 ```  ## Quick start

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           haskoin-core-version:        1.6.1+version:        1.6.2 synopsis:       Bitcoin & Bitcoin Cash library for Haskell description:    Please see the README on GitHub at <https://github.com/jprupp/haskoin-core#readme> category:       Bitcoin, Finance, Network@@ -174,6 +174,7 @@       Haskoin.ScriptSpec       Haskoin.Transaction.PsbtSpec       Haskoin.Transaction.TaprootSpec+      Haskoin.Transaction.VerdictSpec       Haskoin.TransactionSpec       Haskoin.UtilSpec       Paths_haskoin_core

@@ -22,6 +22,9 @@     isCanonicalHalfOrder,     decodeStrictSig,     exportSig,++    -- * Schnorr signatures of Bitcoin Cash+    verifyCashSchnorr,   ) where @@ -31,11 +34,12 @@ import Data.Aeson.Encoding import Data.Binary (Binary (..)) import Data.ByteString (ByteString)+import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as L import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial-import Data.Maybe (fromMaybe)+import Data.Maybe (catMaybes, fromMaybe) import Data.Serialize (Serialize (..)) import Haskoin.Crypto.Hash import Haskoin.Util.Helpers@@ -109,3 +113,56 @@ -- block chain. Use 'isCanonicalHalfOrder' for the low-S relay rule. decodeStrictSig :: Ctx -> ByteString -> Maybe Sig decodeStrictSig = importSig++-- | Verify a Schnorr signature of Bitcoin Cash: 64 bytes, @r@ then @s@,+-- of a public key over a 32-byte digest.+--+-- Bitcoin Cash has had these in @OP_CHECKSIG@ since May 2019, where a+-- signature of 64 bytes and the hash type byte is one, and most of its+-- wallets make them. They are not the Schnorr signatures of BIP 340,+-- which Taproot uses: the key is a full public key and not its x+-- coordinate, the challenge is a plain SHA-256 of @r@, the compressed+-- key and the digest, and @R@ is told from its negation by its y+-- coordinate being a square. libsecp256k1 has no function for them, so+-- this builds the check out of the operations it has on points:+--+-- > e = SHA-256(r || compressed P || m) mod n+-- > R = s*G - e*P+-- > valid when R is not at infinity, x(R) = r, and y(R) is a square mod p+--+-- This is the check of @secp256k1_schnorr_sig_verify@ in Bitcoin Cash+-- Node, and the tests hold it to the test vectors of that code. It only+-- verifies: nothing here is secret, so it is not written to run in+-- constant time.+verifyCashSchnorr :: Ctx -> PubKey -> ByteString -> Hash256 -> Bool+verifyCashSchnorr ctx pub sig h+  | BS.length sig /= 64 = False+  | r >= fieldP || s >= orderN = False+  | otherwise = case combined of+      Nothing -> False+      Just point ->+        let (x, y) = BS.splitAt 32 (BS.drop 1 (exportPubKey ctx False point))+         in bsToInteger x == r && isSquare (bsToInteger y)+  where+    (rBytes, sBytes) = BS.splitAt 32 sig+    r = bsToInteger rBytes+    s = bsToInteger sBytes+    digest = runPutS (serialize h)+    e = bsToInteger (runPutS (serialize (sha256 (rBytes <> exportPubKey ctx True pub <> digest)))) `mod` orderN+    -- s*G, when s is not zero+    sG = derivePubKey ctx <$> secKey (word256 s)+    -- -e*P, when e is not zero+    eP = tweak (word256 ((orderN - e) `mod` orderN)) >>= tweakMulPubKey ctx pub+    -- their sum, which is nothing when it is the point at infinity+    combined = case catMaybes [sG, eP] of+      [] -> Nothing+      points -> combinePubKeys ctx points+    -- Euler's criterion+    isSquare y = powMod y ((fieldP - 1) `div` 2) fieldP == 1+    word256 n = let b = integerToBS n in BS.replicate (32 - BS.length b) 0 <> b+    fieldP = 2 ^ (256 :: Int) - 2 ^ (32 :: Int) - 977 :: Integer+    orderN = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141 :: Integer+    powMod _ 0 _ = 1+    powMod b k m+      | even k = let half = powMod b (k `div` 2) m in half * half `mod` m+      | otherwise = b * powMod b (k - 1) m `mod` m

@@ -41,6 +41,8 @@     sigHashAddNetworkId,     txSigHash,     txSigHashForkId,+    txSigHashCashToken,+    splitTokenPrefix,     TxSignature (..),     decodeTxSig,     encodeTxSig,@@ -356,12 +358,15 @@ --   digest. 'isSigHashUnknown' treats the bit as undefined, so 'decodeTxSig' --   refuses such a signature. ----- * Coins that hold tokens. Their digest also covers the token data, and---   their output script starts with the prefix byte 0xef, which---   'Haskoin.Script.Standard.decodeOutput' does not read. A signature made---   here for such a coin is not valid.+-- * Coins that hold tokens, in this function. Their digest also covers the+--   token data, and their output script starts with the prefix byte 0xef,+--   which 'Haskoin.Script.Standard.decodeOutput' does not read. Their+--   digest is 'txSigHashCashToken', with the prefix that 'splitTokenPrefix'+--   takes off the script. ----- * Schnorr signatures, see 'TxSignature'.+-- * Schnorr signatures as a 'TxSignature'. They are verified by+--   'Haskoin.Crypto.Signature.verifyCashSchnorr', and by+--   'Haskoin.Transaction.Builder.judgeInputs' in an input. -- -- Fails when the input index is not an index of the transaction. txSigHashForkId ::@@ -378,7 +383,33 @@   SigHash ->   -- | hash to be signed   Either String Hash256-txSigHashForkId net tx out v i sh+txSigHashForkId net tx = txSigHashCashToken net tx B.empty++-- | 'txSigHashForkId' for a coin of Bitcoin Cash that holds tokens. The+-- digest of such a coin also covers its token prefix, the bytes that+-- 'splitTokenPrefix' takes off the front of its output script, which go in+-- right before the script. With an empty prefix this is 'txSigHashForkId'.+--+-- The outputs of the transaction need nothing done: on the wire the+-- prefix of an output is part of its script field, and so it is in the+-- 'TxOut' that is hashed.+txSigHashCashToken ::+  Network ->+  -- | transaction to sign+  Tx ->+  -- | token prefix of the output being spent, or empty+  ByteString ->+  -- | script from output being spent, without the prefix+  Script ->+  -- | value of output being spent+  Word64 ->+  -- | index of input being signed+  Int ->+  -- | what to sign+  SigHash ->+  -- | hash to be signed+  Either String Hash256+txSigHashCashToken net tx prefix out v i sh   | i < 0 || i >= length tx.inputs =       Left "txSigHashForkId: input index out of range"   | otherwise = Right . doubleSHA256 . runPutS $ do@@ -386,6 +417,7 @@     serialize hashPrevouts     serialize hashSequence     serialize (tx.inputs !! i).outpoint+    putByteString prefix     putScript out     putWord64le v     putWord32le (tx.inputs !! i).sequence@@ -416,6 +448,63 @@       putByteString encodedScript     zeros :: Hash256     zeros = "0000000000000000000000000000000000000000000000000000000000000000"++-- | Split the script field of an output of Bitcoin Cash into its token+-- prefix and the output script after it. An output without tokens has an+-- empty prefix. 'Nothing' for a prefix that is not well formed.+--+-- Since May 2023 an output may hold tokens (CashTokens). They are written+-- at the front of its script field: the byte @0xef@, the 32 bytes of the+-- token category, a byte of flags, and after it a commitment with its+-- length and an amount, each when its flag is set. What follows is the+-- output script that locks the coin.+splitTokenPrefix :: ByteString -> Maybe (ByteString, ByteString)+splitTokenPrefix bytes+  | B.null bytes || B.head bytes /= 0xef = Just (B.empty, bytes)+  | B.length bytes < 34 = Nothing+  | flags .&. 0x80 /= 0 = Nothing+  -- tokens of some kind, a commitment only with a non-fungible one, and+  -- a capability of none, mutable or minting, only with one too+  | not hasNft && not hasAmount = Nothing+  | not hasNft && (hasCommitment || capability /= 0) = Nothing+  | capability > 2 = Nothing+  | otherwise = do+      afterCommitment <-+        if hasCommitment+          then do+            (n, rest) <- compact afterFlags+            if n == 0 || fromIntegral (B.length rest) < n then Nothing else Just (B.drop (fromIntegral n) rest)+          else Just afterFlags+      afterAmount <-+        if hasAmount+          then do+            (n, rest) <- compact afterCommitment+            if n == 0 || n > 0x7fffffffffffffff then Nothing else Just rest+          else Just afterCommitment+      Just (B.splitAt (B.length bytes - B.length afterAmount) bytes)+  where+    flags = B.index bytes 33+    afterFlags = B.drop 34 bytes+    hasCommitment = flags .&. 0x40 /= 0+    hasNft = flags .&. 0x20 /= 0+    hasAmount = flags .&. 0x10 /= 0+    capability = flags .&. 0x0f+    -- a number in the compact form of the protocol, in its shortest+    -- encoding only+    compact :: ByteString -> Maybe (Word64, ByteString)+    compact b = case B.uncons b of+      Nothing -> Nothing+      Just (w, rest)+        | w < 0xfd -> Just (fromIntegral w, rest)+        | w == 0xfd -> sized 2 0xfd rest+        | w == 0xfe -> sized 4 0x10000 rest+        | otherwise -> sized 8 0x100000000 rest+    sized k least rest+      | B.length rest < k = Nothing+      | n < least = Nothing+      | otherwise = Just (n, B.drop k rest)+      where+        n = B.foldr (\w acc -> acc `shiftL` 8 .|. fromIntegral w) 0 (B.take k rest)  -- | Data type representing a signature together with a 'SigHash'. The 'SigHash' -- is serialized as one byte at the end of an ECDSA 'Sig'. All signatures in

@@ -35,6 +35,8 @@     mergeTxInput,     findSigInput,     verifyStdInput,+    InputVerdict (..),+    judgeInputs,      -- * Coin Selection     Coin (..),@@ -59,7 +61,10 @@ import Control.Monad (foldM, unless, when) import Control.Monad.Identity (runIdentity) import Crypto.Secp256k1+import Data.Bits (popCount, testBit) import Data.ByteString qualified as B+import Data.Bytes.Get (runGetS)+import Data.Bytes.Serial (deserialize) import Data.Conduit (ConduitT, Void, await, runConduit, (.|)) import Data.Conduit.List (sourceList) import Data.Either (fromRight, rights)@@ -771,9 +776,14 @@ -- pay-to-public-key, pay-to-public-key-hash, multisig and pay-to-script-hash -- inputs, their SegWit forms, native or nested in pay-to-script-hash, and -- Taproot inputs spent by the key path or by a script path whose leaf is a--- single key check. An input that is not a witness program must have no--- witness, as @VerifyScript@ requires in Bitcoin Core. Other script path--- spends need script execution and are not verified: they are refused.+-- single key check or a multisig. The multisig of Taproot is @multi_a@ of+-- the output descriptors: a key and @OP_CHECKSIG@, then a key and+-- @OP_CHECKSIGADD@ for each other key, the number of signatures asked+-- for, and @OP_NUMEQUAL@; its witness has an item for every key, that of+-- the last key first, empty for a key that did not sign. An input that+-- is not a witness program must have no witness, as @VerifyScript@+-- requires in Bitcoin Core. Other script path spends need script+-- execution and are not verified: they are refused. -- -- The answer is never 'True' for an input that no block can contain: --@@ -941,8 +951,210 @@                 leafKey <- maybe (Left "not an x-only key") Right (importXOnlyPubKey ctx keyBytes)                 (sig, h) <- schnorr sigBytes spd.annex (Just (leafHash spd.leafVersion spd.script, 0xffffffff))                 return (verifyScriptPathData ctx outKey spd && verifySchnorr ctx leafKey sig (hashToMsg h))-          _ -> Left "script path spends other than a single key check are not verified"+          -- The multisig of Taproot, @multi_a@ of the output descriptors:+          -- a key and OP_CHECKSIG, then a key and OP_CHECKSIGADD for each+          -- other key, the number of signatures asked for, and+          -- OP_NUMEQUAL. The witness has an item for every key, that of+          -- the last key first: a signature, or nothing for a key that+          -- did not sign. A signature that does not verify fails the+          -- script, it does not count for nothing (BIP 342).+          (ops, items)+            | spd.leafVersion == tapscriptLeafVersion,+              Just (keys, asked) <- multiA ops,+              length items == length keys -> do+                let leaf = Just (leafHash spd.leafVersion spd.script, 0xffffffff)+                    signs keyBytes sigBytes+                      | B.null sigBytes = Right False+                      | otherwise = do+                          key <- maybe (Left "not an x-only key") Right (importXOnlyPubKey ctx keyBytes)+                          (sig, h) <- schnorr sigBytes spd.annex leaf+                          if verifySchnorr ctx key sig (hashToMsg h)+                            then Right True+                            else Left "a signature that does not verify"+                signed <- sequence (zipWith signs keys (reverse items))+                return (verifyScriptPathData ctx outKey spd && length (filter id signed) == asked)+          _ -> Left "script path spends other than key checks are not verified"         Nothing -> Left "not a Taproot witness"++-- | What can be said of the signature of an input without running its+-- script.+data InputVerdict+  = -- | the input is one of the standard kinds and its signatures verify+    -- ('verifyStdInput')+    InputVerified+  | -- | the input spends a coin locked to one key, with the signature and+    -- key that such a coin takes, and they do not open it: no node takes+    -- the transaction+    InputForged+  | -- | neither: a script that is not run here, a coin that was not+    -- given, a hash type other than all, an encoding that is not read+    InputUndecided+  deriving (Eq, Show)++-- | Judge each input of a transaction, given the output it spends, in+-- order, as it is in the transaction that made it: 'Nothing' for one that+-- is not known.+--+-- 'verifyStdTx' answers 'False' both for a forged signature and for a+-- script it does not read. To refuse a transaction before sending it,+-- those have to be told apart: a wrong 'InputForged' turns away a good+-- transaction, while 'InputUndecided' only leaves the question to a+-- node. So 'InputForged' is said of little, and only where there is+-- nothing to run:+--+-- * a coin locked to a key hash, to a key, to a witness key hash, to one+--   nested in a script hash, or to a Taproot key, spent by the key and+--   not by a script;+-- * with exactly the items such an input has, and a hash type of all;+-- * whose key is not the one the coin names, or whose signature does not+--   verify over the digest.+--+-- On Bitcoin Cash it reads what 'verifyStdInput' does not: a Schnorr+-- signature ('verifyCashSchnorr'), of one key or in a multisig, bare or in+-- a script hash, and a coin that holds tokens, whose digest covers them+-- ('txSigHashCashToken'). Inputs of those kinds are 'InputVerified' here+-- and not by 'verifyStdInput'. A multisig is never 'InputForged': one+-- that does not verify is 'InputUndecided'.+judgeInputs :: Network -> Ctx -> Tx -> [Maybe TxOut] -> [InputVerdict]+judgeInputs net ctx tx given = zipWith judge [0 ..] decoded+  where+    prevs = take (length tx.inputs) (given <> repeat Nothing)+    forked = net.sigHashForkId /= Nothing+    split bytes+      | forked = splitTokenPrefix bytes+      | otherwise = Just (B.empty, bytes)+    decoded = map (>>= decode) prevs+    decode o = do+      (prefix, script) <- split o.script+      so <- eitherToMaybe (unmarshal ctx script)+      return (prefix, so, o.value)+    spent =+      SpentCoins+        { coins = [d >>= \(prefix, so, v) -> if B.null prefix then Just (so, v) else Nothing | d <- decoded],+          outputs = sequence prevs+        }+    judge :: Int -> Maybe (B.ByteString, ScriptOutput, Word64) -> InputVerdict+    judge _ Nothing = InputUndecided+    judge i (Just (prefix, so, val))+      | B.null prefix && verifyInput net ctx tx spent i = InputVerified+      | otherwise = case so of+          PayPKHash h+            | null ws, Just [sig, pub] <- pushes -> keyed (addressHash pub == h) sig pub legacy+          PayPK pub+            | null ws, Just [sig] <- pushes -> signed sig pub.point legacy+          PayWitnessPKHash h+            | net.segWit, B.null inp, [sig, pub] <- ws -> keyed (addressHash pub == h) sig pub (segwit so)+          PayScriptHash h+            | net.segWit,+              Just [program] <- pushes,+              addressHash program == h,+              Right nested@(PayWitnessPKHash kh) <- unmarshal ctx program,+              [sig, pub] <- ws ->+                keyed (addressHash pub == kh) sig pub (segwit nested)+          PayWitness 1 program+            | net.segWit, B.length program == 32, B.null inp, [sig] <- ws -> taproot program sig+          PayMulSig keys asked+            | forked, null ws, Just (bits : sigs) <- pushes -> cashMultisig so keys asked bits sigs+          PayScriptHash h+            | forked,+              null ws,+              Just items@(_ : _ : _) <- pushes,+              addressHash (last items) == h,+              Right redeem@(PayMulSig keys asked) <- unmarshal ctx (last items),+              bits : sigs <- init items ->+                cashMultisig redeem keys asked bits sigs+          _ -> InputUndecided+      where+        inp = (tx.inputs !! i).script+        ws = if length tx.witness > i then tx.witness !! i else []+        -- the items of an input script that only pushes data+        pushes = case runGetS deserialize inp of+          Right (Script ops) -> mapM pushed ops+          Left _ -> Nothing+        -- a small number is pushed by an opcode of its own+        pushed = \case+          OP_PUSHDATA d _ -> Just d+          op -> B.singleton . fromIntegral <$> eitherToMaybe (scriptOpToInt op)+        legacy sh = do+          script <- encodeOutput ctx so+          if forked then txSigHashCashToken net tx prefix script val i sh else txSigHash net tx script val i sh+        segwit out sh = Sign.makeSigHash net ctx tx i out val sh Nothing+        -- a coin that names the hash of its key: another key does not+        -- open it, whatever it signed+        keyed named sig pub digest+          | not named = InputForged+          | otherwise = maybe InputUndecided (\k -> signed sig k digest) (importPubKey ctx pub)+        -- Forged is said of the hash type "all" only. With another hash+        -- type a signature that verifies is verified, and one that does+        -- not is left alone.+        signed sig key digest+          | B.null sig || not (readable (B.last sig)) = InputUndecided+          | otherwise = case digest (fromIntegral (B.last sig)) of+              Left _ -> InputUndecided+              Right m+                -- on Bitcoin Cash a signature of 64 bytes is a Schnorr one+                | forked && B.length body == 64 -> sure (verifyCashSchnorr ctx key body m)+                | otherwise -> maybe InputUndecided (\s -> sure (verifyHashSig ctx m s key)) (decodeStrictSig ctx body)+          where+            body = B.init sig+            sure ok+              | ok = InputVerified+              | B.last sig == (if forked then 0x41 else 0x01) = InputForged+              | otherwise = InputUndecided+        -- The hash types whose digest is computed here. On Bitcoin Cash:+        -- all, none or single, with the fork id, alone or with "anyone+        -- can pay"; not the one that covers every coin spent.+        readable ht+          | forked = ht `elem` [0x41, 0x42, 0x43, 0xc1, 0xc2, 0xc3]+          | otherwise = ht == 0x01+        -- A multisig of Bitcoin Cash signed with Schnorr signatures. In+        -- place of the empty item that a multisig takes first there is a+        -- field of bits, one for each key in the order of the script,+        -- the first key lowest, set for the keys that signed. It has+        -- exactly the bytes that hold a bit for every key, no bit past+        -- the keys, and as many bits set as signatures are asked for.+        -- The signatures follow in the order of their keys, and every+        -- one must be a Schnorr signature that verifies. This is+        -- OP_CHECKMULTISIG of Bitcoin Cash Node, since November 2019.+        cashMultisig script keys asked bits sigs+          | B.null bits = InputUndecided+          | B.length bits /= (length keys + 7) `div` 8 = InputUndecided+          | field >= 2 ^ length keys || popCount field /= asked || length sigs /= asked = InputUndecided+          | all good (zip signers sigs) = InputVerified+          | otherwise = InputUndecided+          where+            field = B.foldr (\w acc -> acc * 256 + toInteger w) 0 bits :: Integer+            signers = [k | (n, k) <- zip [0 ..] keys, testBit field n]+            good (key, sig) =+              B.length sig == 65+                && readable (B.last sig)+                && either+                  (const False)+                  (verifyCashSchnorr ctx key.point (B.init sig))+                  (encodeOutput ctx script >>= \code -> cashDigest code (fromIntegral (B.last sig)))+            cashDigest code = txSigHashCashToken net tx prefix code val i+        taproot program sig = fromRight InputUndecided $ do+          key <- maybe (Left "not a key") Right (importXOnlyPubKey ctx program)+          outs <- maybe (Left "a spent output is missing") Right spent.outputs+          TaprootSignature s sh <- decodeTaprootSig sig+          unless (sh == sigHashDefault || sh == sigHashAll) $ Left "another hash type"+          m <- taprootSigHash tx outs i sh Nothing Nothing+          return (verdict (verifySchnorr ctx key s (hashToMsg m)))+        verdict ok = if ok then InputVerified else InputForged++-- | The keys of a Taproot multisig script and the number of signatures it+-- asks for, if the script is one: see 'verifyStdInput'.+multiA :: [ScriptOp] -> Maybe ([B.ByteString], Int)+multiA (OP_PUSHDATA first OPCODE : OP_CHECKSIG : rest) = go [first] rest+  where+    go keys (OP_PUSHDATA key OPCODE : OP_CHECKSIGADD : more) = go (key : keys) more+    go keys [number, OP_NUMEQUAL]+      | Right asked <- scriptOpToInt number,+        asked <= length keys,+        all ((== 32) . B.length) keys =+          Just (reverse keys, asked)+    go _ _ = Nothing+multiA _ = Nothing  -- | Whether an output script is a Taproot output: a witness program of -- version 1 that is 32 bytes long

@@ -32,6 +32,7 @@  spec :: Spec spec = prepareContext $ \ctx -> do+  cashSchnorrSpec ctx   describe "Signature property checks" $ do     prop "verifies signature" $       forAll (arbitrarySignature ctx) $ \(m, key', sig) ->@@ -571,3 +572,113 @@  toPubKey :: Ctx -> SecKey -> PublicKey toPubKey ctx = derivePublicKey ctx . wrapSecKey True++-- | The test vectors of the Schnorr module of Bitcoin Cash Node+-- (@src\/secp256k1\/src\/modules\/schnorr\/tests_impl.h@, version 29.0.0):+-- a name, the public key, the digest, the signature, and whether it+-- verifies.+cashSchnorrVectors :: [(String, Text, Text, Text, Bool)]+cashSchnorrVectors =+  [+    ( "1",+      "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798",+      "0000000000000000000000000000000000000000000000000000000000000000",+      "787a848e71043d280c50470e8e1532b2dd5d20ee912a45dbdd2bd1dfbf187ef6\+      \7031a98831859dc34dffeedda86831842ccd0079e1f92af177f7f22cc1dced05",+      True+    ),+    ( "2",+      "02dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659",+      "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89",+      "2a298dacae57395a15d0795ddbfd1dcb564da82b0f269bc70a74f8220429ba1d\+      \1e51a22ccec35599b8f266912281f8365ffc2d035a230434a1a64dc59f7013fd",+      True+    ),+    ( "3",+      "03fac2114c2fbb091527eb7c64ecb11f8021cb45e8e7809d3c0938e4b8c0e5f84b",+      "5e2d58d8b3bcdf1abadec7829054f90dda9805aab56c77333024b9d0a508b75c",+      "00da9b08172a9b6f0466a2defd817f2d7ab437e0d253cb5395a963866b3574be\+      \00880371d01766935b92d2ab4cd5c8a2a5837ec57fed7660773a05f0de142380",+      True+    ),+    ( "4",+      "03defdea4cdb677750a420fee807eacf21eb9898ae79b9768766e4faa04a2d4a34",+      "4df3c3f68fcc83b27e9d42c90431a72499f17875c81a599b566c9889b9696703",+      "00000000000000000000003b78ce563f89a0ed9414f5aa28ad0d96d6795f9c63\+      \02a8dc32e64e86a333f20ef56eac9ba30b7246d6d25e22adb8c6be1aeb08d49d",+      True+    ),+    ( "4b",+      "031b84c5567b126440995d3ed5aaba0565d71e1834604819ff9c17f5e9d5dd078f",+      "0000000000000000000000000000000000000000000000000000000000000000",+      "52818579aca59767e3291d91b76b637bef062083284992f2d95f564ca6cb4e35\+      \30b1da849c8e8304adc0cfe870660334b3cfc18e825ef1db34cfae3dfc5d8187",+      True+    ),+    ( "6: R.y is not a quadratic residue",+      "02dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659",+      "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89",+      "2a298dacae57395a15d0795ddbfd1dcb564da82b0f269bc70a74f8220429ba1d\+      \fa16aee06609280a19b67a24e1977e4697712b5fd2943914ecd5f730901b4ab7",+      False+    ),+    ( "7: negated message hash",+      "03fac2114c2fbb091527eb7c64ecb11f8021cb45e8e7809d3c0938e4b8c0e5f84b",+      "5e2d58d8b3bcdf1abadec7829054f90dda9805aab56c77333024b9d0a508b75c",+      "00da9b08172a9b6f0466a2defd817f2d7ab437e0d253cb5395a963866b3574be\+      \d092f9d860f1776a1f7412ad8a1eb50daccc222bc8c0e26b2056df2f273efdec",+      False+    ),+    ( "8: negated s",+      "0279be667ef9dcbbac55a06295ce870b07029bfcdb2dce28d959f2815b16f81798",+      "0000000000000000000000000000000000000000000000000000000000000000",+      "787a848e71043d280c50470e8e1532b2dd5d20ee912a45dbdd2bd1dfbf187ef6\+      \8fce5677ce7a623cb20011225797ce7a8de1dc6ccd4f754a47da6c600e59543c",+      False+    ),+    ( "9: negated P",+      "03dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659",+      "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89",+      "2a298dacae57395a15d0795ddbfd1dcb564da82b0f269bc70a74f8220429ba1d\+      \1e51a22ccec35599b8f266912281f8365ffc2d035a230434a1a64dc59f7013fd",+      False+    ),+    ( "10: s * G = e * P, R at infinity",+      "02dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659",+      "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89",+      "2a298dacae57395a15d0795ddbfd1dcb564da82b0f269bc70a74f8220429ba1d\+      \8c3428869a663ed1e954705b020cbb3e7bb6ac31965b9ea4c73e227b17c5af5a",+      False+    ),+    ( "11: r not on the curve",+      "02dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659",+      "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89",+      "4a298dacae57395a15d0795ddbfd1dcb564da82b0f269bc70a74f8220429ba1d\+      \1e51a22ccec35599b8f266912281f8365ffc2d035a230434a1a64dc59f7013fd",+      False+    ),+    ( "12: r = p",+      "02dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659",+      "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89",+      "fffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffc2f\+      \1e51a22ccec35599b8f266912281f8365ffc2d035a230434a1a64dc59f7013fd",+      False+    ),+    ( "13: s = n",+      "02dff1d77f2a671c5f36183726db2341be58feae1da2deced843240f7b502ba659",+      "243f6a8885a308d313198a2e03707344a4093822299f31d0082efa98ec4e6c89",+      "2a298dacae57395a15d0795ddbfd1dcb564da82b0f269bc70a74f8220429ba1d\+      \fffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141",+      False+    )+  ]++cashSchnorrSpec :: Ctx -> Spec+cashSchnorrSpec ctx =+  describe "Schnorr signatures of Bitcoin Cash" $+    forM_ cashSchnorrVectors $ \(name, pk, digest, sig, valid) ->+      it ("vector " <> name) $ do+        let bytes = fromJust . decodeHex+            pub = fromJust (importPubKey ctx (bytes pk))+            h = either error id (S.decode (bytes digest)) :: Hash256+        verifyCashSchnorr ctx pub (bytes sig) h `shouldBe` valid

@@ -0,0 +1,288 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE OverloadedStrings #-}++module Haskoin.Transaction.VerdictSpec (spec) where++import Crypto.Secp256k1+import Data.ByteString (ByteString)+import Data.ByteString qualified as B+import Data.Bytes.Get (runGetS)+import Data.Bytes.Put (runPutS)+import Data.Bytes.Serial (deserialize, serialize)+import Data.Either (rights)+import Data.Maybe (fromJust, mapMaybe)+import Data.Word (Word64, Word8)+import Haskoin.Address+import Haskoin.Crypto+import Haskoin.Network.Constants+import Haskoin.Network.Data+import Haskoin.Script+import Haskoin.Transaction+import Haskoin.Util+import Haskoin.Util.Arbitrary+import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck++secret :: Word8 -> SecKey+secret n = fromJust (secKey (B.replicate 31 0 <> B.singleton n))++-- | The compressed bytes of the public key of a secret.+pubBytes :: Ctx -> SecKey -> ByteString+pubBytes ctx = exportPubKey ctx True . derivePubKey ctx++coin :: OutPoint+coin = OutPoint "0101010101010101010101010101010101010101010101010101010101010101" 0++-- | A transaction that spends the coin and pays most of 100,000.+spending :: ByteString -> [ByteString] -> Tx+spending inputScript witness =+  Tx+    { version = 2,+      inputs = [TxIn coin inputScript maxBound],+      outputs = [TxOut 90000 (B.replicate 25 0x51)],+      witness = [witness | not (null witness)],+      locktime = 0+    }++-- | An input script that pushes these items.+pushing :: [ByteString] -> ByteString+pushing = runPutS . serialize . Script . map opPushData++-- | Pay one satoshi less: what was signed is no longer what is there.+tampered :: Tx -> Tx+tampered tx = tx {outputs = [o {value = o.value - 1} | o <- tx.outputs]}++ecdsa :: Ctx -> SecKey -> Word8 -> Either String Hash256 -> ByteString+ecdsa ctx k hashType = either error (\h -> exportSig ctx (signHash ctx k h) <> B.singleton hashType)++-- | A Schnorr signature of Bitcoin Cash, made the plain way: this is a+-- test, and the nonce is not a secret worth keeping.+cashSchnorr :: Ctx -> SecKey -> Hash256 -> ByteString+cashSchnorr ctx k h = head (mapMaybe attempt [1 ..])+  where+    n = 0xfffffffffffffffffffffffffffffffebaaedce6af48a03bbfd25e8cd0364141 :: Integer+    p = 2 ^ (256 :: Int) - 2 ^ (32 :: Int) - 977 :: Integer+    word256 i = let b = integerToBS i in B.replicate (32 - B.length b) 0 <> b+    d = bsToInteger k.get+    attempt nonce = do+      r <- derivePubKey ctx <$> secKey (word256 nonce)+      let (x, y) = B.splitAt 32 (B.drop 1 (exportPubKey ctx False r))+          square = powMod (bsToInteger y) ((p - 1) `div` 2) == 1+          e = bsToInteger (runPutS (serialize (sha256 (x <> pubBytes ctx k <> runPutS (serialize h))))) `mod` n+      if square then Just (x <> word256 ((nonce + e * d) `mod` n)) else Nothing+    powMod _ 0 = 1 :: Integer+    powMod b i+      | even i = let half = powMod b (i `div` 2) in half * half `mod` p+      | otherwise = b * powMod b (i - 1) `mod` p++spec :: Spec+spec = prepareContext $ \ctx -> do+  let k = secret 7+      pub = pubBytes ctx k+      h160 = addressHash pub+      value = 100000 :: Word64+      prev so = Just (TxOut value (marshal ctx so))+      pkhScript = either error id (encodeOutput ctx (PayPKHash h160))+      three net tx prevOut = do+        judgeInputs net ctx tx [prevOut] `shouldBe` [InputVerified]+        judgeInputs net ctx (tampered tx) [prevOut] `shouldBe` [InputForged]+        judgeInputs net ctx tx [Nothing] `shouldBe` [InputUndecided]++  describe "judgeInputs on coins of one key" $ do+    it "tells a key hash input that verifies from a forged one, and from one it cannot see" $ do+      let unsigned = spending "" []+          sig = ecdsa ctx k 0x01 (txSigHash btc unsigned pkhScript value 0 sigHashAll)+      three btc (spending (pushing [sig, pub]) []) (prev (PayPKHash h160))+    it "says forged of another key than the one the coin names" $ do+      let other = secret 8+          unsigned = spending "" []+          sig = ecdsa ctx other 0x01 (txSigHash btc unsigned pkhScript value 0 sigHashAll)+      judgeInputs btc ctx (spending (pushing [sig, pubBytes ctx other]) []) [prev (PayPKHash h160)]+        `shouldBe` [InputForged]+    it "does the same for a witness key hash, plain and nested" $ do+      let unsigned = spending "" []+          sig = ecdsa ctx k 0x01 (txSigHashForkId btc unsigned pkhScript value 0 sigHashAll)+          program = marshal ctx (PayWitnessPKHash h160)+      three btc (spending "" [sig, pub]) (prev (PayWitnessPKHash h160))+      three btc (spending (pushing [program]) [sig, pub]) (prev (PayScriptHash (addressHash program)))+    it "does the same for a Taproot key" $ do+      let outKey = B.drop 1 pub+          out = TxOut value (marshal ctx (PayWitness 1 outKey))+          -- the secret of the key with an even y, whichever of the two it is+          signed = head (rights [signTaprootInput ctx (spending "" []) [out] 0 sigHashDefault s | s <- [k, negated]])+          negated = fromJust (secKey . (.get) =<< tweakNegate ctx =<< tweak k.get)+      three btc signed (Just out)+    it "leaves a hash type other than all, and a script, to a node" $ do+      let unsigned = spending "" []+          none = ecdsa ctx k 0x02 (txSigHash btc unsigned pkhScript value 0 sigHashNone)+      judgeInputs btc ctx (tampered (spending (pushing [none, pub]) [])) [prev (PayPKHash h160)]+        `shouldBe` [InputVerified]+      judgeInputs btc ctx (spending (pushing ["anything"]) []) [prev (PayScriptHash h160)]+        `shouldBe` [InputUndecided]++  describe "judgeInputs on Bitcoin Cash" $ do+    let unsigned = spending "" []+        digest prefix = txSigHashCashToken bch unsigned prefix pkhScript value 0 (setForkIdFlag sigHashAll)+        tokens = B.singleton 0xef <> B.replicate 32 0xaa <> B.pack [0x10, 0xfd, 0xe8, 0x03]+    it "reads a Schnorr signature" $ do+      let sig = cashSchnorr ctx k (either error id (digest "")) <> B.singleton 0x41+      B.length sig `shouldBe` 65+      three bch (spending (pushing [sig, pub]) []) (prev (PayPKHash h160))+    it "reads an ECDSA signature" $+      three bch (spending (pushing [ecdsa ctx k 0x41 (digest ""), pub]) []) (prev (PayPKHash h160))+    it "reads a coin that holds tokens, whose digest covers them" $ do+      let withTokens = Just (TxOut value (tokens <> marshal ctx (PayPKHash h160)))+      three bch (spending (pushing [ecdsa ctx k 0x41 (digest tokens), pub]) []) withTokens+      three bch (spending (pushing [cashSchnorr ctx k (either error id (digest tokens)) <> "\x41", pub]) []) withTokens+      -- signed as if the coin held none: not a signature of this coin+      judgeInputs bch ctx (spending (pushing [ecdsa ctx k 0x41 (digest ""), pub]) []) [withTokens]+        `shouldBe` [InputForged]++  describe "judgeInputs on what Bitcoin Cash Node signed" $ do+    -- Two transactions of the wallet of Bitcoin Cash Node 29.2.0 on+    -- regtest, both with Schnorr signatures. The first spends a coinbase+    -- of 50 coins to the same key and makes 1,000 fungible tokens. The+    -- second spends that output, tokens and all.+    let parse h = either error id (runGetS deserialize (fromJust (decodeHex h))) :: Tx+        genesis =+          parse+            "0200000001f28fd1cdb4293ae6bb76e580c5a3469fb926690471f3ffb798ef0a\+          \cda9886525000000006441e31c237fe3a1a45f6c32c779c78025f29bd735fa44\+          \d18c182bc1c08fbbcab25f08cbd8c1937dccd38acf37ef2bf8907e75029d622c\+          \5a9f6f5161ffe534fa2775412103bcacac8993931b1f0867991841a140425906\+          \839d26c4c906a737a4f2f29dd79effffffff01c0aff629010000003eeff28fd1\+          \cdb4293ae6bb76e580c5a3469fb926690471f3ffb798ef0acda988652510fde8\+          \0376a9145dd6bc82b5a42053b8f7802e68d296ac3578537a88ac00000000"+        spend =+          parse+            "0200000001db5f2a09c11a2aaceb0d9bfa755006380257d48dab94a73cfd4d69\+          \c2e2d122a6000000006441f52f838cf46e41b8c630334d2b6edefdb49f67fd19\+          \45ee864321da50b1fa652b6b2db4b517110ee5598cbf5193eac763a56d59bfe2\+          \e20d8f3fb9af4b08bfe340412103bcacac8993931b1f0867991841a140425906\+          \839d26c4c906a737a4f2f29dd79effffffff01806de729010000003eeff28fd1\+          \cdb4293ae6bb76e580c5a3469fb926690471f3ffb798ef0acda988652510fde8\+          \0376a9145dd6bc82b5a42053b8f7802e68d296ac3578537a88ac00000000"+        coinbase = TxOut 5000000000 (fromJust (decodeHex "76a9145dd6bc82b5a42053b8f7802e68d296ac3578537a88ac"))+    it "verifies its Schnorr signature of a coin without tokens" $ do+      judgeInputs bchRegTest ctx genesis [Just coinbase] `shouldBe` [InputVerified]+      judgeInputs bchRegTest ctx (tampered genesis) [Just coinbase] `shouldBe` [InputForged]+    it "verifies its Schnorr signature of a coin that holds tokens" $ do+      let held = head genesis.outputs+      fmap fst (splitTokenPrefix held.script) `shouldSatisfy` maybe False (not . B.null)+      judgeInputs bchRegTest ctx spend [Just held] `shouldBe` [InputVerified]+      judgeInputs bchRegTest ctx (tampered spend) [Just held] `shouldBe` [InputForged]+      -- the same coin without its tokens is another coin+      let bare = held {script = maybe held.script snd (splitTokenPrefix held.script)} :: TxOut+      judgeInputs bchRegTest ctx spend [Just bare] `shouldBe` [InputForged]++  describe "judgeInputs on a multisig of Bitcoin Cash signed with Schnorr signatures" $ do+    let secrets = map secret [11, 12, 13]+        keys = map (wrapPubKey True . derivePubKey ctx) secrets+        twoOfThree = PayMulSig keys 2+        redeem = marshal ctx twoOfThree+        locked = prev (PayScriptHash (addressHash redeem))+        code = either error id (encodeOutput ctx twoOfThree)+        digest = either error id (txSigHashForkId bch (spending "" []) code value 0 (setForkIdFlag sigHashAll))+        sign s = cashSchnorr ctx s digest <> B.singleton 0x41+        -- the field of bits is a small number, pushed by its own opcode+        spendWith bits sigs =+          spending (runPutS (serialize (Script ([bits] <> map opPushData (sigs <> [redeem]))))) []+        verdict tx = judgeInputs bch ctx tx [locked]+    it "verifies the signatures of the keys that the bits name, in the order of the keys" $ do+      verdict (spendWith OP_5 [sign (head secrets), sign (secrets !! 2)]) `shouldBe` [InputVerified]+      verdict (spendWith OP_3 [sign (head secrets), sign (secrets !! 1)]) `shouldBe` [InputVerified]+      verdict (spendWith OP_6 [sign (secrets !! 1), sign (secrets !! 2)]) `shouldBe` [InputVerified]+    it "does not verify bits that name other keys, too many or too few, or keys past the last" $ do+      let sigs = [sign (head secrets), sign (secrets !! 2)]+      verdict (spendWith OP_3 sigs) `shouldBe` [InputUndecided]+      verdict (spendWith OP_7 sigs) `shouldBe` [InputUndecided]+      verdict (spendWith OP_1 sigs) `shouldBe` [InputUndecided]+      verdict (spendWith OP_9 sigs) `shouldBe` [InputUndecided]+      -- in the other order+      verdict (spendWith OP_5 (reverse sigs)) `shouldBe` [InputUndecided]+    it "does not verify what was not signed, nor an ECDSA signature among them" $ do+      verdict (tampered (spendWith OP_5 [sign (head secrets), sign (secrets !! 2)])) `shouldBe` [InputUndecided]+      let ecdsaSig = ecdsa ctx (head secrets) 0x41 (Right digest)+      verdict (spendWith OP_5 [ecdsaSig, sign (secrets !! 2)]) `shouldBe` [InputUndecided]++  describe "verifyStdInput on a multisig of Taproot" $ do+    let secrets = map secret [11, 12, 13]+        xOnly = B.drop 1 . pubBytes ctx+        leaf =+          Script $+            [opPushData (xOnly (head secrets)), OP_CHECKSIG]+              <> concat [[opPushData (xOnly s), OP_CHECKSIGADD] | s <- drop 1 secrets]+              <> [OP_2, OP_NUMEQUAL]+        internal = derivePubKey ctx (secret 14)+        tree = TaprootOutput {internalKey = internal, mast = Just (MASTLeaf tapscriptLeafVersion leaf)}+        out = TxOut value (marshal ctx (taprootScriptOutput ctx tree))+        unsigned = spending "" []+        leafOf = Just (leafHash tapscriptLeafVersion leaf, 0xffffffff)+        digest = either error id (taprootSigHash unsigned [out] 0 sigHashDefault Nothing leafOf)+        sign s = (signSchnorr ctx s (hashToMsg digest)).get+        spendWith items =+          let path =+                ScriptPathSpend+                  ScriptPathData+                    { annex = Nothing,+                      stack = items,+                      script = leaf,+                      extIsOdd = odd (keyParity ctx (taprootOutputKey ctx tree)),+                      leafVersion = tapscriptLeafVersion,+                      internalKey = internal,+                      control = [],+                      opaqueScript = Nothing+                    }+           in unsigned {witness = [either error id (encodeTaprootWitness ctx path)]} :: Tx+        verdict tx = judgeInputs btc ctx tx [Just out]+    it "verifies two signatures of three keys, with an item for each key, the last first" $ do+      verdict (spendWith [sign (secrets !! 2), "", sign (head secrets)]) `shouldBe` [InputVerified]+      verdict (spendWith ["", sign (secrets !! 1), sign (head secrets)]) `shouldBe` [InputVerified]+      let lastTwo = spendWith [sign (secrets !! 2), sign (secrets !! 1), ""]+      verifyStdInput btc ctx lastTwo [(taprootScriptOutput ctx tree, value, coin)] 0 `shouldBe` True+    it "does not verify one signature, three, a signature of another key, or one of other outputs" $ do+      verdict (spendWith ["", "", sign (head secrets)]) `shouldBe` [InputUndecided]+      verdict (spendWith [sign (secrets !! 2), sign (secrets !! 1), sign (head secrets)]) `shouldBe` [InputUndecided]+      -- the signature of the first key where that of the third goes+      verdict (spendWith [sign (head secrets), "", sign (head secrets)]) `shouldBe` [InputUndecided]+      verdict (tampered (spendWith [sign (secrets !! 2), "", sign (head secrets)])) `shouldBe` [InputUndecided]+      -- an item for a key is missing+      verdict (spendWith [sign (secrets !! 1), sign (head secrets)]) `shouldBe` [InputUndecided]++  describe "splitTokenPrefix" $ do+    let category = B.replicate 32 0xaa+        script = "\x76\xa9"+    it "leaves a script without tokens alone" $+      splitTokenPrefix script `shouldBe` Just ("", script)+    it "takes off fungible tokens, a non-fungible one, and one with a commitment" $ do+      let fungible = "\xef" <> category <> "\x10\x05"+          nft = "\xef" <> category <> "\x22"+          committed = "\xef" <> category <> "\x70\x02\xbe\xef\xfd\x00\x01"+      splitTokenPrefix (fungible <> script) `shouldBe` Just (fungible, script)+      splitTokenPrefix (nft <> script) `shouldBe` Just (nft, script)+      splitTokenPrefix (committed <> script) `shouldBe` Just (committed, script)+    it "refuses a prefix that is not well formed" $ do+      -- no tokens at all, a commitment without a token to carry it, an+      -- amount of zero, a number not in its shortest form, and one cut short+      splitTokenPrefix ("\xef" <> category <> "\x00" <> script) `shouldBe` Nothing+      splitTokenPrefix ("\xef" <> category <> "\x50\x01\x00\x01" <> script) `shouldBe` Nothing+      splitTokenPrefix ("\xef" <> category <> "\x10\x00" <> script) `shouldBe` Nothing+      splitTokenPrefix ("\xef" <> category <> "\x10\xfd\x05\x00" <> script) `shouldBe` Nothing+      splitTokenPrefix ("\xef" <> category) `shouldBe` Nothing++  describe "judgeInputs on signed transactions" $+    prop "never says forged of an input that verifies" $+      forAll (elements [btc, bch] >>= \net -> (,) net <$> arbitrarySigningData net ctx) $ \(net, (tx, sigis, keys)) ->+        case signTx net ctx tx sigis (map (.key) keys) of+          Left _ -> property True+          Right signed ->+            let prevOf i = lookup i.outpoint [(s.outpoint, TxOut s.value (marshal ctx s.script)) | s <- sigis]+                verdicts = judgeInputs net ctx signed (map prevOf signed.inputs)+                coins = [(s.script, s.value, s.outpoint) | s <- sigis]+             in counterexample (show verdicts) $+                  InputForged `notElem` verdicts+                    && (not (verifyStdTx net ctx signed coins) || all (== InputVerified) verdicts)