{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Haskoin.Transaction.Builder
(
buildAddrTx
, buildTx
, buildInput
, SigInput(..)
, signTx
, signNestedWitnessTx
, makeSignature
, signInput
, signNestedInput
, verifyStdTx
, mergeTxs
, sigKeys
, mergeTxInput
, findSigInput
, verifyStdInput
, Coin(..)
, chooseCoins
, chooseCoinsSink
, chooseMSCoins
, chooseMSCoinsSink
, countMulSig
, greedyAddSink
, guessTxFee
, guessMSTxFee
, guessTxSize
, guessMSSize
) where
import Control.Applicative ((<|>))
import Control.Arrow (first)
import Control.Monad (foldM, unless)
import Control.Monad.Identity (runIdentity)
import Crypto.Secp256k1
import qualified Data.ByteString as B
import Data.Conduit (ConduitT, Void, await,
runConduit, (.|))
import Data.Conduit.List (sourceList)
import Data.Either (fromRight)
import Data.List (nub)
import Data.Maybe (catMaybes, fromJust, isJust)
import Data.Serialize (decode, encode)
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Word (Word64)
import Haskoin.Address
import Haskoin.Constants
import Haskoin.Crypto.Hash (Hash256, addressHash)
import Haskoin.Crypto.Signature
import Haskoin.Keys.Common
import Haskoin.Network.Common
import Haskoin.Script
import Haskoin.Transaction.Builder.Sign (SigInput (..), buildInput,
makeSignature, sigKeys)
import qualified Haskoin.Transaction.Builder.Sign as S
import Haskoin.Transaction.Common
import Haskoin.Transaction.Segwit (decodeWitnessInput, isSegwit,
viewWitnessProgram)
import Haskoin.Util
class Coin c where
coinValue :: c -> Word64
chooseCoins :: Coin c
=> Word64
-> Word64
-> Int
-> Bool
-> [c]
-> Either String ([c], Word64)
chooseCoins :: Word64
-> Word64 -> Int -> Bool -> [c] -> Either String ([c], Word64)
chooseCoins target :: Word64
target fee :: Word64
fee nOut :: Int
nOut continue :: Bool
continue coins :: [c]
coins =
Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall a. Identity a -> a
runIdentity (Identity (Either String ([c], Word64))
-> Either String ([c], Word64))
-> (ConduitT () Void Identity (Either String ([c], Word64))
-> Identity (Either String ([c], Word64)))
-> ConduitT () Void Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void Identity (Either String ([c], Word64))
-> Identity (Either String ([c], Word64))
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void Identity (Either String ([c], Word64))
-> Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall a b. (a -> b) -> a -> b
$
[c] -> ConduitT () c Identity ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList [c]
coins ConduitT () c Identity ()
-> ConduitM c Void Identity (Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Word64
-> Word64
-> Int
-> Bool
-> ConduitM c Void Identity (Either String ([c], Word64))
forall (m :: * -> *) c.
(Monad m, Coin c) =>
Word64
-> Word64
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseCoinsSink Word64
target Word64
fee Int
nOut Bool
continue
chooseCoinsSink :: (Monad m, Coin c)
=> Word64
-> Word64
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseCoinsSink :: Word64
-> Word64
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseCoinsSink target :: Word64
target fee :: Word64
fee nOut :: Int
nOut continue :: Bool
continue
| Word64
target Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
String -> Maybe ([c], Word64) -> Either String ([c], Word64)
forall b a. b -> Maybe a -> Either b a
maybeToEither String
err (Maybe ([c], Word64) -> Either String ([c], Word64))
-> ConduitT c Void m (Maybe ([c], Word64))
-> ConduitT c Void m (Either String ([c], Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
forall (m :: * -> *) c.
(Monad m, Coin c) =>
Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
greedyAddSink Word64
target (Word64 -> Int -> Int -> Word64
guessTxFee Word64
fee Int
nOut) Bool
continue
| Bool
otherwise = Either String ([c], Word64)
-> ConduitT c Void m (Either String ([c], Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ([c], Word64)
-> ConduitT c Void m (Either String ([c], Word64)))
-> Either String ([c], Word64)
-> ConduitT c Void m (Either String ([c], Word64))
forall a b. (a -> b) -> a -> b
$ String -> Either String ([c], Word64)
forall a b. a -> Either a b
Left "chooseCoins: Target must be > 0"
where
err :: String
err = "chooseCoins: No solution found"
chooseMSCoins :: Coin c
=> Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> [c]
-> Either String ([c], Word64)
chooseMSCoins :: Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> [c]
-> Either String ([c], Word64)
chooseMSCoins target :: Word64
target fee :: Word64
fee ms :: (Int, Int)
ms nOut :: Int
nOut continue :: Bool
continue coins :: [c]
coins =
Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall a. Identity a -> a
runIdentity (Identity (Either String ([c], Word64))
-> Either String ([c], Word64))
-> (ConduitT () Void Identity (Either String ([c], Word64))
-> Identity (Either String ([c], Word64)))
-> ConduitT () Void Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void Identity (Either String ([c], Word64))
-> Identity (Either String ([c], Word64))
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void Identity (Either String ([c], Word64))
-> Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
-> Either String ([c], Word64)
forall a b. (a -> b) -> a -> b
$
[c] -> ConduitT () c Identity ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
sourceList [c]
coins ConduitT () c Identity ()
-> ConduitM c Void Identity (Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> ConduitM c Void Identity (Either String ([c], Word64))
forall (m :: * -> *) c.
(Monad m, Coin c) =>
Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseMSCoinsSink Word64
target Word64
fee (Int, Int)
ms Int
nOut Bool
continue
chooseMSCoinsSink :: (Monad m, Coin c)
=> Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseMSCoinsSink :: Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> ConduitT c Void m (Either String ([c], Word64))
chooseMSCoinsSink target :: Word64
target fee :: Word64
fee ms :: (Int, Int)
ms nOut :: Int
nOut continue :: Bool
continue
| Word64
target Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 =
String -> Maybe ([c], Word64) -> Either String ([c], Word64)
forall b a. b -> Maybe a -> Either b a
maybeToEither String
err (Maybe ([c], Word64) -> Either String ([c], Word64))
-> ConduitT c Void m (Maybe ([c], Word64))
-> ConduitT c Void m (Either String ([c], Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
forall (m :: * -> *) c.
(Monad m, Coin c) =>
Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
greedyAddSink Word64
target (Word64 -> (Int, Int) -> Int -> Int -> Word64
guessMSTxFee Word64
fee (Int, Int)
ms Int
nOut) Bool
continue
| Bool
otherwise = Either String ([c], Word64)
-> ConduitT c Void m (Either String ([c], Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String ([c], Word64)
-> ConduitT c Void m (Either String ([c], Word64)))
-> Either String ([c], Word64)
-> ConduitT c Void m (Either String ([c], Word64))
forall a b. (a -> b) -> a -> b
$ String -> Either String ([c], Word64)
forall a b. a -> Either a b
Left "chooseMSCoins: Target must be > 0"
where
err :: String
err = "chooseMSCoins: No solution found"
greedyAddSink :: (Monad m, Coin c)
=> Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
greedyAddSink :: Word64
-> (Int -> Word64)
-> Bool
-> ConduitT c Void m (Maybe ([c], Word64))
greedyAddSink target :: Word64
target guessFee :: Int -> Word64
guessFee continue :: Bool
continue =
[c]
-> Word64
-> [c]
-> Word64
-> ConduitT c Void m (Maybe ([c], Word64))
forall (m :: * -> *) a o.
(Monad m, Coin a) =>
[a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go [] 0 [] 0
where
goal :: Int -> Word64
goal c :: Int
c = Word64
target Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Word64
guessFee Int
c
go :: [a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go acc :: [a]
acc aTot :: Word64
aTot ps :: [a]
ps pTot :: Word64
pTot = ConduitT a o m (Maybe a)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await ConduitT a o m (Maybe a)
-> (Maybe a -> ConduitT a o m (Maybe ([a], Word64)))
-> ConduitT a o m (Maybe ([a], Word64))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just coin :: a
coin -> do
let val :: Word64
val = a -> Word64
forall c. Coin c => c -> Word64
coinValue a
coin
if Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
aTot Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Word64
goal ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
then if Bool
continue
then if Word64
pTot Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== 0 Bool -> Bool -> Bool
|| Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
aTot Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
pTot
then [a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go [] 0 (a
coina -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) (Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
aTot)
else Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64)))
-> Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall a b. (a -> b) -> a -> b
$ ([a], Word64) -> Maybe ([a], Word64)
forall a. a -> Maybe a
Just ([a]
ps, Word64
pTot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
goal ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ps))
else Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64)))
-> Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall a b. (a -> b) -> a -> b
$
([a], Word64) -> Maybe ([a], Word64)
forall a. a -> Maybe a
Just (a
coin a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc, Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
aTot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
goal ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
acc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1))
else [a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go (a
coina -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
acc) (Word64
val Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
aTot) [a]
ps Word64
pTot
Nothing ->
Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64)))
-> Maybe ([a], Word64) -> ConduitT a o m (Maybe ([a], Word64))
forall a b. (a -> b) -> a -> b
$ if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
ps
then Maybe ([a], Word64)
forall a. Maybe a
Nothing
else ([a], Word64) -> Maybe ([a], Word64)
forall a. a -> Maybe a
Just ([a]
ps, Word64
pTot Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Int -> Word64
goal ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
ps))
guessTxFee :: Word64 -> Int -> Int -> Word64
guessTxFee :: Word64 -> Int -> Int -> Word64
guessTxFee byteFee :: Word64
byteFee nOut :: Int
nOut nIn :: Int
nIn =
Word64
byteFee Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> [(Int, Int)] -> Int -> Int -> Int
guessTxSize Int
nIn [] Int
nOut 0)
guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64
guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64
guessMSTxFee byteFee :: Word64
byteFee ms :: (Int, Int)
ms nOut :: Int
nOut nIn :: Int
nIn =
Word64
byteFee Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> [(Int, Int)] -> Int -> Int -> Int
guessTxSize 0 (Int -> (Int, Int) -> [(Int, Int)]
forall a. Int -> a -> [a]
replicate Int
nIn (Int, Int)
ms) Int
nOut 0)
guessTxSize :: Int
-> [(Int,Int)]
-> Int
-> Int
-> Int
guessTxSize :: Int -> [(Int, Int)] -> Int -> Int -> Int
guessTxSize pki :: Int
pki msi :: [(Int, Int)]
msi pkout :: Int
pkout msout :: Int
msout =
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inpLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
inp Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
outLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
out
where
inpLen :: Int
inpLen = ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ VarInt -> ByteString
forall a. Serialize a => a -> ByteString
encode (VarInt -> ByteString) -> VarInt -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> VarInt
VarInt (Word64 -> VarInt) -> Word64 -> VarInt
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ [(Int, Int)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
msi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
pki
outLen :: Int
outLen = ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ VarInt -> ByteString
forall a. Serialize a => a -> ByteString
encode (VarInt -> ByteString) -> VarInt -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> VarInt
VarInt (Word64 -> VarInt) -> Word64 -> VarInt
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ Int
pkout Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
msout
inp :: Int
inp = Int
pki Int -> Int -> Int
forall a. Num a => a -> a -> a
* 148 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (((Int, Int) -> Int) -> [(Int, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int) -> Int
guessMSSize [(Int, Int)]
msi)
out :: Int
out =
Int
pkout Int -> Int -> Int
forall a. Num a => a -> a -> a
* 34 Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Int
msout Int -> Int -> Int
forall a. Num a => a -> a -> a
* 32
guessMSSize :: (Int,Int) -> Int
guessMSSize :: (Int, Int) -> Int
guessMSSize (m :: Int
m, n :: Int
n)
= 40 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ VarInt -> ByteString
forall a. Serialize a => a -> ByteString
encode (VarInt -> ByteString) -> VarInt -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> VarInt
VarInt (Word64 -> VarInt) -> Word64 -> VarInt
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
scp) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
scp
where
rdm :: Int
rdm =
Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$
ByteString -> Int
B.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ ScriptOp -> ByteString
forall a. Serialize a => a -> ByteString
encode (ScriptOp -> ByteString) -> ScriptOp -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ScriptOp
opPushData (ByteString -> ScriptOp) -> ByteString -> ScriptOp
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
B.replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* 34 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 3) 0
scp :: Int
scp = Int
rdm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* 73 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
buildAddrTx :: Network -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
buildAddrTx :: Network -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
buildAddrTx net :: Network
net ops :: [OutPoint]
ops rcps :: [(Text, Word64)]
rcps =
[OutPoint] -> [(ScriptOutput, Word64)] -> Tx
buildTx [OutPoint]
ops ([(ScriptOutput, Word64)] -> Tx)
-> Either String [(ScriptOutput, Word64)] -> Either String Tx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Word64) -> Either String (ScriptOutput, Word64))
-> [(Text, Word64)] -> Either String [(ScriptOutput, Word64)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, Word64) -> Either String (ScriptOutput, Word64)
forall b b.
(Semigroup b, IsString b, ConvertibleStrings Text b) =>
(Text, b) -> Either b (ScriptOutput, b)
f [(Text, Word64)]
rcps
where
f :: (Text, b) -> Either b (ScriptOutput, b)
f (aTxt :: Text
aTxt, v :: b
v) =
b -> Maybe (ScriptOutput, b) -> Either b (ScriptOutput, b)
forall b a. b -> Maybe a -> Either b a
maybeToEither ("buildAddrTx: Invalid address " b -> b -> b
forall a. Semigroup a => a -> a -> a
<> Text -> b
forall a b. ConvertibleStrings a b => a -> b
cs Text
aTxt) (Maybe (ScriptOutput, b) -> Either b (ScriptOutput, b))
-> Maybe (ScriptOutput, b) -> Either b (ScriptOutput, b)
forall a b. (a -> b) -> a -> b
$ do
Address
a <- Network -> Text -> Maybe Address
textToAddr Network
net Text
aTxt
let o :: ScriptOutput
o = Address -> ScriptOutput
addressToOutput Address
a
(ScriptOutput, b) -> Maybe (ScriptOutput, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptOutput
o, b
v)
buildTx :: [OutPoint] -> [(ScriptOutput, Word64)] -> Tx
buildTx :: [OutPoint] -> [(ScriptOutput, Word64)] -> Tx
buildTx ops :: [OutPoint]
ops rcpts :: [(ScriptOutput, Word64)]
rcpts =
Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx 1 (OutPoint -> TxIn
toIn (OutPoint -> TxIn) -> [OutPoint] -> [TxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OutPoint]
ops) ((ScriptOutput, Word64) -> TxOut
toOut ((ScriptOutput, Word64) -> TxOut)
-> [(ScriptOutput, Word64)] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ScriptOutput, Word64)]
rcpts) [] 0
where
toIn :: OutPoint -> TxIn
toIn op :: OutPoint
op = OutPoint -> ByteString -> Word32 -> TxIn
TxIn OutPoint
op ByteString
B.empty Word32
forall a. Bounded a => a
maxBound
toOut :: (ScriptOutput, Word64) -> TxOut
toOut (o :: ScriptOutput
o, v :: Word64
v) = Word64 -> ByteString -> TxOut
TxOut Word64
v (ByteString -> TxOut) -> ByteString -> TxOut
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> ByteString
encodeOutputBS ScriptOutput
o
signTx :: Network
-> Tx
-> [SigInput]
-> [SecKey]
-> Either String Tx
signTx :: Network -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signTx net :: Network
net tx :: Tx
tx si :: [SigInput]
si = Network -> Tx -> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
S.signTx Network
net Tx
tx ([(SigInput, Bool)] -> [SecKey] -> Either String Tx)
-> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
forall a b. (a -> b) -> a -> b
$ SigInput -> (SigInput, Bool)
forall a. a -> (a, Bool)
notNested (SigInput -> (SigInput, Bool)) -> [SigInput] -> [(SigInput, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigInput]
si
where notNested :: a -> (a, Bool)
notNested s :: a
s = (a
s, Bool
False)
signNestedWitnessTx :: Network
-> Tx
-> [SigInput]
-> [SecKey]
-> Either String Tx
signNestedWitnessTx :: Network -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signNestedWitnessTx net :: Network
net tx :: Tx
tx si :: [SigInput]
si = Network -> Tx -> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
S.signTx Network
net Tx
tx ([(SigInput, Bool)] -> [SecKey] -> Either String Tx)
-> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
forall a b. (a -> b) -> a -> b
$ SigInput -> (SigInput, Bool)
forall a. a -> (a, Bool)
nested (SigInput -> (SigInput, Bool)) -> [SigInput] -> [(SigInput, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SigInput]
si
where
nested :: a -> (a, Bool)
nested s :: a
s = (a
s, Bool
True)
signInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx
signInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx
signInput net :: Network
net tx :: Tx
tx i :: Int
i si :: SigInput
si = Network
-> Tx -> Int -> (SigInput, Bool) -> SecKeyI -> Either String Tx
S.signInput Network
net Tx
tx Int
i (SigInput
si, Bool
False)
signNestedInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx
signNestedInput :: Network -> Tx -> Int -> SigInput -> SecKeyI -> Either String Tx
signNestedInput net :: Network
net tx :: Tx
tx i :: Int
i si :: SigInput
si = Network
-> Tx -> Int -> (SigInput, Bool) -> SecKeyI -> Either String Tx
S.signInput Network
net Tx
tx Int
i (SigInput
si, Bool
True)
findSigInput :: [SigInput] -> [TxIn] -> [(SigInput, Int)]
findSigInput :: [SigInput] -> [TxIn] -> [(SigInput, Int)]
findSigInput = (SigInput -> OutPoint) -> [SigInput] -> [TxIn] -> [(SigInput, Int)]
forall a. (a -> OutPoint) -> [a] -> [TxIn] -> [(a, Int)]
S.findInputIndex SigInput -> OutPoint
sigInputOP
mergeTxs ::
Network -> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx
mergeTxs :: Network
-> [Tx] -> [(ScriptOutput, Word64, OutPoint)] -> Either String Tx
mergeTxs net :: Network
net txs :: [Tx]
txs os :: [(ScriptOutput, Word64, OutPoint)]
os
| [Tx] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tx]
txs = String -> Either String Tx
forall a b. a -> Either a b
Left "Transaction list is empty"
| [Tx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Tx] -> [Tx]
forall a. Eq a => [a] -> [a]
nub [Tx]
emptyTxs) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 1 = String -> Either String Tx
forall a b. a -> Either a b
Left "Transactions do not match"
| [Tx] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Tx]
txs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = Tx -> Either String Tx
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx -> Either String Tx) -> Tx -> Either String Tx
forall a b. (a -> b) -> a -> b
$ [Tx] -> Tx
forall a. [a] -> a
head [Tx]
txs
| Bool
otherwise = (Tx -> ((ScriptOutput, Word64), Int) -> Either String Tx)
-> Tx -> [((ScriptOutput, Word64), Int)] -> Either String Tx
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Network
-> [Tx] -> Tx -> ((ScriptOutput, Word64), Int) -> Either String Tx
mergeTxInput Network
net [Tx]
txs) ([Tx] -> Tx
forall a. [a] -> a
head [Tx]
emptyTxs) [((ScriptOutput, Word64), Int)]
outs
where
zipOp :: [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
zipOp = [Maybe (ScriptOutput, Word64, OutPoint)]
-> [Int] -> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(ScriptOutput, Word64, OutPoint)]
-> [TxIn]
-> ((ScriptOutput, Word64, OutPoint) -> TxIn -> Bool)
-> [Maybe (ScriptOutput, Word64, OutPoint)]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [(ScriptOutput, Word64, OutPoint)]
os (Tx -> [TxIn]
txIn (Tx -> [TxIn]) -> Tx -> [TxIn]
forall a b. (a -> b) -> a -> b
$ [Tx] -> Tx
forall a. [a] -> a
head [Tx]
txs) (ScriptOutput, Word64, OutPoint) -> TxIn -> Bool
forall a b. (a, b, OutPoint) -> TxIn -> Bool
f) [0 ..]
outs :: [((ScriptOutput, Word64), Int)]
outs =
((Maybe (ScriptOutput, Word64, OutPoint), Int)
-> ((ScriptOutput, Word64), Int))
-> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
-> [((ScriptOutput, Word64), Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (ScriptOutput, Word64, OutPoint) -> (ScriptOutput, Word64))
-> (Maybe (ScriptOutput, Word64, OutPoint), Int)
-> ((ScriptOutput, Word64), Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Maybe (ScriptOutput, Word64, OutPoint) -> (ScriptOutput, Word64))
-> (Maybe (ScriptOutput, Word64, OutPoint), Int)
-> ((ScriptOutput, Word64), Int))
-> (Maybe (ScriptOutput, Word64, OutPoint)
-> (ScriptOutput, Word64))
-> (Maybe (ScriptOutput, Word64, OutPoint), Int)
-> ((ScriptOutput, Word64), Int)
forall a b. (a -> b) -> a -> b
$ (\(o :: ScriptOutput
o, v :: Word64
v, _) -> (ScriptOutput
o, Word64
v)) ((ScriptOutput, Word64, OutPoint) -> (ScriptOutput, Word64))
-> (Maybe (ScriptOutput, Word64, OutPoint)
-> (ScriptOutput, Word64, OutPoint))
-> Maybe (ScriptOutput, Word64, OutPoint)
-> (ScriptOutput, Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (ScriptOutput, Word64, OutPoint)
-> (ScriptOutput, Word64, OutPoint)
forall a. HasCallStack => Maybe a -> a
fromJust) ([(Maybe (ScriptOutput, Word64, OutPoint), Int)]
-> [((ScriptOutput, Word64), Int)])
-> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
-> [((ScriptOutput, Word64), Int)]
forall a b. (a -> b) -> a -> b
$
((Maybe (ScriptOutput, Word64, OutPoint), Int) -> Bool)
-> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
-> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (ScriptOutput, Word64, OutPoint) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (ScriptOutput, Word64, OutPoint) -> Bool)
-> ((Maybe (ScriptOutput, Word64, OutPoint), Int)
-> Maybe (ScriptOutput, Word64, OutPoint))
-> (Maybe (ScriptOutput, Word64, OutPoint), Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ScriptOutput, Word64, OutPoint), Int)
-> Maybe (ScriptOutput, Word64, OutPoint)
forall a b. (a, b) -> a
fst) [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
zipOp
f :: (a, b, OutPoint) -> TxIn -> Bool
f (_, _, o :: OutPoint
o) txin :: TxIn
txin = OutPoint
o OutPoint -> OutPoint -> Bool
forall a. Eq a => a -> a -> Bool
== TxIn -> OutPoint
prevOutput TxIn
txin
emptyTxs :: [Tx]
emptyTxs = (Tx -> Tx) -> [Tx] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map (\tx :: Tx
tx -> (Tx -> ((ScriptOutput, Word64), Int) -> Tx)
-> Tx -> [((ScriptOutput, Word64), Int)] -> Tx
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Tx -> ((ScriptOutput, Word64), Int) -> Tx
forall a. Tx -> (a, Int) -> Tx
clearInput Tx
tx [((ScriptOutput, Word64), Int)]
outs) [Tx]
txs
ins :: [TxIn] -> Int -> [TxIn]
ins is :: [TxIn]
is i :: Int
i = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i [TxIn]
is (\ti :: TxIn
ti -> TxIn
ti {scriptInput :: ByteString
scriptInput = ByteString
B.empty})
clearInput :: Tx -> (a, Int) -> Tx
clearInput tx :: Tx
tx (_, i :: Int
i) =
Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx (Tx -> Word32
txVersion Tx
tx) ([TxIn] -> Int -> [TxIn]
ins (Tx -> [TxIn]
txIn Tx
tx) Int
i) (Tx -> [TxOut]
txOut Tx
tx) [] (Tx -> Word32
txLockTime Tx
tx)
mergeTxInput ::
Network
-> [Tx]
-> Tx
-> ((ScriptOutput, Word64), Int)
-> Either String Tx
mergeTxInput :: Network
-> [Tx] -> Tx -> ((ScriptOutput, Word64), Int) -> Either String Tx
mergeTxInput net :: Network
net txs :: [Tx]
txs tx :: Tx
tx ((so :: ScriptOutput
so, val :: Word64
val), i :: Int
i) = do
let ins :: [ByteString]
ins = (Tx -> ByteString) -> [Tx] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (TxIn -> ByteString
scriptInput (TxIn -> ByteString) -> (Tx -> TxIn) -> Tx -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxIn] -> Int -> TxIn
forall a. [a] -> Int -> a
!! Int
i) ([TxIn] -> TxIn) -> (Tx -> [TxIn]) -> Tx -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> [TxIn]
txIn) [Tx]
txs
[([TxSignature], Maybe ScriptOutput)]
sigRes <- (ByteString -> Either String ([TxSignature], Maybe ScriptOutput))
-> [ByteString]
-> Either String [([TxSignature], Maybe ScriptOutput)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Either String ([TxSignature], Maybe ScriptOutput)
forall a.
IsString a =>
ByteString -> Either a ([TxSignature], Maybe ScriptOutput)
extractSigs ([ByteString]
-> Either String [([TxSignature], Maybe ScriptOutput)])
-> [ByteString]
-> Either String [([TxSignature], Maybe ScriptOutput)]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
B.null) [ByteString]
ins
let rdm :: Maybe ScriptOutput
rdm = ([TxSignature], Maybe ScriptOutput) -> Maybe ScriptOutput
forall a b. (a, b) -> b
snd (([TxSignature], Maybe ScriptOutput) -> Maybe ScriptOutput)
-> ([TxSignature], Maybe ScriptOutput) -> Maybe ScriptOutput
forall a b. (a -> b) -> a -> b
$ [([TxSignature], Maybe ScriptOutput)]
-> ([TxSignature], Maybe ScriptOutput)
forall a. [a] -> a
head [([TxSignature], Maybe ScriptOutput)]
sigRes
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((([TxSignature], Maybe ScriptOutput) -> Bool)
-> [([TxSignature], Maybe ScriptOutput)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Maybe ScriptOutput -> Maybe ScriptOutput -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ScriptOutput
rdm) (Maybe ScriptOutput -> Bool)
-> (([TxSignature], Maybe ScriptOutput) -> Maybe ScriptOutput)
-> ([TxSignature], Maybe ScriptOutput)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxSignature], Maybe ScriptOutput) -> Maybe ScriptOutput
forall a b. (a, b) -> b
snd) [([TxSignature], Maybe ScriptOutput)]
sigRes) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left "Redeem scripts do not match"
ByteString
si <- ScriptInput -> ByteString
encodeInputBS (ScriptInput -> ByteString)
-> Either String ScriptInput -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSignature]
-> ScriptOutput -> Maybe ScriptOutput -> Either String ScriptInput
forall a.
IsString a =>
[TxSignature]
-> ScriptOutput -> Maybe ScriptOutput -> Either a ScriptInput
go ([TxSignature] -> [TxSignature]
forall a. Eq a => [a] -> [a]
nub ([TxSignature] -> [TxSignature]) -> [TxSignature] -> [TxSignature]
forall a b. (a -> b) -> a -> b
$ (([TxSignature], Maybe ScriptOutput) -> [TxSignature])
-> [([TxSignature], Maybe ScriptOutput)] -> [TxSignature]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([TxSignature], Maybe ScriptOutput) -> [TxSignature]
forall a b. (a, b) -> a
fst [([TxSignature], Maybe ScriptOutput)]
sigRes) ScriptOutput
so Maybe ScriptOutput
rdm
let ins' :: [TxIn]
ins' = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i (Tx -> [TxIn]
txIn Tx
tx) (\ti :: TxIn
ti -> TxIn
ti {scriptInput :: ByteString
scriptInput = ByteString
si})
Tx -> Either String Tx
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx -> Either String Tx) -> Tx -> Either String Tx
forall a b. (a -> b) -> a -> b
$ Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx (Tx -> Word32
txVersion Tx
tx) [TxIn]
ins' (Tx -> [TxOut]
txOut Tx
tx) [] (Tx -> Word32
txLockTime Tx
tx)
where
go :: [TxSignature]
-> ScriptOutput -> Maybe ScriptOutput -> Either a ScriptInput
go allSigs :: [TxSignature]
allSigs out :: ScriptOutput
out rdmM :: Maybe ScriptOutput
rdmM =
case ScriptOutput
out of
PayMulSig msPubs :: [PubKeyI]
msPubs r :: Int
r ->
let sigs :: [TxSignature]
sigs =
Int -> [TxSignature] -> [TxSignature]
forall a. Int -> [a] -> [a]
take Int
r ([TxSignature] -> [TxSignature]) -> [TxSignature] -> [TxSignature]
forall a b. (a -> b) -> a -> b
$
[Maybe TxSignature] -> [TxSignature]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe TxSignature] -> [TxSignature])
-> [Maybe TxSignature] -> [TxSignature]
forall a b. (a -> b) -> a -> b
$ [TxSignature]
-> [PubKeyI]
-> (TxSignature -> PubKeyI -> Bool)
-> [Maybe TxSignature]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [TxSignature]
allSigs [PubKeyI]
msPubs ((TxSignature -> PubKeyI -> Bool) -> [Maybe TxSignature])
-> (TxSignature -> PubKeyI -> Bool) -> [Maybe TxSignature]
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> TxSignature -> PubKeyI -> Bool
f ScriptOutput
out
in ScriptInput -> Either a ScriptInput
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Either a ScriptInput)
-> ScriptInput -> Either a ScriptInput
forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptInput
RegularInput (SimpleInput -> ScriptInput) -> SimpleInput -> ScriptInput
forall a b. (a -> b) -> a -> b
$ [TxSignature] -> SimpleInput
SpendMulSig [TxSignature]
sigs
PayScriptHash _ ->
case Maybe ScriptOutput
rdmM of
Just rdm :: ScriptOutput
rdm -> do
ScriptInput
si <- [TxSignature]
-> ScriptOutput -> Maybe ScriptOutput -> Either a ScriptInput
go [TxSignature]
allSigs ScriptOutput
rdm Maybe ScriptOutput
forall a. Maybe a
Nothing
ScriptInput -> Either a ScriptInput
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptInput -> Either a ScriptInput)
-> ScriptInput -> Either a ScriptInput
forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptOutput -> ScriptInput
ScriptHashInput (ScriptInput -> SimpleInput
getRegularInput ScriptInput
si) ScriptOutput
rdm
_ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left "Invalid output script type"
_ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left "Invalid output script type"
extractSigs :: ByteString -> Either a ([TxSignature], Maybe ScriptOutput)
extractSigs si :: ByteString
si =
case Network -> ByteString -> Either String ScriptInput
decodeInputBS Network
net ByteString
si of
Right (RegularInput (SpendMulSig sigs :: [TxSignature]
sigs)) -> ([TxSignature], Maybe ScriptOutput)
-> Either a ([TxSignature], Maybe ScriptOutput)
forall a b. b -> Either a b
Right ([TxSignature]
sigs, Maybe ScriptOutput
forall a. Maybe a
Nothing)
Right (ScriptHashInput (SpendMulSig sigs :: [TxSignature]
sigs) rdm :: ScriptOutput
rdm) ->
([TxSignature], Maybe ScriptOutput)
-> Either a ([TxSignature], Maybe ScriptOutput)
forall a b. b -> Either a b
Right ([TxSignature]
sigs, ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
rdm)
_ -> a -> Either a ([TxSignature], Maybe ScriptOutput)
forall a b. a -> Either a b
Left "Invalid script input type"
f :: ScriptOutput -> TxSignature -> PubKeyI -> Bool
f out :: ScriptOutput
out (TxSignature x :: Sig
x sh :: SigHash
sh) p :: PubKeyI
p =
Hash256 -> Sig -> PubKey -> Bool
verifyHashSig
(Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHash Network
net Tx
tx (ScriptOutput -> Script
encodeOutput ScriptOutput
out) Word64
val Int
i SigHash
sh)
Sig
x
(PubKeyI -> PubKey
pubKeyPoint PubKeyI
p)
f _ TxSignatureEmpty _ = Bool
False
verifyStdTx :: Network -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
verifyStdTx :: Network -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
verifyStdTx net :: Network
net tx :: Tx
tx xs :: [(ScriptOutput, Word64, OutPoint)]
xs =
Bool -> Bool
not ([TxIn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Tx -> [TxIn]
txIn Tx
tx)) Bool -> Bool -> Bool
&& ((Maybe (ScriptOutput, Word64, OutPoint), Int) -> Bool)
-> [(Maybe (ScriptOutput, Word64, OutPoint), Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe (ScriptOutput, Word64, OutPoint), Int) -> Bool
forall c. (Maybe (ScriptOutput, Word64, c), Int) -> Bool
go ([Maybe (ScriptOutput, Word64, OutPoint)]
-> [Int] -> [(Maybe (ScriptOutput, Word64, OutPoint), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(ScriptOutput, Word64, OutPoint)]
-> [TxIn]
-> ((ScriptOutput, Word64, OutPoint) -> TxIn -> Bool)
-> [Maybe (ScriptOutput, Word64, OutPoint)]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [(ScriptOutput, Word64, OutPoint)]
xs (Tx -> [TxIn]
txIn Tx
tx) (ScriptOutput, Word64, OutPoint) -> TxIn -> Bool
forall a b. (a, b, OutPoint) -> TxIn -> Bool
f) [0 ..])
where
f :: (a, b, OutPoint) -> TxIn -> Bool
f (_, _, o :: OutPoint
o) txin :: TxIn
txin = OutPoint
o OutPoint -> OutPoint -> Bool
forall a. Eq a => a -> a -> Bool
== TxIn -> OutPoint
prevOutput TxIn
txin
go :: (Maybe (ScriptOutput, Word64, c), Int) -> Bool
go (Just (so :: ScriptOutput
so, val :: Word64
val, _), i :: Int
i) = Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput Network
net Tx
tx Int
i ScriptOutput
so Word64
val
go _ = Bool
False
verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput net :: Network
net tx :: Tx
tx i :: Int
i so0 :: ScriptOutput
so0 val :: Word64
val
| ScriptOutput -> Bool
isSegwit ScriptOutput
so0 =
Bool -> Either String Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Either String Bool -> Bool) -> Either String Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ByteString
inp ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
&&) (Bool -> Bool)
-> ((Maybe ScriptOutput, SimpleInput) -> Bool)
-> (Maybe ScriptOutput, SimpleInput)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput ScriptOutput
so0 ((Maybe ScriptOutput, SimpleInput) -> Bool)
-> Either String (Maybe ScriptOutput, SimpleInput)
-> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput)
wp ScriptOutput
so0
| Bool
otherwise =
Bool -> Either String Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False (Either String Bool -> Bool) -> Either String Bool -> Bool
forall a b. (a -> b) -> a -> b
$
(ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput ScriptOutput
so0 (ScriptInput -> Bool)
-> Either String ScriptInput -> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> ByteString -> Either String ScriptInput
decodeInputBS Network
net ByteString
inp) Either String Bool -> Either String Bool -> Either String Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Either String ScriptOutput
nestedScriptOutput Either String ScriptOutput
-> (ScriptOutput -> Either String Bool) -> Either String Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \so :: ScriptOutput
so -> ScriptOutput
-> ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifyNestedInput ScriptOutput
so0 ScriptOutput
so ((Maybe ScriptOutput, SimpleInput) -> Bool)
-> Either String (Maybe ScriptOutput, SimpleInput)
-> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput)
wp ScriptOutput
so)
where
inp :: ByteString
inp = 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
theTxSigHash :: ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash so :: ScriptOutput
so = Network
-> Tx
-> Int
-> ScriptOutput
-> Word64
-> SigHash
-> Maybe ScriptOutput
-> Hash256
S.makeSigHash Network
net Tx
tx Int
i ScriptOutput
so Word64
val
ws :: WitnessStack
ws :: [ByteString]
ws | WitnessData -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Tx -> WitnessData
txWitness Tx
tx) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i = Tx -> WitnessData
txWitness Tx
tx WitnessData -> Int -> [ByteString]
forall a. [a] -> Int -> a
!! Int
i
| Bool
otherwise = []
wp :: ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput)
wp :: ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput)
wp so :: ScriptOutput
so = Network
-> WitnessProgram
-> Either String (Maybe ScriptOutput, SimpleInput)
decodeWitnessInput Network
net (WitnessProgram -> Either String (Maybe ScriptOutput, SimpleInput))
-> Either String WitnessProgram
-> Either String (Maybe ScriptOutput, SimpleInput)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Network
-> ScriptOutput -> [ByteString] -> Either String WitnessProgram
viewWitnessProgram Network
net ScriptOutput
so [ByteString]
ws
nestedScriptOutput :: Either String ScriptOutput
nestedScriptOutput :: Either String ScriptOutput
nestedScriptOutput = Script -> [ScriptOp]
scriptOps (Script -> [ScriptOp])
-> Either String Script -> Either String [ScriptOp]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String Script
forall a. Serialize a => ByteString -> Either String a
decode ByteString
inp Either String [ScriptOp]
-> ([ScriptOp] -> Either String ScriptOutput)
-> Either String ScriptOutput
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[OP_PUSHDATA bs :: ByteString
bs _] -> ByteString -> Either String ScriptOutput
decodeOutputBS ByteString
bs
_ -> String -> Either String ScriptOutput
forall a b. a -> Either a b
Left "nestedScriptOutput: not a nested output"
verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput so :: ScriptOutput
so si :: ScriptInput
si = case (ScriptOutput
so, ScriptInput
si) of
(PayPK pub :: PubKeyI
pub, RegularInput (SpendPK (TxSignature sig :: Sig
sig sh :: SigHash
sh))) ->
Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh Maybe ScriptOutput
forall a. Maybe a
Nothing) Sig
sig (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pub)
(PayPKHash h :: Hash160
h, RegularInput (SpendPKHash (TxSignature sig :: Sig
sig sh :: SigHash
sh) pub :: PubKeyI
pub)) ->
PubKeyI -> Address
pubKeyAddr PubKeyI
pub Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2pkhAddr Hash160
h Bool -> Bool -> Bool
&&
Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh Maybe ScriptOutput
forall a. Maybe a
Nothing) Sig
sig (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pub)
(PayMulSig pubs :: [PubKeyI]
pubs r :: Int
r, RegularInput (SpendMulSig sigs :: [TxSignature]
sigs)) ->
Network
-> Tx
-> Script
-> Word64
-> Int
-> [PubKey]
-> [TxSignature]
-> Int
countMulSig Network
net Tx
tx Script
out Word64
val Int
i (PubKeyI -> PubKey
pubKeyPoint (PubKeyI -> PubKey) -> [PubKeyI] -> [PubKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PubKeyI]
pubs) [TxSignature]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
(PayScriptHash h :: Hash160
h, ScriptHashInput si' :: SimpleInput
si' rdm :: ScriptOutput
rdm) ->
ScriptOutput -> Address
payToScriptAddress ScriptOutput
rdm Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2shAddr Hash160
h Bool -> Bool -> Bool
&& ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput ScriptOutput
rdm (SimpleInput -> ScriptInput
RegularInput SimpleInput
si')
_ -> Bool
False
where out :: Script
out = ScriptOutput -> Script
encodeOutput ScriptOutput
so
verifySegwitInput ::
ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput :: ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput so :: ScriptOutput
so (rdm :: Maybe ScriptOutput
rdm, si :: SimpleInput
si) = case (ScriptOutput
so, Maybe ScriptOutput
rdm, SimpleInput
si) of
(PayWitnessPKHash h :: Hash160
h, Nothing, SpendPKHash (TxSignature sig :: Sig
sig sh :: SigHash
sh) pub :: PubKeyI
pub) ->
PubKeyI -> Address
pubKeyWitnessAddr PubKeyI
pub Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2wpkhAddr Hash160
h Bool -> Bool -> Bool
&&
Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh Maybe ScriptOutput
forall a. Maybe a
Nothing) Sig
sig (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pub)
(PayWitnessScriptHash h :: Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayPK pub :: PubKeyI
pub), SpendPK (TxSignature sig :: Sig
sig sh :: SigHash
sh)) ->
ScriptOutput -> Address
payToWitnessScriptAddress ScriptOutput
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h Bool -> Bool -> Bool
&&
Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh (Maybe ScriptOutput -> Hash256) -> Maybe ScriptOutput -> Hash256
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
rdm') Sig
sig (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pub)
(PayWitnessScriptHash h :: Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayPKHash kh :: Hash160
kh), SpendPKHash (TxSignature sig :: Sig
sig sh :: SigHash
sh) pub :: PubKeyI
pub) ->
ScriptOutput -> Address
payToWitnessScriptAddress ScriptOutput
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h Bool -> Bool -> Bool
&&
ByteString -> Hash160
forall b. ByteArrayAccess b => b -> Hash160
addressHash (PubKeyI -> ByteString
forall a. Serialize a => a -> ByteString
encode PubKeyI
pub) Hash160 -> Hash160 -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160
kh Bool -> Bool -> Bool
&&
Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh (Maybe ScriptOutput -> Hash256) -> Maybe ScriptOutput -> Hash256
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
rdm') Sig
sig (PubKeyI -> PubKey
pubKeyPoint PubKeyI
pub)
(PayWitnessScriptHash h :: Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayMulSig pubs :: [PubKeyI]
pubs r :: Int
r), SpendMulSig sigs :: [TxSignature]
sigs) ->
ScriptOutput -> Address
payToWitnessScriptAddress ScriptOutput
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h Bool -> Bool -> Bool
&&
(SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' (\sh :: SigHash
sh -> ScriptOutput -> SigHash -> Maybe ScriptOutput -> Hash256
theTxSigHash ScriptOutput
so SigHash
sh (Maybe ScriptOutput -> Hash256) -> Maybe ScriptOutput -> Hash256
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
rdm') (PubKeyI -> PubKey
pubKeyPoint (PubKeyI -> PubKey) -> [PubKeyI] -> [PubKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PubKeyI]
pubs) [TxSignature]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
_ -> Bool
False
verifyNestedInput ::
ScriptOutput -> ScriptOutput -> (Maybe RedeemScript, SimpleInput) -> Bool
verifyNestedInput :: ScriptOutput
-> ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifyNestedInput so :: ScriptOutput
so so' :: ScriptOutput
so' x :: (Maybe ScriptOutput, SimpleInput)
x = case ScriptOutput
so of
PayScriptHash h :: Hash160
h -> ScriptOutput -> Address
payToScriptAddress ScriptOutput
so' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2shAddr Hash160
h Bool -> Bool -> Bool
&& ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput ScriptOutput
so' (Maybe ScriptOutput, SimpleInput)
x
_ -> Bool
False
countMulSig ::
Network
-> Tx
-> Script
-> Word64
-> Int
-> [PubKey]
-> [TxSignature]
-> Int
countMulSig :: Network
-> Tx
-> Script
-> Word64
-> Int
-> [PubKey]
-> [TxSignature]
-> Int
countMulSig net :: Network
net tx :: Tx
tx out :: Script
out val :: Word64
val i :: Int
i =
(SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' SigHash -> Hash256
h
where
h :: SigHash -> Hash256
h = Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHash Network
net Tx
tx Script
out Word64
val Int
i
countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' :: (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' _ [] _ = 0
countMulSig' _ _ [] = 0
countMulSig' h :: SigHash -> Hash256
h (_:pubs :: [PubKey]
pubs) (TxSignatureEmpty:sigs :: [TxSignature]
sigs) = (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs
countMulSig' h :: SigHash -> Hash256
h (pub :: PubKey
pub:pubs :: [PubKey]
pubs) sigs :: [TxSignature]
sigs@(TxSignature sig :: Sig
sig sh :: SigHash
sh : sigs' :: [TxSignature]
sigs')
| Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (SigHash -> Hash256
h SigHash
sh) Sig
sig PubKey
pub = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs'
| Bool
otherwise = (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs