{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      : Haskoin.Transaction.Builder.Sign
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX

Types and logic for signing transactions.
-}
module Haskoin.Transaction.Builder.Sign (
    SigInput (..),
    makeSignature,
    makeSigHash,
    signTx,
    findInputIndex,
    signInput,
    buildInput,
    sigKeys,
) where

import Control.DeepSeq (NFData)
import Control.Monad (foldM, when)
import Data.Aeson (
    FromJSON,
    ToJSON (..),
    object,
    pairs,
    parseJSON,
    withObject,
    (.:),
    (.:?),
    (.=),
 )
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import Data.Either (rights)
import Data.Hashable (Hashable)
import Data.List (find, nub)
import Data.Maybe (
    catMaybes,
    fromMaybe,
    mapMaybe,
    maybeToList,
 )
import Data.Word (Word64)
import GHC.Generics (Generic)
import Haskoin.Address (getAddrHash160, pubKeyAddr)
import Haskoin.Crypto (Hash256, SecKey)
import Haskoin.Crypto.Signature (signHash, verifyHashSig)
import Haskoin.Data (Network)
import Haskoin.Keys.Common (
    PubKeyI (..),
    SecKeyI (..),
    derivePubKeyI,
    wrapSecKey,
 )
import Haskoin.Script
import Haskoin.Transaction.Common
import Haskoin.Transaction.Segwit
import Haskoin.Util (matchTemplate, updateIndex)

{- | Data type used to specify the signing parameters of a transaction input.
 To sign an input, the previous output script, outpoint and sighash are
 required. When signing a pay to script hash output, an additional redeem
 script is required.
-}
data SigInput = SigInput
    { -- | output script to spend
      -- ^ output script value
      SigInput -> ScriptOutput
sigInputScript :: !ScriptOutput
    , -- | output script value
      -- ^ outpoint to spend
      SigInput -> Word64
sigInputValue :: !Word64
    , -- | outpoint to spend
      -- ^ signature type
      SigInput -> OutPoint
sigInputOP :: !OutPoint
    , -- | signature type
      -- ^ redeem script
      SigInput -> SigHash
sigInputSH :: !SigHash
    , -- | redeem script
      SigInput -> Maybe ScriptOutput
sigInputRedeem :: !(Maybe RedeemScript)
    }
    deriving (SigInput -> SigInput -> Bool
(SigInput -> SigInput -> Bool)
-> (SigInput -> SigInput -> Bool) -> Eq SigInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SigInput -> SigInput -> Bool
$c/= :: SigInput -> SigInput -> Bool
== :: SigInput -> SigInput -> Bool
$c== :: SigInput -> SigInput -> Bool
Eq, Int -> SigInput -> ShowS
[SigInput] -> ShowS
SigInput -> String
(Int -> SigInput -> ShowS)
-> (SigInput -> String) -> ([SigInput] -> ShowS) -> Show SigInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SigInput] -> ShowS
$cshowList :: [SigInput] -> ShowS
show :: SigInput -> String
$cshow :: SigInput -> String
showsPrec :: Int -> SigInput -> ShowS
$cshowsPrec :: Int -> SigInput -> ShowS
Show, ReadPrec [SigInput]
ReadPrec SigInput
Int -> ReadS SigInput
ReadS [SigInput]
(Int -> ReadS SigInput)
-> ReadS [SigInput]
-> ReadPrec SigInput
-> ReadPrec [SigInput]
-> Read SigInput
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SigInput]
$creadListPrec :: ReadPrec [SigInput]
readPrec :: ReadPrec SigInput
$creadPrec :: ReadPrec SigInput
readList :: ReadS [SigInput]
$creadList :: ReadS [SigInput]
readsPrec :: Int -> ReadS SigInput
$creadsPrec :: Int -> ReadS SigInput
Read, (forall x. SigInput -> Rep SigInput x)
-> (forall x. Rep SigInput x -> SigInput) -> Generic SigInput
forall x. Rep SigInput x -> SigInput
forall x. SigInput -> Rep SigInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SigInput x -> SigInput
$cfrom :: forall x. SigInput -> Rep SigInput x
Generic, Int -> SigInput -> Int
SigInput -> Int
(Int -> SigInput -> Int) -> (SigInput -> Int) -> Hashable SigInput
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SigInput -> Int
$chash :: SigInput -> Int
hashWithSalt :: Int -> SigInput -> Int
$chashWithSalt :: Int -> SigInput -> Int
Hashable, SigInput -> ()
(SigInput -> ()) -> NFData SigInput
forall a. (a -> ()) -> NFData a
rnf :: SigInput -> ()
$crnf :: SigInput -> ()
NFData)

instance ToJSON SigInput where
    toJSON :: SigInput -> Value
toJSON (SigInput ScriptOutput
so Word64
val OutPoint
op SigHash
sh Maybe ScriptOutput
rdm) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            [ Key
"pkscript" Key -> ScriptOutput -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScriptOutput
so
            , Key
"value" Key -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64
val
            , Key
"outpoint" Key -> OutPoint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OutPoint
op
            , Key
"sighash" Key -> SigHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SigHash
sh
            ]
                [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Key
"redeem" Key -> ScriptOutput -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScriptOutput
r | ScriptOutput
r <- Maybe ScriptOutput -> [ScriptOutput]
forall a. Maybe a -> [a]
maybeToList Maybe ScriptOutput
rdm]
    toEncoding :: SigInput -> Encoding
toEncoding (SigInput ScriptOutput
so Word64
val OutPoint
op SigHash
sh Maybe ScriptOutput
rdm) =
        Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
            Key
"pkscript" Key -> ScriptOutput -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScriptOutput
so
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"value" Key -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word64
val
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"outpoint" Key -> OutPoint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OutPoint
op
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Key
"sighash" Key -> SigHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SigHash
sh
                Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Series -> (ScriptOutput -> Series) -> Maybe ScriptOutput -> Series
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Series
forall a. Monoid a => a
mempty (Key
"redeem" Key -> ScriptOutput -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=) Maybe ScriptOutput
rdm

instance FromJSON SigInput where
    parseJSON :: Value -> Parser SigInput
parseJSON =
        String -> (Object -> Parser SigInput) -> Value -> Parser SigInput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SigInput" ((Object -> Parser SigInput) -> Value -> Parser SigInput)
-> (Object -> Parser SigInput) -> Value -> Parser SigInput
forall a b. (a -> b) -> a -> b
$ \Object
o ->
            ScriptOutput
-> Word64 -> OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput
SigInput (ScriptOutput
 -> Word64 -> OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput)
-> Parser ScriptOutput
-> Parser
     (Word64 -> OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ScriptOutput
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pkscript"
                Parser
  (Word64 -> OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput)
-> Parser Word64
-> Parser (OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
                Parser (OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput)
-> Parser OutPoint
-> Parser (SigHash -> Maybe ScriptOutput -> SigInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser OutPoint
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"outpoint"
                Parser (SigHash -> Maybe ScriptOutput -> SigInput)
-> Parser SigHash -> Parser (Maybe ScriptOutput -> SigInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser SigHash
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sighash"
                Parser (Maybe ScriptOutput -> SigInput)
-> Parser (Maybe ScriptOutput) -> Parser SigInput
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe ScriptOutput)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"redeem"

{- | 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.
-}
signTx ::
    Network ->
    -- | transaction to sign
    Tx ->
    -- | signing parameters, with nesting flag
    [(SigInput, Bool)] ->
    -- | private keys to sign with
    [SecKey] ->
    -- | signed transaction
    Either String Tx
signTx :: Network -> Tx -> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
signTx Network
net Tx
otx [(SigInput, Bool)]
sigis [SecKey]
allKeys
    | [TxIn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TxIn]
ti = String -> Either String Tx
forall a b. a -> Either a b
Left String
"signTx: Transaction has no inputs"
    | Bool
otherwise = (Tx -> ((SigInput, Bool), Int) -> Either String Tx)
-> Tx -> [((SigInput, Bool), Int)] -> Either String Tx
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Tx -> ((SigInput, Bool), Int) -> Either String Tx
go Tx
otx ([((SigInput, Bool), Int)] -> Either String Tx)
-> [((SigInput, Bool), Int)] -> Either String Tx
forall a b. (a -> b) -> a -> b
$ ((SigInput, Bool) -> OutPoint)
-> [(SigInput, Bool)] -> [TxIn] -> [((SigInput, Bool), Int)]
forall a. (a -> OutPoint) -> [a] -> [TxIn] -> [(a, Int)]
findInputIndex (SigInput -> OutPoint
sigInputOP (SigInput -> OutPoint)
-> ((SigInput, Bool) -> SigInput) -> (SigInput, Bool) -> OutPoint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigInput, Bool) -> SigInput
forall a b. (a, b) -> a
fst) [(SigInput, Bool)]
sigis [TxIn]
ti
  where
    ti :: [TxIn]
ti = Tx -> [TxIn]
txIn Tx
otx
    go :: Tx -> ((SigInput, Bool), Int) -> Either String Tx
go Tx
tx (sigi :: (SigInput, Bool)
sigi@(SigInput ScriptOutput
so Word64
_ OutPoint
_ SigHash
_ Maybe ScriptOutput
rdmM, Bool
_), Int
i) = do
        [SecKeyI]
keys <- ScriptOutput
-> Maybe ScriptOutput -> [SecKey] -> Either String [SecKeyI]
sigKeys ScriptOutput
so Maybe ScriptOutput
rdmM [SecKey]
allKeys
        (Tx -> SecKeyI -> Either String Tx)
-> Tx -> [SecKeyI] -> Either String Tx
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\Tx
t SecKeyI
k -> Network
-> Tx -> Int -> (SigInput, Bool) -> SecKeyI -> Either String Tx
signInput Network
net Tx
t Int
i (SigInput, Bool)
sigi SecKeyI
k) Tx
tx [SecKeyI]
keys

{- | Sign a single input in a transaction deterministically (RFC-6979).  The
 nesting flag only affects the behavior of segwit inputs.
-}
signInput ::
    Network ->
    Tx ->
    Int ->
    -- | boolean flag: nest input
    (SigInput, Bool) ->
    SecKeyI ->
    Either String Tx
signInput :: Network
-> Tx -> Int -> (SigInput, Bool) -> SecKeyI -> Either String Tx
signInput Network
net Tx
tx Int
i (sigIn :: SigInput
sigIn@(SigInput ScriptOutput
so Word64
val OutPoint
_ SigHash
_ Maybe ScriptOutput
rdmM), Bool
nest) SecKeyI
key = do
    let sig :: TxSignature
sig = Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature
makeSignature Network
net Tx
tx Int
i SigInput
sigIn SecKeyI
key
    ScriptInput
si <- Network
-> Tx
-> Int
-> ScriptOutput
-> Word64
-> Maybe ScriptOutput
-> TxSignature
-> PubKeyI
-> Either String ScriptInput
buildInput Network
net Tx
tx Int
i ScriptOutput
so Word64
val Maybe ScriptOutput
rdmM TxSignature
sig (PubKeyI -> Either String ScriptInput)
-> PubKeyI -> Either String ScriptInput
forall a b. (a -> b) -> a -> b
$ SecKeyI -> PubKeyI
derivePubKeyI SecKeyI
key
    WitnessData
w <- Tx
-> Int -> ScriptOutput -> ScriptInput -> Either String WitnessData
updatedWitnessData Tx
tx Int
i ScriptOutput
so ScriptInput
si
    Tx -> Either String Tx
forall (m :: * -> *) a. Monad m => a -> m a
return
        Tx
tx
            { txIn :: [TxIn]
txIn = ScriptOutput -> ScriptInput -> [TxIn]
nextTxIn ScriptOutput
so ScriptInput
si
            , txWitness :: WitnessData
txWitness = WitnessData
w
            }
  where
    f :: ScriptInput -> TxIn -> TxIn
f ScriptInput
si TxIn
x = TxIn
x{scriptInput :: ByteString
scriptInput = ScriptInput -> ByteString
encodeInputBS ScriptInput
si}
    g :: ScriptOutput -> TxIn -> TxIn
g ScriptOutput
so' TxIn
x = TxIn
x{scriptInput :: ByteString
scriptInput = Put -> ByteString
runPutS (Put -> ByteString)
-> (ByteString -> Put) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOp -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ScriptOp -> Put) -> (ByteString -> ScriptOp) -> ByteString -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ScriptOp
opPushData (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> ByteString
encodeOutputBS ScriptOutput
so'}
    txis :: [TxIn]
txis = Tx -> [TxIn]
txIn Tx
tx
    nextTxIn :: ScriptOutput -> ScriptInput -> [TxIn]
nextTxIn ScriptOutput
so' ScriptInput
si
        | ScriptOutput -> Bool
isSegwit ScriptOutput
so' Bool -> Bool -> Bool
&& Bool
nest = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i [TxIn]
txis (ScriptOutput -> TxIn -> TxIn
g ScriptOutput
so')
        | ScriptOutput -> Bool
isSegwit ScriptOutput
so' = Tx -> [TxIn]
txIn Tx
tx
        | Bool
otherwise = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i [TxIn]
txis (ScriptInput -> TxIn -> TxIn
f ScriptInput
si)

{- | Add the witness data of the transaction given segwit parameters for an input.

 @since 0.11.0.0
-}
updatedWitnessData :: Tx -> Int -> ScriptOutput -> ScriptInput -> Either String WitnessData
updatedWitnessData :: Tx
-> Int -> ScriptOutput -> ScriptInput -> Either String WitnessData
updatedWitnessData Tx
tx Int
i ScriptOutput
so ScriptInput
si
    | ScriptOutput -> Bool
isSegwit ScriptOutput
so = WitnessStack -> Either String WitnessData
forall a. IsString a => WitnessStack -> Either a WitnessData
updateWitness (WitnessStack -> Either String WitnessData)
-> (WitnessProgram -> WitnessStack)
-> WitnessProgram
-> Either String WitnessData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WitnessProgram -> WitnessStack
toWitnessStack (WitnessProgram -> Either String WitnessData)
-> Either String WitnessProgram -> Either String WitnessData
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ScriptOutput -> ScriptInput -> Either String WitnessProgram
calcWitnessProgram ScriptOutput
so ScriptInput
si
    | Bool
otherwise = WitnessData -> Either String WitnessData
forall (m :: * -> *) a. Monad m => a -> m a
return (WitnessData -> Either String WitnessData)
-> WitnessData -> Either String WitnessData
forall a b. (a -> b) -> a -> b
$ Tx -> WitnessData
txWitness Tx
tx
  where
    updateWitness :: WitnessStack -> Either a WitnessData
updateWitness WitnessStack
w
        | WitnessData -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (WitnessData -> Bool) -> WitnessData -> Bool
forall a b. (a -> b) -> a -> b
$ Tx -> WitnessData
txWitness Tx
tx = WitnessData -> Either a WitnessData
forall (m :: * -> *) a. Monad m => a -> m a
return (WitnessData -> Either a WitnessData)
-> WitnessData -> Either a WitnessData
forall a b. (a -> b) -> a -> b
$ Int -> WitnessData -> (WitnessStack -> WitnessStack) -> WitnessData
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i WitnessData
defaultStack (WitnessStack -> WitnessStack -> WitnessStack
forall a b. a -> b -> a
const WitnessStack
w)
        | WitnessData -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> WitnessData
txWitness Tx
tx) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n = a -> Either a WitnessData
forall a b. a -> Either a b
Left a
"Invalid number of witness stacks"
        | Bool
otherwise = WitnessData -> Either a WitnessData
forall (m :: * -> *) a. Monad m => a -> m a
return (WitnessData -> Either a WitnessData)
-> WitnessData -> Either a WitnessData
forall a b. (a -> b) -> a -> b
$ Int -> WitnessData -> (WitnessStack -> WitnessStack) -> WitnessData
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i (Tx -> WitnessData
txWitness Tx
tx) (WitnessStack -> WitnessStack -> WitnessStack
forall a b. a -> b -> a
const WitnessStack
w)
    defaultStack :: WitnessData
defaultStack = Int -> WitnessStack -> WitnessData
forall a. Int -> a -> [a]
replicate Int
n (WitnessStack -> WitnessData) -> WitnessStack -> WitnessData
forall a b. (a -> b) -> a -> b
$ WitnessProgram -> WitnessStack
toWitnessStack WitnessProgram
EmptyWitnessProgram
    n :: Int
n = [TxIn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([TxIn] -> Int) -> [TxIn] -> Int
forall a b. (a -> b) -> a -> b
$ Tx -> [TxIn]
txIn Tx
tx

-- | Associate an input index to each value in a list
findInputIndex ::
    -- | extract an outpoint
    (a -> OutPoint) ->
    -- | input list
    [a] ->
    -- | reference list of inputs
    [TxIn] ->
    [(a, Int)]
findInputIndex :: (a -> OutPoint) -> [a] -> [TxIn] -> [(a, Int)]
findInputIndex a -> OutPoint
getOutPoint [a]
as [TxIn]
ti =
    ((Maybe a, Int) -> Maybe (a, Int))
-> [(Maybe a, Int)] -> [(a, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Maybe a, Int) -> Maybe (a, Int)
forall a b. (Maybe a, b) -> Maybe (a, b)
g ([(Maybe a, Int)] -> [(a, Int)]) -> [(Maybe a, Int)] -> [(a, Int)]
forall a b. (a -> b) -> a -> b
$ [Maybe a] -> [Int] -> [(Maybe a, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [TxIn] -> (a -> TxIn -> Bool) -> [Maybe a]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [a]
as [TxIn]
ti a -> TxIn -> Bool
f) [Int
0 ..]
  where
    f :: a -> TxIn -> Bool
f a
s TxIn
txin = a -> OutPoint
getOutPoint a
s OutPoint -> OutPoint -> Bool
forall a. Eq a => a -> a -> Bool
== TxIn -> OutPoint
prevOutput TxIn
txin
    g :: (Maybe a, b) -> Maybe (a, b)
g (Just a
s, b
i) = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
s, b
i)
    g (Maybe a
Nothing, b
_) = Maybe (a, b)
forall a. Maybe a
Nothing

{- | Find from the list of provided private keys which one is required to sign
 the 'ScriptOutput'.
-}
sigKeys ::
    ScriptOutput ->
    Maybe RedeemScript ->
    [SecKey] ->
    Either String [SecKeyI]
sigKeys :: ScriptOutput
-> Maybe ScriptOutput -> [SecKey] -> Either String [SecKeyI]
sigKeys ScriptOutput
so Maybe ScriptOutput
rdmM [SecKey]
keys =
    case (ScriptOutput
so, Maybe ScriptOutput
rdmM) of
        (PayPK PubKeyI
p, Maybe ScriptOutput
Nothing) ->
            [SecKeyI] -> Either String [SecKeyI]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecKeyI] -> Either String [SecKeyI])
-> (Maybe (SecKeyI, PubKeyI) -> [SecKeyI])
-> Maybe (SecKeyI, PubKeyI)
-> Either String [SecKeyI]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SecKeyI, PubKeyI) -> SecKeyI)
-> [(SecKeyI, PubKeyI)] -> [SecKeyI]
forall a b. (a -> b) -> [a] -> [b]
map (SecKeyI, PubKeyI) -> SecKeyI
forall a b. (a, b) -> a
fst ([(SecKeyI, PubKeyI)] -> [SecKeyI])
-> (Maybe (SecKeyI, PubKeyI) -> [(SecKeyI, PubKeyI)])
-> Maybe (SecKeyI, PubKeyI)
-> [SecKeyI]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (SecKeyI, PubKeyI) -> [(SecKeyI, PubKeyI)]
forall a. Maybe a -> [a]
maybeToList (Maybe (SecKeyI, PubKeyI) -> Either String [SecKeyI])
-> Maybe (SecKeyI, PubKeyI) -> Either String [SecKeyI]
forall a b. (a -> b) -> a -> b
$ ((SecKeyI, PubKeyI) -> Bool)
-> [(SecKeyI, PubKeyI)] -> Maybe (SecKeyI, PubKeyI)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((PubKeyI -> PubKeyI -> Bool
forall a. Eq a => a -> a -> Bool
== PubKeyI
p) (PubKeyI -> Bool)
-> ((SecKeyI, PubKeyI) -> PubKeyI) -> (SecKeyI, PubKeyI) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SecKeyI, PubKeyI) -> PubKeyI
forall a b. (a, b) -> b
snd) [(SecKeyI, PubKeyI)]
zipKeys
        (PayPKHash Hash160
h, Maybe ScriptOutput
Nothing) -> [SecKeyI] -> Either String [SecKeyI]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecKeyI] -> Either String [SecKeyI])
-> [SecKeyI] -> Either String [SecKeyI]
forall a b. (a -> b) -> a -> b
$ Hash160 -> [SecKeyI]
keyByHash Hash160
h
        (PayMulSig [PubKeyI]
ps Int
r, Maybe ScriptOutput
Nothing) ->
            [SecKeyI] -> Either String [SecKeyI]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecKeyI] -> Either String [SecKeyI])
-> [SecKeyI] -> Either String [SecKeyI]
forall a b. (a -> b) -> a -> b
$ ((SecKeyI, PubKeyI) -> SecKeyI)
-> [(SecKeyI, PubKeyI)] -> [SecKeyI]
forall a b. (a -> b) -> [a] -> [b]
map (SecKeyI, PubKeyI) -> SecKeyI
forall a b. (a, b) -> a
fst ([(SecKeyI, PubKeyI)] -> [SecKeyI])
-> [(SecKeyI, PubKeyI)] -> [SecKeyI]
forall a b. (a -> b) -> a -> b
$ Int -> [(SecKeyI, PubKeyI)] -> [(SecKeyI, PubKeyI)]
forall a. Int -> [a] -> [a]
take Int
r ([(SecKeyI, PubKeyI)] -> [(SecKeyI, PubKeyI)])
-> [(SecKeyI, PubKeyI)] -> [(SecKeyI, PubKeyI)]
forall a b. (a -> b) -> a -> b
$ ((SecKeyI, PubKeyI) -> Bool)
-> [(SecKeyI, PubKeyI)] -> [(SecKeyI, PubKeyI)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((PubKeyI -> [PubKeyI] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PubKeyI]
ps) (PubKeyI -> Bool)
-> ((SecKeyI, PubKeyI) -> PubKeyI) -> (SecKeyI, PubKeyI) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SecKeyI, PubKeyI) -> PubKeyI
forall a b. (a, b) -> b
snd) [(SecKeyI, PubKeyI)]
zipKeys
        (PayScriptHash Hash160
_, Just ScriptOutput
rdm) -> ScriptOutput
-> Maybe ScriptOutput -> [SecKey] -> Either String [SecKeyI]
sigKeys ScriptOutput
rdm Maybe ScriptOutput
forall a. Maybe a
Nothing [SecKey]
keys
        (PayWitnessPKHash Hash160
h, Maybe ScriptOutput
_) -> [SecKeyI] -> Either String [SecKeyI]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SecKeyI] -> Either String [SecKeyI])
-> [SecKeyI] -> Either String [SecKeyI]
forall a b. (a -> b) -> a -> b
$ Hash160 -> [SecKeyI]
keyByHash Hash160
h
        (PayWitnessScriptHash Hash256
_, Just ScriptOutput
rdm) -> ScriptOutput
-> Maybe ScriptOutput -> [SecKey] -> Either String [SecKeyI]
sigKeys ScriptOutput
rdm Maybe ScriptOutput
forall a. Maybe a
Nothing [SecKey]
keys
        (ScriptOutput, Maybe ScriptOutput)
_ -> String -> Either String [SecKeyI]
forall a b. a -> Either a b
Left String
"sigKeys: Could not decode output script"
  where
    zipKeys :: [(SecKeyI, PubKeyI)]
zipKeys =
        [ (SecKeyI
prv, PubKeyI
pub)
        | SecKey
k <- [SecKey]
keys
        , Bool
t <- [Bool
True, Bool
False]
        , let prv :: SecKeyI
prv = Bool -> SecKey -> SecKeyI
wrapSecKey Bool
t SecKey
k
        , let pub :: PubKeyI
pub = SecKeyI -> PubKeyI
derivePubKeyI SecKeyI
prv
        ]
    keyByHash :: Hash160 -> [SecKeyI]
keyByHash Hash160
h = ((SecKeyI, PubKeyI) -> SecKeyI)
-> [(SecKeyI, PubKeyI)] -> [SecKeyI]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SecKeyI, PubKeyI) -> SecKeyI
forall a b. (a, b) -> a
fst ([(SecKeyI, PubKeyI)] -> [SecKeyI])
-> ([(SecKeyI, PubKeyI)] -> [(SecKeyI, PubKeyI)])
-> [(SecKeyI, PubKeyI)]
-> [SecKeyI]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (SecKeyI, PubKeyI) -> [(SecKeyI, PubKeyI)]
forall a. Maybe a -> [a]
maybeToList (Maybe (SecKeyI, PubKeyI) -> [(SecKeyI, PubKeyI)])
-> ([(SecKeyI, PubKeyI)] -> Maybe (SecKeyI, PubKeyI))
-> [(SecKeyI, PubKeyI)]
-> [(SecKeyI, PubKeyI)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash160 -> [(SecKeyI, PubKeyI)] -> Maybe (SecKeyI, PubKeyI)
forall (t :: * -> *) a.
Foldable t =>
Hash160 -> t (a, PubKeyI) -> Maybe (a, PubKeyI)
findKey Hash160
h ([(SecKeyI, PubKeyI)] -> [SecKeyI])
-> [(SecKeyI, PubKeyI)] -> [SecKeyI]
forall a b. (a -> b) -> a -> b
$ [(SecKeyI, PubKeyI)]
zipKeys
    findKey :: Hash160 -> t (a, PubKeyI) -> Maybe (a, PubKeyI)
findKey Hash160
h = ((a, PubKeyI) -> Bool) -> t (a, PubKeyI) -> Maybe (a, PubKeyI)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (((a, PubKeyI) -> Bool) -> t (a, PubKeyI) -> Maybe (a, PubKeyI))
-> ((a, PubKeyI) -> Bool) -> t (a, PubKeyI) -> Maybe (a, PubKeyI)
forall a b. (a -> b) -> a -> b
$ (Hash160 -> Hash160 -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160
h) (Hash160 -> Bool)
-> ((a, PubKeyI) -> Hash160) -> (a, PubKeyI) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Hash160
getAddrHash160 (Address -> Hash160)
-> ((a, PubKeyI) -> Address) -> (a, PubKeyI) -> Hash160
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyI -> Address
pubKeyAddr (PubKeyI -> Address)
-> ((a, PubKeyI) -> PubKeyI) -> (a, PubKeyI) -> Address
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, PubKeyI) -> PubKeyI
forall a b. (a, b) -> b
snd

{- | Construct an input for a transaction given a signature, public key and data
 about the previous output.
-}
buildInput ::
    Network ->
    -- | transaction where input will be added
    Tx ->
    -- | input index where signature will go
    Int ->
    -- | output script being spent
    ScriptOutput ->
    -- | amount of previous output
    Word64 ->
    -- | redeem script if pay-to-script-hash
    Maybe RedeemScript ->
    TxSignature ->
    PubKeyI ->
    Either String ScriptInput
buildInput :: Network
-> Tx
-> Int
-> ScriptOutput
-> Word64
-> Maybe ScriptOutput
-> TxSignature
-> PubKeyI
-> Either String ScriptInput
buildInput Network
net Tx
tx Int
i ScriptOutput
so Word64
val Maybe ScriptOutput
rdmM TxSignature
sig PubKeyI
pub = do
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [TxIn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> [TxIn]
txIn Tx
tx)) (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
"buildInput: Invalid input index"
    case (ScriptOutput
so, Maybe ScriptOutput
rdmM) of
        (PayScriptHash Hash160
_, Just ScriptOutput
rdm) -> ScriptOutput -> Either String ScriptInput
buildScriptHashInput ScriptOutput
rdm
        (PayWitnessScriptHash Hash256
_, Just ScriptOutput
rdm) -> ScriptOutput -> Either String ScriptInput
buildScriptHashInput ScriptOutput
rdm
        (PayWitnessPKHash Hash160
_, Maybe ScriptOutput
Nothing) -> ScriptInput -> Either String ScriptInput
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Either String ScriptInput)
-> (SimpleInput -> ScriptInput)
-> SimpleInput
-> Either String ScriptInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleInput -> ScriptInput
RegularInput (SimpleInput -> Either String ScriptInput)
-> SimpleInput -> Either String ScriptInput
forall a b. (a -> b) -> a -> b
$ TxSignature -> PubKeyI -> SimpleInput
SpendPKHash TxSignature
sig PubKeyI
pub
        (ScriptOutput
_, Maybe ScriptOutput
Nothing) -> ScriptOutput -> Either String ScriptInput
buildRegularInput ScriptOutput
so
        (ScriptOutput, Maybe ScriptOutput)
_ -> String -> Either String ScriptInput
forall a b. a -> Either a b
Left String
"buildInput: Invalid output/redeem script combination"
  where
    buildRegularInput :: ScriptOutput -> Either String ScriptInput
buildRegularInput = \case
        PayPK PubKeyI
_ -> ScriptInput -> Either String ScriptInput
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Either String ScriptInput)
-> ScriptInput -> Either String ScriptInput
forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptInput
RegularInput (SimpleInput -> ScriptInput) -> SimpleInput -> ScriptInput
forall a b. (a -> b) -> a -> b
$ TxSignature -> SimpleInput
SpendPK TxSignature
sig
        PayPKHash Hash160
_ -> ScriptInput -> Either String ScriptInput
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Either String ScriptInput)
-> ScriptInput -> Either String ScriptInput
forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptInput
RegularInput (SimpleInput -> ScriptInput) -> SimpleInput -> ScriptInput
forall a b. (a -> b) -> a -> b
$ TxSignature -> PubKeyI -> SimpleInput
SpendPKHash TxSignature
sig PubKeyI
pub
        PayMulSig [PubKeyI]
msPubs Int
r -> do
            let mSigs :: [TxSignature]
mSigs = Int -> [TxSignature] -> [TxSignature]
forall a. Int -> [a] -> [a]
take Int
r ([TxSignature] -> [TxSignature]) -> [TxSignature] -> [TxSignature]
forall a b. (a -> b) -> a -> b
$ [Maybe TxSignature] -> [TxSignature]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TxSignature] -> [TxSignature])
-> [Maybe TxSignature] -> [TxSignature]
forall a b. (a -> b) -> a -> b
$ [TxSignature]
-> [PubKeyI]
-> (TxSignature -> PubKeyI -> Bool)
-> [Maybe TxSignature]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [TxSignature]
allSigs [PubKeyI]
msPubs TxSignature -> PubKeyI -> Bool
f
                allSigs :: [TxSignature]
allSigs = [TxSignature] -> [TxSignature]
forall a. Eq a => [a] -> [a]
nub ([TxSignature] -> [TxSignature]) -> [TxSignature] -> [TxSignature]
forall a b. (a -> b) -> a -> b
$ TxSignature
sig TxSignature -> [TxSignature] -> [TxSignature]
forall a. a -> [a] -> [a]
: Network -> Tx -> ScriptOutput -> Int -> [TxSignature]
parseExistingSigs Network
net Tx
tx ScriptOutput
so Int
i
            ScriptInput -> Either String ScriptInput
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Either String ScriptInput)
-> ScriptInput -> Either String 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]
mSigs
        ScriptOutput
_ -> String -> Either String ScriptInput
forall a b. a -> Either a b
Left String
"buildInput: Invalid output/redeem script combination"
    buildScriptHashInput :: ScriptOutput -> Either String ScriptInput
buildScriptHashInput ScriptOutput
rdm = do
        ScriptInput
inp <- ScriptOutput -> Either String ScriptInput
buildRegularInput ScriptOutput
rdm
        ScriptInput -> Either String ScriptInput
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Either String ScriptInput)
-> ScriptInput -> Either String ScriptInput
forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptOutput -> ScriptInput
ScriptHashInput (ScriptInput -> SimpleInput
getRegularInput ScriptInput
inp) ScriptOutput
rdm
    f :: TxSignature -> PubKeyI -> Bool
f (TxSignature Sig
x SigHash
sh) PubKeyI
p =
        Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (Network
-> Tx
-> Int
-> ScriptOutput
-> Word64
-> SigHash
-> Maybe ScriptOutput
-> Hash256
makeSigHash Network
net Tx
tx Int
i ScriptOutput
so Word64
val SigHash
sh Maybe ScriptOutput
rdmM) Sig
x (PubKeyI -> PubKey
pubKeyPoint PubKeyI
p)
    f TxSignature
TxSignatureEmpty PubKeyI
_ = Bool
False

{- | Apply heuristics to extract the signatures for a particular input that are
 embedded in the transaction.

 @since 0.11.0.0
-}
parseExistingSigs :: Network -> Tx -> ScriptOutput -> Int -> [TxSignature]
parseExistingSigs :: Network -> Tx -> ScriptOutput -> Int -> [TxSignature]
parseExistingSigs Network
net Tx
tx ScriptOutput
so Int
i = [TxSignature]
insSigs [TxSignature] -> [TxSignature] -> [TxSignature]
forall a. Semigroup a => a -> a -> a
<> [TxSignature]
witSigs
  where
    insSigs :: [TxSignature]
insSigs = case Network -> ByteString -> Either String ScriptInput
decodeInputBS Network
net ByteString
scp of
        Right (ScriptHashInput (SpendMulSig [TxSignature]
xs) ScriptOutput
_) -> [TxSignature]
xs
        Right (RegularInput (SpendMulSig [TxSignature]
xs)) -> [TxSignature]
xs
        Either String ScriptInput
_ -> []
    scp :: ByteString
scp = TxIn -> ByteString
scriptInput (TxIn -> ByteString) -> TxIn -> ByteString
forall a b. (a -> b) -> a -> b
$ Tx -> [TxIn]
txIn Tx
tx [TxIn] -> Int -> TxIn
forall a. [a] -> Int -> a
!! Int
i
    witSigs :: [TxSignature]
witSigs
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Bool
isSegwit ScriptOutput
so = []
        | WitnessData -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (WitnessData -> Bool) -> WitnessData -> Bool
forall a b. (a -> b) -> a -> b
$ Tx -> WitnessData
txWitness Tx
tx = []
        | Bool
otherwise = [Either String TxSignature] -> [TxSignature]
forall a b. [Either a b] -> [b]
rights ([Either String TxSignature] -> [TxSignature])
-> [Either String TxSignature] -> [TxSignature]
forall a b. (a -> b) -> a -> b
$ Network -> ByteString -> Either String TxSignature
decodeTxSig Network
net (ByteString -> Either String TxSignature)
-> WitnessStack -> [Either String TxSignature]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Tx -> WitnessData
txWitness Tx
tx WitnessData -> Int -> WitnessStack
forall a. [a] -> Int -> a
!! Int
i)

-- | Produce a structured representation of a deterministic (RFC-6979) signature over an input.
makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature
makeSignature :: Network -> Tx -> Int -> SigInput -> SecKeyI -> TxSignature
makeSignature Network
net Tx
tx Int
i (SigInput ScriptOutput
so Word64
val OutPoint
_ SigHash
sh Maybe ScriptOutput
rdmM) SecKeyI
key =
    Sig -> SigHash -> TxSignature
TxSignature (SecKey -> Hash256 -> Sig
signHash (SecKeyI -> SecKey
secKeyData SecKeyI
key) Hash256
m) SigHash
sh
  where
    m :: Hash256
m = Network
-> Tx
-> Int
-> ScriptOutput
-> Word64
-> SigHash
-> Maybe ScriptOutput
-> Hash256
makeSigHash Network
net Tx
tx Int
i ScriptOutput
so Word64
val SigHash
sh Maybe ScriptOutput
rdmM

{- | A function which selects the digest algorithm and parameters as appropriate

 @since 0.11.0.0
-}
makeSigHash ::
    Network ->
    Tx ->
    Int ->
    ScriptOutput ->
    Word64 ->
    SigHash ->
    Maybe RedeemScript ->
    Hash256
makeSigHash :: Network
-> Tx
-> Int
-> ScriptOutput
-> Word64
-> SigHash
-> Maybe ScriptOutput
-> Hash256
makeSigHash Network
net Tx
tx Int
i ScriptOutput
so Word64
val SigHash
sh Maybe ScriptOutput
rdmM = Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
h Network
net Tx
tx (ScriptOutput -> Script
encodeOutput ScriptOutput
so') Word64
val Int
i SigHash
sh
  where
    so' :: ScriptOutput
so' = case ScriptOutput
so of
        PayWitnessPKHash Hash160
h' -> Hash160 -> ScriptOutput
PayPKHash Hash160
h'
        ScriptOutput
_ -> ScriptOutput -> Maybe ScriptOutput -> ScriptOutput
forall a. a -> Maybe a -> a
fromMaybe ScriptOutput
so Maybe ScriptOutput
rdmM
    h :: Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
h
        | ScriptOutput -> Bool
isSegwit ScriptOutput
so = Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHashForkId
        | Bool
otherwise = Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHash