{-|
Module      : Haskoin.Test.Transaction
Copyright   : No rights reserved
License     : MIT
Maintainer  : jprupp@protonmail.ch
Stability   : experimental
Portability : POSIX
-}
module Haskoin.Util.Arbitrary.Transaction where

import           Control.Monad
import qualified Data.ByteString     as BS
import           Data.Either         (fromRight)
import           Data.List           (nub, nubBy, permutations)
import           Data.Word           (Word64)
import           Haskoin.Address
import           Haskoin.Constants
import           Haskoin.Keys.Common
import           Haskoin.Script
import           Haskoin.Util.Arbitrary.Crypto
import           Haskoin.Util.Arbitrary.Keys
import           Haskoin.Util.Arbitrary.Script
import           Haskoin.Util.Arbitrary.Util
import           Haskoin.Transaction
import           Test.QuickCheck

-- | Wrapped coin value for testing.
newtype TestCoin = TestCoin { TestCoin -> Word64
getTestCoin :: Word64 }
    deriving (TestCoin -> TestCoin -> Bool
(TestCoin -> TestCoin -> Bool)
-> (TestCoin -> TestCoin -> Bool) -> Eq TestCoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TestCoin -> TestCoin -> Bool
$c/= :: TestCoin -> TestCoin -> Bool
== :: TestCoin -> TestCoin -> Bool
$c== :: TestCoin -> TestCoin -> Bool
Eq, Int -> TestCoin -> ShowS
[TestCoin] -> ShowS
TestCoin -> String
(Int -> TestCoin -> ShowS)
-> (TestCoin -> String) -> ([TestCoin] -> ShowS) -> Show TestCoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestCoin] -> ShowS
$cshowList :: [TestCoin] -> ShowS
show :: TestCoin -> String
$cshow :: TestCoin -> String
showsPrec :: Int -> TestCoin -> ShowS
$cshowsPrec :: Int -> TestCoin -> ShowS
Show)

instance Coin TestCoin where
    coinValue :: TestCoin -> Word64
coinValue = TestCoin -> Word64
getTestCoin

-- | Arbitrary transaction hash (for non-existent transaction).
arbitraryTxHash :: Gen TxHash
arbitraryTxHash :: Gen TxHash
arbitraryTxHash = Hash256 -> TxHash
TxHash (Hash256 -> TxHash) -> Gen Hash256 -> Gen TxHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Hash256
arbitraryHash256

-- | Arbitrary amount of Satoshi as 'Word64' (Between 1 and 21e14)
arbitrarySatoshi :: Network -> Gen TestCoin
arbitrarySatoshi :: Network -> Gen TestCoin
arbitrarySatoshi net :: Network
net = Word64 -> TestCoin
TestCoin (Word64 -> TestCoin) -> Gen Word64 -> Gen TestCoin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (1, Network -> Word64
getMaxSatoshi Network
net)

-- | Arbitrary 'OutPoint'.
arbitraryOutPoint :: Gen OutPoint
arbitraryOutPoint :: Gen OutPoint
arbitraryOutPoint = TxHash -> Word32 -> OutPoint
OutPoint (TxHash -> Word32 -> OutPoint)
-> Gen TxHash -> Gen (Word32 -> OutPoint)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxHash
arbitraryTxHash Gen (Word32 -> OutPoint) -> Gen Word32 -> Gen OutPoint
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary 'TxOut'.
arbitraryTxOut :: Network -> Gen TxOut
arbitraryTxOut :: Network -> Gen TxOut
arbitraryTxOut net :: Network
net =
    Word64 -> ByteString -> TxOut
TxOut (Word64 -> ByteString -> TxOut)
-> Gen Word64 -> Gen (ByteString -> TxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TestCoin -> Word64
getTestCoin (TestCoin -> Word64) -> Gen TestCoin -> Gen Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen TestCoin
arbitrarySatoshi Network
net)
          Gen (ByteString -> TxOut) -> Gen ByteString -> Gen TxOut
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ScriptOutput -> ByteString
encodeOutputBS (ScriptOutput -> ByteString) -> Gen ScriptOutput -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen ScriptOutput
arbitraryScriptOutput Network
net)

-- | Arbitrary 'TxIn'.
arbitraryTxIn :: Network -> Gen TxIn
arbitraryTxIn :: Network -> Gen TxIn
arbitraryTxIn net :: Network
net =
    OutPoint -> ByteString -> Word32 -> TxIn
TxIn (OutPoint -> ByteString -> Word32 -> TxIn)
-> Gen OutPoint -> Gen (ByteString -> Word32 -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen OutPoint
arbitraryOutPoint
         Gen (ByteString -> Word32 -> TxIn)
-> Gen ByteString -> Gen (Word32 -> TxIn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ScriptInput -> ByteString
encodeInputBS (ScriptInput -> ByteString) -> Gen ScriptInput -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen ScriptInput
arbitraryScriptInput Network
net)
         Gen (Word32 -> TxIn) -> Gen Word32 -> Gen TxIn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary transaction. Can be regular or with witnesses.
arbitraryTx :: Network -> Gen Tx
arbitraryTx :: Network -> Gen Tx
arbitraryTx net :: Network
net = [Gen Tx] -> Gen Tx
forall a. [Gen a] -> Gen a
oneof [Network -> Gen Tx
arbitraryLegacyTx Network
net, Network -> Gen Tx
arbitraryWitnessTx Network
net]

-- | Arbitrary regular transaction.
arbitraryLegacyTx :: Network -> Gen Tx
arbitraryLegacyTx :: Network -> Gen Tx
arbitraryLegacyTx net :: Network
net = Network -> Bool -> Gen Tx
arbitraryWLTx Network
net Bool
False

-- | Arbitrary witness transaction (witness data is fake).
arbitraryWitnessTx :: Network -> Gen Tx
arbitraryWitnessTx :: Network -> Gen Tx
arbitraryWitnessTx net :: Network
net = Network -> Bool -> Gen Tx
arbitraryWLTx Network
net Bool
True

-- | Arbitrary witness or legacy transaction.
arbitraryWLTx :: Network -> Bool -> Gen Tx
arbitraryWLTx :: Network -> Bool -> Gen Tx
arbitraryWLTx net :: Network
net wit :: Bool
wit = do
    Int
ni <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1, 5)
    Int
no <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1, 5)
    [TxIn]
inps <- Int -> Gen TxIn -> Gen [TxIn]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
ni (Network -> Gen TxIn
arbitraryTxIn Network
net)
    [TxOut]
outs <- Int -> Gen TxOut -> Gen [TxOut]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
no (Network -> Gen TxOut
arbitraryTxOut Network
net)
    let uniqueInps :: [TxIn]
uniqueInps = (TxIn -> TxIn -> Bool) -> [TxIn] -> [TxIn]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\a :: TxIn
a b :: TxIn
b -> TxIn -> OutPoint
prevOutput TxIn
a OutPoint -> OutPoint -> Bool
forall a. Eq a => a -> a -> Bool
== TxIn -> OutPoint
prevOutput TxIn
b) [TxIn]
inps
    [[ByteString]]
w <-
        if Bool
wit
            then Int -> Gen [ByteString] -> Gen [[ByteString]]
forall a. Int -> Gen a -> Gen [a]
vectorOf ([TxIn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
uniqueInps) (Gen ByteString -> Gen [ByteString]
forall a. Gen a -> Gen [a]
listOf Gen ByteString
arbitraryBS)
            else [[ByteString]] -> Gen [[ByteString]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    Word32 -> [TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx
Tx (Word32 -> [TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx)
-> Gen Word32
-> Gen ([TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary Gen ([TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx)
-> Gen [TxIn] -> Gen ([TxOut] -> [[ByteString]] -> Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TxIn] -> Gen [TxIn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TxIn]
uniqueInps Gen ([TxOut] -> [[ByteString]] -> Word32 -> Tx)
-> Gen [TxOut] -> Gen ([[ByteString]] -> Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TxOut] -> Gen [TxOut]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TxOut]
outs Gen ([[ByteString]] -> Word32 -> Tx)
-> Gen [[ByteString]] -> Gen (Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[ByteString]] -> Gen [[ByteString]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [[ByteString]]
w Gen (Word32 -> Tx) -> Gen Word32 -> Gen Tx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary transaction containing only inputs of type 'SpendPKHash',
-- 'SpendScriptHash' (multisig) and outputs of type 'PayPKHash' and 'PaySH'.
-- Only compressed public keys are used.
arbitraryAddrOnlyTx :: Network -> Gen Tx
arbitraryAddrOnlyTx :: Network -> Gen Tx
arbitraryAddrOnlyTx net :: Network
net = do
    Int
ni <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1, 5)
    Int
no <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1, 5)
    [TxIn]
inps <- Int -> Gen TxIn -> Gen [TxIn]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
ni (Network -> Gen TxIn
arbitraryAddrOnlyTxIn Network
net)
    [TxOut]
outs <- Int -> Gen TxOut -> Gen [TxOut]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
no (Network -> Gen TxOut
arbitraryAddrOnlyTxOut Network
net)
    Word32 -> [TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx
Tx (Word32 -> [TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx)
-> Gen Word32
-> Gen ([TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary Gen ([TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx)
-> Gen [TxIn] -> Gen ([TxOut] -> [[ByteString]] -> Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TxIn] -> Gen [TxIn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TxIn]
inps Gen ([TxOut] -> [[ByteString]] -> Word32 -> Tx)
-> Gen [TxOut] -> Gen ([[ByteString]] -> Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TxOut] -> Gen [TxOut]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TxOut]
outs Gen ([[ByteString]] -> Word32 -> Tx)
-> Gen [[ByteString]] -> Gen (Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[ByteString]] -> Gen [[ByteString]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] Gen (Word32 -> Tx) -> Gen Word32 -> Gen Tx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary

-- | Like 'arbitraryAddrOnlyTx' without empty signatures in the inputs.
arbitraryAddrOnlyTxFull :: Network -> Gen Tx
arbitraryAddrOnlyTxFull :: Network -> Gen Tx
arbitraryAddrOnlyTxFull net :: Network
net = do
    Int
ni <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1, 5)
    Int
no <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1, 5)
    [TxIn]
inps <- Int -> Gen TxIn -> Gen [TxIn]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
ni (Network -> Gen TxIn
arbitraryAddrOnlyTxInFull Network
net)
    [TxOut]
outs <- Int -> Gen TxOut -> Gen [TxOut]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
no (Network -> Gen TxOut
arbitraryAddrOnlyTxOut Network
net)
    Word32 -> [TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx
Tx (Word32 -> [TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx)
-> Gen Word32
-> Gen ([TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary Gen ([TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx)
-> Gen [TxIn] -> Gen ([TxOut] -> [[ByteString]] -> Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TxIn] -> Gen [TxIn]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TxIn]
inps Gen ([TxOut] -> [[ByteString]] -> Word32 -> Tx)
-> Gen [TxOut] -> Gen ([[ByteString]] -> Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [TxOut] -> Gen [TxOut]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [TxOut]
outs Gen ([[ByteString]] -> Word32 -> Tx)
-> Gen [[ByteString]] -> Gen (Word32 -> Tx)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [[ByteString]] -> Gen [[ByteString]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] Gen (Word32 -> Tx) -> Gen Word32 -> Gen Tx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary TxIn that can only be of type 'SpendPKHash' or 'SpendScriptHash'
-- (multisig). Only compressed public keys are used.
arbitraryAddrOnlyTxIn :: Network -> Gen TxIn
arbitraryAddrOnlyTxIn :: Network -> Gen TxIn
arbitraryAddrOnlyTxIn net :: Network
net = do
    ScriptInput
inp <- [Gen ScriptInput] -> Gen ScriptInput
forall a. [Gen a] -> Gen a
oneof [Network -> Gen ScriptInput
arbitraryPKHashInput Network
net, Network -> Gen ScriptInput
arbitraryMulSigSHInput Network
net]
    OutPoint -> ByteString -> Word32 -> TxIn
TxIn (OutPoint -> ByteString -> Word32 -> TxIn)
-> Gen OutPoint -> Gen (ByteString -> Word32 -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen OutPoint
arbitraryOutPoint Gen (ByteString -> Word32 -> TxIn)
-> Gen ByteString -> Gen (Word32 -> TxIn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Gen ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptInput -> ByteString
encodeInputBS ScriptInput
inp) Gen (Word32 -> TxIn) -> Gen Word32 -> Gen TxIn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary

-- | like 'arbitraryAddrOnlyTxIn' with no empty signatures.
arbitraryAddrOnlyTxInFull :: Network -> Gen TxIn
arbitraryAddrOnlyTxInFull :: Network -> Gen TxIn
arbitraryAddrOnlyTxInFull net :: Network
net = do
    ScriptInput
inp <-
        [Gen ScriptInput] -> Gen ScriptInput
forall a. [Gen a] -> Gen a
oneof [Network -> Gen ScriptInput
arbitraryPKHashInputFullC Network
net, Network -> Gen ScriptInput
arbitraryMulSigSHInputFullC Network
net]
    OutPoint -> ByteString -> Word32 -> TxIn
TxIn (OutPoint -> ByteString -> Word32 -> TxIn)
-> Gen OutPoint -> Gen (ByteString -> Word32 -> TxIn)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen OutPoint
arbitraryOutPoint Gen (ByteString -> Word32 -> TxIn)
-> Gen ByteString -> Gen (Word32 -> TxIn)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Gen ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptInput -> ByteString
encodeInputBS ScriptInput
inp) Gen (Word32 -> TxIn) -> Gen Word32 -> Gen TxIn
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary

-- | Arbitrary 'TxOut' that can only be of type 'PayPKHash' or 'PaySH'.
arbitraryAddrOnlyTxOut :: Network -> Gen TxOut
arbitraryAddrOnlyTxOut :: Network -> Gen TxOut
arbitraryAddrOnlyTxOut net :: Network
net = do
    Word64
v <- TestCoin -> Word64
getTestCoin (TestCoin -> Word64) -> Gen TestCoin -> Gen Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen TestCoin
arbitrarySatoshi Network
net
    ScriptOutput
out <- [Gen ScriptOutput] -> Gen ScriptOutput
forall a. [Gen a] -> Gen a
oneof [Gen ScriptOutput
arbitraryPKHashOutput, Gen ScriptOutput
arbitrarySHOutput]
    TxOut -> Gen TxOut
forall (m :: * -> *) a. Monad m => a -> m a
return (TxOut -> Gen TxOut) -> TxOut -> Gen TxOut
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString -> TxOut
TxOut Word64
v (ByteString -> TxOut) -> ByteString -> TxOut
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> ByteString
encodeOutputBS ScriptOutput
out

-- | Arbitrary 'SigInput' with the corresponding private keys used
-- to generate the 'ScriptOutput' or 'RedeemScript'.
arbitrarySigInput :: Network -> Gen (SigInput, [SecKeyI])
arbitrarySigInput :: Network -> Gen (SigInput, [SecKeyI])
arbitrarySigInput net :: Network
net =
    [Gen (SigInput, [SecKeyI])] -> Gen (SigInput, [SecKeyI])
forall a. [Gen a] -> Gen a
oneof
        [ (SigInput, SecKeyI) -> (SigInput, [SecKeyI])
wrapKey ((SigInput, SecKeyI) -> (SigInput, [SecKeyI]))
-> Gen (SigInput, SecKeyI) -> Gen (SigInput, [SecKeyI])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen (SigInput, SecKeyI)
arbitraryPKSigInput Network
net
        , (SigInput, SecKeyI) -> (SigInput, [SecKeyI])
wrapKey ((SigInput, SecKeyI) -> (SigInput, [SecKeyI]))
-> Gen (SigInput, SecKeyI) -> Gen (SigInput, [SecKeyI])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen (SigInput, SecKeyI)
arbitraryPKHashSigInput Network
net
        , Network -> Gen (SigInput, [SecKeyI])
arbitraryMSSigInput Network
net
        , Network -> Gen (SigInput, [SecKeyI])
arbitrarySHSigInput Network
net
        , (SigInput, SecKeyI) -> (SigInput, [SecKeyI])
wrapKey ((SigInput, SecKeyI) -> (SigInput, [SecKeyI]))
-> Gen (SigInput, SecKeyI) -> Gen (SigInput, [SecKeyI])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen (SigInput, SecKeyI)
arbitraryWPKHSigInput Network
net
        , Network -> Gen (SigInput, [SecKeyI])
arbitraryWSHSigInput Network
net
        ]

-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPK'.
arbitraryPKSigInput :: Network -> Gen (SigInput, SecKeyI)
arbitraryPKSigInput :: Network -> Gen (SigInput, SecKeyI)
arbitraryPKSigInput net :: Network
net = Network -> Bool -> Gen (SigInput, SecKeyI)
arbitraryAnyInput Network
net Bool
False

-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayPKHash'.
arbitraryPKHashSigInput :: Network -> Gen (SigInput, SecKeyI)
arbitraryPKHashSigInput :: Network -> Gen (SigInput, SecKeyI)
arbitraryPKHashSigInput net :: Network
net = Network -> Bool -> Gen (SigInput, SecKeyI)
arbitraryAnyInput Network
net Bool
True

-- | Arbitrary 'SigInput'.
arbitraryAnyInput :: Network -> Bool -> Gen (SigInput, SecKeyI)
arbitraryAnyInput :: Network -> Bool -> Gen (SigInput, SecKeyI)
arbitraryAnyInput net :: Network
net pkh :: Bool
pkh = do
    (k :: SecKeyI
k, p :: PubKeyI
p) <- Gen (SecKeyI, PubKeyI)
arbitraryKeyPair
    let out :: ScriptOutput
out | Bool
pkh = Hash160 -> ScriptOutput
PayPKHash (Hash160 -> ScriptOutput) -> Hash160 -> ScriptOutput
forall a b. (a -> b) -> a -> b
$ Address -> Hash160
getAddrHash160 (Address -> Hash160) -> Address -> Hash160
forall a b. (a -> b) -> a -> b
$ PubKeyI -> Address
pubKeyAddr PubKeyI
p
            | Bool
otherwise = PubKeyI -> ScriptOutput
PayPK PubKeyI
p
    (val :: Word64
val, op :: OutPoint
op, sh :: SigHash
sh) <- Network -> Gen (Word64, OutPoint, SigHash)
arbitraryInputStuff Network
net
    (SigInput, SecKeyI) -> Gen (SigInput, SecKeyI)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptOutput
-> Word64 -> OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput
SigInput ScriptOutput
out Word64
val OutPoint
op SigHash
sh Maybe ScriptOutput
forall a. Maybe a
Nothing, SecKeyI
k)

-- | Arbitrary value, out point and sighash for an input.
arbitraryInputStuff :: Network -> Gen (Word64, OutPoint, SigHash)
arbitraryInputStuff :: Network -> Gen (Word64, OutPoint, SigHash)
arbitraryInputStuff net :: Network
net = do
    Word64
val <- TestCoin -> Word64
getTestCoin (TestCoin -> Word64) -> Gen TestCoin -> Gen Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen TestCoin
arbitrarySatoshi Network
net
    OutPoint
op <- Gen OutPoint
arbitraryOutPoint
    SigHash
sh <- Network -> Gen SigHash
arbitraryValidSigHash Network
net
    (Word64, OutPoint, SigHash) -> Gen (Word64, OutPoint, SigHash)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
val, OutPoint
op, SigHash
sh)

-- | Arbitrary 'SigInput' with a 'ScriptOutput' of type 'PayMulSig'.
arbitraryMSSigInput :: Network -> Gen (SigInput, [SecKeyI])
arbitraryMSSigInput :: Network -> Gen (SigInput, [SecKeyI])
arbitraryMSSigInput net :: Network
net = do
    (m :: Int
m, n :: Int
n) <- Gen (Int, Int)
arbitraryMSParam
    [(SecKeyI, PubKeyI)]
ks <- Int -> Gen (SecKeyI, PubKeyI) -> Gen [(SecKeyI, PubKeyI)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen (SecKeyI, PubKeyI)
arbitraryKeyPair
    let out :: ScriptOutput
out = [PubKeyI] -> Int -> ScriptOutput
PayMulSig (((SecKeyI, PubKeyI) -> PubKeyI)
-> [(SecKeyI, PubKeyI)] -> [PubKeyI]
forall a b. (a -> b) -> [a] -> [b]
map (SecKeyI, PubKeyI) -> PubKeyI
forall a b. (a, b) -> b
snd [(SecKeyI, PubKeyI)]
ks) Int
m
    (val :: Word64
val, op :: OutPoint
op, sh :: SigHash
sh) <- Network -> Gen (Word64, OutPoint, SigHash)
arbitraryInputStuff Network
net
    Int
perm <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (0, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
    let ksPerm :: [SecKeyI]
ksPerm = ((SecKeyI, PubKeyI) -> SecKeyI)
-> [(SecKeyI, PubKeyI)] -> [SecKeyI]
forall a b. (a -> b) -> [a] -> [b]
map (SecKeyI, PubKeyI) -> SecKeyI
forall a b. (a, b) -> a
fst ([(SecKeyI, PubKeyI)] -> [SecKeyI])
-> [(SecKeyI, PubKeyI)] -> [SecKeyI]
forall a b. (a -> b) -> a -> b
$ Int -> [(SecKeyI, PubKeyI)] -> [(SecKeyI, PubKeyI)]
forall a. Int -> [a] -> [a]
take Int
m ([(SecKeyI, PubKeyI)] -> [(SecKeyI, PubKeyI)])
-> [(SecKeyI, PubKeyI)] -> [(SecKeyI, PubKeyI)]
forall a b. (a -> b) -> a -> b
$ [(SecKeyI, PubKeyI)] -> [[(SecKeyI, PubKeyI)]]
forall a. [a] -> [[a]]
permutations [(SecKeyI, PubKeyI)]
ks [[(SecKeyI, PubKeyI)]] -> Int -> [(SecKeyI, PubKeyI)]
forall a. [a] -> Int -> a
!! Int
perm
    (SigInput, [SecKeyI]) -> Gen (SigInput, [SecKeyI])
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptOutput
-> Word64 -> OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput
SigInput ScriptOutput
out Word64
val OutPoint
op SigHash
sh Maybe ScriptOutput
forall a. Maybe a
Nothing, [SecKeyI]
ksPerm)

-- | Arbitrary 'SigInput' with 'ScriptOutput' of type 'PaySH' and a
-- 'RedeemScript'.
arbitrarySHSigInput :: Network -> Gen (SigInput, [SecKeyI])
arbitrarySHSigInput :: Network -> Gen (SigInput, [SecKeyI])
arbitrarySHSigInput net :: Network
net = do
    (SigInput rdm :: ScriptOutput
rdm val :: Word64
val op :: OutPoint
op sh :: SigHash
sh _, ks :: [SecKeyI]
ks) <- [Gen (SigInput, [SecKeyI])] -> Gen (SigInput, [SecKeyI])
forall a. [Gen a] -> Gen a
oneof
        [ (SigInput, SecKeyI) -> (SigInput, [SecKeyI])
wrapKey ((SigInput, SecKeyI) -> (SigInput, [SecKeyI]))
-> Gen (SigInput, SecKeyI) -> Gen (SigInput, [SecKeyI])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen (SigInput, SecKeyI)
arbitraryPKSigInput Network
net
        , (SigInput, SecKeyI) -> (SigInput, [SecKeyI])
wrapKey ((SigInput, SecKeyI) -> (SigInput, [SecKeyI]))
-> Gen (SigInput, SecKeyI) -> Gen (SigInput, [SecKeyI])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen (SigInput, SecKeyI)
arbitraryPKHashSigInput Network
net
        , Network -> Gen (SigInput, [SecKeyI])
arbitraryMSSigInput Network
net
        ]
    let out :: ScriptOutput
out = Hash160 -> ScriptOutput
PayScriptHash (Hash160 -> ScriptOutput) -> Hash160 -> ScriptOutput
forall a b. (a -> b) -> a -> b
$ Address -> Hash160
getAddrHash160 (Address -> Hash160) -> Address -> Hash160
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Address
payToScriptAddress ScriptOutput
rdm
    (SigInput, [SecKeyI]) -> Gen (SigInput, [SecKeyI])
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptOutput
-> Word64 -> OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput
SigInput ScriptOutput
out Word64
val OutPoint
op SigHash
sh (Maybe ScriptOutput -> SigInput) -> Maybe ScriptOutput -> SigInput
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
rdm, [SecKeyI]
ks)

arbitraryWPKHSigInput :: Network -> Gen (SigInput, SecKeyI)
arbitraryWPKHSigInput :: Network -> Gen (SigInput, SecKeyI)
arbitraryWPKHSigInput net :: Network
net = do
    (k :: SecKeyI
k, p :: PubKeyI
p) <- Gen (SecKeyI, PubKeyI)
arbitraryKeyPair
    (val :: Word64
val, op :: OutPoint
op, sh :: SigHash
sh) <- Network -> Gen (Word64, OutPoint, SigHash)
arbitraryInputStuff Network
net
    let out :: ScriptOutput
out = Hash160 -> ScriptOutput
PayWitnessPKHash (Hash160 -> ScriptOutput)
-> (Address -> Hash160) -> Address -> ScriptOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Hash160
getAddrHash160 (Address -> ScriptOutput) -> Address -> ScriptOutput
forall a b. (a -> b) -> a -> b
$ PubKeyI -> Address
pubKeyAddr PubKeyI
p
    (SigInput, SecKeyI) -> Gen (SigInput, SecKeyI)
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptOutput
-> Word64 -> OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput
SigInput ScriptOutput
out Word64
val OutPoint
op SigHash
sh Maybe ScriptOutput
forall a. Maybe a
Nothing, SecKeyI
k)

arbitraryWSHSigInput :: Network -> Gen (SigInput, [SecKeyI])
arbitraryWSHSigInput :: Network -> Gen (SigInput, [SecKeyI])
arbitraryWSHSigInput net :: Network
net = do
    (SigInput rdm :: ScriptOutput
rdm val :: Word64
val op :: OutPoint
op sh :: SigHash
sh _, ks :: [SecKeyI]
ks) <- [Gen (SigInput, [SecKeyI])] -> Gen (SigInput, [SecKeyI])
forall a. [Gen a] -> Gen a
oneof
        [ (SigInput, SecKeyI) -> (SigInput, [SecKeyI])
wrapKey ((SigInput, SecKeyI) -> (SigInput, [SecKeyI]))
-> Gen (SigInput, SecKeyI) -> Gen (SigInput, [SecKeyI])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen (SigInput, SecKeyI)
arbitraryPKSigInput Network
net
        , (SigInput, SecKeyI) -> (SigInput, [SecKeyI])
wrapKey ((SigInput, SecKeyI) -> (SigInput, [SecKeyI]))
-> Gen (SigInput, SecKeyI) -> Gen (SigInput, [SecKeyI])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen (SigInput, SecKeyI)
arbitraryPKHashSigInput Network
net
        , Network -> Gen (SigInput, [SecKeyI])
arbitraryMSSigInput Network
net
        ]
    let out :: ScriptOutput
out = Hash256 -> ScriptOutput
PayWitnessScriptHash (Hash256 -> ScriptOutput)
-> (Address -> Hash256) -> Address -> ScriptOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Hash256
getAddrHash256 (Address -> ScriptOutput) -> Address -> ScriptOutput
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Address
payToWitnessScriptAddress ScriptOutput
rdm
    (SigInput, [SecKeyI]) -> Gen (SigInput, [SecKeyI])
forall (m :: * -> *) a. Monad m => a -> m a
return (ScriptOutput
-> Word64 -> OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput
SigInput ScriptOutput
out Word64
val OutPoint
op SigHash
sh (Maybe ScriptOutput -> SigInput) -> Maybe ScriptOutput -> SigInput
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
rdm, [SecKeyI]
ks)

-- | Arbitrary 'Tx' (empty 'TxIn'), 'SigInputs' and private keys that can be
-- passed to 'signTx' or 'detSignTx' to fully sign the 'Tx'.
arbitrarySigningData :: Network -> Gen (Tx, [SigInput], [SecKeyI])
arbitrarySigningData :: Network -> Gen (Tx, [SigInput], [SecKeyI])
arbitrarySigningData net :: Network
net = do
    Word32
v <- Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
    Int
ni <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1, 5)
    Int
no <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1, 5)
    [(SigInput, [SecKeyI])]
sigis <- Int -> Gen (SigInput, [SecKeyI]) -> Gen [(SigInput, [SecKeyI])]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
ni (Network -> Gen (SigInput, [SecKeyI])
arbitrarySigInput Network
net)
    let uSigis :: [(SigInput, [SecKeyI])]
uSigis = ((SigInput, [SecKeyI]) -> (SigInput, [SecKeyI]) -> Bool)
-> [(SigInput, [SecKeyI])] -> [(SigInput, [SecKeyI])]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy (\(a :: SigInput
a, _) (b :: SigInput
b, _) -> SigInput -> OutPoint
sigInputOP SigInput
a OutPoint -> OutPoint -> Bool
forall a. Eq a => a -> a -> Bool
== SigInput -> OutPoint
sigInputOP SigInput
b) [(SigInput, [SecKeyI])]
sigis
    [TxIn]
inps <- [(SigInput, [SecKeyI])]
-> ((SigInput, [SecKeyI]) -> Gen TxIn) -> Gen [TxIn]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(SigInput, [SecKeyI])]
uSigis (((SigInput, [SecKeyI]) -> Gen TxIn) -> Gen [TxIn])
-> ((SigInput, [SecKeyI]) -> Gen TxIn) -> Gen [TxIn]
forall a b. (a -> b) -> a -> b
$ \(s :: SigInput
s, _) -> OutPoint -> ByteString -> Word32 -> TxIn
TxIn (SigInput -> OutPoint
sigInputOP SigInput
s) ByteString
BS.empty (Word32 -> TxIn) -> Gen Word32 -> Gen TxIn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
    [TxOut]
outs <- Int -> Gen TxOut -> Gen [TxOut]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
no (Network -> Gen TxOut
arbitraryTxOut Network
net)
    Word32
l <- Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
    Int
perm <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (0, [TxIn] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxIn]
inps Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
    let tx :: Tx
tx = Word32 -> [TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx
Tx Word32
v ([TxIn] -> [[TxIn]]
forall a. [a] -> [[a]]
permutations [TxIn]
inps [[TxIn]] -> Int -> [TxIn]
forall a. [a] -> Int -> a
!! Int
perm) [TxOut]
outs [] Word32
l
        keys :: [SecKeyI]
keys = ((SigInput, [SecKeyI]) -> [SecKeyI])
-> [(SigInput, [SecKeyI])] -> [SecKeyI]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SigInput, [SecKeyI]) -> [SecKeyI]
forall a b. (a, b) -> b
snd [(SigInput, [SecKeyI])]
uSigis
    (Tx, [SigInput], [SecKeyI]) -> Gen (Tx, [SigInput], [SecKeyI])
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx
tx, ((SigInput, [SecKeyI]) -> SigInput)
-> [(SigInput, [SecKeyI])] -> [SigInput]
forall a b. (a -> b) -> [a] -> [b]
map (SigInput, [SecKeyI]) -> SigInput
forall a b. (a, b) -> a
fst [(SigInput, [SecKeyI])]
uSigis, [SecKeyI]
keys)

-- | Arbitrary transaction with empty inputs.
arbitraryEmptyTx :: Network -> Gen Tx
arbitraryEmptyTx :: Network -> Gen Tx
arbitraryEmptyTx net :: Network
net = do
    Word32
v    <- Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
    Int
no   <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1,5)
    Int
ni   <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (1,5)
    [TxOut]
outs <- Int -> Gen TxOut -> Gen [TxOut]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
no (Network -> Gen TxOut
arbitraryTxOut Network
net)
    [OutPoint]
ops  <- Int -> Gen OutPoint -> Gen [OutPoint]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
ni Gen OutPoint
arbitraryOutPoint
    Word32
t    <- Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
    Word32
s    <- Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
    Tx -> Gen Tx
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx -> Gen Tx) -> Tx -> Gen Tx
forall a b. (a -> b) -> a -> b
$ Word32 -> [TxIn] -> [TxOut] -> [[ByteString]] -> Word32 -> Tx
Tx Word32
v ((OutPoint -> TxIn) -> [OutPoint] -> [TxIn]
forall a b. (a -> b) -> [a] -> [b]
map (\op :: OutPoint
op -> OutPoint -> ByteString -> Word32 -> TxIn
TxIn OutPoint
op ByteString
BS.empty Word32
s) ([OutPoint] -> [OutPoint]
forall a. Eq a => [a] -> [a]
nub [OutPoint]
ops)) [TxOut]
outs [] Word32
t

-- | Arbitrary partially-signed transactions.
arbitraryPartialTxs ::
       Network -> Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)])
arbitraryPartialTxs :: Network -> Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)])
arbitraryPartialTxs net :: Network
net = do
    Tx
tx <- Network -> Gen Tx
arbitraryEmptyTx Network
net
    [([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))]
res <-
        [OutPoint]
-> (OutPoint
    -> Gen ([Tx], (ScriptOutput, Word64, OutPoint, Int, Int)))
-> Gen [([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ((TxIn -> OutPoint) -> [TxIn] -> [OutPoint]
forall a b. (a -> b) -> [a] -> [b]
map TxIn -> OutPoint
prevOutput ([TxIn] -> [OutPoint]) -> [TxIn] -> [OutPoint]
forall a b. (a -> b) -> a -> b
$ Tx -> [TxIn]
txIn Tx
tx) ((OutPoint
  -> Gen ([Tx], (ScriptOutput, Word64, OutPoint, Int, Int)))
 -> Gen [([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))])
-> (OutPoint
    -> Gen ([Tx], (ScriptOutput, Word64, OutPoint, Int, Int)))
-> Gen [([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))]
forall a b. (a -> b) -> a -> b
$ \op :: OutPoint
op -> do
            (so :: ScriptOutput
so, val :: Word64
val, rdmM :: Maybe ScriptOutput
rdmM, prvs :: [SecKeyI]
prvs, m :: Int
m, n :: Int
n) <- Gen (ScriptOutput, Word64, Maybe ScriptOutput, [SecKeyI], Int, Int)
arbitraryData
            [Tx]
txs <- (SecKeyI -> Gen Tx) -> [SecKeyI] -> Gen [Tx]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ScriptOutput
-> Word64
-> Maybe ScriptOutput
-> Tx
-> OutPoint
-> SecKey
-> Gen Tx
singleSig ScriptOutput
so Word64
val Maybe ScriptOutput
rdmM Tx
tx OutPoint
op (SecKey -> Gen Tx) -> (SecKeyI -> SecKey) -> SecKeyI -> Gen Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecKeyI -> SecKey
secKeyData) [SecKeyI]
prvs
            ([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))
-> Gen ([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return ([Tx]
txs, (ScriptOutput
so, Word64
val, OutPoint
op, Int
m, Int
n))
    ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)])
-> Gen ([Tx], [(ScriptOutput, Word64, OutPoint, Int, Int)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((([Tx], (ScriptOutput, Word64, OutPoint, Int, Int)) -> [Tx])
-> [([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))] -> [Tx]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Tx], (ScriptOutput, Word64, OutPoint, Int, Int)) -> [Tx]
forall a b. (a, b) -> a
fst [([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))]
res, (([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))
 -> (ScriptOutput, Word64, OutPoint, Int, Int))
-> [([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))]
-> [(ScriptOutput, Word64, OutPoint, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))
-> (ScriptOutput, Word64, OutPoint, Int, Int)
forall a b. (a, b) -> b
snd [([Tx], (ScriptOutput, Word64, OutPoint, Int, Int))]
res)
  where
    singleSig :: ScriptOutput
-> Word64
-> Maybe ScriptOutput
-> Tx
-> OutPoint
-> SecKey
-> Gen Tx
singleSig so :: ScriptOutput
so val :: Word64
val rdmM :: Maybe ScriptOutput
rdmM tx :: Tx
tx op :: OutPoint
op prv :: SecKey
prv = do
        SigHash
sh <- Network -> Gen SigHash
arbitraryValidSigHash Network
net
        let sigi :: SigInput
sigi = ScriptOutput
-> Word64 -> OutPoint -> SigHash -> Maybe ScriptOutput -> SigInput
SigInput ScriptOutput
so Word64
val OutPoint
op SigHash
sh Maybe ScriptOutput
rdmM
        Tx -> Gen Tx
forall (m :: * -> *) a. Monad m => a -> m a
return (Tx -> Gen Tx)
-> (Either String Tx -> Tx) -> Either String Tx -> Gen Tx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx -> Either String Tx -> Tx
forall b a. b -> Either a b -> b
fromRight (String -> Tx
forall a. HasCallStack => String -> a
error "Could not decode transaction") (Either String Tx -> Gen Tx) -> Either String Tx -> Gen Tx
forall a b. (a -> b) -> a -> b
$
            Network -> Tx -> [SigInput] -> [SecKey] -> Either String Tx
signTx Network
net Tx
tx [SigInput
sigi] [SecKey
prv]
    arbitraryData :: Gen (ScriptOutput, Word64, Maybe ScriptOutput, [SecKeyI], Int, Int)
arbitraryData = do
        (m :: Int
m, n :: Int
n) <- Gen (Int, Int)
arbitraryMSParam
        Word64
val <- TestCoin -> Word64
getTestCoin (TestCoin -> Word64) -> Gen TestCoin -> Gen Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen TestCoin
arbitrarySatoshi Network
net
        Int
nPrv <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
m, Int
n)
        [(SecKeyI, PubKeyI)]
keys <- Int -> Gen (SecKeyI, PubKeyI) -> Gen [(SecKeyI, PubKeyI)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen (SecKeyI, PubKeyI)
arbitraryKeyPair
        Int
perm <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (0, [(SecKeyI, PubKeyI)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(SecKeyI, PubKeyI)]
keys Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
        let pubKeys :: [PubKeyI]
pubKeys = ((SecKeyI, PubKeyI) -> PubKeyI)
-> [(SecKeyI, PubKeyI)] -> [PubKeyI]
forall a b. (a -> b) -> [a] -> [b]
map (SecKeyI, PubKeyI) -> PubKeyI
forall a b. (a, b) -> b
snd [(SecKeyI, PubKeyI)]
keys
            prvKeys :: [SecKeyI]
prvKeys = Int -> [SecKeyI] -> [SecKeyI]
forall a. Int -> [a] -> [a]
take Int
nPrv ([SecKeyI] -> [SecKeyI]) -> [SecKeyI] -> [SecKeyI]
forall a b. (a -> b) -> a -> b
$ [SecKeyI] -> [[SecKeyI]]
forall a. [a] -> [[a]]
permutations (((SecKeyI, PubKeyI) -> SecKeyI)
-> [(SecKeyI, PubKeyI)] -> [SecKeyI]
forall a b. (a -> b) -> [a] -> [b]
map (SecKeyI, PubKeyI) -> SecKeyI
forall a b. (a, b) -> a
fst [(SecKeyI, PubKeyI)]
keys) [[SecKeyI]] -> Int -> [SecKeyI]
forall a. [a] -> Int -> a
!! Int
perm
        let so :: ScriptOutput
so = [PubKeyI] -> Int -> ScriptOutput
PayMulSig [PubKeyI]
pubKeys Int
m
        [(ScriptOutput, Word64, Maybe ScriptOutput, [SecKeyI], Int, Int)]
-> Gen
     (ScriptOutput, Word64, Maybe ScriptOutput, [SecKeyI], Int, Int)
forall a. [a] -> Gen a
elements
            [ (ScriptOutput
so, Word64
val, Maybe ScriptOutput
forall a. Maybe a
Nothing, [SecKeyI]
prvKeys, Int
m, Int
n)
            , ( Hash160 -> ScriptOutput
PayScriptHash (Hash160 -> ScriptOutput) -> Hash160 -> ScriptOutput
forall a b. (a -> b) -> a -> b
$ Address -> Hash160
getAddrHash160 (Address -> Hash160) -> Address -> Hash160
forall a b. (a -> b) -> a -> b
$ ScriptOutput -> Address
payToScriptAddress ScriptOutput
so
              , Word64
val
              , ScriptOutput -> Maybe ScriptOutput
forall a. a -> Maybe a
Just ScriptOutput
so
              , [SecKeyI]
prvKeys
              , Int
m
              , Int
n)
            ]

wrapKey :: (SigInput, SecKeyI) -> (SigInput, [SecKeyI])
wrapKey :: (SigInput, SecKeyI) -> (SigInput, [SecKeyI])
wrapKey (s :: SigInput
s, k :: SecKeyI
k) = (SigInput
s, [SecKeyI
k])