{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoFieldSelectors #-}
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 Data.ByteString qualified 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, rights)
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.Keys.Common
import Haskoin.Crypto.Signature
import Haskoin.Network.Common
import Haskoin.Network.Data
import Haskoin.Script
import Haskoin.Transaction.Builder.Sign (SigInput, buildInput, makeSignature, sigKeys)
import Haskoin.Transaction.Builder.Sign qualified as Sign
import Haskoin.Transaction.Common
import Haskoin.Transaction.Segwit
import Haskoin.Util
class Coin c where
coinValue :: c -> Word64
chooseCoins ::
(Coin c) =>
Word64 ->
Word64 ->
Int ->
Bool ->
[c] ->
Either String ([c], Word64)
chooseCoins :: forall c.
Coin c =>
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 ()
-> ConduitT c Void Identity (Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Word64
-> Word64
-> Int
-> Bool
-> ConduitT 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 :: 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
| 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 a. a -> ConduitT c Void m a
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 :: forall c.
Coin c =>
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 ()
-> ConduitT c Void Identity (Either String ([c], Word64))
-> ConduitT () Void Identity (Either String ([c], Word64))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| Word64
-> Word64
-> (Int, Int)
-> Int
-> Bool
-> ConduitT 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 :: 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
| 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 a. a -> ConduitT c Void m a
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 :: forall (m :: * -> *) c.
(Monad m, Coin c) =>
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 o. Monad m => ConduitT i o 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 a b.
ConduitT a o m a -> (a -> ConduitT a o m b) -> ConduitT a o m b
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 a. [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 a. a -> ConduitT a o m a
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 a. [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 a. a -> ConduitT a o m a
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 a. [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 a. a -> ConduitT a o m a
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 a. [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 a. [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 ()
forall (m :: * -> *). MonadPut m => VarInt -> 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 a. [a] -> 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 ()
forall (m :: * -> *). MonadPut m => VarInt -> 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 a. Num a => [a] -> a
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 ()
forall (m :: * -> *). MonadPut m => VarInt -> 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 ()
forall (m :: * -> *). MonadPut m => ScriptOp -> 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 -> Ctx -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
buildAddrTx :: Network
-> Ctx -> [OutPoint] -> [(Text, Word64)] -> Either String Tx
buildAddrTx Network
net Ctx
ctx [OutPoint]
ops [(Text, Word64)]
rcps =
Ctx -> [OutPoint] -> [(RedeemScript, Word64)] -> Tx
buildTx Ctx
ctx [OutPoint]
ops ([(RedeemScript, Word64)] -> Tx)
-> Either String [(RedeemScript, Word64)] -> Either String Tx
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Word64) -> Either String (RedeemScript, Word64))
-> [(Text, Word64)] -> Either String [(RedeemScript, Word64)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text, Word64) -> Either String (RedeemScript, Word64)
forall {b} {b}.
(Semigroup b, IsString b, ConvertibleStrings Text b) =>
(Text, b) -> Either b (RedeemScript, b)
f [(Text, Word64)]
rcps
where
f :: (Text, b) -> Either b (RedeemScript, b)
f (Text
aTxt, b
v) =
b -> Maybe (RedeemScript, b) -> Either b (RedeemScript, 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 (RedeemScript, b) -> Either b (RedeemScript, b))
-> Maybe (RedeemScript, b) -> Either b (RedeemScript, b)
forall a b. (a -> b) -> a -> b
$ do
Address
a <- Network -> Text -> Maybe Address
textToAddr Network
net Text
aTxt
let o :: RedeemScript
o = Address -> RedeemScript
addressToOutput Address
a
(RedeemScript, b) -> Maybe (RedeemScript, b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (RedeemScript
o, b
v)
buildTx :: Ctx -> [OutPoint] -> [(ScriptOutput, Word64)] -> Tx
buildTx :: Ctx -> [OutPoint] -> [(RedeemScript, Word64)] -> Tx
buildTx Ctx
ctx [OutPoint]
ops [(RedeemScript, Word64)]
rcpts =
Word32 -> [TxIn] -> [TxOut] -> [WitnessStack] -> 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) ((RedeemScript, Word64) -> TxOut
forall {a}. Marshal Ctx a => (a, Word64) -> TxOut
toOut ((RedeemScript, Word64) -> TxOut)
-> [(RedeemScript, Word64)] -> [TxOut]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(RedeemScript, 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 :: (a, Word64) -> TxOut
toOut (a
o, Word64
v) = Word64 -> ByteString -> TxOut
TxOut Word64
v (ByteString -> TxOut) -> ByteString -> TxOut
forall a b. (a -> b) -> a -> b
$ Ctx -> a -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx a
o
signTx ::
Network ->
Ctx ->
Tx ->
[SigInput] ->
[SecKey] ->
Either String Tx
signTx :: Network -> Ctx -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signTx Network
net Ctx
ctx Tx
tx [SigInput]
si = Network
-> Ctx -> Tx -> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
Sign.signTx Network
net Ctx
ctx 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 ->
Ctx ->
Tx ->
[SigInput] ->
[SecKey] ->
Either String Tx
signNestedWitnessTx :: Network -> Ctx -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signNestedWitnessTx Network
net Ctx
ctx Tx
tx [SigInput]
si = Network
-> Ctx -> Tx -> [(SigInput, Bool)] -> [SecKey] -> Either String Tx
Sign.signTx Network
net Ctx
ctx 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 -> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx
signInput :: Network
-> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx
signInput Network
net Ctx
ctx Tx
tx Int
i SigInput
si =
Network
-> Ctx
-> Tx
-> Int
-> (SigInput, Bool)
-> PrivateKey
-> Either String Tx
Sign.signInput Network
net Ctx
ctx Tx
tx Int
i (SigInput
si, Bool
False)
signNestedInput ::
Network -> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx
signNestedInput :: Network
-> Ctx -> Tx -> Int -> SigInput -> PrivateKey -> Either String Tx
signNestedInput Network
net Ctx
ctx Tx
tx Int
i SigInput
si =
Network
-> Ctx
-> Tx
-> Int
-> (SigInput, Bool)
-> PrivateKey
-> Either String Tx
Sign.signInput Network
net Ctx
ctx 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)]
Sign.findInputIndex (.outpoint)
mergeTxs ::
Network ->
Ctx ->
[Tx] ->
[(ScriptOutput, Word64, OutPoint)] ->
Either String Tx
mergeTxs :: Network
-> Ctx
-> [Tx]
-> [(RedeemScript, Word64, OutPoint)]
-> Either String Tx
mergeTxs Network
net Ctx
ctx [Tx]
txs [(RedeemScript, Word64, OutPoint)]
os
| [Tx] -> Bool
forall a. [a] -> 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 a. [a] -> 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 a. [a] -> 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 a. a -> Either String a
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. HasCallStack => [a] -> a
head [Tx]
txs
| Bool
otherwise = (Tx -> ((RedeemScript, Word64), Int) -> Either String Tx)
-> Tx -> [((RedeemScript, 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
-> Ctx
-> [Tx]
-> Tx
-> ((RedeemScript, Word64), Int)
-> Either String Tx
mergeTxInput Network
net Ctx
ctx [Tx]
txs) ([Tx] -> Tx
forall a. HasCallStack => [a] -> a
head [Tx]
emptyTxs) [((RedeemScript, Word64), Int)]
outs
where
zipOp :: [(Maybe (RedeemScript, Word64, OutPoint), Int)]
zipOp = [Maybe (RedeemScript, Word64, OutPoint)]
-> [Int] -> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(RedeemScript, Word64, OutPoint)]
-> [TxIn]
-> ((RedeemScript, Word64, OutPoint) -> TxIn -> Bool)
-> [Maybe (RedeemScript, Word64, OutPoint)]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [(RedeemScript, Word64, OutPoint)]
os ([Tx] -> Tx
forall a. HasCallStack => [a] -> a
head [Tx]
txs).inputs (RedeemScript, Word64, OutPoint) -> TxIn -> Bool
forall {a} {r} {a} {b}.
(Eq a, HasField "outpoint" r a) =>
(a, b, a) -> r -> Bool
f) [Int
0 ..]
outs :: [((RedeemScript, Word64), Int)]
outs =
((Maybe (RedeemScript, Word64, OutPoint), Int)
-> ((RedeemScript, Word64), Int))
-> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
-> [((RedeemScript, Word64), Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe (RedeemScript, Word64, OutPoint) -> (RedeemScript, Word64))
-> (Maybe (RedeemScript, Word64, OutPoint), Int)
-> ((RedeemScript, Word64), Int)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((Maybe (RedeemScript, Word64, OutPoint) -> (RedeemScript, Word64))
-> (Maybe (RedeemScript, Word64, OutPoint), Int)
-> ((RedeemScript, Word64), Int))
-> (Maybe (RedeemScript, Word64, OutPoint)
-> (RedeemScript, Word64))
-> (Maybe (RedeemScript, Word64, OutPoint), Int)
-> ((RedeemScript, Word64), Int)
forall a b. (a -> b) -> a -> b
$ (\(RedeemScript
o, Word64
v, OutPoint
_) -> (RedeemScript
o, Word64
v)) ((RedeemScript, Word64, OutPoint) -> (RedeemScript, Word64))
-> (Maybe (RedeemScript, Word64, OutPoint)
-> (RedeemScript, Word64, OutPoint))
-> Maybe (RedeemScript, Word64, OutPoint)
-> (RedeemScript, Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (RedeemScript, Word64, OutPoint)
-> (RedeemScript, Word64, OutPoint)
forall a. HasCallStack => Maybe a -> a
fromJust) ([(Maybe (RedeemScript, Word64, OutPoint), Int)]
-> [((RedeemScript, Word64), Int)])
-> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
-> [((RedeemScript, Word64), Int)]
forall a b. (a -> b) -> a -> b
$
((Maybe (RedeemScript, Word64, OutPoint), Int) -> Bool)
-> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
-> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (RedeemScript, Word64, OutPoint) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (RedeemScript, Word64, OutPoint) -> Bool)
-> ((Maybe (RedeemScript, Word64, OutPoint), Int)
-> Maybe (RedeemScript, Word64, OutPoint))
-> (Maybe (RedeemScript, Word64, OutPoint), Int)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (RedeemScript, Word64, OutPoint), Int)
-> Maybe (RedeemScript, Word64, OutPoint)
forall a b. (a, b) -> a
fst) [(Maybe (RedeemScript, Word64, OutPoint), Int)]
zipOp
f :: (a, b, a) -> r -> Bool
f (a
_, b
_, a
o) r
txin = a
o a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== r
txin.outpoint
emptyTxs :: [Tx]
emptyTxs = (Tx -> Tx) -> [Tx] -> [Tx]
forall a b. (a -> b) -> [a] -> [b]
map (\Tx
tx -> (Tx -> ((RedeemScript, Word64), Int) -> Tx)
-> Tx -> [((RedeemScript, Word64), Int)] -> Tx
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Tx -> ((RedeemScript, Word64), Int) -> Tx
forall {r} {a}.
(HasField "version" r Word32, HasField "inputs" r [TxIn],
HasField "outputs" r [TxOut], HasField "locktime" r Word32) =>
r -> (a, Int) -> Tx
clearInput Tx
tx [((RedeemScript, 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 {Word32
ByteString
OutPoint
outpoint :: OutPoint
script :: ByteString
sequence :: Word32
$sel:outpoint:TxIn :: TxIn -> OutPoint
$sel:script:TxIn :: TxIn -> ByteString
$sel:sequence:TxIn :: TxIn -> Word32
..} -> TxIn {$sel:script:TxIn :: ByteString
script = ByteString
B.empty, Word32
OutPoint
outpoint :: OutPoint
sequence :: Word32
$sel:outpoint:TxIn :: OutPoint
$sel:sequence:TxIn :: Word32
..})
clearInput :: r -> (a, Int) -> Tx
clearInput r
tx (a
_, Int
i) =
Word32 -> [TxIn] -> [TxOut] -> [WitnessStack] -> Word32 -> Tx
Tx r
tx.version ([TxIn] -> Int -> [TxIn]
ins r
tx.inputs Int
i) r
tx.outputs [] r
tx.locktime
mergeTxInput ::
Network ->
Ctx ->
[Tx] ->
Tx ->
((ScriptOutput, Word64), Int) ->
Either String Tx
mergeTxInput :: Network
-> Ctx
-> [Tx]
-> Tx
-> ((RedeemScript, Word64), Int)
-> Either String Tx
mergeTxInput Network
net Ctx
ctx [Tx]
txs Tx
tx ((RedeemScript
so, Word64
val), Int
i) = do
let ins :: WitnessStack
ins = (Tx -> ByteString) -> [Tx] -> WitnessStack
forall a b. (a -> b) -> [a] -> [b]
map ((.script) (TxIn -> ByteString) -> (Tx -> TxIn) -> Tx -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxIn] -> Int -> TxIn
forall a. HasCallStack => [a] -> Int -> a
!! Int
i) ([TxIn] -> TxIn) -> (Tx -> [TxIn]) -> Tx -> TxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.inputs)) [Tx]
txs
[([TxSignature], Maybe RedeemScript)]
sigRes <- (ByteString -> Either String ([TxSignature], Maybe RedeemScript))
-> WitnessStack
-> Either String [([TxSignature], Maybe RedeemScript)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ByteString -> Either String ([TxSignature], Maybe RedeemScript)
forall {a}.
IsString a =>
ByteString -> Either a ([TxSignature], Maybe RedeemScript)
extractSigs (WitnessStack
-> Either String [([TxSignature], Maybe RedeemScript)])
-> WitnessStack
-> Either String [([TxSignature], Maybe RedeemScript)]
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> WitnessStack -> WitnessStack
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) WitnessStack
ins
let rdm :: Maybe RedeemScript
rdm = ([TxSignature], Maybe RedeemScript) -> Maybe RedeemScript
forall a b. (a, b) -> b
snd (([TxSignature], Maybe RedeemScript) -> Maybe RedeemScript)
-> ([TxSignature], Maybe RedeemScript) -> Maybe RedeemScript
forall a b. (a -> b) -> a -> b
$ [([TxSignature], Maybe RedeemScript)]
-> ([TxSignature], Maybe RedeemScript)
forall a. HasCallStack => [a] -> a
head [([TxSignature], Maybe RedeemScript)]
sigRes
Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ((([TxSignature], Maybe RedeemScript) -> Bool)
-> [([TxSignature], Maybe RedeemScript)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Maybe RedeemScript -> Maybe RedeemScript -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe RedeemScript
rdm) (Maybe RedeemScript -> Bool)
-> (([TxSignature], Maybe RedeemScript) -> Maybe RedeemScript)
-> ([TxSignature], Maybe RedeemScript)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TxSignature], Maybe RedeemScript) -> Maybe RedeemScript
forall a b. (a, b) -> b
snd) [([TxSignature], Maybe RedeemScript)]
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 <- (Network, Ctx) -> ScriptInput -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal (Network
net, Ctx
ctx) (ScriptInput -> ByteString)
-> Either String ScriptInput -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TxSignature]
-> RedeemScript -> Maybe RedeemScript -> Either String ScriptInput
forall {a}.
IsString a =>
[TxSignature]
-> RedeemScript -> Maybe RedeemScript -> 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 RedeemScript) -> [TxSignature])
-> [([TxSignature], Maybe RedeemScript)] -> [TxSignature]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([TxSignature], Maybe RedeemScript) -> [TxSignature]
forall a b. (a, b) -> a
fst [([TxSignature], Maybe RedeemScript)]
sigRes) RedeemScript
so Maybe RedeemScript
rdm
let ins' :: [TxIn]
ins' = Int -> [TxIn] -> (TxIn -> TxIn) -> [TxIn]
forall a. Int -> [a] -> (a -> a) -> [a]
updateIndex Int
i Tx
tx.inputs (\TxIn {Word32
ByteString
OutPoint
$sel:outpoint:TxIn :: TxIn -> OutPoint
$sel:script:TxIn :: TxIn -> ByteString
$sel:sequence:TxIn :: TxIn -> Word32
outpoint :: OutPoint
script :: ByteString
sequence :: Word32
..} -> TxIn {$sel:script:TxIn :: ByteString
script = ByteString
si, Word32
OutPoint
$sel:outpoint:TxIn :: OutPoint
$sel:sequence:TxIn :: Word32
outpoint :: OutPoint
sequence :: Word32
..})
Tx -> Either String Tx
forall a. a -> Either String a
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] -> [WitnessStack] -> Word32 -> Tx
Tx Tx
tx.version [TxIn]
ins' Tx
tx.outputs [] Tx
tx.locktime
where
go :: [TxSignature]
-> RedeemScript -> Maybe RedeemScript -> Either a ScriptInput
go [TxSignature]
allSigs RedeemScript
out Maybe RedeemScript
rdmM =
case RedeemScript
out of
PayMulSig [PublicKey]
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]
-> [PublicKey]
-> (TxSignature -> PublicKey -> Bool)
-> [Maybe TxSignature]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [TxSignature]
allSigs [PublicKey]
msPubs ((TxSignature -> PublicKey -> Bool) -> [Maybe TxSignature])
-> (TxSignature -> PublicKey -> Bool) -> [Maybe TxSignature]
forall a b. (a -> b) -> a -> b
$
RedeemScript -> TxSignature -> PublicKey -> Bool
forall {r}.
HasField "point" r PubKey =>
RedeemScript -> TxSignature -> r -> Bool
f RedeemScript
out
in ScriptInput -> Either a ScriptInput
forall a. a -> Either a a
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 RedeemScript
rdmM of
Just RedeemScript
rdm -> do
ScriptInput
si <- [TxSignature]
-> RedeemScript -> Maybe RedeemScript -> Either a ScriptInput
go [TxSignature]
allSigs RedeemScript
rdm Maybe RedeemScript
forall a. Maybe a
Nothing
ScriptInput -> Either a ScriptInput
forall a. a -> Either a a
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 -> RedeemScript -> ScriptInput
ScriptHashInput ScriptInput
si.get RedeemScript
rdm
Maybe RedeemScript
_ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left a
"Invalid output script type"
RedeemScript
_ -> a -> Either a ScriptInput
forall a b. a -> Either a b
Left a
"Invalid output script type"
extractSigs :: ByteString -> Either a ([TxSignature], Maybe RedeemScript)
extractSigs ByteString
si =
case (Network, Ctx) -> ByteString -> Either String ScriptInput
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal (Network
net, Ctx
ctx) ByteString
si of
Right (RegularInput (SpendMulSig [TxSignature]
sigs)) ->
([TxSignature], Maybe RedeemScript)
-> Either a ([TxSignature], Maybe RedeemScript)
forall a b. b -> Either a b
Right ([TxSignature]
sigs, Maybe RedeemScript
forall a. Maybe a
Nothing)
Right (ScriptHashInput (SpendMulSig [TxSignature]
sigs) RedeemScript
rdm) ->
([TxSignature], Maybe RedeemScript)
-> Either a ([TxSignature], Maybe RedeemScript)
forall a b. b -> Either a b
Right ([TxSignature]
sigs, RedeemScript -> Maybe RedeemScript
forall a. a -> Maybe a
Just RedeemScript
rdm)
Either String ScriptInput
_ -> a -> Either a ([TxSignature], Maybe RedeemScript)
forall a b. a -> Either a b
Left a
"Invalid script input type"
f :: RedeemScript -> TxSignature -> r -> Bool
f RedeemScript
out (TxSignature Sig
x SigHash
sh) r
p =
Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig
Ctx
ctx
(Network -> Tx -> Script -> Word64 -> Int -> SigHash -> Hash256
txSigHash Network
net Tx
tx (Ctx -> RedeemScript -> Script
encodeOutput Ctx
ctx RedeemScript
out) Word64
val Int
i SigHash
sh)
Sig
x
r
p.point
f RedeemScript
_ TxSignature
TxSignatureEmpty r
_ = Bool
False
verifyStdTx ::
Network -> Ctx -> Tx -> [(ScriptOutput, Word64, OutPoint)] -> Bool
verifyStdTx :: Network -> Ctx -> Tx -> [(RedeemScript, Word64, OutPoint)] -> Bool
verifyStdTx Network
net Ctx
ctx Tx
tx [(RedeemScript, Word64, OutPoint)]
xs =
Bool -> Bool
not ([TxIn] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Tx
tx.inputs) Bool -> Bool -> Bool
&& ((Maybe (RedeemScript, Word64, OutPoint), Int) -> Bool)
-> [(Maybe (RedeemScript, Word64, OutPoint), Int)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Maybe (RedeemScript, Word64, OutPoint), Int) -> Bool
forall {c}. (Maybe (RedeemScript, Word64, c), Int) -> Bool
go ([Maybe (RedeemScript, Word64, OutPoint)]
-> [Int] -> [(Maybe (RedeemScript, Word64, OutPoint), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([(RedeemScript, Word64, OutPoint)]
-> [TxIn]
-> ((RedeemScript, Word64, OutPoint) -> TxIn -> Bool)
-> [Maybe (RedeemScript, Word64, OutPoint)]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe a]
matchTemplate [(RedeemScript, Word64, OutPoint)]
xs Tx
tx.inputs (RedeemScript, Word64, OutPoint) -> TxIn -> Bool
forall {a} {r} {a} {b}.
(Eq a, HasField "outpoint" r a) =>
(a, b, a) -> r -> Bool
f) [Int
0 ..])
where
f :: (a, b, a) -> r -> Bool
f (a
_, b
_, a
o) r
txin = a
o a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== r
txin.outpoint
go :: (Maybe (RedeemScript, Word64, c), Int) -> Bool
go (Just (RedeemScript
so, Word64
val, c
_), Int
i) = Network -> Ctx -> Tx -> Int -> RedeemScript -> Word64 -> Bool
verifyStdInput Network
net Ctx
ctx Tx
tx Int
i RedeemScript
so Word64
val
go (Maybe (RedeemScript, Word64, c), Int)
_ = Bool
False
verifyStdInput :: Network -> Ctx -> Tx -> Int -> ScriptOutput -> Word64 -> Bool
verifyStdInput :: Network -> Ctx -> Tx -> Int -> RedeemScript -> Word64 -> Bool
verifyStdInput Network
net Ctx
ctx Tx
tx Int
i RedeemScript
so0 Word64
val
| RedeemScript -> Bool
isSegwit RedeemScript
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 RedeemScript, SimpleInput) -> Bool)
-> (Maybe RedeemScript, SimpleInput)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedeemScript -> (Maybe RedeemScript, SimpleInput) -> Bool
verifySegwitInput RedeemScript
so0 ((Maybe RedeemScript, SimpleInput) -> Bool)
-> Either String (Maybe RedeemScript, SimpleInput)
-> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RedeemScript -> Either String (Maybe RedeemScript, SimpleInput)
wp RedeemScript
so0
| Bool
otherwise =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$
[Either String Bool] -> [Bool]
forall a b. [Either a b] -> [b]
rights
[ RedeemScript -> ScriptInput -> Bool
verifyLegacyInput RedeemScript
so0 (ScriptInput -> Bool)
-> Either String ScriptInput -> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Network, Ctx) -> ByteString -> Either String ScriptInput
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal (Network
net, Ctx
ctx) ByteString
inp,
Either String RedeemScript
nestedScriptOutput Either String RedeemScript
-> (RedeemScript -> Either String Bool) -> Either String Bool
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \RedeemScript
so -> RedeemScript
-> RedeemScript -> (Maybe RedeemScript, SimpleInput) -> Bool
verifyNestedInput RedeemScript
so0 RedeemScript
so ((Maybe RedeemScript, SimpleInput) -> Bool)
-> Either String (Maybe RedeemScript, SimpleInput)
-> Either String Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RedeemScript -> Either String (Maybe RedeemScript, SimpleInput)
wp RedeemScript
so
]
where
inp :: ByteString
inp = (Tx
tx.inputs [TxIn] -> Int -> TxIn
forall a. HasCallStack => [a] -> Int -> a
!! Int
i).script
theTxSigHash :: RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so = Network
-> Ctx
-> Tx
-> Int
-> RedeemScript
-> Word64
-> SigHash
-> Maybe RedeemScript
-> Hash256
Sign.makeSigHash Network
net Ctx
ctx Tx
tx Int
i RedeemScript
so Word64
val
ws :: WitnessStack
ws :: WitnessStack
ws
| [WitnessStack] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Tx
tx.witness Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
i = Tx
tx.witness [WitnessStack] -> Int -> WitnessStack
forall a. HasCallStack => [a] -> Int -> a
!! Int
i
| Bool
otherwise = []
wp :: ScriptOutput -> Either String (Maybe ScriptOutput, SimpleInput)
wp :: RedeemScript -> Either String (Maybe RedeemScript, SimpleInput)
wp RedeemScript
so = Network
-> Ctx
-> WitnessProgram
-> Either String (Maybe RedeemScript, SimpleInput)
decodeWitnessInput Network
net Ctx
ctx (WitnessProgram -> Either String (Maybe RedeemScript, SimpleInput))
-> Either String WitnessProgram
-> Either String (Maybe RedeemScript, SimpleInput)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Network
-> Ctx
-> RedeemScript
-> WitnessStack
-> Either String WitnessProgram
viewWitnessProgram Network
net Ctx
ctx RedeemScript
so WitnessStack
ws
nestedScriptOutput :: Either String ScriptOutput
nestedScriptOutput :: Either String RedeemScript
nestedScriptOutput =
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
forall (m :: * -> *). MonadGet m => m Script
deserialize ByteString
inp Either String Script
-> (Script -> Either String RedeemScript)
-> Either String RedeemScript
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ScriptOp] -> Either String RedeemScript
dec ([ScriptOp] -> Either String RedeemScript)
-> (Script -> [ScriptOp]) -> Script -> Either String RedeemScript
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> [ScriptOp]
ops
where
ops :: Script -> [ScriptOp]
ops (Script [ScriptOp]
ops') = [ScriptOp]
ops'
dec :: [ScriptOp] -> Either String RedeemScript
dec = \case
[OP_PUSHDATA ByteString
bs PushDataType
_] -> Ctx -> ByteString -> Either String RedeemScript
forall s a. Marshal s a => s -> ByteString -> Either String a
unmarshal Ctx
ctx ByteString
bs
[ScriptOp]
_ -> String -> Either String RedeemScript
forall a b. a -> Either a b
Left String
"nestedScriptOutput: not a nested output"
verifyLegacyInput :: ScriptOutput -> ScriptInput -> Bool
verifyLegacyInput :: RedeemScript -> ScriptInput -> Bool
verifyLegacyInput RedeemScript
so ScriptInput
si = case (RedeemScript
so, ScriptInput
si) of
(PayPK PublicKey
pub, RegularInput (SpendPK (TxSignature Sig
sig SigHash
sh))) ->
Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx (RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh Maybe RedeemScript
forall a. Maybe a
Nothing) Sig
sig PublicKey
pub.point
(PayPKHash Hash160
h, RegularInput (SpendPKHash (TxSignature Sig
sig SigHash
sh) PublicKey
pub)) ->
Ctx -> PublicKey -> Address
pubKeyAddr Ctx
ctx PublicKey
pub Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2pkhAddr Hash160
h
Bool -> Bool -> Bool
&& Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx (RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh Maybe RedeemScript
forall a. Maybe a
Nothing) Sig
sig PublicKey
pub.point
(PayMulSig [PublicKey]
pubs Int
r, RegularInput (SpendMulSig [TxSignature]
sigs)) ->
Network
-> Ctx
-> Tx
-> Script
-> Word64
-> Int
-> [PubKey]
-> [TxSignature]
-> Int
countMulSig Network
net Ctx
ctx Tx
tx Script
out Word64
val Int
i ((.point) (PublicKey -> PubKey) -> [PublicKey] -> [PubKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PublicKey]
pubs) [TxSignature]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
(PayScriptHash Hash160
h, ScriptHashInput SimpleInput
si' RedeemScript
rdm) ->
Ctx -> RedeemScript -> Address
payToScriptAddress Ctx
ctx RedeemScript
rdm Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2shAddr Hash160
h Bool -> Bool -> Bool
&& RedeemScript -> ScriptInput -> Bool
verifyLegacyInput RedeemScript
rdm (SimpleInput -> ScriptInput
RegularInput SimpleInput
si')
(RedeemScript, ScriptInput)
_ -> Bool
False
where
out :: Script
out = Ctx -> RedeemScript -> Script
encodeOutput Ctx
ctx RedeemScript
so
verifySegwitInput ::
ScriptOutput -> (Maybe ScriptOutput, SimpleInput) -> Bool
verifySegwitInput :: RedeemScript -> (Maybe RedeemScript, SimpleInput) -> Bool
verifySegwitInput RedeemScript
so (Maybe RedeemScript
rdm, SimpleInput
si) = case (RedeemScript
so, Maybe RedeemScript
rdm, SimpleInput
si) of
( PayWitnessPKHash Hash160
h,
Maybe RedeemScript
Nothing,
SpendPKHash (TxSignature Sig
sig SigHash
sh) PublicKey
pub
) ->
let keytest :: Bool
keytest = Ctx -> PublicKey -> Address
pubKeyWitnessAddr Ctx
ctx PublicKey
pub Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2wpkhAddr Hash160
h
sighash :: Hash256
sighash = RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh Maybe RedeemScript
forall a. Maybe a
Nothing
pkpoint :: PubKey
pkpoint = PublicKey
pub.point
verify :: Bool
verify = Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx Hash256
sighash Sig
sig PubKey
pkpoint
in Bool
keytest Bool -> Bool -> Bool
&& Bool
verify
( PayWitnessScriptHash Hash256
h,
Just rdm' :: RedeemScript
rdm'@(PayPK PublicKey
pub),
SpendPK (TxSignature Sig
sig SigHash
sh)
) ->
let keytest :: Bool
keytest = Ctx -> RedeemScript -> Address
payToWitnessScriptAddress Ctx
ctx RedeemScript
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h
sighash :: Hash256
sighash = RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh (Maybe RedeemScript -> Hash256) -> Maybe RedeemScript -> Hash256
forall a b. (a -> b) -> a -> b
$ RedeemScript -> Maybe RedeemScript
forall a. a -> Maybe a
Just RedeemScript
rdm'
pkpoint :: PubKey
pkpoint = PublicKey
pub.point
verify :: Bool
verify = Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx Hash256
sighash Sig
sig PubKey
pkpoint
in Bool
keytest Bool -> Bool -> Bool
&& Bool
verify
( PayWitnessScriptHash Hash256
h,
Just rdm' :: RedeemScript
rdm'@(PayPKHash Hash160
kh),
SpendPKHash (TxSignature Sig
sig SigHash
sh) PublicKey
pub
) ->
let keytest :: Bool
keytest = Ctx -> RedeemScript -> Address
payToWitnessScriptAddress Ctx
ctx RedeemScript
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h
addrtest :: Bool
addrtest = ByteString -> Hash160
forall b. ByteArrayAccess b => b -> Hash160
addressHash (Ctx -> PublicKey -> ByteString
forall s a. Marshal s a => s -> a -> ByteString
marshal Ctx
ctx PublicKey
pub) Hash160 -> Hash160 -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160
kh
pkpoint :: PubKey
pkpoint = PublicKey
pub.point
sighash :: Hash256
sighash = RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh (Maybe RedeemScript -> Hash256) -> Maybe RedeemScript -> Hash256
forall a b. (a -> b) -> a -> b
$ RedeemScript -> Maybe RedeemScript
forall a. a -> Maybe a
Just RedeemScript
rdm'
verify :: Bool
verify = Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx Hash256
sighash Sig
sig PubKey
pkpoint
in Bool
keytest Bool -> Bool -> Bool
&& Bool
addrtest Bool -> Bool -> Bool
&& Bool
verify
( PayWitnessScriptHash Hash256
h,
Just rdm' :: RedeemScript
rdm'@(PayMulSig [PublicKey]
pubs Int
r),
SpendMulSig [TxSignature]
sigs
) ->
let keytest :: Bool
keytest = Ctx -> RedeemScript -> Address
payToWitnessScriptAddress Ctx
ctx RedeemScript
rdm' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash256 -> Address
p2wshAddr Hash256
h
pkpoints :: [PubKey]
pkpoints = (.point) (PublicKey -> PubKey) -> [PublicKey] -> [PubKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [PublicKey]
pubs
hashfun :: SigHash -> Hash256
hashfun SigHash
sh = RedeemScript -> SigHash -> Maybe RedeemScript -> Hash256
theTxSigHash RedeemScript
so SigHash
sh (Maybe RedeemScript -> Hash256) -> Maybe RedeemScript -> Hash256
forall a b. (a -> b) -> a -> b
$ RedeemScript -> Maybe RedeemScript
forall a. a -> Maybe a
Just RedeemScript
rdm'
verify :: Bool
verify = Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
ctx SigHash -> Hash256
hashfun [PubKey]
pkpoints [TxSignature]
sigs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
r
in Bool
keytest Bool -> Bool -> Bool
&& Bool
verify
(RedeemScript, Maybe RedeemScript, SimpleInput)
_ -> Bool
False
verifyNestedInput ::
ScriptOutput -> ScriptOutput -> (Maybe RedeemScript, SimpleInput) -> Bool
verifyNestedInput :: RedeemScript
-> RedeemScript -> (Maybe RedeemScript, SimpleInput) -> Bool
verifyNestedInput RedeemScript
so RedeemScript
so' (Maybe RedeemScript, SimpleInput)
x = case RedeemScript
so of
PayScriptHash Hash160
h -> Ctx -> RedeemScript -> Address
payToScriptAddress Ctx
ctx RedeemScript
so' Address -> Address -> Bool
forall a. Eq a => a -> a -> Bool
== Hash160 -> Address
p2shAddr Hash160
h Bool -> Bool -> Bool
&& RedeemScript -> (Maybe RedeemScript, SimpleInput) -> Bool
verifySegwitInput RedeemScript
so' (Maybe RedeemScript, SimpleInput)
x
RedeemScript
_ -> Bool
False
countMulSig ::
Network ->
Ctx ->
Tx ->
Script ->
Word64 ->
Int ->
[PubKey] ->
[TxSignature] ->
Int
countMulSig :: Network
-> Ctx
-> Tx
-> Script
-> Word64
-> Int
-> [PubKey]
-> [TxSignature]
-> Int
countMulSig Network
net Ctx
ctx Tx
tx Script
out Word64
val Int
i =
Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
ctx 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' :: Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' :: Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
_ SigHash -> Hash256
_ [] [TxSignature]
_ = Int
0
countMulSig' Ctx
_ SigHash -> Hash256
_ [PubKey]
_ [] = Int
0
countMulSig' Ctx
ctx SigHash -> Hash256
h (PubKey
_ : [PubKey]
pubs) (TxSignature
TxSignatureEmpty : [TxSignature]
sigs) =
Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
ctx SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs
countMulSig' Ctx
ctx SigHash -> Hash256
h (PubKey
pub : [PubKey]
pubs) sigs :: [TxSignature]
sigs@(TxSignature Sig
sig SigHash
sh : [TxSignature]
sigs')
| Ctx -> Hash256 -> Sig -> PubKey -> Bool
verifyHashSig Ctx
ctx (SigHash -> Hash256
h SigHash
sh) Sig
sig PubKey
pub = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
ctx SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs'
| Bool
otherwise = Ctx -> (SigHash -> Hash256) -> [PubKey] -> [TxSignature] -> Int
countMulSig' Ctx
ctx SigHash -> Hash256
h [PubKey]
pubs [TxSignature]
sigs