{-# 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.Either                (rights)
import           Data.Hashable              (Hashable)
import           Data.List                  (find, nub)
import           Data.Maybe                 (catMaybes, fromMaybe, mapMaybe,
                                             maybeToList)
import qualified Data.Serialize             as S
import           Data.Word                  (Word64)
import           GHC.Generics               (Generic)
import           Haskoin.Address            (getAddrHash160, pubKeyAddr)
import           Haskoin.Constants          (Network)
import           Haskoin.Crypto             (Hash256, SecKey)
import           Haskoin.Crypto.Signature   (signHash, verifyHashSig)
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
    { SigInput -> ScriptOutput
sigInputScript :: !ScriptOutput -- ^ output script to spend
    -- ^ output script value
    , SigInput -> Word64
sigInputValue  :: !Word64 -- ^ output script value
    -- ^ outpoint to spend
    , SigInput -> OutPoint
sigInputOP     :: !OutPoint -- ^ outpoint to spend
    -- ^ signature type
    , SigInput -> SigHash
sigInputSH     :: !SigHash -- ^ signature type
    -- ^ redeem script
    , SigInput -> Maybe ScriptOutput
sigInputRedeem :: !(Maybe RedeemScript) -- ^ redeem script
    }
    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 so :: ScriptOutput
so val :: Word64
val op :: OutPoint
op sh :: SigHash
sh rdm :: Maybe ScriptOutput
rdm) =
        [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
            [ "pkscript" Text -> ScriptOutput -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ScriptOutput
so
            , "value"    Text -> Word64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
val
            , "outpoint" Text -> OutPoint -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OutPoint
op
            , "sighash"  Text -> SigHash -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= SigHash
sh
            ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
            [ "redeem" Text -> ScriptOutput -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ScriptOutput
r | ScriptOutput
r <- Maybe ScriptOutput -> [ScriptOutput]
forall a. Maybe a -> [a]
maybeToList Maybe ScriptOutput
rdm ]
    toEncoding :: SigInput -> Encoding
toEncoding (SigInput so :: ScriptOutput
so val :: Word64
val op :: OutPoint
op sh :: SigHash
sh rdm :: Maybe ScriptOutput
rdm) =
        Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
            "pkscript" Text -> ScriptOutput -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ScriptOutput
so
         Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "value"    Text -> Word64 -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Word64
val
         Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "outpoint" Text -> OutPoint -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= OutPoint
op
         Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> "sighash"  Text -> SigHash -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 ("redeem" Text -> ScriptOutput -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> 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 "SigInput" ((Object -> Parser SigInput) -> Value -> Parser SigInput)
-> (Object -> Parser SigInput) -> Value -> Parser SigInput
forall a b. (a -> b) -> a -> b
$ \o :: 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 -> Text -> Parser ScriptOutput
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 -> Text -> Parser Word64
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 -> Text -> Parser OutPoint
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 -> Text -> Parser SigHash
forall a. FromJSON a => Object -> Text -> Parser a
.: "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 -> Text -> Parser (Maybe ScriptOutput)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "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
       -> Tx                 -- ^ transaction to sign
       -> [(SigInput, Bool)] -- ^ signing parameters, with nesting flag
       -> [SecKey]           -- ^ private keys to sign with
       -> Either String Tx   -- ^ signed transaction
signTx :: Network -> Tx -> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
signTx net :: Network
net otx :: Tx
otx sigis :: [(SigInput, Bool)]
sigis allKeys :: [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 "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
tx (sigi :: (SigInput, Bool)
sigi@(SigInput so :: ScriptOutput
so _ _ _ rdmM :: Maybe ScriptOutput
rdmM, _), i :: 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 (\t :: Tx
t k :: 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
    -> (SigInput, Bool) -- ^ boolean flag: nest input
    -> SecKeyI
    -> Either String Tx
signInput :: Network
-> Tx -> Int -> (SigInput, Bool) -> SecKeyI -> Either String Tx
signInput net :: Network
net tx :: Tx
tx i :: Int
i (sigIn :: SigInput
sigIn@(SigInput so :: ScriptOutput
so val :: Word64
val _ _ rdmM :: Maybe ScriptOutput
rdmM), nest :: Bool
nest) key :: 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 si :: ScriptInput
si x :: TxIn
x = TxIn
x {scriptInput :: ByteString
scriptInput = ScriptInput -> ByteString
encodeInputBS ScriptInput
si}
    g :: ScriptOutput -> TxIn -> TxIn
g so' :: ScriptOutput
so' x :: TxIn
x = TxIn
x {scriptInput :: ByteString
scriptInput = ScriptOp -> ByteString
forall a. Serialize a => a -> ByteString
S.encode (ScriptOp -> ByteString)
-> (ByteString -> ScriptOp) -> ByteString -> ByteString
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 so' :: ScriptOutput
so' si :: 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
tx i :: Int
i so :: ScriptOutput
so si :: 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 w :: 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 "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 ::
       (a -> OutPoint) -- ^ extract an outpoint
    -> [a]             -- ^ input list
    -> [TxIn]          -- ^ reference list of inputs
    -> [(a, Int)]
findInputIndex :: (a -> OutPoint) -> [a] -> [TxIn] -> [(a, Int)]
findInputIndex getOutPoint :: a -> OutPoint
getOutPoint as :: [a]
as ti :: [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) [0..]
  where
    f :: a -> TxIn -> Bool
f s :: a
s txin :: 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 s :: a
s, i :: b
i)  = (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
s,b
i)
    g (Nothing, _) = 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 so :: ScriptOutput
so rdmM :: Maybe ScriptOutput
rdmM keys :: [SecKey]
keys =
    case (ScriptOutput
so, Maybe ScriptOutput
rdmM) of
        (PayPK p :: PubKeyI
p, 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 h :: Hash160
h, 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 ps :: [PubKeyI]
ps r :: Int
r, 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 _, Just rdm :: ScriptOutput
rdm) -> ScriptOutput
-> Maybe ScriptOutput -> [SecKey] -> Either String [SecKeyI]
sigKeys ScriptOutput
rdm Maybe ScriptOutput
forall a. Maybe a
Nothing [SecKey]
keys
        (PayWitnessPKHash h :: Hash160
h, _) -> [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 _, Just rdm :: ScriptOutput
rdm) -> ScriptOutput
-> Maybe ScriptOutput -> [SecKey] -> Either String [SecKeyI]
sigKeys ScriptOutput
rdm Maybe ScriptOutput
forall a. Maybe a
Nothing [SecKey]
keys
        _ -> String -> Either String [SecKeyI]
forall a b. a -> Either a b
Left "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 h :: 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 h :: 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
    -> Tx                 -- ^ transaction where input will be added
    -> Int                -- ^ input index where signature will go
    -> ScriptOutput       -- ^ output script being spent
    -> Word64             -- ^ amount of previous output
    -> Maybe RedeemScript -- ^ redeem script if pay-to-script-hash
    -> TxSignature
    -> PubKeyI
    -> Either String ScriptInput
buildInput :: Network
-> Tx
-> Int
-> ScriptOutput
-> Word64
-> Maybe ScriptOutput
-> TxSignature
-> PubKeyI
-> Either String ScriptInput
buildInput net :: Network
net tx :: Tx
tx i :: Int
i so :: ScriptOutput
so val :: Word64
val rdmM :: Maybe ScriptOutput
rdmM sig :: TxSignature
sig pub :: 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 "buildInput: Invalid input index"
    case (ScriptOutput
so, Maybe ScriptOutput
rdmM) of
        (PayScriptHash _, Just rdm :: ScriptOutput
rdm)        -> ScriptOutput -> Either String ScriptInput
buildScriptHashInput ScriptOutput
rdm
        (PayWitnessScriptHash _, Just rdm :: ScriptOutput
rdm) -> ScriptOutput -> Either String ScriptInput
buildScriptHashInput ScriptOutput
rdm
        (PayWitnessPKHash _, 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
        (_, Nothing)                       -> ScriptOutput -> Either String ScriptInput
buildRegularInput ScriptOutput
so
        _ -> String -> Either String ScriptInput
forall a b. a -> Either a b
Left "buildInput: Invalid output/redeem script combination"
  where
    buildRegularInput :: ScriptOutput -> Either String ScriptInput
buildRegularInput = \case
        PayPK _ -> 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 _ -> 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 msPubs :: [PubKeyI]
msPubs r :: 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
        _ -> String -> Either String ScriptInput
forall a b. a -> Either a b
Left "buildInput: Invalid output/redeem script combination"
    buildScriptHashInput :: ScriptOutput -> Either String ScriptInput
buildScriptHashInput rdm :: 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 x :: Sig
x sh :: SigHash
sh) p :: 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 TxSignatureEmpty _ = 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 net :: Network
net tx :: Tx
tx so :: ScriptOutput
so i :: 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 xs :: [TxSignature]
xs) _) -> [TxSignature]
xs
            Right (RegularInput (SpendMulSig xs :: [TxSignature]
xs))      -> [TxSignature]
xs
            _                                          -> []
    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 net :: Network
net tx :: Tx
tx i :: Int
i (SigInput so :: ScriptOutput
so val :: Word64
val _ sh :: SigHash
sh rdmM :: Maybe ScriptOutput
rdmM) key :: 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 net :: Network
net tx :: Tx
tx i :: Int
i so :: ScriptOutput
so val :: Word64
val sh :: SigHash
sh rdmM :: 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 h' :: Hash160
h' -> Hash160 -> ScriptOutput
PayPKHash Hash160
h'
        _                   -> 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