{-# 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.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 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 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"
signTx :: Network
-> Tx
-> [(SigInput, Bool)]
-> [SecKey]
-> Either String Tx
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
signInput ::
Network
-> Tx
-> Int
-> (SigInput, Bool)
-> 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)
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
findInputIndex ::
(a -> OutPoint)
-> [a]
-> [TxIn]
-> [(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
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
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 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
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)
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
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