{-# 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.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
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.String.Conversions (cs)
import Data.Text (Text)
import Data.Word (Word64)
import Haskoin.Address
import Haskoin.Crypto.Hash (Hash256, addressHash)
import Haskoin.Crypto.Signature
import Haskoin.Data
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 =>
    -- | value to send
    Word64 ->
    -- | fee per byte
    Word64 ->
    -- | number of outputs (including change)
    Int ->
    -- | try to find better solutions
    Bool ->
    -- | list of ordered coins to choose from
    [c] ->
    -- | coin selection and change
    Either String ([c], Word64)
chooseCoins :: Word64
-> Word64 -> Int -> Bool -> [c] -> Either String ([c], Word64)
chooseCoins Word64
target Word64
fee Int
nOut Bool
continue [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) =>
    -- | value to send
    Word64 ->
    -- | fee per byte
    Word64 ->
    -- | number of outputs (including change)
    Int ->
    -- | try to find better solution
    Bool ->
    -- | coin selection and change
    ConduitT c Void m (Either String ([c], Word64))
chooseCoinsSink :: Word64
-> Word64
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseCoinsSink Word64
target Word64
fee Int
nOut Bool
continue
    | Word64
target Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
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 String
"chooseCoins: Target must be > 0"
  where
    err :: String
err = String
"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 =>
    -- | value to send
    Word64 ->
    -- | fee per byte
    Word64 ->
    -- | m of n multisig
    (Int, Int) ->
    -- | number of outputs (including change)
    Int ->
    -- | try to find better solution
    Bool ->
    [c] ->
    -- | coin selection change amount
    Either String ([c], Word64)
chooseMSCoins :: Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> [c]
-> Either String ([c], Word64)
chooseMSCoins Word64
target Word64
fee (Int, Int)
ms Int
nOut Bool
continue [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) =>
    -- | value to send
    Word64 ->
    -- | fee per byte
    Word64 ->
    -- | m of n multisig
    (Int, Int) ->
    -- | number of outputs (including change)
    Int ->
    -- | try to find better solution
    Bool ->
    -- | coin selection and change
    ConduitT c Void m (Either String ([c], Word64))
chooseMSCoinsSink :: 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
    | Word64
target Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
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 String
"chooseMSCoins: Target must be > 0"
  where
    err :: String
err = String
"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) =>
    -- | value to send
    Word64 ->
    -- | coin count to fee function
    (Int -> Word64) ->
    -- | try to find better solutions
    Bool ->
    -- | coin selection and change
    ConduitT c Void m (Maybe ([c], Word64))
greedyAddSink :: Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
greedyAddSink Word64
target Int -> Word64
guessFee 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 [] Word64
0 [] Word64
0
  where
    -- The goal is the value we must reach (including the fee) for a certain
    -- amount of selected coins.
    goal :: Int -> Word64
goal 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 [a]
acc Word64
aTot [a]
ps 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 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
+ Int
1)
                    then -- If we want to continue searching for better solutions

                        if Bool
continue
                            then -- This solution is the first one or
                            -- This solution is better than the previous one

                                if Word64
pTot Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
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
                                    then -- Continue searching for better solutions in the stream
                                        [a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go [] Word64
0 (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)
                                    else -- Otherwise, we stop here and return the previous
                                    -- solution
                                        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))
                            else -- Otherwise, return this solution

                                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
+ Int
1))
                    else -- We have not yet reached the goal. Add the coin to the
                    -- accumulator
                        [a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go (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) [a]
ps Word64
pTot
            -- We reached the end of the stream
            Maybe a
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
                        then -- If no solution was found, return Nothing
                            Maybe ([a], Word64)
forall a. Maybe a
Nothing
                        else -- If we have a solution, return it
                            ([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 Word64
byteFee Int
nOut 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 Int
0)

-- | Same as 'guessTxFee' but for multisig transactions.
guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64
guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64
guessMSTxFee Word64
byteFee (Int, Int)
ms Int
nOut 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
0 (Int -> (Int, Int) -> [(Int, Int)]
forall a. Int -> a -> [a]
replicate Int
nIn (Int, Int)
ms) Int
nOut Int
0)

{- | Computes an upper bound on the size of a transaction based on some known
 properties of the transaction.
-}
guessTxSize ::
    -- | number of regular transaction inputs
    Int ->
    -- | multisig m of n for each input
    [(Int, Int)] ->
    -- | number of P2PKH outputs
    Int ->
    -- | number of P2SH outputs
    Int ->
    -- | upper bound on transaction size
    Int
guessTxSize :: Int -> [(Int, Int)] -> Int -> Int -> Int
guessTxSize Int
pki [(Int, Int)]
msi Int
pkout Int
msout =
    Int
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) -> (Int -> ByteString) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS
            (Put -> ByteString) -> (Int -> Put) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
            (VarInt -> Put) -> (Int -> VarInt) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> VarInt
VarInt
            (Word64 -> VarInt) -> (Int -> Word64) -> Int -> VarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            (Int -> Int) -> Int -> Int
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) -> (Int -> ByteString) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS
            (Put -> ByteString) -> (Int -> Put) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
            (VarInt -> Put) -> (Int -> VarInt) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> VarInt
VarInt
            (Word64 -> VarInt) -> (Int -> Word64) -> Int -> VarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
            (Int -> Int) -> Int -> Int
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
* Int
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
* Int
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
* Int
32

-- | Size of a multisig P2SH input.
guessMSSize :: (Int, Int) -> Int
guessMSSize :: (Int, Int) -> Int
guessMSSize (Int
m, Int
n) =
    -- OutPoint (36) + Sequence (4) + Script
    Int
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
$ Put -> ByteString
runPutS (Put -> ByteString) -> (VarInt -> Put) -> VarInt -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (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
  where
    -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG

    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
$ Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ScriptOp -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ScriptOp -> Put) -> ScriptOp -> Put
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
* Int
34 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
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
* Int
73 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 Network
net [OutPoint]
ops [(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 (Text
aTxt, b
v) =
        b -> Maybe (ScriptOutput, b) -> Either b (ScriptOutput, b)
forall b a. b -> Maybe a -> Either b a
maybeToEither (b
"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 [OutPoint]
ops [(ScriptOutput, Word64)]
rcpts =
    Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx Word32
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) [] Word32
0
  where
    toIn :: OutPoint -> TxIn
toIn OutPoint
op = OutPoint -> ByteString -> Word32 -> TxIn
TxIn OutPoint
op ByteString
B.empty Word32
forall a. Bounded a => a
maxBound
    toOut :: (ScriptOutput, Word64) -> TxOut
toOut (ScriptOutput
o, 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 ->
    -- | transaction to sign
    Tx ->
    -- | signing parameters
    [SigInput] ->
    -- | private keys to sign with
    [SecKey] ->
    -- | signed transaction
    Either String Tx
signTx :: Network -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signTx Network
net Tx
tx [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 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 ->
    -- | transaction to sign
    Tx ->
    -- | signing parameters
    [SigInput] ->
    -- | private keys to sign with
    [SecKey] ->
    -- | signed transaction
    Either String Tx
signNestedWitnessTx :: Network -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signNestedWitnessTx Network
net Tx
tx [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 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 Network
net Tx
tx Int
i 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 Network
net Tx
tx Int
i 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 Network
net [Tx]
txs [(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 String
"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
/= Int
1 = String -> Either String Tx
forall a b. a -> Either a b
Left String
"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
== Int
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) [Int
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
$ (\(ScriptOutput
o, Word64
v, OutPoint
_) -> (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 (a
_, b
_, OutPoint
o) 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 -> ((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 [TxIn]
is Int
i = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i [TxIn]
is (\TxIn
ti -> TxIn
ti{scriptInput :: ByteString
scriptInput = ByteString
B.empty})
    clearInput :: Tx -> (a, Int) -> Tx
clearInput Tx
tx (a
_, 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 Network
net [Tx]
txs Tx
tx ((ScriptOutput
so, Word64
val), 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 String
"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) (\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 [TxSignature]
allSigs ScriptOutput
out Maybe ScriptOutput
rdmM =
        case ScriptOutput
out of
            PayMulSig [PubKeyI]
msPubs 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 Hash160
_ ->
                case Maybe ScriptOutput
rdmM of
                    Just 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
                    Maybe ScriptOutput
_ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left a
"Invalid output script type"
            ScriptOutput
_ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left a
"Invalid output script type"
    extractSigs :: ByteString -> Either a ([TxSignature], Maybe ScriptOutput)
extractSigs ByteString
si =
        case Network -> ByteString -> Either String ScriptInput
decodeInputBS Network
net ByteString
si of
            Right (RegularInput (SpendMulSig [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 [TxSignature]
sigs) 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)
            Either String ScriptInput
_ -> a -> Either a ([TxSignature], Maybe ScriptOutput)
forall a b. a -> Either a b
Left a
"Invalid script input type"
    f :: ScriptOutput -> TxSignature -> PubKeyI -> Bool
f ScriptOutput
out (TxSignature Sig
x SigHash
sh) 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 ScriptOutput
_ TxSignature
TxSignatureEmpty PubKeyI
_ = 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 Network
net Tx
tx [(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) [Int
0 ..])
  where
    f :: (a, b, OutPoint) -> TxIn -> Bool
f (a
_, b
_, OutPoint
o) 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 (ScriptOutput
so, Word64
val, c
_), Int
i) = Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput Network
net Tx
tx Int
i ScriptOutput
so Word64
val
    go (Maybe (ScriptOutput, Word64, c), Int)
_ = 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 Network
net Tx
tx Int
i ScriptOutput
so0 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
>>= \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 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 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
<$> Get Script -> ByteString -> Either String Script
forall a. Get a -> ByteString -> Either String a
runGetS Get Script
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize 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 ByteString
bs PushDataType
_] -> ByteString -> Either String ScriptOutput
decodeOutputBS ByteString
bs
            [ScriptOp]
_ -> String -> Either String ScriptOutput
forall a b. a -> Either a b
Left String
"nestedScriptOutput: not a nested output"

    verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
    verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput ScriptOutput
so ScriptInput
si = case (ScriptOutput
so, ScriptInput
si) of
        (PayPK PubKeyI
pub, RegularInput (SpendPK (TxSignature Sig
sig 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 Hash160
h, RegularInput (SpendPKHash (TxSignature Sig
sig SigHash
sh) 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 [PubKeyI]
pubs Int
r, RegularInput (SpendMulSig [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 Hash160
h, ScriptHashInput SimpleInput
si' 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')
        (ScriptOutput, ScriptInput)
_ -> Bool
False
      where
        out :: Script
out = ScriptOutput -> Script
encodeOutput ScriptOutput
so

    verifySegwitInput ::
        ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
    verifySegwitInput :: ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput ScriptOutput
so (Maybe ScriptOutput
rdm, SimpleInput
si) = case (ScriptOutput
so, Maybe ScriptOutput
rdm, SimpleInput
si) of
        (PayWitnessPKHash Hash160
h, Maybe ScriptOutput
Nothing, SpendPKHash (TxSignature Sig
sig SigHash
sh) 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 Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayPK PubKeyI
pub), SpendPK (TxSignature Sig
sig 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 Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayPKHash Hash160
kh), SpendPKHash (TxSignature Sig
sig SigHash
sh) 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 (Put -> ByteString
runPutS (PubKeyI -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize 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 Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayMulSig [PubKeyI]
pubs Int
r), SpendMulSig [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' (\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
        (ScriptOutput, Maybe ScriptOutput, SimpleInput)
_ -> Bool
False

    verifyNestedInput ::
        ScriptOutput -> ScriptOutput -> (Maybe RedeemScript, SimpleInput) -> Bool
    verifyNestedInput :: ScriptOutput
-> ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifyNestedInput ScriptOutput
so ScriptOutput
so' (Maybe ScriptOutput, SimpleInput)
x = case ScriptOutput
so of
        PayScriptHash 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
        ScriptOutput
_ -> 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 Network
net Tx
tx Script
out Word64
val 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' SigHash -> Hash256
_ [] [TxSignature]
_ = Int
0
countMulSig' SigHash -> Hash256
_ [PubKey]
_ [] = Int
0
countMulSig' SigHash -> Hash256
h (PubKey
_ : [PubKey]
pubs) (TxSignature
TxSignatureEmpty : [TxSignature]
sigs) = (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs
countMulSig' SigHash -> Hash256
h (PubKey
pub : [PubKey]
pubs) sigs :: [TxSignature]
sigs@(TxSignature Sig
sig SigHash
sh : [TxSignature]
sigs')
    | Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (SigHash -> Hash256
h SigHash
sh) Sig
sig PubKey
pub = Int
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