{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-}

-- |
-- 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 Data.ByteString qualified 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, rights)
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.Keys.Common
import Haskoin.Crypto.Signature
import Haskoin.Network.Common
import Haskoin.Network.Data
import Haskoin.Script
import Haskoin.Transaction.Builder.Sign (SigInput, buildInput, makeSignature, sigKeys)
import Haskoin.Transaction.Builder.Sign qualified as Sign
import Haskoin.Transaction.Common
import Haskoin.Transaction.Segwit
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 =
  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 ()
-> ConduitT c Void Identity (Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Word64
-> Word64
-> Int
-> Bool
-> ConduitT 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 :: 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 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 a. a -> ConduitT c Void m a
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 :: 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 =
  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 ()
-> ConduitT c Void Identity (Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> ConduitT 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 :: 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 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 a. a -> ConduitT c Void m a
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 :: 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 =
  [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 o. Monad m => ConduitT i o 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 a b.
ConduitT a o m a -> (a -> ConduitT a o m b) -> ConduitT a o m b
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 a. [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 a. a -> ConduitT a o m a
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 a. [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 a. a -> ConduitT a o m a
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 a. [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 a. a -> ConduitT a o m a
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 a. [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 a. [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 ()
forall (m :: * -> *). MonadPut m => VarInt -> 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 a. [a] -> 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 ()
forall (m :: * -> *). MonadPut m => VarInt -> 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 a. Num a => [a] -> a
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) +
        -- (20: hash160) + (3: opcodes) +
        -- (20: hash160) + (3: opcodes) +
        -- (20: hash160) + (3: opcodes) +
        -- (1: script len) + (8: Word64)
        -- (1: script len) + (8: Word64)
        -- (1: script len) + (8: Word64)
        -- (1: script len) + (8: Word64)

        -- (20: hash160) + (3: opcodes) +

        -- (20: hash160) + (3: opcodes) +
        -- (1: script len) + (8: Word64)
        -- (1: script len) + (8: Word64)

        -- (20: hash160) + (3: opcodes) +
        -- (20: hash160) + (3: opcodes) +
        -- (1: script len) + (8: Word64)
        -- (1: script len) + (8: Word64)

        -- (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 ()
forall (m :: * -> *). MonadPut m => VarInt -> 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 ()
forall (m :: * -> *). MonadPut m => ScriptOp -> 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 -> Ctx -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
buildAddrTx :: Network
-> Ctx -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
buildAddrTx Network
net Ctx
ctx [OutPoint]
ops [(Text, Word64)]
rcps =
  Ctx -> [OutPoint] -> [(RedeemScript, Word64)] -> Tx
buildTx Ctx
ctx [OutPoint]
ops ([(RedeemScript, Word64)] -> Tx)
-> Either String [(RedeemScript, Word64)] -> Either String Tx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Word64) -> Either String (RedeemScript, Word64))
-> [(Text, Word64)] -> Either String [(RedeemScript, Word64)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text, Word64) -> Either String (RedeemScript, Word64)
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) =
      b -> Maybe (RedeemScript, b) -> Either b (RedeemScript, 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 (RedeemScript, b) -> Either b (RedeemScript, b))
-> Maybe (RedeemScript, b) -> Either b (RedeemScript, b)
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
        (RedeemScript, b) -> Maybe (RedeemScript, b)
forall a. a -> Maybe 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 :: Ctx -> [OutPoint] -> [(ScriptOutput, Word64)] -> Tx
buildTx :: Ctx -> [OutPoint] -> [(RedeemScript, Word64)] -> Tx
buildTx Ctx
ctx [OutPoint]
ops [(RedeemScript, Word64)]
rcpts =
  Word32 -> [TxIn] -> [TxOut] -> [WitnessStack] -> 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) ((RedeemScript, Word64) -> TxOut
forall {a}. Marshal Ctx a => (a, Word64) -> TxOut
toOut ((RedeemScript, Word64) -> TxOut)
-> [(RedeemScript, Word64)] -> [TxOut]
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 Word32
forall a. Bounded a => a
maxBound
    toOut :: (a, Word64) -> TxOut
toOut (a
o, Word64
v) = Word64 -> ByteString -> TxOut
TxOut Word64
v (ByteString -> TxOut) -> ByteString -> TxOut
forall a b. (a -> b) -> a -> b
$ Ctx -> a -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx a
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 ->
  Ctx ->
  -- | transaction to sign
  Tx ->
  -- | signing parameters
  [SigInput] ->
  -- | private keys to sign with
  [SecKey] ->
  -- | signed transaction
  Either String Tx
signTx :: Network -> Ctx -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signTx Network
net Ctx
ctx Tx
tx [SigInput]
si = Network
-> Ctx -> Tx -> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
Sign.signTx Network
net Ctx
ctx 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 ->
  Ctx ->
  -- | transaction to sign
  Tx ->
  -- | signing parameters
  [SigInput] ->
  -- | private keys to sign with
  [SecKey] ->
  -- | signed transaction
  Either String Tx
signNestedWitnessTx :: Network -> Ctx -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signNestedWitnessTx Network
net Ctx
ctx Tx
tx [SigInput]
si = Network
-> Ctx -> Tx -> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
Sign.signTx Network
net Ctx
ctx 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 -> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx
signInput :: Network
-> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx
signInput Network
net Ctx
ctx Tx
tx Int
i SigInput
si =
  Network
-> Ctx
-> Tx
-> Int
-> (SigInput, Bool)
-> PrivateKey
-> Either String Tx
Sign.signInput Network
net Ctx
ctx Tx
tx Int
i (SigInput
si, Bool
False)

-- | Like 'signInput' but treat segwit inputs as nested
signNestedInput ::
  Network -> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx
signNestedInput :: Network
-> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx
signNestedInput Network
net Ctx
ctx Tx
tx Int
i SigInput
si =
  Network
-> Ctx
-> Tx
-> Int
-> (SigInput, Bool)
-> PrivateKey
-> Either String Tx
Sign.signInput Network
net Ctx
ctx 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)]
Sign.findInputIndex (.outpoint)

{- 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 ->
  Ctx ->
  [Tx] ->
  [(ScriptOutput, Word64, OutPoint)] ->
  Either String Tx
mergeTxs :: Network
-> Ctx
-> [Tx]
-> [(RedeemScript, Word64, OutPoint)]
-> Either String Tx
mergeTxs Network
net Ctx
ctx [Tx]
txs [(RedeemScript, Word64, OutPoint)]
os
  | [Tx] -> Bool
forall a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. a -> Either String a
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. HasCallStack => [a] -> a
head [Tx]
txs
  | Bool
otherwise = (Tx -> ((RedeemScript, Word64), Int) -> Either String Tx)
-> Tx -> [((RedeemScript, 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
-> Ctx
-> [Tx]
-> Tx
-> ((RedeemScript, Word64), Int)
-> Either String Tx
mergeTxInput Network
net Ctx
ctx [Tx]
txs) ([Tx] -> Tx
forall a. HasCallStack => [a] -> a
head [Tx]
emptyTxs) [((RedeemScript, Word64), Int)]
outs
  where
    zipOp :: [(Maybe (RedeemScript, Word64, OutPoint), Int)]
zipOp = [Maybe (RedeemScript, Word64, OutPoint)]
-> [Int] -> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(RedeemScript, Word64, OutPoint)]
-> [TxIn]
-> ((RedeemScript, Word64, OutPoint) -> TxIn -> Bool)
-> [Maybe (RedeemScript, Word64, OutPoint)]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [(RedeemScript, Word64, OutPoint)]
os ([Tx] -> Tx
forall a. HasCallStack => [a] -> a
head [Tx]
txs).inputs (RedeemScript, Word64, OutPoint) -> TxIn -> Bool
forall {a} {r} {a} {b}.
(Eq a, HasField "outpoint" r a) =>
(a, b, a) -> r -> Bool
f) [Int
0 ..]
    outs :: [((RedeemScript, Word64), Int)]
outs =
      ((Maybe (RedeemScript, Word64, OutPoint), Int)
 -> ((RedeemScript, Word64), Int))
-> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
-> [((RedeemScript, Word64), Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (RedeemScript, Word64, OutPoint) -> (RedeemScript, Word64))
-> (Maybe (RedeemScript, Word64, OutPoint), Int)
-> ((RedeemScript, Word64), Int)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Maybe (RedeemScript, Word64, OutPoint) -> (RedeemScript, Word64))
 -> (Maybe (RedeemScript, Word64, OutPoint), Int)
 -> ((RedeemScript, Word64), Int))
-> (Maybe (RedeemScript, Word64, OutPoint)
    -> (RedeemScript, Word64))
-> (Maybe (RedeemScript, Word64, OutPoint), Int)
-> ((RedeemScript, Word64), Int)
forall a b. (a -> b) -> a -> b
$ (\(RedeemScript
o, Word64
v, OutPoint
_) -> (RedeemScript
o, Word64
v)) ((RedeemScript, Word64, OutPoint) -> (RedeemScript, Word64))
-> (Maybe (RedeemScript, Word64, OutPoint)
    -> (RedeemScript, Word64, OutPoint))
-> Maybe (RedeemScript, Word64, OutPoint)
-> (RedeemScript, Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (RedeemScript, Word64, OutPoint)
-> (RedeemScript, Word64, OutPoint)
forall a. HasCallStack => Maybe a -> a
fromJust) ([(Maybe (RedeemScript, Word64, OutPoint), Int)]
 -> [((RedeemScript, Word64), Int)])
-> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
-> [((RedeemScript, Word64), Int)]
forall a b. (a -> b) -> a -> b
$
        ((Maybe (RedeemScript, Word64, OutPoint), Int) -> Bool)
-> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
-> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (RedeemScript, Word64, OutPoint) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (RedeemScript, Word64, OutPoint) -> Bool)
-> ((Maybe (RedeemScript, Word64, OutPoint), Int)
    -> Maybe (RedeemScript, Word64, OutPoint))
-> (Maybe (RedeemScript, Word64, OutPoint), Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (RedeemScript, Word64, OutPoint), Int)
-> Maybe (RedeemScript, Word64, OutPoint)
forall a b. (a, b) -> a
fst) [(Maybe (RedeemScript, Word64, OutPoint), Int)]
zipOp
    f :: (a, b, a) -> r -> Bool
f (a
_, b
_, a
o) r
txin = a
o a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== r
txin.outpoint
    emptyTxs :: [Tx]
emptyTxs = (Tx -> Tx) -> [Tx] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map (\Tx
tx -> (Tx -> ((RedeemScript, Word64), Int) -> Tx)
-> Tx -> [((RedeemScript, Word64), Int)] -> Tx
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Tx -> ((RedeemScript, Word64), Int) -> Tx
forall {r} {a}.
(HasField "version" r Word32, HasField "inputs" r [TxIn],
 HasField "outputs" r [TxOut], HasField "locktime" r Word32) =>
r -> (a, Int) -> Tx
clearInput Tx
tx [((RedeemScript, 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 {Word32
ByteString
OutPoint
outpoint :: OutPoint
script :: ByteString
sequence :: Word32
$sel:outpoint:TxIn :: TxIn -> OutPoint
$sel:script:TxIn :: TxIn -> ByteString
$sel:sequence:TxIn :: TxIn -> Word32
..} -> TxIn {$sel:script:TxIn :: ByteString
script = ByteString
B.empty, Word32
OutPoint
outpoint :: OutPoint
sequence :: Word32
$sel:outpoint:TxIn :: OutPoint
$sel:sequence:TxIn :: Word32
..})
    clearInput :: r -> (a, Int) -> Tx
clearInput r
tx (a
_, Int
i) =
      Word32 -> [TxIn] -> [TxOut] -> [WitnessStack] -> Word32 -> Tx
Tx r
tx.version ([TxIn] -> Int -> [TxIn]
ins r
tx.inputs Int
i) r
tx.outputs [] r
tx.locktime

-- | Merge input from partially-signed multisig transactions.  This function
-- does not support segwit and P2SH-segwit inputs.
mergeTxInput ::
  Network ->
  Ctx ->
  [Tx] ->
  Tx ->
  ((ScriptOutput, Word64), Int) ->
  Either String Tx
mergeTxInput :: Network
-> Ctx
-> [Tx]
-> Tx
-> ((RedeemScript, Word64), Int)
-> Either String Tx
mergeTxInput Network
net Ctx
ctx [Tx]
txs Tx
tx ((RedeemScript
so, Word64
val), Int
i) = do
  -- Ignore transactions with empty inputs
  let ins :: WitnessStack
ins = (Tx -> ByteString) -> [Tx] -> WitnessStack
forall a b. (a -> b) -> [a] -> [b]
map ((.script) (TxIn -> ByteString) -> (Tx -> TxIn) -> Tx -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxIn] -> Int -> TxIn
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) ([TxIn] -> TxIn) -> (Tx -> [TxIn]) -> Tx -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.inputs)) [Tx]
txs
  [([TxSignature], Maybe RedeemScript)]
sigRes <- (ByteString -> Either String ([TxSignature], Maybe RedeemScript))
-> WitnessStack
-> Either String [([TxSignature], Maybe RedeemScript)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ByteString -> Either String ([TxSignature], Maybe RedeemScript)
forall {a}.
IsString a =>
ByteString -> Either a ([TxSignature], Maybe RedeemScript)
extractSigs (WitnessStack
 -> Either String [([TxSignature], Maybe RedeemScript)])
-> WitnessStack
-> Either String [([TxSignature], Maybe RedeemScript)]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> WitnessStack -> WitnessStack
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) WitnessStack
ins
  let rdm :: Maybe RedeemScript
rdm = ([TxSignature], Maybe RedeemScript) -> Maybe RedeemScript
forall a b. (a, b) -> b
snd (([TxSignature], Maybe RedeemScript) -> Maybe RedeemScript)
-> ([TxSignature], Maybe RedeemScript) -> Maybe RedeemScript
forall a b. (a -> b) -> a -> b
$ [([TxSignature], Maybe RedeemScript)]
-> ([TxSignature], Maybe RedeemScript)
forall a. HasCallStack => [a] -> a
head [([TxSignature], Maybe RedeemScript)]
sigRes
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((([TxSignature], Maybe RedeemScript) -> Bool)
-> [([TxSignature], Maybe RedeemScript)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Maybe RedeemScript -> Maybe RedeemScript -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe RedeemScript
rdm) (Maybe RedeemScript -> Bool)
-> (([TxSignature], Maybe RedeemScript) -> Maybe RedeemScript)
-> ([TxSignature], Maybe RedeemScript)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxSignature], Maybe RedeemScript) -> Maybe RedeemScript
forall a b. (a, b) -> b
snd) [([TxSignature], Maybe RedeemScript)]
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 <- (Network, Ctx) -> ScriptInput -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal (Network
net, Ctx
ctx) (ScriptInput -> ByteString)
-> Either String ScriptInput -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSignature]
-> RedeemScript -> Maybe RedeemScript -> Either String ScriptInput
forall {a}.
IsString a =>
[TxSignature]
-> RedeemScript -> Maybe RedeemScript -> 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 RedeemScript) -> [TxSignature])
-> [([TxSignature], Maybe RedeemScript)] -> [TxSignature]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([TxSignature], Maybe RedeemScript) -> [TxSignature]
forall a b. (a, b) -> a
fst [([TxSignature], Maybe RedeemScript)]
sigRes) RedeemScript
so Maybe RedeemScript
rdm
  let ins' :: [TxIn]
ins' = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i Tx
tx.inputs (\TxIn {Word32
ByteString
OutPoint
$sel:outpoint:TxIn :: TxIn -> OutPoint
$sel:script:TxIn :: TxIn -> ByteString
$sel:sequence:TxIn :: TxIn -> Word32
outpoint :: OutPoint
script :: ByteString
sequence :: Word32
..} -> TxIn {$sel:script:TxIn :: ByteString
script = ByteString
si, Word32
OutPoint
$sel:outpoint:TxIn :: OutPoint
$sel:sequence:TxIn :: Word32
outpoint :: OutPoint
sequence :: Word32
..})
  Tx -> Either String Tx
forall a. a -> Either String a
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] -> [WitnessStack] -> Word32 -> Tx
Tx Tx
tx.version [TxIn]
ins' Tx
tx.outputs [] Tx
tx.locktime
  where
    go :: [TxSignature]
-> RedeemScript -> Maybe RedeemScript -> Either a ScriptInput
go [TxSignature]
allSigs RedeemScript
out Maybe RedeemScript
rdmM =
      case RedeemScript
out of
        PayMulSig [PublicKey]
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]
-> [PublicKey]
-> (TxSignature -> PublicKey -> Bool)
-> [Maybe TxSignature]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [TxSignature]
allSigs [PublicKey]
msPubs ((TxSignature -> PublicKey -> Bool) -> [Maybe TxSignature])
-> (TxSignature -> PublicKey -> Bool) -> [Maybe TxSignature]
forall a b. (a -> b) -> a -> b
$
                      RedeemScript -> TxSignature -> PublicKey -> Bool
forall {r}.
HasField "point" r PubKey =>
RedeemScript -> TxSignature -> r -> Bool
f RedeemScript
out
           in ScriptInput -> Either a ScriptInput
forall a. a -> Either a a
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 RedeemScript
rdmM of
            Just RedeemScript
rdm -> do
              ScriptInput
si <- [TxSignature]
-> RedeemScript -> Maybe RedeemScript -> Either a ScriptInput
go [TxSignature]
allSigs RedeemScript
rdm Maybe RedeemScript
forall a. Maybe a
Nothing
              ScriptInput -> Either a ScriptInput
forall a. a -> Either a a
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 -> RedeemScript -> ScriptInput
ScriptHashInput ScriptInput
si.get RedeemScript
rdm
            Maybe RedeemScript
_ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left a
"Invalid output script type"
        RedeemScript
_ -> a -> Either a ScriptInput
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, Ctx) -> ByteString -> Either String ScriptInput
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal (Network
net, Ctx
ctx) ByteString
si of
        Right (RegularInput (SpendMulSig [TxSignature]
sigs)) ->
          ([TxSignature], Maybe RedeemScript)
-> Either a ([TxSignature], Maybe RedeemScript)
forall a b. b -> Either a b
Right ([TxSignature]
sigs, Maybe RedeemScript
forall a. Maybe a
Nothing)
        Right (ScriptHashInput (SpendMulSig [TxSignature]
sigs) RedeemScript
rdm) ->
          ([TxSignature], Maybe RedeemScript)
-> Either a ([TxSignature], Maybe RedeemScript)
forall a b. b -> Either a b
Right ([TxSignature]
sigs, RedeemScript -> Maybe RedeemScript
forall a. a -> Maybe a
Just RedeemScript
rdm)
        Either String ScriptInput
_ -> a -> Either a ([TxSignature], Maybe RedeemScript)
forall a b. a -> Either a b
Left a
"Invalid script input type"
    f :: RedeemScript -> TxSignature -> r -> Bool
f RedeemScript
out (TxSignature Sig
x SigHash
sh) r
p =
      Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig
        Ctx
ctx
        (Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHash Network
net Tx
tx (Ctx -> RedeemScript -> Script
encodeOutput Ctx
ctx RedeemScript
out) Word64
val Int
i SigHash
sh)
        Sig
x
        r
p.point
    f RedeemScript
_ TxSignature
TxSignatureEmpty r
_ = Bool
False

{- Tx verification -}

-- | Verify if a transaction is valid and all of its inputs are standard.
verifyStdTx ::
  Network -> Ctx -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
verifyStdTx :: Network -> Ctx -> Tx -> [(RedeemScript, Word64, OutPoint)] -> Bool
verifyStdTx Network
net Ctx
ctx Tx
tx [(RedeemScript, Word64, OutPoint)]
xs =
  Bool -> Bool
not ([TxIn] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Tx
tx.inputs) Bool -> Bool -> Bool
&& ((Maybe (RedeemScript, Word64, OutPoint), Int) -> Bool)
-> [(Maybe (RedeemScript, Word64, OutPoint), Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe (RedeemScript, Word64, OutPoint), Int) -> Bool
forall {c}. (Maybe (RedeemScript, Word64, c), Int) -> Bool
go ([Maybe (RedeemScript, Word64, OutPoint)]
-> [Int] -> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(RedeemScript, Word64, OutPoint)]
-> [TxIn]
-> ((RedeemScript, Word64, OutPoint) -> TxIn -> Bool)
-> [Maybe (RedeemScript, Word64, OutPoint)]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [(RedeemScript, Word64, OutPoint)]
xs Tx
tx.inputs (RedeemScript, Word64, OutPoint) -> TxIn -> Bool
forall {a} {r} {a} {b}.
(Eq a, HasField "outpoint" r a) =>
(a, b, a) -> r -> Bool
f) [Int
0 ..])
  where
    f :: (a, b, a) -> r -> Bool
f (a
_, b
_, a
o) r
txin = a
o a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== r
txin.outpoint
    go :: (Maybe (RedeemScript, Word64, c), Int) -> Bool
go (Just (RedeemScript
so, Word64
val, c
_), Int
i) = Network -> Ctx -> Tx -> Int -> RedeemScript -> Word64 -> Bool
verifyStdInput Network
net Ctx
ctx 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 -> Ctx -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput :: Network -> Ctx -> Tx -> Int -> RedeemScript -> Word64 -> Bool
verifyStdInput Network
net Ctx
ctx Tx
tx Int
i RedeemScript
so0 Word64
val
  | RedeemScript -> Bool
isSegwit RedeemScript
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 RedeemScript, SimpleInput) -> Bool)
-> (Maybe RedeemScript, SimpleInput)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedeemScript -> (Maybe RedeemScript, SimpleInput) -> Bool
verifySegwitInput RedeemScript
so0 ((Maybe RedeemScript, SimpleInput) -> Bool)
-> Either String (Maybe RedeemScript, SimpleInput)
-> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RedeemScript -> Either String (Maybe RedeemScript, SimpleInput)
wp RedeemScript
so0
  | Bool
otherwise =
      [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$
        [Either String Bool] -> [Bool]
forall a b. [Either a b] -> [b]
rights
          [ RedeemScript -> ScriptInput -> Bool
verifyLegacyInput RedeemScript
so0 (ScriptInput -> Bool)
-> Either String ScriptInput -> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Network, Ctx) -> ByteString -> Either String ScriptInput
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal (Network
net, Ctx
ctx) ByteString
inp,
            Either String RedeemScript
nestedScriptOutput Either String RedeemScript
-> (RedeemScript -> Either String Bool) -> Either String Bool
forall a b.
Either String a -> (a -> Either String b) -> Either String b
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 ((Maybe RedeemScript, SimpleInput) -> Bool)
-> Either String (Maybe RedeemScript, SimpleInput)
-> Either String Bool
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 = (Tx
tx.inputs [TxIn] -> Int -> TxIn
forall a. HasCallStack => [a] -> Int -> a
!! Int
i).script
    theTxSigHash :: RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so = Network
-> Ctx
-> Tx
-> Int
-> RedeemScript
-> Word64
-> SigHash
-> Maybe RedeemScript
-> Hash256
Sign.makeSigHash Network
net Ctx
ctx Tx
tx Int
i RedeemScript
so Word64
val

    ws :: WitnessStack
    ws :: WitnessStack
ws
      | [WitnessStack] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Tx
tx.witness Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i = Tx
tx.witness [WitnessStack] -> Int -> WitnessStack
forall a. HasCallStack => [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
-> Ctx
-> WitnessProgram
-> Either String (Maybe RedeemScript, SimpleInput)
decodeWitnessInput Network
net Ctx
ctx (WitnessProgram -> Either String (Maybe RedeemScript, SimpleInput))
-> Either String WitnessProgram
-> Either String (Maybe RedeemScript, SimpleInput)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Network
-> Ctx
-> RedeemScript
-> WitnessStack
-> Either String WitnessProgram
viewWitnessProgram Network
net Ctx
ctx RedeemScript
so WitnessStack
ws

    nestedScriptOutput :: Either String ScriptOutput
    nestedScriptOutput :: Either String RedeemScript
nestedScriptOutput =
      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
forall (m :: * -> *). MonadGet m => m Script
deserialize ByteString
inp Either String Script
-> (Script -> Either String RedeemScript)
-> Either String RedeemScript
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ScriptOp] -> Either String RedeemScript
dec ([ScriptOp] -> Either String RedeemScript)
-> (Script -> [ScriptOp]) -> Script -> Either String RedeemScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> [ScriptOp]
ops
      where
        ops :: Script -> [ScriptOp]
ops (Script [ScriptOp]
ops') = [ScriptOp]
ops'
        dec :: [ScriptOp] -> Either String RedeemScript
dec = \case
          [OP_PUSHDATA ByteString
bs PushDataType
_] -> Ctx -> ByteString -> Either String RedeemScript
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal Ctx
ctx ByteString
bs
          [ScriptOp]
_ -> String -> Either String RedeemScript
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 PublicKey
pub, RegularInput (SpendPK (TxSignature Sig
sig SigHash
sh))) ->
        Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx (RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh Maybe RedeemScript
forall a. Maybe a
Nothing) Sig
sig PublicKey
pub.point
      (PayPKHash Hash160
h, RegularInput (SpendPKHash (TxSignature Sig
sig SigHash
sh) PublicKey
pub)) ->
        Ctx -> PublicKey -> Address
pubKeyAddr Ctx
ctx PublicKey
pub Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2pkhAddr Hash160
h
          Bool -> Bool -> Bool
&& Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx (RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh Maybe RedeemScript
forall a. Maybe a
Nothing) Sig
sig PublicKey
pub.point
      (PayMulSig [PublicKey]
pubs Int
r, RegularInput (SpendMulSig [TxSignature]
sigs)) ->
        Network
-> Ctx
-> Tx
-> Script
-> Word64
-> Int
-> [PubKey]
-> [TxSignature]
-> Int
countMulSig Network
net Ctx
ctx Tx
tx Script
out Word64
val Int
i ((.point) (PublicKey -> PubKey) -> [PublicKey] -> [PubKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PublicKey]
pubs) [TxSignature]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
      (PayScriptHash Hash160
h, ScriptHashInput SimpleInput
si' RedeemScript
rdm) ->
        Ctx -> RedeemScript -> Address
payToScriptAddress Ctx
ctx RedeemScript
rdm Address -> Address -> Bool
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 = Ctx -> RedeemScript -> Script
encodeOutput Ctx
ctx 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) PublicKey
pub
        ) ->
          let keytest :: Bool
keytest = Ctx -> PublicKey -> Address
pubKeyWitnessAddr Ctx
ctx PublicKey
pub Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2wpkhAddr Hash160
h
              sighash :: Hash256
sighash = RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh Maybe RedeemScript
forall a. Maybe a
Nothing
              pkpoint :: PubKey
pkpoint = PublicKey
pub.point
              verify :: Bool
verify = Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx Hash256
sighash Sig
sig PubKey
pkpoint
           in Bool
keytest Bool -> Bool -> Bool
&& Bool
verify
      ( PayWitnessScriptHash Hash256
h,
        Just rdm' :: RedeemScript
rdm'@(PayPK PublicKey
pub),
        SpendPK (TxSignature Sig
sig SigHash
sh)
        ) ->
          let keytest :: Bool
keytest = Ctx -> RedeemScript -> Address
payToWitnessScriptAddress Ctx
ctx RedeemScript
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h
              sighash :: Hash256
sighash = RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh (Maybe RedeemScript -> Hash256) -> Maybe RedeemScript -> Hash256
forall a b. (a -> b) -> a -> b
$ RedeemScript -> Maybe RedeemScript
forall a. a -> Maybe a
Just RedeemScript
rdm'
              pkpoint :: PubKey
pkpoint = PublicKey
pub.point
              verify :: Bool
verify = Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx Hash256
sighash Sig
sig PubKey
pkpoint
           in Bool
keytest Bool -> Bool -> Bool
&& Bool
verify
      ( PayWitnessScriptHash Hash256
h,
        Just rdm' :: RedeemScript
rdm'@(PayPKHash Hash160
kh),
        SpendPKHash (TxSignature Sig
sig SigHash
sh) PublicKey
pub
        ) ->
          let keytest :: Bool
keytest = Ctx -> RedeemScript -> Address
payToWitnessScriptAddress Ctx
ctx RedeemScript
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h
              addrtest :: Bool
addrtest = ByteString -> Hash160
forall b. ByteArrayAccess b => b -> Hash160
addressHash (Ctx -> PublicKey -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx PublicKey
pub) Hash160 -> Hash160 -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160
kh
              pkpoint :: PubKey
pkpoint = PublicKey
pub.point
              sighash :: Hash256
sighash = RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh (Maybe RedeemScript -> Hash256) -> Maybe RedeemScript -> Hash256
forall a b. (a -> b) -> a -> b
$ RedeemScript -> Maybe RedeemScript
forall a. a -> Maybe a
Just RedeemScript
rdm'
              verify :: Bool
verify = Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx Hash256
sighash Sig
sig PubKey
pkpoint
           in Bool
keytest Bool -> Bool -> Bool
&& Bool
addrtest Bool -> Bool -> Bool
&& Bool
verify
      ( PayWitnessScriptHash Hash256
h,
        Just rdm' :: RedeemScript
rdm'@(PayMulSig [PublicKey]
pubs Int
r),
        SpendMulSig [TxSignature]
sigs
        ) ->
          let keytest :: Bool
keytest = Ctx -> RedeemScript -> Address
payToWitnessScriptAddress Ctx
ctx RedeemScript
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h
              pkpoints :: [PubKey]
pkpoints = (.point) (PublicKey -> PubKey) -> [PublicKey] -> [PubKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PublicKey]
pubs
              hashfun :: SigHash -> Hash256
hashfun SigHash
sh = RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh (Maybe RedeemScript -> Hash256) -> Maybe RedeemScript -> Hash256
forall a b. (a -> b) -> a -> b
$ RedeemScript -> Maybe RedeemScript
forall a. a -> Maybe a
Just RedeemScript
rdm'
              verify :: Bool
verify = Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
ctx SigHash -> Hash256
hashfun [PubKey]
pkpoints [TxSignature]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
           in Bool
keytest Bool -> Bool -> Bool
&& Bool
verify
      (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 -> Ctx -> RedeemScript -> Address
payToScriptAddress Ctx
ctx RedeemScript
so' Address -> Address -> Bool
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 ->
  Ctx ->
  Tx ->
  Script ->
  Word64 ->
  Int ->
  [PubKey] ->
  [TxSignature] ->
  Int
countMulSig :: Network
-> Ctx
-> Tx
-> Script
-> Word64
-> Int
-> [PubKey]
-> [TxSignature]
-> Int
countMulSig Network
net Ctx
ctx Tx
tx Script
out Word64
val Int
i =
  Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
ctx 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' :: Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' :: Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
_ SigHash -> Hash256
_ [] [TxSignature]
_ = Int
0
countMulSig' Ctx
_ SigHash -> Hash256
_ [PubKey]
_ [] = Int
0
countMulSig' Ctx
ctx SigHash -> Hash256
h (PubKey
_ : [PubKey]
pubs) (TxSignature
TxSignatureEmpty : [TxSignature]
sigs) =
  Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
ctx SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs
countMulSig' Ctx
ctx SigHash -> Hash256
h (PubKey
pub : [PubKey]
pubs) sigs :: [TxSignature]
sigs@(TxSignature Sig
sig SigHash
sh : [TxSignature]
sigs')
  | Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx (SigHash -> Hash256
h SigHash
sh) Sig
sig PubKey
pub = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
ctx SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs'
  | Bool
otherwise = Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
ctx SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs