{-# 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.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
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.String.Conversions (cs)
import Data.Text (Text)
import Data.Word (Word64)
import Haskoin.Address
import Haskoin.Crypto.Hash (Hash256, addressHash)
import Haskoin.Crypto.Signature
import Haskoin.Data
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 Word64
target Word64
fee Int
nOut Bool
continue [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 Word64
target Word64
fee Int
nOut Bool
continue
| Word64
target Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
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 String
"chooseCoins: Target must be > 0"
where
err :: String
err = String
"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 Word64
target Word64
fee (Int, Int)
ms Int
nOut Bool
continue [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 Word64
target Word64
fee (Int, Int)
ms Int
nOut Bool
continue
| Word64
target Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
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 String
"chooseMSCoins: Target must be > 0"
where
err :: String
err = String
"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 Word64
target Int -> Word64
guessFee 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 [] Word64
0 [] Word64
0
where
goal :: Int -> Word64
goal 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 [a]
acc Word64
aTot [a]
ps 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 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
+ Int
1)
then
if Bool
continue
then
if Word64
pTot Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
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 [] Word64
0 (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)
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
+ Int
1))
else
[a]
-> Word64 -> [a] -> Word64 -> ConduitT a o m (Maybe ([a], Word64))
go (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) [a]
ps Word64
pTot
Maybe a
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 Word64
byteFee Int
nOut 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 Int
0)
guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64
guessMSTxFee :: Word64 -> (Int, Int) -> Int -> Int -> Word64
guessMSTxFee Word64
byteFee (Int, Int)
ms Int
nOut 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
0 (Int -> (Int, Int) -> [(Int, Int)]
forall a. Int -> a -> [a]
replicate Int
nIn (Int, Int)
ms) Int
nOut Int
0)
guessTxSize ::
Int ->
[(Int, Int)] ->
Int ->
Int ->
Int
guessTxSize :: Int -> [(Int, Int)] -> Int -> Int -> Int
guessTxSize Int
pki [(Int, Int)]
msi Int
pkout Int
msout =
Int
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) -> (Int -> ByteString) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS
(Put -> ByteString) -> (Int -> Put) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
(VarInt -> Put) -> (Int -> VarInt) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> VarInt
VarInt
(Word64 -> VarInt) -> (Int -> Word64) -> Int -> VarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Int -> Int) -> Int -> Int
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) -> (Int -> ByteString) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPutS
(Put -> ByteString) -> (Int -> Put) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize
(VarInt -> Put) -> (Int -> VarInt) -> Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> VarInt
VarInt
(Word64 -> VarInt) -> (Int -> Word64) -> Int -> VarInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Int -> Int) -> Int -> Int
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
* Int
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
* Int
34
Int -> Int -> Int
forall a. Num a => a -> a -> a
+
Int
msout Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
32
guessMSSize :: (Int, Int) -> Int
guessMSSize :: (Int, Int) -> Int
guessMSSize (Int
m, Int
n) =
Int
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
$ Put -> ByteString
runPutS (Put -> ByteString) -> (VarInt -> Put) -> VarInt -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarInt -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (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
$ Put -> ByteString
runPutS (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ ScriptOp -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize (ScriptOp -> Put) -> ScriptOp -> Put
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
* Int
34 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Word8
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
* Int
73 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
buildAddrTx :: Network -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
buildAddrTx :: Network -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
buildAddrTx Network
net [OutPoint]
ops [(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 (Text
aTxt, b
v) =
b -> Maybe (ScriptOutput, b) -> Either b (ScriptOutput, b)
forall b a. b -> Maybe a -> Either b a
maybeToEither (b
"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 [OutPoint]
ops [(ScriptOutput, Word64)]
rcpts =
Word32 -> [TxIn] -> [TxOut] -> WitnessData -> Word32 -> Tx
Tx Word32
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) [] Word32
0
where
toIn :: OutPoint -> TxIn
toIn OutPoint
op = OutPoint -> ByteString -> Word32 -> TxIn
TxIn OutPoint
op ByteString
B.empty Word32
forall a. Bounded a => a
maxBound
toOut :: (ScriptOutput, Word64) -> TxOut
toOut (ScriptOutput
o, 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 Network
net Tx
tx [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 a
s = (a
s, Bool
False)
signNestedWitnessTx ::
Network ->
Tx ->
[SigInput] ->
[SecKey] ->
Either String Tx
signNestedWitnessTx :: Network -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signNestedWitnessTx Network
net Tx
tx [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 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 Network
net Tx
tx Int
i 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 Network
net Tx
tx Int
i 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 Network
net [Tx]
txs [(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 String
"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
/= Int
1 = String -> Either String Tx
forall a b. a -> Either a b
Left String
"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
== Int
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) [Int
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
$ (\(ScriptOutput
o, Word64
v, OutPoint
_) -> (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 (a
_, b
_, OutPoint
o) 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 -> ((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 [TxIn]
is Int
i = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i [TxIn]
is (\TxIn
ti -> TxIn
ti{scriptInput :: ByteString
scriptInput = ByteString
B.empty})
clearInput :: Tx -> (a, Int) -> Tx
clearInput Tx
tx (a
_, 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 Network
net [Tx]
txs Tx
tx ((ScriptOutput
so, Word64
val), 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 String
"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) (\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 [TxSignature]
allSigs ScriptOutput
out Maybe ScriptOutput
rdmM =
case ScriptOutput
out of
PayMulSig [PubKeyI]
msPubs 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 Hash160
_ ->
case Maybe ScriptOutput
rdmM of
Just 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
Maybe ScriptOutput
_ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left a
"Invalid output script type"
ScriptOutput
_ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left a
"Invalid output script type"
extractSigs :: ByteString -> Either a ([TxSignature], Maybe ScriptOutput)
extractSigs ByteString
si =
case Network -> ByteString -> Either String ScriptInput
decodeInputBS Network
net ByteString
si of
Right (RegularInput (SpendMulSig [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 [TxSignature]
sigs) 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)
Either String ScriptInput
_ -> a -> Either a ([TxSignature], Maybe ScriptOutput)
forall a b. a -> Either a b
Left a
"Invalid script input type"
f :: ScriptOutput -> TxSignature -> PubKeyI -> Bool
f ScriptOutput
out (TxSignature Sig
x SigHash
sh) 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 ScriptOutput
_ TxSignature
TxSignatureEmpty PubKeyI
_ = Bool
False
verifyStdTx :: Network -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
verifyStdTx :: Network -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
verifyStdTx Network
net Tx
tx [(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) [Int
0 ..])
where
f :: (a, b, OutPoint) -> TxIn -> Bool
f (a
_, b
_, OutPoint
o) 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 (ScriptOutput
so, Word64
val, c
_), Int
i) = Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput Network
net Tx
tx Int
i ScriptOutput
so Word64
val
go (Maybe (ScriptOutput, Word64, c), Int)
_ = Bool
False
verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput :: Network -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput Network
net Tx
tx Int
i ScriptOutput
so0 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
>>= \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 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 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
<$> Get Script -> ByteString -> Either String Script
forall a. Get a -> ByteString -> Either String a
runGetS Get Script
forall a (m :: * -> *). (Serial a, MonadGet m) => m a
deserialize 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 ByteString
bs PushDataType
_] -> ByteString -> Either String ScriptOutput
decodeOutputBS ByteString
bs
[ScriptOp]
_ -> String -> Either String ScriptOutput
forall a b. a -> Either a b
Left String
"nestedScriptOutput: not a nested output"
verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput ScriptOutput
so ScriptInput
si = case (ScriptOutput
so, ScriptInput
si) of
(PayPK PubKeyI
pub, RegularInput (SpendPK (TxSignature Sig
sig 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 Hash160
h, RegularInput (SpendPKHash (TxSignature Sig
sig SigHash
sh) 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 [PubKeyI]
pubs Int
r, RegularInput (SpendMulSig [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 Hash160
h, ScriptHashInput SimpleInput
si' 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')
(ScriptOutput, ScriptInput)
_ -> Bool
False
where
out :: Script
out = ScriptOutput -> Script
encodeOutput ScriptOutput
so
verifySegwitInput ::
ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput :: ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput ScriptOutput
so (Maybe ScriptOutput
rdm, SimpleInput
si) = case (ScriptOutput
so, Maybe ScriptOutput
rdm, SimpleInput
si) of
(PayWitnessPKHash Hash160
h, Maybe ScriptOutput
Nothing, SpendPKHash (TxSignature Sig
sig SigHash
sh) 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 Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayPK PubKeyI
pub), SpendPK (TxSignature Sig
sig 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 Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayPKHash Hash160
kh), SpendPKHash (TxSignature Sig
sig SigHash
sh) 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 (Put -> ByteString
runPutS (PubKeyI -> Put
forall a (m :: * -> *). (Serial a, MonadPut m) => a -> m ()
serialize 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 Hash256
h, Just rdm' :: ScriptOutput
rdm'@(PayMulSig [PubKeyI]
pubs Int
r), SpendMulSig [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' (\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
(ScriptOutput, Maybe ScriptOutput, SimpleInput)
_ -> Bool
False
verifyNestedInput ::
ScriptOutput -> ScriptOutput -> (Maybe RedeemScript, SimpleInput) -> Bool
verifyNestedInput :: ScriptOutput
-> ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifyNestedInput ScriptOutput
so ScriptOutput
so' (Maybe ScriptOutput, SimpleInput)
x = case ScriptOutput
so of
PayScriptHash 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
ScriptOutput
_ -> Bool
False
countMulSig ::
Network ->
Tx ->
Script ->
Word64 ->
Int ->
[PubKey] ->
[TxSignature] ->
Int
countMulSig :: Network
-> Tx
-> Script
-> Word64
-> Int
-> [PubKey]
-> [TxSignature]
-> Int
countMulSig Network
net Tx
tx Script
out Word64
val 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' SigHash -> Hash256
_ [] [TxSignature]
_ = Int
0
countMulSig' SigHash -> Hash256
_ [PubKey]
_ [] = Int
0
countMulSig' SigHash -> Hash256
h (PubKey
_ : [PubKey]
pubs) (TxSignature
TxSignatureEmpty : [TxSignature]
sigs) = (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs
countMulSig' SigHash -> Hash256
h (PubKey
pub : [PubKey]
pubs) sigs :: [TxSignature]
sigs@(TxSignature Sig
sig SigHash
sh : [TxSignature]
sigs')
| Hash256 -> Sig -> PubKey -> Bool
verifyHashSig (SigHash -> Hash256
h SigHash
sh) Sig
sig PubKey
pub = Int
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