{-# 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 :: forall c.
Coin c =>
Word64
-> Word64 -> Int -> Bool -> [c] -> Either String ([c], Word64)
chooseCoins Word64
target Word64
fee Int
nOut Bool
continue [c]
coins =
    forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList [c]
coins forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| 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 :: 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
    | Word64
target forall a. Ord a => a -> a -> Bool
> Word64
0 =
        forall b a. b -> Maybe a -> Either b a
maybeToEither String
err
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall c.
Coin c =>
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 =
    forall a. Identity a -> a
runIdentity forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$
        forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList [c]
coins forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| 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 :: 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
    | Word64
target forall a. Ord a => a -> a -> Bool
> Word64
0 =
        forall b a. b -> Maybe a -> Either b a
maybeToEither String
err
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *) c.
(Monad m, Coin c) =>
Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
greedyAddSink Word64
target Int -> Word64
guessFee Bool
continue =
    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 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 =
        forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await 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 = forall c. Coin c => c -> Word64
coinValue a
coin
                -- We have reached the goal using this coin
                if Word64
val forall a. Num a => a -> a -> a
+ Word64
aTot forall a. Ord a => a -> a -> Bool
>= Int -> Word64
goal (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
acc 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 forall a. Eq a => a -> a -> Bool
== Word64
0 Bool -> Bool -> Bool
|| Word64
val forall a. Num a => a -> a -> a
+ Word64
aTot 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 forall a. a -> [a] -> [a]
: [a]
acc) (Word64
val forall a. Num a => a -> a -> a
+ Word64
aTot)
                                    else -- Otherwise, we stop here and return the previous
                                    -- solution
                                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just ([a]
ps, Word64
pTot forall a. Num a => a -> a -> a
- Int -> Word64
goal (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ps))
                            else -- Otherwise, return this solution

                                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                                    forall a. a -> Maybe a
Just (a
coin forall a. a -> [a] -> [a]
: [a]
acc, Word64
val forall a. Num a => a -> a -> a
+ Word64
aTot forall a. Num a => a -> a -> a
- Int -> Word64
goal (forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
acc 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 forall a. a -> [a] -> [a]
: [a]
acc) (Word64
val forall a. Num a => a -> a -> a
+ Word64
aTot) [a]
ps Word64
pTot
            -- We reached the end of the stream
            Maybe a
Nothing ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
                    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ps
                        then -- If no solution was found, return Nothing
                            forall a. Maybe a
Nothing
                        else -- If we have a solution, return it
                            forall a. a -> Maybe a
Just ([a]
ps, Word64
pTot forall a. Num a => a -> a -> a
- Int -> Word64
goal (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 forall a. Num a => a -> a -> a
* 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 forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> [(Int, Int)] -> Int -> Int -> Int
guessTxSize Int
0 (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 forall a. Num a => a -> a -> a
+ Int
inpLen forall a. Num a => a -> a -> a
+ Int
inp forall a. Num a => a -> a -> a
+ Int
outLen forall a. Num a => a -> a -> a
+ Int
out
  where
    inpLen :: Int
inpLen =
        ByteString -> Int
B.length
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> VarInt
VarInt
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
            forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
msi forall a. Num a => a -> a -> a
+ Int
pki
    outLen :: Int
outLen =
        ByteString -> Int
B.length
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> VarInt
VarInt
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral
            forall a b. (a -> b) -> a -> b
$ Int
pkout forall a. Num a => a -> a -> a
+ Int
msout
    inp :: Int
inp = Int
pki forall a. Num a => a -> a -> a
* Int
148 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (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 forall a. Num a => a -> a -> a
* Int
34
            forall a. Num a => a -> a -> a
+
            -- (20: hash160) + (3: opcodes) +
            -- (1: script len) + (8: Word64)
            Int
msout 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
        forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ Word64 -> VarInt
VarInt forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
scp)
        forall a. Num a => a -> a -> a
+ Int
scp
  where
    -- OP_M + n*PubKey + OP_N + OP_CHECKMULTISIG

    rdm :: Int
rdm =
        forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$
            ByteString -> Int
B.length forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPutS forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize forall a b. (a -> b) -> a -> b
$ ByteString -> ScriptOp
opPushData forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate (Int
n forall a. Num a => a -> a -> a
* Int
34 forall a. Num a => a -> a -> a
+ Int
3) Word8
0
    -- Redeem + m*sig + OP_0
    scp :: Int
scp = Int
rdm forall a. Num a => a -> a -> a
+ Int
m forall a. Num a => a -> a -> a
* Int
73 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] -> [(RedeemScript, Word64)] -> Tx
buildTx [OutPoint]
ops forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {b} {b}.
(Semigroup b, IsString b, ConvertibleStrings Text b) =>
(Text, b) -> Either b (RedeemScript, b)
f [(Text, Word64)]
rcps
  where
    f :: (Text, b) -> Either b (RedeemScript, b)
f (Text
aTxt, b
v) =
        forall b a. b -> Maybe a -> Either b a
maybeToEither (b
"buildAddrTx: Invalid address " forall a. Semigroup a => a -> a -> a
<> forall a b. ConvertibleStrings a b => a -> b
cs Text
aTxt) forall a b. (a -> b) -> a -> b
$ do
            Address
a <- Network -> Text -> Maybe Address
textToAddr Network
net Text
aTxt
            let o :: RedeemScript
o = Address -> RedeemScript
addressToOutput Address
a
            forall (m :: * -> *) a. Monad m => a -> m a
return (RedeemScript
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] -> [(RedeemScript, Word64)] -> Tx
buildTx [OutPoint]
ops [(RedeemScript, Word64)]
rcpts =
    Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx Word32
1 (OutPoint -> TxIn
toIn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OutPoint]
ops) ((RedeemScript, Word64) -> TxOut
toOut forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(RedeemScript, Word64)]
rcpts) [] Word32
0
  where
    toIn :: OutPoint -> TxIn
toIn OutPoint
op = OutPoint -> ByteString -> Word32 -> TxIn
TxIn OutPoint
op ByteString
B.empty forall a. Bounded a => a
maxBound
    toOut :: (RedeemScript, Word64) -> TxOut
toOut (RedeemScript
o, Word64
v) = Word64 -> ByteString -> TxOut
TxOut Word64
v forall a b. (a -> b) -> a -> b
$ RedeemScript -> ByteString
encodeOutputBS RedeemScript
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 forall a b. (a -> b) -> a -> b
$ forall {a}. a -> (a, Bool)
notNested 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 forall a b. (a -> b) -> a -> b
$ forall {a}. a -> (a, Bool)
nested 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 = 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] -> [(RedeemScript, Word64, OutPoint)] -> Either String Tx
mergeTxs Network
net [Tx]
txs [(RedeemScript, Word64, OutPoint)]
os
    | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tx]
txs = forall a b. a -> Either a b
Left String
"Transaction list is empty"
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Eq a => [a] -> [a]
nub [Tx]
emptyTxs) forall a. Eq a => a -> a -> Bool
/= Int
1 = forall a b. a -> Either a b
Left String
"Transactions do not match"
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
txs forall a. Eq a => a -> a -> Bool
== Int
1 = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Tx]
txs
    | Bool
otherwise = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Network
-> [Tx] -> Tx -> ((RedeemScript, Word64), Int) -> Either String Tx
mergeTxInput Network
net [Tx]
txs) (forall a. [a] -> a
head [Tx]
emptyTxs) [((RedeemScript, Word64), Int)]
outs
  where
    zipOp :: [(Maybe (RedeemScript, Word64, OutPoint), Int)]
zipOp = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [(RedeemScript, Word64, OutPoint)]
os (Tx -> [TxIn]
txIn forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [Tx]
txs) forall {a} {b}. (a, b, OutPoint) -> TxIn -> Bool
f) [Int
0 ..]
    outs :: [((RedeemScript, Word64), Int)]
outs =
        forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. (a -> b) -> a -> b
$ (\(RedeemScript
o, Word64
v, OutPoint
_) -> (RedeemScript
o, Word64
v)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HasCallStack => Maybe a -> a
fromJust) forall a b. (a -> b) -> a -> b
$
            forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Maybe (RedeemScript, Word64, OutPoint), Int)]
zipOp
    f :: (a, b, OutPoint) -> TxIn -> Bool
f (a
_, b
_, OutPoint
o) TxIn
txin = OutPoint
o forall a. Eq a => a -> a -> Bool
== TxIn -> OutPoint
prevOutput TxIn
txin
    emptyTxs :: [Tx]
emptyTxs = forall a b. (a -> b) -> [a] -> [b]
map (\Tx
tx -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {a}. Tx -> (a, Int) -> Tx
clearInput Tx
tx [((RedeemScript, Word64), Int)]
outs) [Tx]
txs
    ins :: [TxIn] -> Int -> [TxIn]
ins [TxIn]
is Int
i = 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 -> ((RedeemScript, Word64), Int) -> Either String Tx
mergeTxInput Network
net [Tx]
txs Tx
tx ((RedeemScript
so, Word64
val), Int
i) = do
    -- Ignore transactions with empty inputs
    let ins :: [ByteString]
ins = forall a b. (a -> b) -> [a] -> [b]
map (TxIn -> ByteString
scriptInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. [a] -> Int -> a
!! Int
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [TxIn]
txIn) [Tx]
txs
    [([TxSignature], Maybe RedeemScript)]
sigRes <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a}.
IsString a =>
ByteString -> Either a ([TxSignature], Maybe RedeemScript)
extractSigs forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
B.null) [ByteString]
ins
    let rdm :: Maybe RedeemScript
rdm = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [([TxSignature], Maybe RedeemScript)]
sigRes
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
== Maybe RedeemScript
rdm) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [([TxSignature], Maybe RedeemScript)]
sigRes) forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left String
"Redeem scripts do not match"
    ByteString
si <- ScriptInput -> ByteString
encodeInputBS forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {a}.
IsString a =>
[TxSignature]
-> RedeemScript -> Maybe RedeemScript -> Either a ScriptInput
go (forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> a
fst [([TxSignature], Maybe RedeemScript)]
sigRes) RedeemScript
so Maybe RedeemScript
rdm
    let ins' :: [TxIn]
ins' = forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i (Tx -> [TxIn]
txIn Tx
tx) (\TxIn
ti -> TxIn
ti{scriptInput :: ByteString
scriptInput = ByteString
si})
    forall (m :: * -> *) a. Monad m => a -> m a
return 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]
-> RedeemScript -> Maybe RedeemScript -> Either a ScriptInput
go [TxSignature]
allSigs RedeemScript
out Maybe RedeemScript
rdmM =
        case RedeemScript
out of
            PayMulSig [PubKeyI]
msPubs Int
r ->
                let sigs :: [TxSignature]
sigs =
                        forall a. Int -> [a] -> [a]
take Int
r forall a b. (a -> b) -> a -> b
$
                            forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [TxSignature]
allSigs [PubKeyI]
msPubs forall a b. (a -> b) -> a -> b
$ RedeemScript -> TxSignature -> PubKeyI -> Bool
f RedeemScript
out
                 in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptInput
RegularInput forall a b. (a -> b) -> a -> b
$ [TxSignature] -> SimpleInput
SpendMulSig [TxSignature]
sigs
            PayScriptHash Hash160
_ ->
                case Maybe RedeemScript
rdmM of
                    Just RedeemScript
rdm -> do
                        ScriptInput
si <- [TxSignature]
-> RedeemScript -> Maybe RedeemScript -> Either a ScriptInput
go [TxSignature]
allSigs RedeemScript
rdm forall a. Maybe a
Nothing
                        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> RedeemScript -> ScriptInput
ScriptHashInput (ScriptInput -> SimpleInput
getRegularInput ScriptInput
si) RedeemScript
rdm
                    Maybe RedeemScript
_ -> forall a b. a -> Either a b
Left a
"Invalid output script type"
            RedeemScript
_ -> forall a b. a -> Either a b
Left a
"Invalid output script type"
    extractSigs :: ByteString -> Either a ([TxSignature], Maybe RedeemScript)
extractSigs ByteString
si =
        case Network -> ByteString -> Either String ScriptInput
decodeInputBS Network
net ByteString
si of
            Right (RegularInput (SpendMulSig [TxSignature]
sigs)) -> forall a b. b -> Either a b
Right ([TxSignature]
sigs, forall a. Maybe a
Nothing)
            Right (ScriptHashInput (SpendMulSig [TxSignature]
sigs) RedeemScript
rdm) ->
                forall a b. b -> Either a b
Right ([TxSignature]
sigs, forall a. a -> Maybe a
Just RedeemScript
rdm)
            Either String ScriptInput
_ -> forall a b. a -> Either a b
Left a
"Invalid script input type"
    f :: RedeemScript -> TxSignature -> PubKeyI -> Bool
f RedeemScript
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 (RedeemScript -> Script
encodeOutput RedeemScript
out) Word64
val Int
i SigHash
sh)
            Sig
x
            (PubKeyI -> PubKey
pubKeyPoint PubKeyI
p)
    f RedeemScript
_ 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 -> [(RedeemScript, Word64, OutPoint)] -> Bool
verifyStdTx Network
net Tx
tx [(RedeemScript, Word64, OutPoint)]
xs =
    Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Tx -> [TxIn]
txIn Tx
tx)) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {c}. (Maybe (RedeemScript, Word64, c), Int) -> Bool
go (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [(RedeemScript, Word64, OutPoint)]
xs (Tx -> [TxIn]
txIn Tx
tx) 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 forall a. Eq a => a -> a -> Bool
== TxIn -> OutPoint
prevOutput TxIn
txin
    go :: (Maybe (RedeemScript, Word64, c), Int) -> Bool
go (Just (RedeemScript
so, Word64
val, c
_), Int
i) = Network -> Tx -> Int -> RedeemScript -> Word64 -> Bool
verifyStdInput Network
net Tx
tx Int
i RedeemScript
so Word64
val
    go (Maybe (RedeemScript, 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 -> RedeemScript -> Word64 -> Bool
verifyStdInput Network
net Tx
tx Int
i RedeemScript
so0 Word64
val
    | RedeemScript -> Bool
isSegwit RedeemScript
so0 =
        forall b a. b -> Either a b -> b
fromRight Bool
False forall a b. (a -> b) -> a -> b
$ (ByteString
inp forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&&) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedeemScript -> (Maybe RedeemScript, SimpleInput) -> Bool
verifySegwitInput RedeemScript
so0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RedeemScript -> Either String (Maybe RedeemScript, SimpleInput)
wp RedeemScript
so0
    | Bool
otherwise =
        forall b a. b -> Either a b -> b
fromRight Bool
False forall a b. (a -> b) -> a -> b
$
            (RedeemScript -> ScriptInput -> Bool
verifyLegacyInput RedeemScript
so0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> ByteString -> Either String ScriptInput
decodeInputBS Network
net ByteString
inp)
                forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Either String RedeemScript
nestedScriptOutput forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RedeemScript
so -> RedeemScript
-> RedeemScript -> (Maybe RedeemScript, SimpleInput) -> Bool
verifyNestedInput RedeemScript
so0 RedeemScript
so forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RedeemScript -> Either String (Maybe RedeemScript, SimpleInput)
wp RedeemScript
so)
  where
    inp :: ByteString
inp = TxIn -> ByteString
scriptInput forall a b. (a -> b) -> a -> b
$ Tx -> [TxIn]
txIn Tx
tx forall a. [a] -> Int -> a
!! Int
i
    theTxSigHash :: RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so = Network
-> Tx
-> Int
-> RedeemScript
-> Word64
-> SigHash
-> Maybe RedeemScript
-> Hash256
S.makeSigHash Network
net Tx
tx Int
i RedeemScript
so Word64
val

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

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

    nestedScriptOutput :: Either String ScriptOutput
    nestedScriptOutput :: Either String RedeemScript
nestedScriptOutput =
        Script -> [ScriptOp]
scriptOps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> ByteString -> Either String a
runGetS forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize ByteString
inp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            [OP_PUSHDATA ByteString
bs PushDataType
_] -> ByteString -> Either String RedeemScript
decodeOutputBS ByteString
bs
            [ScriptOp]
_ -> forall a b. a -> Either a b
Left String
"nestedScriptOutput: not a nested output"

    verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
    verifyLegacyInput :: RedeemScript -> ScriptInput -> Bool
verifyLegacyInput RedeemScript
so ScriptInput
si = case (RedeemScript
so, ScriptInput
si) of
        (PayPK PubKeyI
pub, RegularInput (SpendPK (TxSignature Sig
sig SigHash
sh))) ->
            Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh 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 forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2pkhAddr Hash160
h
                Bool -> Bool -> Bool
&& Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PubKeyI]
pubs) [TxSignature]
sigs forall a. Eq a => a -> a -> Bool
== Int
r
        (PayScriptHash Hash160
h, ScriptHashInput SimpleInput
si' RedeemScript
rdm) ->
            RedeemScript -> Address
payToScriptAddress RedeemScript
rdm forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2shAddr Hash160
h Bool -> Bool -> Bool
&& RedeemScript -> ScriptInput -> Bool
verifyLegacyInput RedeemScript
rdm (SimpleInput -> ScriptInput
RegularInput SimpleInput
si')
        (RedeemScript, ScriptInput)
_ -> Bool
False
      where
        out :: Script
out = RedeemScript -> Script
encodeOutput RedeemScript
so

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

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