{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
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 SigInput = SigInput
{
SigInput -> ScriptOutput
sigInputScript :: !ScriptOutput
,
SigInput -> Word64
sigInputValue :: !Word64
,
SigInput -> OutPoint
sigInputOP :: !OutPoint
,
SigInput -> SigHash
sigInputSH :: !SigHash
,
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"
signTx ::
Network ->
Tx ->
[(SigInput, Bool)] ->
[SecKey] ->
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
signInput ::
Network ->
Tx ->
Int ->
(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)
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
findInputIndex ::
(a -> OutPoint) ->
[a] ->
[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
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
buildInput ::
Network ->
Tx ->
Int ->
ScriptOutput ->
Word64 ->
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
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)
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
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