{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}
{-|
Module      : Haskoin.Transaction.Builder
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX

Code to simplify transaction creation, signing, fee calculation and coin
selection.
-}
module Haskoin.Transaction.Builder
    ( -- * Transaction Builder
      buildAddrTx
    , buildTx
    , buildInput
    , SigInput(..)
    , signTx
    , signNestedWitnessTx
    , makeSignature
    , signInput
    , signNestedInput
    , verifyStdTx
    , mergeTxs
    , sigKeys
    , mergeTxInput
    , findSigInput
    , verifyStdInput
      -- * Coin Selection
    , Coin(..)
    , chooseCoins
    , chooseCoinsSink
    , chooseMSCoins
    , chooseMSCoinsSink
    , countMulSig
    , greedyAddSink
    , guessTxFee
    , guessMSTxFee
    , guessTxSize
    , guessMSSize
    ) where

import           Control.Applicative              ((<|>))
import           Control.Arrow                    (first)
import           Control.Monad                    (foldM, unless)
import           Control.Monad.Identity           (runIdentity)
import           Crypto.Secp256k1
import qualified Data.ByteString                  as B
import           Data.Conduit                     (ConduitT, Void, await,
                                                   runConduit, (.|))
import           Data.Conduit.List                (sourceList)
import           Data.Either                      (fromRight)
import           Data.List                        (nub)
import           Data.Maybe                       (catMaybes, fromJust, isJust)
import           Data.Serialize                   (decode, encode)
import           Data.String.Conversions          (cs)
import           Data.Text                        (Text)
import           Data.Word                        (Word64)
import           Haskoin.Address
import           Haskoin.Constants
import           Haskoin.Crypto.Hash              (Hash256, addressHash)
import           Haskoin.Crypto.Signature
import           Haskoin.Keys.Common
import           Haskoin.Network.Common
import           Haskoin.Script
import           Haskoin.Transaction.Builder.Sign (SigInput (..), buildInput,
                                                   makeSignature, sigKeys)
import qualified Haskoin.Transaction.Builder.Sign as S
import           Haskoin.Transaction.Common
import           Haskoin.Transaction.Segwit       (decodeWitnessInput, isSegwit,
                                                   viewWitnessProgram)
import           Haskoin.Util

-- | Any type can be used as a Coin if it can provide a value in Satoshi.
-- The value is used in coin selection algorithms.
class Coin c where
    coinValue :: c -> Word64

-- | Coin selection algorithm for normal (non-multisig) transactions. This
-- function returns the selected coins together with the amount of change to
-- send back to yourself, taking the fee into account.
chooseCoins :: Coin c
            => Word64 -- ^ value to send
            -> Word64 -- ^ fee per byte
            -> Int    -- ^ number of outputs (including change)
            -> Bool   -- ^ try to find better solutions
            -> [c]    -- ^ list of ordered coins to choose from
            -> Either String ([c], Word64)
            -- ^ coin selection and change
chooseCoins :: Word64
-> Word64 -> Int -> Bool -> [c] -> Either String ([c], Word64)
chooseCoins target :: Word64
target fee :: Word64
fee nOut :: Int
nOut continue :: Bool
continue coins :: [c]
coins =
    Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall a. Identity a -> a
runIdentity (Identity (Either String ([c], Word64))
 -> Either String ([c], Word64))
-> (ConduitT () Void Identity (Either String ([c], Word64))
    -> Identity (Either String ([c], Word64)))
-> ConduitT () Void Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void Identity (Either String ([c], Word64))
-> Identity (Either String ([c], Word64))
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void Identity (Either String ([c], Word64))
 -> Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall a b. (a -> b) -> a -> b
$
    [c] -> ConduitT () c Identity ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList [c]
coins ConduitT () c Identity ()
-> ConduitM c Void Identity (Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Word64
-> Word64
-> Int
-> Bool
-> ConduitM c Void Identity (Either String ([c], Word64))
forall (m :: * -> *) c.
(Monad m, Coin c) =>
Word64
-> Word64
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseCoinsSink Word64
target Word64
fee Int
nOut Bool
continue

-- | Coin selection algorithm for normal (non-multisig) transactions. This
-- function returns the selected coins together with the amount of change to
-- send back to yourself, taking the fee into account. This version uses a Sink
-- for conduit-based coin selection.
chooseCoinsSink :: (Monad m, Coin c)
                => Word64 -- ^ value to send
                -> Word64 -- ^ fee per byte
                -> Int    -- ^ number of outputs (including change)
                -> Bool   -- ^ try to find better solution
                -> ConduitT c Void m (Either String ([c], Word64))
                -- ^ coin selection and change
chooseCoinsSink :: Word64
-> Word64
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseCoinsSink target :: Word64
target fee :: Word64
fee nOut :: Int
nOut continue :: Bool
continue
    | Word64
target Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
        String -> Maybe ([c], Word64) -> Either String ([c], Word64)
forall b a. b -> Maybe a -> Either b a
maybeToEither String
err (Maybe ([c], Word64) -> Either String ([c], Word64))
-> ConduitT c Void m (Maybe ([c], Word64))
-> ConduitT c Void m (Either String ([c], Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
forall (m :: * -> *) c.
(Monad m, Coin c) =>
Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
greedyAddSink Word64
target (Word64 -> Int -> Int -> Word64
guessTxFee Word64
fee Int
nOut) Bool
continue
    | Bool
otherwise = Either String ([c], Word64)
-> ConduitT c Void m (Either String ([c], Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ([c], Word64)
 -> ConduitT c Void m (Either String ([c], Word64)))
-> Either String ([c], Word64)
-> ConduitT c Void m (Either String ([c], Word64))
forall a b. (a -> b) -> a -> b
$ String -> Either String ([c], Word64)
forall a b. a -> Either a b
Left "chooseCoins: Target must be > 0"
  where
    err :: String
err = "chooseCoins: No solution found"

-- | Coin selection algorithm for multisig transactions. This function returns
-- the selected coins together with the amount of change to send back to
-- yourself, taking the fee into account. This function assumes all the coins
-- are script hash outputs that send funds to a multisignature address.
chooseMSCoins :: Coin c
              => Word64     -- ^ value to send
              -> Word64     -- ^ fee per byte
              -> (Int, Int) -- ^ m of n multisig
              -> Int        -- ^ number of outputs (including change)
              -> Bool       -- ^ try to find better solution
              -> [c]
              -> Either String ([c], Word64)
              -- ^ coin selection change amount
chooseMSCoins :: Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> [c]
-> Either String ([c], Word64)
chooseMSCoins target :: Word64
target fee :: Word64
fee ms :: (Int, Int)
ms nOut :: Int
nOut continue :: Bool
continue coins :: [c]
coins =
    Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall a. Identity a -> a
runIdentity (Identity (Either String ([c], Word64))
 -> Either String ([c], Word64))
-> (ConduitT () Void Identity (Either String ([c], Word64))
    -> Identity (Either String ([c], Word64)))
-> ConduitT () Void Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void Identity (Either String ([c], Word64))
-> Identity (Either String ([c], Word64))
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void Identity (Either String ([c], Word64))
 -> Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall a b. (a -> b) -> a -> b
$
        [c] -> ConduitT () c Identity ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList [c]
coins ConduitT () c Identity ()
-> ConduitM c Void Identity (Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> ConduitM c Void Identity (Either String ([c], Word64))
forall (m :: * -> *) c.
(Monad m, Coin c) =>
Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseMSCoinsSink Word64
target Word64
fee (Int, Int)
ms Int
nOut Bool
continue

-- | Coin selection algorithm for multisig transactions. This function returns
-- the selected coins together with the amount of change to send back to
-- yourself, taking the fee into account. This function assumes all the coins
-- are script hash outputs that send funds to a multisignature address. This
-- version uses a Sink if you need conduit-based coin selection.
chooseMSCoinsSink :: (Monad m, Coin c)
                  => Word64     -- ^ value to send
                  -> Word64     -- ^ fee per byte
                  -> (Int, Int) -- ^ m of n multisig
                  -> Int        -- ^ number of outputs (including change)
                  -> Bool       -- ^ try to find better solution
                  -> ConduitT c Void m (Either String ([c], Word64))
                  -- ^ coin selection and change
chooseMSCoinsSink :: Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseMSCoinsSink target :: Word64
target fee :: Word64
fee ms :: (Int, Int)
ms nOut :: Int
nOut continue :: Bool
continue
    | Word64
target Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
        String -> Maybe ([c], Word64) -> Either String ([c], Word64)
forall b a. b -> Maybe a -> Either b a
maybeToEither String
err (Maybe ([c], Word64) -> Either String ([c], Word64))
-> ConduitT c Void m (Maybe ([c], Word64))
-> ConduitT c Void m (Either String ([c], Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
forall (m :: * -> *) c.
(Monad m, Coin c) =>
Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
greedyAddSink Word64
target (Word64 -> (Int, Int) -> Int -> Int -> Word64
guessMSTxFee Word64
fee (Int, Int)
ms Int
nOut) Bool
continue
    | Bool
otherwise = Either String ([c], Word64)
-> ConduitT c Void m (Either String ([c], Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ([c], Word64)
 -> ConduitT c Void m (Either String ([c], Word64)))
-> Either String ([c], Word64)
-> ConduitT c Void m (Either String ([c], Word64))
forall a b. (a -> b) -> a -> b
$ String -> Either String ([c], Word64)
forall a b. a -> Either a b
Left "chooseMSCoins: Target must be > 0"
  where
    err :: String
err = "chooseMSCoins: No solution found"

-- | Select coins greedily by starting from an empty solution. If the 'continue'
-- flag is set, the algorithm will try to find a better solution in the stream
-- after a solution is found. If the next solution found is not strictly better
-- than the previously found solution, the algorithm stops and returns the
-- previous solution. If the continue flag is not set, the algorithm will return
-- the first solution it finds in the stream.
greedyAddSink :: (Monad m, Coin c)
              => Word64          -- ^ value to send
              -> (Int -> Word64) -- ^ coin count to fee function
              -> Bool            -- ^ try to find better solutions
              -> ConduitT c Void m (Maybe ([c], Word64))
              -- ^ coin selection and change
greedyAddSink :: Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
greedyAddSink target :: Word64
target guessFee :: Int -> Word64
guessFee continue :: Bool
continue =
    [c]
-> Word64
-> [c]
-> Word64
-> ConduitT c Void m (Maybe ([c], Word64))
forall (m :: * -> *) a o.
(Monad m, Coin a) =>
[a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go [] 0 [] 0
  where
    -- The goal is the value we must reach (including the fee) for a certain
    -- amount of selected coins.
    goal :: Int -> Word64
goal c :: Int
c = Word64
target Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
guessFee Int
c
    go :: [a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go acc :: [a]
acc aTot :: Word64
aTot ps :: [a]
ps pTot :: Word64
pTot = ConduitT a o m (Maybe a)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT a o m (Maybe a)
-> (Maybe a -> ConduitT a o m (Maybe ([a], Word64)))
-> ConduitT a o m (Maybe ([a], Word64))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        -- A coin is available in the stream
        Just coin :: a
coin -> do
            let val :: Word64
val = a -> Word64
forall c. Coin c => c -> Word64
coinValue a
coin
            -- We have reached the goal using this coin
            if Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
aTot Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Word64
goal ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
                -- If we want to continue searching for better solutions
                then if Bool
continue
                    -- This solution is the first one or
                    -- This solution is better than the previous one
                    then if Word64
pTot Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
aTot Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
pTot
                        -- Continue searching for better solutions in the stream
                        then [a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go [] 0 (a
coina -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) (Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
aTot)
                        -- Otherwise, we stop here and return the previous
                        -- solution
                        else Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64)))
-> Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall a b. (a -> b) -> a -> b
$ ([a], Word64) -> Maybe ([a], Word64)
forall a. a -> Maybe a
Just ([a]
ps, Word64
pTot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
goal ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ps))
                    -- Otherwise, return this solution
                    else Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64)))
-> Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall a b. (a -> b) -> a -> b
$
                        ([a], Word64) -> Maybe ([a], Word64)
forall a. a -> Maybe a
Just (a
coin a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc, Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
aTot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
goal ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
                -- We have not yet reached the goal. Add the coin to the
                -- accumulator
                else [a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go (a
coina -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) (Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
aTot) [a]
ps Word64
pTot
        -- We reached the end of the stream
        Nothing ->
            Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64)))
-> Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall a b. (a -> b) -> a -> b
$ if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ps
                -- If no solution was found, return Nothing
                then Maybe ([a], Word64)
forall a. Maybe a
Nothing
                -- If we have a solution, return it
                else ([a], Word64) -> Maybe ([a], Word64)
forall a. a -> Maybe a
Just ([a]
ps, Word64
pTot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
goal ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ps))

-- | Estimate tranasction fee to pay based on transaction size estimation.
guessTxFee :: Word64 -> Int -> Int -> Word64
guessTxFee :: Word64 -> Int -> Int -> Word64
guessTxFee byteFee :: Word64
byteFee nOut :: Int
nOut nIn :: Int
nIn =
    Word64
byteFee Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> [(Int, Int)] -> Int -> Int -> Int
guessTxSize Int
nIn [] Int
nOut 0)

-- | Same as 'guessTxFee' but for multisig transactions.
guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64
guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64
guessMSTxFee byteFee :: Word64
byteFee ms :: (Int, Int)
ms nOut :: Int
nOut nIn :: Int
nIn =
    Word64
byteFee Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> [(Int, Int)] -> Int -> Int -> Int
guessTxSize 0 (Int -> (Int, Int) -> [(Int, Int)]
forall a. Int -> a -> [a]
replicate Int
nIn (Int, Int)
ms) Int
nOut 0)

-- | Computes an upper bound on the size of a transaction based on some known
-- properties of the transaction.
guessTxSize :: Int         -- ^ number of regular transaction inputs
            -> [(Int,Int)] -- ^ multisig m of n for each input
            -> Int         -- ^ number of P2PKH outputs
            -> Int         -- ^ number of P2SH outputs
            -> Int         -- ^ upper bound on transaction size
guessTxSize :: Int -> [(Int, Int)] -> Int -> Int -> Int
guessTxSize pki :: Int
pki msi :: [(Int, Int)]
msi pkout :: Int
pkout msout :: Int
msout =
    8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inpLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
out
  where
    inpLen :: Int
inpLen = ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ VarInt -> ByteString
forall a. Serialize a => a -> ByteString
encode (VarInt -> ByteString) -> VarInt -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> VarInt
VarInt (Word64 -> VarInt) -> Word64 -> VarInt
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
msi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pki
    outLen :: Int
outLen = ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ VarInt -> ByteString
forall a. Serialize a => a -> ByteString
encode (VarInt -> ByteString) -> VarInt -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> VarInt
VarInt (Word64 -> VarInt) -> Word64 -> VarInt
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Int
pkout Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
msout
    inp :: Int
inp = Int
pki Int -> Int -> Int
forall a. Num a => a -> a -> a
* 148 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
guessMSSize [(Int, Int)]
msi)
             -- (20: hash160) + (5: opcodes) +
             -- (1: script len) + (8: Word64)
    out :: Int
out =
        Int
pkout Int -> Int -> Int
forall a. Num a => a -> a -> a
* 34 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
             -- (20: hash160) + (3: opcodes) +
             -- (1: script len) + (8: Word64)
        Int
msout Int -> Int -> Int
forall a. Num a => a -> a -> a
* 32

-- | Size of a multisig P2SH input.
guessMSSize :: (Int,Int) -> Int
guessMSSize :: (Int, Int) -> Int
guessMSSize (m :: Int
m, n :: Int
n)
    -- OutPoint (36) + Sequence (4) + Script
 = 40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ VarInt -> ByteString
forall a. Serialize a => a -> ByteString
encode (VarInt -> ByteString) -> VarInt -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> VarInt
VarInt (Word64 -> VarInt) -> Word64 -> VarInt
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
scp) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
scp
    -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG
  where
    rdm :: Int
rdm =
        Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
        ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ ScriptOp -> ByteString
forall a. Serialize a => a -> ByteString
encode (ScriptOp -> ByteString) -> ScriptOp -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* 34 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3) 0
    -- Redeem + m*sig + OP_0
    scp :: Int
scp = Int
rdm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* 73 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1

{- Build a new Tx -}

-- | Build a transaction by providing a list of outpoints as inputs
-- and a list of recipient addresses and amounts as outputs.
buildAddrTx :: Network -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
buildAddrTx :: Network -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
buildAddrTx net :: Network
net ops :: [OutPoint]
ops rcps :: [(Text, Word64)]
rcps =
    [OutPoint] -> [(ScriptOutput, Word64)] -> Tx
buildTx [OutPoint]
ops ([(ScriptOutput, Word64)] -> Tx)
-> Either String [(ScriptOutput, Word64)] -> Either String Tx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Word64) -> Either String (ScriptOutput, Word64))
-> [(Text, Word64)] -> Either String [(ScriptOutput, Word64)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Word64) -> Either String (ScriptOutput, Word64)
forall b b.
(Semigroup b, IsString b, ConvertibleStrings Text b) =>
(Text, b) -> Either b (ScriptOutput, b)
f [(Text, Word64)]
rcps
  where
    f :: (Text, b) -> Either b (ScriptOutput, b)
f (aTxt :: Text
aTxt, v :: b
v) =
        b -> Maybe (ScriptOutput, b) -> Either b (ScriptOutput, b)
forall b a. b -> Maybe a -> Either b a
maybeToEither ("buildAddrTx: Invalid address " b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Text -> b
forall a b. ConvertibleStrings a b => a -> b
cs Text
aTxt) (Maybe (ScriptOutput, b) -> Either b (ScriptOutput, b))
-> Maybe (ScriptOutput, b) -> Either b (ScriptOutput, b)
forall a b. (a -> b) -> a -> b
$ do
            Address
a <- Network -> Text -> Maybe Address
textToAddr Network
net Text
aTxt
            let o :: ScriptOutput
o = Address -> ScriptOutput
addressToOutput Address
a
            (ScriptOutput, b) -> Maybe (ScriptOutput, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptOutput
o, b
v)

-- | Build a transaction by providing a list of outpoints as inputs
-- and a list of 'ScriptOutput' and amounts as outputs.
buildTx :: [OutPoint] -> [(ScriptOutput, Word64)] -> Tx
buildTx :: [OutPoint] -> [(ScriptOutput, Word64)] -> Tx
buildTx ops :: [OutPoint]
ops rcpts :: [(ScriptOutput, Word64)]
rcpts =
    Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx 1 (OutPoint -> TxIn
toIn (OutPoint -> TxIn) -> [OutPoint] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OutPoint]
ops) ((ScriptOutput, Word64) -> TxOut
toOut ((ScriptOutput, Word64) -> TxOut)
-> [(ScriptOutput, Word64)] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ScriptOutput, Word64)]
rcpts) [] 0
  where
    toIn :: OutPoint -> TxIn
toIn op :: OutPoint
op = OutPoint -> ByteString -> Word32 -> TxIn
TxIn OutPoint
op ByteString
B.empty Word32
forall a. Bounded a => a
maxBound
    toOut :: (ScriptOutput, Word64) -> TxOut
toOut (o :: ScriptOutput
o, v :: Word64
v) = Word64 -> ByteString -> TxOut
TxOut Word64
v (ByteString -> TxOut) -> ByteString -> TxOut
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> ByteString
encodeOutputBS ScriptOutput
o

-- | Sign a transaction by providing the 'SigInput' signing parameters and a
-- list of private keys. The signature is computed deterministically as defined
-- in RFC-6979.
--
-- Example: P2SH-P2WKH
--
-- > sigIn = SigInput (PayWitnessPKHash h) 100000 op sigHashAll Nothing
-- > signedTx = signTx btc unsignedTx [sigIn] [key]
--
-- Example: P2SH-P2WSH multisig
--
-- > sigIn = SigInput (PayWitnessScriptHash h) 100000 op sigHashAll (Just $ PayMulSig [p1,p2,p3] 2)
-- > signedTx = signTx btc unsignedTx [sigIn] [k1,k3]
signTx :: Network
       -> Tx               -- ^ transaction to sign
       -> [SigInput]       -- ^ signing parameters
       -> [SecKey]         -- ^ private keys to sign with
       -> Either String Tx -- ^ signed transaction
signTx :: Network -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signTx net :: Network
net tx :: Tx
tx si :: [SigInput]
si = Network -> Tx -> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
S.signTx Network
net Tx
tx ([(SigInput, Bool)] -> [SecKey] -> Either String Tx)
-> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
forall a b. (a -> b) -> a -> b
$ SigInput -> (SigInput, Bool)
forall a. a -> (a, Bool)
notNested (SigInput -> (SigInput, Bool)) -> [SigInput] -> [(SigInput, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigInput]
si
  where notNested :: a -> (a, Bool)
notNested s :: a
s = (a
s, Bool
False)

-- | This function differs from 'signTx' by assuming all segwit inputs are
-- P2SH-nested.  Use the same signing parameters for segwit inputs as in 'signTx'.
signNestedWitnessTx :: Network
                    -> Tx               -- ^ transaction to sign
                    -> [SigInput]       -- ^ signing parameters
                    -> [SecKey]         -- ^ private keys to sign with
                    -> Either String Tx -- ^ signed transaction
signNestedWitnessTx :: Network -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signNestedWitnessTx net :: Network
net tx :: Tx
tx si :: [SigInput]
si = Network -> Tx -> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
S.signTx Network
net Tx
tx ([(SigInput, Bool)] -> [SecKey] -> Either String Tx)
-> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
forall a b. (a -> b) -> a -> b
$ SigInput -> (SigInput, Bool)
forall a. a -> (a, Bool)
nested (SigInput -> (SigInput, Bool)) -> [SigInput] -> [(SigInput, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigInput]
si
  where
    -- NOTE: the nesting flag is ignored for non-segwit inputs
    nested :: a -> (a, Bool)
nested s :: a
s = (a
s, Bool
True)


-- | Sign a single input in a transaction deterministically (RFC-6979).
signInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx
signInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx
signInput net :: Network
net tx :: Tx
tx i :: Int
i si :: SigInput
si = Network
-> Tx -> Int -> (SigInput, Bool) -> SecKeyI -> Either String Tx
S.signInput Network
net Tx
tx Int
i (SigInput
si, Bool
False)

-- | Like 'signInput' but treat segwit inputs as nested
signNestedInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx
signNestedInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx
signNestedInput net :: Network
net tx :: Tx
tx i :: Int
i si :: SigInput
si = Network
-> Tx -> Int -> (SigInput, Bool) -> SecKeyI -> Either String Tx
S.signInput Network
net Tx
tx Int
i (SigInput
si, Bool
True)

-- | Order the 'SigInput' with respect to the transaction inputs. This allows
-- the user to provide the 'SigInput' in any order. Users can also provide only
-- a partial set of 'SigInput' entries.
findSigInput :: [SigInput] -> [TxIn] -> [(SigInput, Int)]
findSigInput :: [SigInput] -> [TxIn] -> [(SigInput, Int)]
findSigInput = (SigInput -> OutPoint) -> [SigInput] -> [TxIn] -> [(SigInput, Int)]
forall a. (a -> OutPoint) -> [a] -> [TxIn] -> [(a, Int)]
S.findInputIndex SigInput -> OutPoint
sigInputOP

{- Merge multisig transactions -}

-- | Merge partially-signed multisig transactions.  This function does not
-- support segwit and P2SH-segwit inputs.  Use PSBTs to merge transactions with
-- segwit inputs.
mergeTxs ::
       Network -> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx
mergeTxs :: Network
-> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx
mergeTxs net :: Network
net txs :: [Tx]
txs os :: [(ScriptOutput, Word64, OutPoint)]
os
    | [Tx] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tx]
txs = String -> Either String Tx
forall a b. a -> Either a b
Left "Transaction list is empty"
    | [Tx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Tx] -> [Tx]
forall a. Eq a => [a] -> [a]
nub [Tx]
emptyTxs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1 = String -> Either String Tx
forall a b. a -> Either a b
Left "Transactions do not match"
    | [Tx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
txs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = Tx -> Either String Tx
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx -> Either String Tx) -> Tx -> Either String Tx
forall a b. (a -> b) -> a -> b
$ [Tx] -> Tx
forall a. [a] -> a
head [Tx]
txs
    | Bool
otherwise = (Tx -> ((ScriptOutput, Word64), Int) -> Either String Tx)
-> Tx -> [((ScriptOutput, Word64), Int)] -> Either String Tx
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Network
-> [Tx] -> Tx -> ((ScriptOutput, Word64), Int) -> Either String Tx
mergeTxInput Network
net [Tx]
txs) ([Tx] -> Tx
forall a. [a] -> a
head [Tx]
emptyTxs) [((ScriptOutput, Word64), Int)]
outs
  where
    zipOp :: [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
zipOp = [Maybe (ScriptOutput, Word64, OutPoint)]
-> [Int] -> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(ScriptOutput, Word64, OutPoint)]
-> [TxIn]
-> ((ScriptOutput, Word64, OutPoint) -> TxIn -> Bool)
-> [Maybe (ScriptOutput, Word64, OutPoint)]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [(ScriptOutput, Word64, OutPoint)]
os (Tx -> [TxIn]
txIn (Tx -> [TxIn]) -> Tx -> [TxIn]
forall a b. (a -> b) -> a -> b
$ [Tx] -> Tx
forall a. [a] -> a
head [Tx]
txs) (ScriptOutput, Word64, OutPoint) -> TxIn -> Bool
forall a b. (a, b, OutPoint) -> TxIn -> Bool
f) [0 ..]
    outs :: [((ScriptOutput, Word64), Int)]
outs =
        ((Maybe (ScriptOutput, Word64, OutPoint), Int)
 -> ((ScriptOutput, Word64), Int))
-> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
-> [((ScriptOutput, Word64), Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (ScriptOutput, Word64, OutPoint) -> (ScriptOutput, Word64))
-> (Maybe (ScriptOutput, Word64, OutPoint), Int)
-> ((ScriptOutput, Word64), Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Maybe (ScriptOutput, Word64, OutPoint) -> (ScriptOutput, Word64))
 -> (Maybe (ScriptOutput, Word64, OutPoint), Int)
 -> ((ScriptOutput, Word64), Int))
-> (Maybe (ScriptOutput, Word64, OutPoint)
    -> (ScriptOutput, Word64))
-> (Maybe (ScriptOutput, Word64, OutPoint), Int)
-> ((ScriptOutput, Word64), Int)
forall a b. (a -> b) -> a -> b
$ (\(o :: ScriptOutput
o, v :: Word64
v, _) -> (ScriptOutput
o, Word64
v)) ((ScriptOutput, Word64, OutPoint) -> (ScriptOutput, Word64))
-> (Maybe (ScriptOutput, Word64, OutPoint)
    -> (ScriptOutput, Word64, OutPoint))
-> Maybe (ScriptOutput, Word64, OutPoint)
-> (ScriptOutput, Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (ScriptOutput, Word64, OutPoint)
-> (ScriptOutput, Word64, OutPoint)
forall a. HasCallStack => Maybe a -> a
fromJust) ([(Maybe (ScriptOutput, Word64, OutPoint), Int)]
 -> [((ScriptOutput, Word64), Int)])
-> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
-> [((ScriptOutput, Word64), Int)]
forall a b. (a -> b) -> a -> b
$
        ((Maybe (ScriptOutput, Word64, OutPoint), Int) -> Bool)
-> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
-> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (ScriptOutput, Word64, OutPoint) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (ScriptOutput, Word64, OutPoint) -> Bool)
-> ((Maybe (ScriptOutput, Word64, OutPoint), Int)
    -> Maybe (ScriptOutput, Word64, OutPoint))
-> (Maybe (ScriptOutput, Word64, OutPoint), Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ScriptOutput, Word64, OutPoint), Int)
-> Maybe (ScriptOutput, Word64, OutPoint)
forall a b. (a, b) -> a
fst) [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
zipOp
    f :: (a, b, OutPoint) -> TxIn -> Bool
f (_, _, o :: OutPoint
o) txin :: TxIn
txin = OutPoint
o OutPoint -> OutPoint -> Bool
forall a. Eq a => a -> a -> Bool
== TxIn -> OutPoint
prevOutput TxIn
txin
    emptyTxs :: [Tx]
emptyTxs = (Tx -> Tx) -> [Tx] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map (\tx :: Tx
tx -> (Tx -> ((ScriptOutput, Word64), Int) -> Tx)
-> Tx -> [((ScriptOutput, Word64), Int)] -> Tx
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Tx -> ((ScriptOutput, Word64), Int) -> Tx
forall a. Tx -> (a, Int) -> Tx
clearInput Tx
tx [((ScriptOutput, Word64), Int)]
outs) [Tx]
txs
    ins :: [TxIn] -> Int -> [TxIn]
ins is :: [TxIn]
is i :: Int
i = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i [TxIn]
is (\ti :: TxIn
ti -> TxIn
ti {scriptInput :: ByteString
scriptInput = ByteString
B.empty})
    clearInput :: Tx -> (a, Int) -> Tx
clearInput tx :: Tx
tx (_, i :: Int
i) =
        Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx (Tx -> Word32
txVersion Tx
tx) ([TxIn] -> Int -> [TxIn]
ins (Tx -> [TxIn]
txIn Tx
tx) Int
i) (Tx -> [TxOut]
txOut Tx
tx) [] (Tx -> Word32
txLockTime Tx
tx)

-- | Merge input from partially-signed multisig transactions.  This function
-- does not support segwit and P2SH-segwit inputs.
mergeTxInput ::
       Network
    -> [Tx]
    -> Tx
    -> ((ScriptOutput, Word64), Int)
    -> Either String Tx
mergeTxInput :: Network
-> [Tx] -> Tx -> ((ScriptOutput, Word64), Int) -> Either String Tx
mergeTxInput net :: Network
net txs :: [Tx]
txs tx :: Tx
tx ((so :: ScriptOutput
so, val :: Word64
val), i :: Int
i) = do
    -- Ignore transactions with empty inputs
    let ins :: [ByteString]
ins = (Tx -> ByteString) -> [Tx] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn -> ByteString
scriptInput (TxIn -> ByteString) -> (Tx -> TxIn) -> Tx -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxIn] -> Int -> TxIn
forall a. [a] -> Int -> a
!! Int
i) ([TxIn] -> TxIn) -> (Tx -> [TxIn]) -> Tx -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [TxIn]
txIn) [Tx]
txs
    [([TxSignature], Maybe ScriptOutput)]
sigRes <- (ByteString -> Either String ([TxSignature], Maybe ScriptOutput))
-> [ByteString]
-> Either String [([TxSignature], Maybe ScriptOutput)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Either String ([TxSignature], Maybe ScriptOutput)
forall a.
IsString a =>
ByteString -> Either a ([TxSignature], Maybe ScriptOutput)
extractSigs ([ByteString]
 -> Either String [([TxSignature], Maybe ScriptOutput)])
-> [ByteString]
-> Either String [([TxSignature], Maybe ScriptOutput)]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
B.null) [ByteString]
ins
    let rdm :: Maybe ScriptOutput
rdm = ([TxSignature], Maybe ScriptOutput) -> Maybe ScriptOutput
forall a b. (a, b) -> b
snd (([TxSignature], Maybe ScriptOutput) -> Maybe ScriptOutput)
-> ([TxSignature], Maybe ScriptOutput) -> Maybe ScriptOutput
forall a b. (a -> b) -> a -> b
$ [([TxSignature], Maybe ScriptOutput)]
-> ([TxSignature], Maybe ScriptOutput)
forall a. [a] -> a
head [([TxSignature], Maybe ScriptOutput)]
sigRes
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((([TxSignature], Maybe ScriptOutput) -> Bool)
-> [([TxSignature], Maybe ScriptOutput)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Maybe ScriptOutput -> Maybe ScriptOutput -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ScriptOutput
rdm) (Maybe ScriptOutput -> Bool)
-> (([TxSignature], Maybe ScriptOutput) -> Maybe ScriptOutput)
-> ([TxSignature], Maybe ScriptOutput)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxSignature], Maybe ScriptOutput) -> Maybe ScriptOutput
forall a b. (a, b) -> b
snd) [([TxSignature], Maybe ScriptOutput)]
sigRes) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left "Redeem scripts do not match"
    ByteString
si <- ScriptInput -> ByteString
encodeInputBS (ScriptInput -> ByteString)
-> Either String ScriptInput -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSignature]
-> ScriptOutput -> Maybe ScriptOutput -> Either String ScriptInput
forall a.
IsString a =>
[TxSignature]
-> ScriptOutput -> Maybe ScriptOutput -> Either a ScriptInput
go ([TxSignature] -> [TxSignature]
forall a. Eq a => [a] -> [a]
nub ([TxSignature] -> [TxSignature]) -> [TxSignature] -> [TxSignature]
forall a b. (a -> b) -> a -> b
$ (([TxSignature], Maybe ScriptOutput) -> [TxSignature])
-> [([TxSignature], Maybe ScriptOutput)] -> [TxSignature]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([TxSignature], Maybe ScriptOutput) -> [TxSignature]
forall a b. (a, b) -> a
fst [([TxSignature], Maybe ScriptOutput)]
sigRes) ScriptOutput
so Maybe ScriptOutput
rdm
    let ins' :: [TxIn]
ins' = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i (Tx -> [TxIn]
txIn Tx
tx) (\ti :: TxIn
ti -> TxIn
ti {scriptInput :: ByteString
scriptInput = ByteString
si})
    Tx -> Either String Tx
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx -> Either String Tx) -> Tx -> Either String Tx
forall a b. (a -> b) -> a -> b
$ Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx (Tx -> Word32
txVersion Tx
tx) [TxIn]
ins' (Tx -> [TxOut]
txOut Tx
tx) [] (Tx -> Word32
txLockTime Tx
tx)
  where
    go :: [TxSignature]
-> ScriptOutput -> Maybe ScriptOutput -> Either a ScriptInput
go allSigs :: [TxSignature]
allSigs out :: ScriptOutput
out rdmM :: Maybe ScriptOutput
rdmM =
        case ScriptOutput
out of
            PayMulSig msPubs :: [PubKeyI]
msPubs r :: Int
r ->
                let sigs :: [TxSignature]
sigs =
                        Int -> [TxSignature] -> [TxSignature]
forall a. Int -> [a] -> [a]
take Int
r ([TxSignature] -> [TxSignature]) -> [TxSignature] -> [TxSignature]
forall a b. (a -> b) -> a -> b
$
                        [Maybe TxSignature] -> [TxSignature]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TxSignature] -> [TxSignature])
-> [Maybe TxSignature] -> [TxSignature]
forall a b. (a -> b) -> a -> b
$ [TxSignature]
-> [PubKeyI]
-> (TxSignature -> PubKeyI -> Bool)
-> [Maybe TxSignature]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [TxSignature]
allSigs [PubKeyI]
msPubs ((TxSignature -> PubKeyI -> Bool) -> [Maybe TxSignature])
-> (TxSignature -> PubKeyI -> Bool) -> [Maybe TxSignature]
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> TxSignature -> PubKeyI -> Bool
f ScriptOutput
out
                 in ScriptInput -> Either a ScriptInput
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Either a ScriptInput)
-> ScriptInput -> Either a ScriptInput
forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptInput
RegularInput (SimpleInput -> ScriptInput) -> SimpleInput -> ScriptInput
forall a b. (a -> b) -> a -> b
$ [TxSignature] -> SimpleInput
SpendMulSig [TxSignature]
sigs
            PayScriptHash _ ->
                case Maybe ScriptOutput
rdmM of
                    Just rdm :: ScriptOutput
rdm -> do
                        ScriptInput
si <- [TxSignature]
-> ScriptOutput -> Maybe ScriptOutput -> Either a ScriptInput
go [TxSignature]
allSigs ScriptOutput
rdm Maybe ScriptOutput
forall a. Maybe a
Nothing
                        ScriptInput -> Either a ScriptInput
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Either a ScriptInput)
-> ScriptInput -> Either a ScriptInput
forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptOutput -> ScriptInput
ScriptHashInput (ScriptInput -> SimpleInput
getRegularInput ScriptInput
si) ScriptOutput
rdm
                    _ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left "Invalid output script type"
            _ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left "Invalid output script type"
    extractSigs :: ByteString -> Either a ([TxSignature], Maybe ScriptOutput)
extractSigs si :: ByteString
si =
        case Network -> ByteString -> Either String ScriptInput
decodeInputBS Network
net ByteString
si of
            Right (RegularInput (SpendMulSig sigs :: [TxSignature]
sigs)) -> ([TxSignature], Maybe ScriptOutput)
-> Either a ([TxSignature], Maybe ScriptOutput)
forall a b. b -> Either a b
Right ([TxSignature]
sigs, Maybe ScriptOutput
forall a. Maybe a
Nothing)
            Right (ScriptHashInput (SpendMulSig sigs :: [TxSignature]
sigs) rdm :: ScriptOutput
rdm) ->
                ([TxSignature], Maybe ScriptOutput)
-> Either a ([TxSignature], Maybe ScriptOutput)
forall a b. b -> Either a b
Right ([TxSignature]
sigs, ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
rdm)
            _ -> a -> Either a ([TxSignature], Maybe ScriptOutput)
forall a b. a -> Either a b
Left "Invalid script input type"
    f :: ScriptOutput -> TxSignature -> PubKeyI -> Bool
f out :: ScriptOutput
out (TxSignature x :: Sig
x sh :: SigHash
sh) p :: PubKeyI
p =
        Hash256 -> Sig -> PubKey -> Bool
verifyHashSig
            (Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHash Network
net Tx
tx (ScriptOutput -> Script
encodeOutput ScriptOutput
out) Word64
val Int
i SigHash
sh)
            Sig
x
            (PubKeyI -> PubKey
pubKeyPoint PubKeyI
p)
    f _ TxSignatureEmpty _ = Bool
False

{- Tx verification -}

-- | Verify if a transaction is valid and all of its inputs are standard.
verifyStdTx :: Network -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
verifyStdTx :: Network -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
verifyStdTx net :: Network
net tx :: Tx
tx xs :: [(ScriptOutput, Word64, OutPoint)]
xs =
    Bool -> Bool
not ([TxIn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Tx -> [TxIn]
txIn Tx
tx)) Bool -> Bool -> Bool
&& ((Maybe (ScriptOutput, Word64, OutPoint), Int) -> Bool)
-> [(Maybe (ScriptOutput, Word64, OutPoint), Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe (ScriptOutput, Word64, OutPoint), Int) -> Bool
forall c. (Maybe (ScriptOutput, Word64, c), Int) -> Bool
go ([Maybe (ScriptOutput, Word64, OutPoint)]
-> [Int] -> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(ScriptOutput, Word64, OutPoint)]
-> [TxIn]
-> ((ScriptOutput, Word64, OutPoint) -> TxIn -> Bool)
-> [Maybe (ScriptOutput, Word64, OutPoint)]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [(ScriptOutput, Word64, OutPoint)]
xs (Tx -> [TxIn]
txIn Tx
tx) (ScriptOutput, Word64, OutPoint) -> TxIn -> Bool
forall a b. (a, b, OutPoint) -> TxIn -> Bool
f) [0 ..])
  where
    f :: (a, b, OutPoint) -> TxIn -> Bool
f (_, _, o :: OutPoint
o) txin :: TxIn
txin = OutPoint
o OutPoint -> OutPoint -> Bool
forall a. Eq a => a -> a -> Bool
== TxIn -> OutPoint
prevOutput TxIn
txin
    go :: (Maybe (ScriptOutput, Word64, c), Int) -> Bool
go (Just (so :: ScriptOutput
so, val :: Word64
val, _), i :: Int
i) = Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput Network
net Tx
tx Int
i ScriptOutput
so Word64
val
    go _                      = Bool
False

-- | Verify if a transaction input is valid and standard.
verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput net :: Network
net tx :: Tx
tx i :: Int
i so0 :: ScriptOutput
so0 val :: Word64
val
    | ScriptOutput -> Bool
isSegwit ScriptOutput
so0 =
      Bool -> Either String Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Either String Bool -> Bool) -> Either String Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ByteString
inp ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&&) (Bool -> Bool)
-> ((Maybe ScriptOutput, SimpleInput) -> Bool)
-> (Maybe ScriptOutput, SimpleInput)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput ScriptOutput
so0 ((Maybe ScriptOutput, SimpleInput) -> Bool)
-> Either String (Maybe ScriptOutput, SimpleInput)
-> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput)
wp ScriptOutput
so0
    | Bool
otherwise =
        Bool -> Either String Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Either String Bool -> Bool) -> Either String Bool -> Bool
forall a b. (a -> b) -> a -> b
$
            (ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput ScriptOutput
so0 (ScriptInput -> Bool)
-> Either String ScriptInput -> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> ByteString -> Either String ScriptInput
decodeInputBS Network
net ByteString
inp) Either String Bool -> Either String Bool -> Either String Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
            (Either String ScriptOutput
nestedScriptOutput Either String ScriptOutput
-> (ScriptOutput -> Either String Bool) -> Either String Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \so :: ScriptOutput
so -> ScriptOutput
-> ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifyNestedInput ScriptOutput
so0 ScriptOutput
so ((Maybe ScriptOutput, SimpleInput) -> Bool)
-> Either String (Maybe ScriptOutput, SimpleInput)
-> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput)
wp ScriptOutput
so)
  where
    inp :: ByteString
inp = TxIn -> ByteString
scriptInput (TxIn -> ByteString) -> TxIn -> ByteString
forall a b. (a -> b) -> a -> b
$ Tx -> [TxIn]
txIn Tx
tx [TxIn] -> Int -> TxIn
forall a. [a] -> Int -> a
!! Int
i
    theTxSigHash :: ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash so :: ScriptOutput
so = Network
-> Tx
-> Int
-> ScriptOutput
-> Word64
-> SigHash
-> Maybe ScriptOutput
-> Hash256
S.makeSigHash Network
net Tx
tx Int
i ScriptOutput
so Word64
val

    ws :: WitnessStack
    ws :: [ByteString]
ws | WitnessData -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> WitnessData
txWitness Tx
tx) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i = Tx -> WitnessData
txWitness Tx
tx WitnessData -> Int -> [ByteString]
forall a. [a] -> Int -> a
!! Int
i
       | Bool
otherwise = []

    wp :: ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput)
    wp :: ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput)
wp so :: ScriptOutput
so = Network
-> WitnessProgram
-> Either String (Maybe ScriptOutput, SimpleInput)
decodeWitnessInput Network
net (WitnessProgram -> Either String (Maybe ScriptOutput, SimpleInput))
-> Either String WitnessProgram
-> Either String (Maybe ScriptOutput, SimpleInput)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Network
-> ScriptOutput -> [ByteString] -> Either String WitnessProgram
viewWitnessProgram Network
net ScriptOutput
so [ByteString]
ws

    nestedScriptOutput :: Either String ScriptOutput
    nestedScriptOutput :: Either String ScriptOutput
nestedScriptOutput = Script -> [ScriptOp]
scriptOps (Script -> [ScriptOp])
-> Either String Script -> Either String [ScriptOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String Script
forall a. Serialize a => ByteString -> Either String a
decode ByteString
inp Either String [ScriptOp]
-> ([ScriptOp] -> Either String ScriptOutput)
-> Either String ScriptOutput
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        [OP_PUSHDATA bs :: ByteString
bs _] -> ByteString -> Either String ScriptOutput
decodeOutputBS ByteString
bs
        _ -> String -> Either String ScriptOutput
forall a b. a -> Either a b
Left "nestedScriptOutput: not a nested output"

    verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
    verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput so :: ScriptOutput
so si :: ScriptInput
si = case (ScriptOutput
so, ScriptInput
si) of
        (PayPK pub :: PubKeyI
pub, RegularInput (SpendPK (TxSignature sig :: Sig
sig sh :: SigHash
sh))) ->
            Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh Maybe ScriptOutput
forall a. Maybe a
Nothing) Sig
sig (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pub)
        (PayPKHash h :: Hash160
h, RegularInput (SpendPKHash (TxSignature sig :: Sig
sig sh :: SigHash
sh) pub :: PubKeyI
pub)) ->
            PubKeyI -> Address
pubKeyAddr PubKeyI
pub Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2pkhAddr Hash160
h Bool -> Bool -> Bool
&&
            Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh Maybe ScriptOutput
forall a. Maybe a
Nothing) Sig
sig (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pub)
        (PayMulSig pubs :: [PubKeyI]
pubs r :: Int
r, RegularInput (SpendMulSig sigs :: [TxSignature]
sigs)) ->
            Network
-> Tx
-> Script
-> Word64
-> Int
-> [PubKey]
-> [TxSignature]
-> Int
countMulSig Network
net Tx
tx Script
out Word64
val Int
i (PubKeyI -> PubKey
pubKeyPoint (PubKeyI -> PubKey) -> [PubKeyI] -> [PubKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PubKeyI]
pubs) [TxSignature]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
        (PayScriptHash h :: Hash160
h, ScriptHashInput si' :: SimpleInput
si' rdm :: ScriptOutput
rdm) ->
            ScriptOutput -> Address
payToScriptAddress ScriptOutput
rdm Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2shAddr Hash160
h Bool -> Bool -> Bool
&& ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput ScriptOutput
rdm (SimpleInput -> ScriptInput
RegularInput SimpleInput
si')
        _ -> Bool
False
      where out :: Script
out = ScriptOutput -> Script
encodeOutput ScriptOutput
so

    verifySegwitInput ::
        ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
    verifySegwitInput :: ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput so :: ScriptOutput
so (rdm :: Maybe ScriptOutput
rdm, si :: SimpleInput
si) = case (ScriptOutput
so, Maybe ScriptOutput
rdm, SimpleInput
si) of
        (PayWitnessPKHash h :: Hash160
h, Nothing, SpendPKHash (TxSignature sig :: Sig
sig sh :: SigHash
sh) pub :: PubKeyI
pub) ->
            PubKeyI -> Address
pubKeyWitnessAddr PubKeyI
pub Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2wpkhAddr Hash160
h Bool -> Bool -> Bool
&&
            Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh Maybe ScriptOutput
forall a. Maybe a
Nothing) Sig
sig (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pub)
        (PayWitnessScriptHash h :: Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayPK pub :: PubKeyI
pub), SpendPK (TxSignature sig :: Sig
sig sh :: SigHash
sh)) ->
            ScriptOutput -> Address
payToWitnessScriptAddress ScriptOutput
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h Bool -> Bool -> Bool
&&
            Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh (Maybe ScriptOutput -> Hash256) -> Maybe ScriptOutput -> Hash256
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
rdm') Sig
sig (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pub)
        (PayWitnessScriptHash h :: Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayPKHash kh :: Hash160
kh), SpendPKHash (TxSignature sig :: Sig
sig sh :: SigHash
sh) pub :: PubKeyI
pub) ->
            ScriptOutput -> Address
payToWitnessScriptAddress ScriptOutput
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h Bool -> Bool -> Bool
&&
            ByteString -> Hash160
forall b. ByteArrayAccess b => b -> Hash160
addressHash (PubKeyI -> ByteString
forall a. Serialize a => a -> ByteString
encode PubKeyI
pub) Hash160 -> Hash160 -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160
kh Bool -> Bool -> Bool
&&
            Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh (Maybe ScriptOutput -> Hash256) -> Maybe ScriptOutput -> Hash256
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
rdm') Sig
sig (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pub)
        (PayWitnessScriptHash h :: Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayMulSig pubs :: [PubKeyI]
pubs r :: Int
r), SpendMulSig sigs :: [TxSignature]
sigs) ->
            ScriptOutput -> Address
payToWitnessScriptAddress ScriptOutput
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h Bool -> Bool -> Bool
&&
            (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' (\sh :: SigHash
sh -> ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh (Maybe ScriptOutput -> Hash256) -> Maybe ScriptOutput -> Hash256
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
rdm') (PubKeyI -> PubKey
pubKeyPoint (PubKeyI -> PubKey) -> [PubKeyI] -> [PubKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PubKeyI]
pubs) [TxSignature]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
        _ -> Bool
False

    verifyNestedInput ::
        ScriptOutput -> ScriptOutput -> (Maybe RedeemScript, SimpleInput) -> Bool
    verifyNestedInput :: ScriptOutput
-> ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifyNestedInput so :: ScriptOutput
so so' :: ScriptOutput
so' x :: (Maybe ScriptOutput, SimpleInput)
x = case ScriptOutput
so of
        PayScriptHash h :: Hash160
h -> ScriptOutput -> Address
payToScriptAddress ScriptOutput
so' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2shAddr Hash160
h Bool -> Bool -> Bool
&& ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput ScriptOutput
so' (Maybe ScriptOutput, SimpleInput)
x
        _ -> Bool
False

-- | Count the number of valid signatures for a multi-signature transaction.
countMulSig ::
       Network
    -> Tx
    -> Script
    -> Word64
    -> Int
    -> [PubKey]
    -> [TxSignature]
    -> Int
countMulSig :: Network
-> Tx
-> Script
-> Word64
-> Int
-> [PubKey]
-> [TxSignature]
-> Int
countMulSig net :: Network
net tx :: Tx
tx out :: Script
out val :: Word64
val i :: Int
i =
    (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' SigHash -> Hash256
h
  where
    h :: SigHash -> Hash256
h = Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHash Network
net Tx
tx Script
out Word64
val Int
i

countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' _ [] _ = 0
countMulSig' _ _ [] = 0
countMulSig' h :: SigHash -> Hash256
h (_:pubs :: [PubKey]
pubs) (TxSignatureEmpty:sigs :: [TxSignature]
sigs) = (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs
countMulSig' h :: SigHash -> Hash256
h (pub :: PubKey
pub:pubs :: [PubKey]
pubs) sigs :: [TxSignature]
sigs@(TxSignature sig :: Sig
sig sh :: SigHash
sh : sigs' :: [TxSignature]
sigs')
    | Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (SigHash -> Hash256
h SigHash
sh) Sig
sig PubKey
pub = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs'
    | Bool
otherwise                    = (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs