{-# LANGUAGE LambdaCase #-}

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

import Crypto.Secp256k1
import qualified Data.ByteString as B
import Data.Maybe
import Data.Word
import Haskoin.Address
import Haskoin.Constants
import Haskoin.Data
import Haskoin.Keys.Common
import Haskoin.Script
import Haskoin.Transaction.Common
import Haskoin.Util
import Haskoin.Util.Arbitrary.Address
import Haskoin.Util.Arbitrary.Crypto
import Haskoin.Util.Arbitrary.Keys
import Haskoin.Util.Arbitrary.Util
import Test.QuickCheck

-- | Arbitrary 'Script' with random script ops.
arbitraryScript :: Gen Script
arbitraryScript :: Gen Script
arbitraryScript = [ScriptOp] -> Script
Script forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf Gen ScriptOp
arbitraryScriptOp

-- | Arbitrary 'ScriptOp' (push operations have random data).
arbitraryScriptOp :: Gen ScriptOp
arbitraryScriptOp :: Gen ScriptOp
arbitraryScriptOp =
    forall a. [Gen a] -> Gen a
oneof
        -- Pushing Data
        [ ByteString -> ScriptOp
opPushData forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
arbitraryBS1
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_0
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_1NEGATE
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_RESERVED
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_1
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_2
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_3
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_4
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_5
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_6
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_7
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_8
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_9
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_10
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_11
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_12
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_13
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_14
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_15
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_16
        , -- Flow control
          forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOP
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_VER
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_IF
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOTIF
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_VERIF
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_VERNOTIF
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_ELSE
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_ENDIF
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_VERIFY
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_RETURN
        , -- Stack operations
          forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_TOALTSTACK
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_FROMALTSTACK
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_IFDUP
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_DEPTH
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_DROP
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_DUP
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NIP
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_OVER
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_PICK
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_ROLL
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_ROT
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_SWAP
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_TUCK
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_2DROP
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_2DUP
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_3DUP
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_2OVER
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_2ROT
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_2SWAP
        , -- Splice
          forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_CAT
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_SUBSTR
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_LEFT
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_RIGHT
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_SIZE
        , -- Bitwise logic
          forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_INVERT
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_AND
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_OR
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_XOR
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_EQUAL
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_EQUALVERIFY
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_RESERVED1
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_RESERVED2
        , -- Arithmetic
          forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_1ADD
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_1SUB
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_2MUL
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_2DIV
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NEGATE
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_ABS
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOT
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_0NOTEQUAL
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_ADD
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_SUB
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_MUL
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_DIV
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_MOD
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_LSHIFT
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_RSHIFT
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_BOOLAND
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_BOOLOR
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NUMEQUAL
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NUMEQUALVERIFY
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NUMNOTEQUAL
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_LESSTHAN
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_GREATERTHAN
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_LESSTHANOREQUAL
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_GREATERTHANOREQUAL
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_MIN
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_MAX
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_WITHIN
        , -- Crypto
          forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_RIPEMD160
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_SHA1
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_SHA256
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_HASH160
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_HASH256
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_CODESEPARATOR
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_CHECKSIG
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_CHECKSIGVERIFY
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_CHECKMULTISIG
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_CHECKMULTISIGVERIFY
        , -- Expansion
          forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOP1
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_CHECKLOCKTIMEVERIFY
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_CHECKSEQUENCEVERIFY
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOP4
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOP5
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOP6
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOP7
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOP8
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOP9
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_NOP10
        , -- Bitcoin Cash Nov 2018 hard fork
          forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_CHECKDATASIG
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_CHECKDATASIGVERIFY
        , -- Bitcoin Cash May 2020 hard fork
          forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_REVERSEBYTES
        , -- Other
          forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_PUBKEYHASH
        , forall (m :: * -> *) a. Monad m => a -> m a
return ScriptOp
OP_PUBKEY
        , forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> ScriptOp
OP_INVALIDOPCODE Word8
0xff
        ]

-- | Arbtirary 'ScriptOp' with a value in @[OP_1 .. OP_16]@.
arbitraryIntScriptOp :: Gen ScriptOp
arbitraryIntScriptOp :: Gen ScriptOp
arbitraryIntScriptOp =
    forall a. [a] -> Gen a
elements
        [ ScriptOp
OP_1
        , ScriptOp
OP_2
        , ScriptOp
OP_3
        , ScriptOp
OP_4
        , ScriptOp
OP_5
        , ScriptOp
OP_6
        , ScriptOp
OP_7
        , ScriptOp
OP_8
        , ScriptOp
OP_9
        , ScriptOp
OP_10
        , ScriptOp
OP_11
        , ScriptOp
OP_12
        , ScriptOp
OP_13
        , ScriptOp
OP_14
        , ScriptOp
OP_15
        , ScriptOp
OP_16
        ]

-- | Arbitrary 'PushDataType'.
arbitraryPushDataType :: Gen PushDataType
arbitraryPushDataType :: Gen PushDataType
arbitraryPushDataType = forall a. [a] -> Gen a
elements [PushDataType
OPCODE, PushDataType
OPDATA1, PushDataType
OPDATA2, PushDataType
OPDATA4]

-- | Arbitrary 'SigHash' (including invalid/unknown sighash codes).
arbitrarySigHash :: Gen SigHash
arbitrarySigHash :: Gen SigHash
arbitrarySigHash = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Arbitrary a => Gen a
arbitrary :: Gen Word32)

-- | Arbitrary valid 'SigHash'.
arbitraryValidSigHash :: Network -> Gen SigHash
arbitraryValidSigHash :: Network -> Gen SigHash
arbitraryValidSigHash Network
net = do
    SigHash
sh <- forall a. [a] -> Gen a
elements [SigHash
sigHashAll, SigHash
sigHashNone, SigHash
sigHashSingle]
    SigHash -> SigHash
f1 <-
        forall a. [a] -> Gen a
elements forall a b. (a -> b) -> a -> b
$
            if forall a. Maybe a -> Bool
isJust (Network -> Maybe Word32
getSigHashForkId Network
net)
                then [forall a. a -> a
id, SigHash -> SigHash
setForkIdFlag]
                else [forall a. a -> a
id]
    SigHash -> SigHash
f2 <- forall a. [a] -> Gen a
elements [forall a. a -> a
id, SigHash -> SigHash
setAnyoneCanPayFlag]
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SigHash -> SigHash
f1 forall a b. (a -> b) -> a -> b
$ SigHash -> SigHash
f2 SigHash
sh

arbitrarySigHashFlag :: Gen SigHashFlag
arbitrarySigHashFlag :: Gen SigHashFlag
arbitrarySigHashFlag =
    forall a. [a] -> Gen a
elements
        [ SigHashFlag
SIGHASH_ALL
        , SigHashFlag
SIGHASH_NONE
        , SigHashFlag
SIGHASH_SINGLE
        , SigHashFlag
SIGHASH_FORKID
        , SigHashFlag
SIGHASH_ANYONECANPAY
        ]

{- | Arbitrary message hash, private key and corresponding 'TxSignature'. The
 signature is generated deterministically using a random message and a random
 private key.
-}
arbitraryTxSignature :: Network -> Gen (TxHash, SecKey, TxSignature)
arbitraryTxSignature :: Network -> Gen (TxHash, SecKey, TxSignature)
arbitraryTxSignature Network
net = do
    (Hash256
m, SecKey
key, Sig
sig) <- Gen (Hash256, SecKey, Sig)
arbitrarySignature
    SigHash
sh <- (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Arbitrary a => Gen a
arbitrary :: Gen Word8)) forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` SigHash -> Bool
filterBad
    let txsig :: TxSignature
txsig = Sig -> SigHash -> TxSignature
TxSignature Sig
sig SigHash
sh
    forall (m :: * -> *) a. Monad m => a -> m a
return (Hash256 -> TxHash
TxHash Hash256
m, SecKey
key, TxSignature
txsig)
  where
    filterBad :: SigHash -> Bool
filterBad SigHash
sh =
        Bool -> Bool
not forall a b. (a -> b) -> a -> b
$
            SigHash -> Bool
isSigHashUnknown SigHash
sh
                Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isNothing (Network -> Maybe Word32
getSigHashForkId Network
net) Bool -> Bool -> Bool
&& SigHash -> Bool
hasForkIdFlag SigHash
sh

-- | Arbitrary transaction signature that could also be empty.
arbitraryTxSignatureEmpty :: Network -> Gen TxSignature
arbitraryTxSignatureEmpty :: Network -> Gen TxSignature
arbitraryTxSignatureEmpty Network
net =
    forall a. [(Int, Gen a)] -> Gen a
frequency
        [ (Int
1, forall (m :: * -> *) a. Monad m => a -> m a
return TxSignature
TxSignatureEmpty)
        , (Int
10, forall a b c. (a, b, c) -> c
lst3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen (TxHash, SecKey, TxSignature)
arbitraryTxSignature Network
net)
        ]

-- | Arbitrary m of n parameters.
arbitraryMSParam :: Gen (Int, Int)
arbitraryMSParam :: Gen (Int, Int)
arbitraryMSParam = do
    Int
m <- forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
16)
    Int
n <- forall a. Random a => (a, a) -> Gen a
choose (Int
m, Int
16)
    forall (m :: * -> *) a. Monad m => a -> m a
return (Int
m, Int
n)

-- | Arbitrary 'ScriptOutput' (Can by any valid type).
arbitraryScriptOutput :: Network -> Gen ScriptOutput
arbitraryScriptOutput :: Network -> Gen ScriptOutput
arbitraryScriptOutput Network
net =
    forall a. [Gen a] -> Gen a
oneof forall a b. (a -> b) -> a -> b
$
        [ Gen ScriptOutput
arbitraryPKOutput
        , Gen ScriptOutput
arbitraryPKHashOutput
        , Gen ScriptOutput
arbitraryMSOutput
        , Gen ScriptOutput
arbitrarySHOutput
        , Gen ScriptOutput
arbitraryDCOutput
        ]
            forall a. [a] -> [a] -> [a]
++ if Network -> Bool
getSegWit Network
net
                then
                    [ Gen ScriptOutput
arbitraryWPKHashOutput
                    , Gen ScriptOutput
arbitraryWSHOutput
                    , Gen ScriptOutput
arbitraryWitOutput
                    ]
                else []

{- | Arbitrary 'ScriptOutput' of type 'PayPK', 'PayPKHash' or 'PayMS'
 (Not 'PayScriptHash', 'DataCarrier', or SegWit)
-}
arbitrarySimpleOutput :: Gen ScriptOutput
arbitrarySimpleOutput :: Gen ScriptOutput
arbitrarySimpleOutput =
    forall a. [Gen a] -> Gen a
oneof
        [ Gen ScriptOutput
arbitraryPKOutput
        , Gen ScriptOutput
arbitraryPKHashOutput
        , Gen ScriptOutput
arbitraryMSOutput
        ]

-- | Arbitrary 'ScriptOutput' of type 'PayPK'
arbitraryPKOutput :: Gen ScriptOutput
arbitraryPKOutput :: Gen ScriptOutput
arbitraryPKOutput = PubKeyI -> ScriptOutput
PayPK forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SecKeyI, PubKeyI)
arbitraryKeyPair

-- | Arbitrary 'ScriptOutput' of type 'PayPKHash'
arbitraryPKHashOutput :: Gen ScriptOutput
arbitraryPKHashOutput :: Gen ScriptOutput
arbitraryPKHashOutput = Hash160 -> ScriptOutput
PayPKHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Hash160
arbitraryHash160

-- | Arbitrary 'PayWitnessPKHash' output.
arbitraryWPKHashOutput :: Gen ScriptOutput
arbitraryWPKHashOutput :: Gen ScriptOutput
arbitraryWPKHashOutput = Hash160 -> ScriptOutput
PayWitnessPKHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Hash160
arbitraryHash160

-- | Arbitrary 'PayWitnessScriptHash' output.
arbitraryWSHOutput :: Gen ScriptOutput
arbitraryWSHOutput :: Gen ScriptOutput
arbitraryWSHOutput = Hash256 -> ScriptOutput
PayWitnessScriptHash forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Hash256
arbitraryHash256

arbitraryWitOutput :: Gen ScriptOutput
arbitraryWitOutput :: Gen ScriptOutput
arbitraryWitOutput = do
    Word8
ver <- forall a. Random a => (a, a) -> Gen a
choose (Word8
1, Word8
16)
    Int
len <- forall a. Random a => (a, a) -> Gen a
choose (Int
2, Int
40)
    [Word8]
ws <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
len forall a. Arbitrary a => Gen a
arbitrary
    let bs :: ByteString
bs = [Word8] -> ByteString
B.pack [Word8]
ws
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ScriptOutput
PayWitness Word8
ver ByteString
bs

-- | Arbitrary 'ScriptOutput' of type 'PayMS'.
arbitraryMSOutput :: Gen ScriptOutput
arbitraryMSOutput :: Gen ScriptOutput
arbitraryMSOutput = do
    (Int
m, Int
n) <- Gen (Int, Int)
arbitraryMSParam
    [PubKeyI]
keys <- forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n Gen (SecKeyI, PubKeyI)
arbitraryKeyPair
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [PubKeyI] -> Int -> ScriptOutput
PayMulSig [PubKeyI]
keys Int
m

-- | Arbitrary 'ScriptOutput' of type 'PayMS', only using compressed keys.
arbitraryMSOutputC :: Gen ScriptOutput
arbitraryMSOutputC :: Gen ScriptOutput
arbitraryMSOutputC = do
    (Int
m, Int
n) <- Gen (Int, Int)
arbitraryMSParam
    [PubKeyI]
keys <-
        forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf Int
n (Gen (SecKeyI, PubKeyI)
arbitraryKeyPair forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (PubKeyI -> Bool
pubKeyCompressed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [PubKeyI] -> Int -> ScriptOutput
PayMulSig [PubKeyI]
keys Int
m

-- | Arbitrary 'ScriptOutput' of type 'PayScriptHash'.
arbitrarySHOutput :: Gen ScriptOutput
arbitrarySHOutput :: Gen ScriptOutput
arbitrarySHOutput = Hash160 -> ScriptOutput
PayScriptHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. Address -> Hash160
getAddrHash160 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Address
arbitraryScriptAddress

-- | Arbitrary 'ScriptOutput' of type 'DataCarrier'.
arbitraryDCOutput :: Gen ScriptOutput
arbitraryDCOutput :: Gen ScriptOutput
arbitraryDCOutput = ByteString -> ScriptOutput
DataCarrier forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
arbitraryBS1

-- | Arbitrary 'ScriptInput'.
arbitraryScriptInput :: Network -> Gen ScriptInput
arbitraryScriptInput :: Network -> Gen ScriptInput
arbitraryScriptInput Network
net =
    forall a. [Gen a] -> Gen a
oneof
        [ Network -> Gen ScriptInput
arbitraryPKInput Network
net
        , Network -> Gen ScriptInput
arbitraryPKHashInput Network
net
        , Network -> Gen ScriptInput
arbitraryMSInput Network
net
        , Network -> Gen ScriptInput
arbitrarySHInput Network
net
        ]

{- | Arbitrary 'ScriptInput' of type 'SpendPK', 'SpendPKHash' or 'SpendMulSig'
 (not 'ScriptHashInput')
-}
arbitrarySimpleInput :: Network -> Gen ScriptInput
arbitrarySimpleInput :: Network -> Gen ScriptInput
arbitrarySimpleInput Network
net =
    forall a. [Gen a] -> Gen a
oneof
        [ Network -> Gen ScriptInput
arbitraryPKInput Network
net
        , Network -> Gen ScriptInput
arbitraryPKHashInput Network
net
        , Network -> Gen ScriptInput
arbitraryMSInput Network
net
        ]

-- | Arbitrary 'ScriptInput' of type 'SpendPK'.
arbitraryPKInput :: Network -> Gen ScriptInput
arbitraryPKInput :: Network -> Gen ScriptInput
arbitraryPKInput Network
net = SimpleInput -> ScriptInput
RegularInput forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSignature -> SimpleInput
SpendPK forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen TxSignature
arbitraryTxSignatureEmpty Network
net

-- | Arbitrary 'ScriptInput' of type 'SpendPK'.
arbitraryPKHashInput :: Network -> Gen ScriptInput
arbitraryPKHashInput :: Network -> Gen ScriptInput
arbitraryPKHashInput Network
net = do
    TxSignature
sig <- Network -> Gen TxSignature
arbitraryTxSignatureEmpty Network
net
    PubKeyI
key <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SecKeyI, PubKeyI)
arbitraryKeyPair
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptInput
RegularInput forall a b. (a -> b) -> a -> b
$ TxSignature -> PubKeyI -> SimpleInput
SpendPKHash TxSignature
sig PubKeyI
key

-- | Like 'arbitraryPKHashInput' without empty signatures.
arbitraryPKHashInputFull :: Network -> Gen ScriptInput
arbitraryPKHashInputFull :: Network -> Gen ScriptInput
arbitraryPKHashInputFull Network
net = do
    TxSignature
sig <- forall a b c. (a, b, c) -> c
lst3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen (TxHash, SecKey, TxSignature)
arbitraryTxSignature Network
net
    PubKeyI
key <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SecKeyI, PubKeyI)
arbitraryKeyPair
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptInput
RegularInput forall a b. (a -> b) -> a -> b
$ TxSignature -> PubKeyI -> SimpleInput
SpendPKHash TxSignature
sig PubKeyI
key

-- | Like above but only compressed.
arbitraryPKHashInputFullC :: Network -> Gen ScriptInput
arbitraryPKHashInputFullC :: Network -> Gen ScriptInput
arbitraryPKHashInputFullC Network
net = do
    TxSignature
sig <- forall a b c. (a, b, c) -> c
lst3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Network -> Gen (TxHash, SecKey, TxSignature)
arbitraryTxSignature Network
net
    PubKeyI
key <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Gen (SecKeyI, PubKeyI)
arbitraryKeyPair forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (PubKeyI -> Bool
pubKeyCompressed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptInput
RegularInput forall a b. (a -> b) -> a -> b
$ TxSignature -> PubKeyI -> SimpleInput
SpendPKHash TxSignature
sig PubKeyI
key

-- | Arbitrary 'ScriptInput' of type 'SpendMulSig'.
arbitraryMSInput :: Network -> Gen ScriptInput
arbitraryMSInput :: Network -> Gen ScriptInput
arbitraryMSInput Network
net = do
    Int
m <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Int, Int)
arbitraryMSParam
    [TxSignature]
sigs <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
m (Network -> Gen TxSignature
arbitraryTxSignatureEmpty Network
net)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptInput
RegularInput forall a b. (a -> b) -> a -> b
$ [TxSignature] -> SimpleInput
SpendMulSig [TxSignature]
sigs

-- | Arbitrary 'ScriptInput' of type 'ScriptHashInput'.
arbitrarySHInput :: Network -> Gen ScriptInput
arbitrarySHInput :: Network -> Gen ScriptInput
arbitrarySHInput Network
net = do
    ScriptInput
i <- Network -> Gen ScriptInput
arbitrarySimpleInput Network
net
    SimpleInput -> ScriptOutput -> ScriptInput
ScriptHashInput (ScriptInput -> SimpleInput
getRegularInput ScriptInput
i) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ScriptOutput
arbitrarySimpleOutput

{- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a
 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'.
-}
arbitraryMulSigSHInput :: Network -> Gen ScriptInput
arbitraryMulSigSHInput :: Network -> Gen ScriptInput
arbitraryMulSigSHInput Network
net =
    Gen ScriptOutput
arbitraryMSOutput forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        rdm :: ScriptOutput
rdm@(PayMulSig [PubKeyI]
_ Int
m) -> do
            [TxSignature]
sigs <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
m (Network -> Gen TxSignature
arbitraryTxSignatureEmpty Network
net)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptOutput -> ScriptInput
ScriptHashInput ([TxSignature] -> SimpleInput
SpendMulSig [TxSignature]
sigs) ScriptOutput
rdm
        ScriptOutput
_ -> forall a. HasCallStack => a
undefined

{- | Arbitrary 'ScriptInput' of type 'ScriptHashInput' containing a
 'RedeemScript' of type 'PayMulSig' and an input of type 'SpendMulSig'.
-}
arbitraryMulSigSHInputC :: Network -> Gen ScriptInput
arbitraryMulSigSHInputC :: Network -> Gen ScriptInput
arbitraryMulSigSHInputC Network
net =
    Gen ScriptOutput
arbitraryMSOutputC forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        rdm :: ScriptOutput
rdm@(PayMulSig [PubKeyI]
_ Int
m) -> do
            [TxSignature]
sigs <- forall a. Int -> Gen a -> Gen [a]
vectorOf Int
m (Network -> Gen TxSignature
arbitraryTxSignatureEmpty Network
net)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptOutput -> ScriptInput
ScriptHashInput ([TxSignature] -> SimpleInput
SpendMulSig [TxSignature]
sigs) ScriptOutput
rdm
        ScriptOutput
_ -> forall a. HasCallStack => a
undefined

-- | Like 'arbitraryMulSigSHCInput' with no empty signatures.
arbitraryMulSigSHInputFull :: Network -> Gen ScriptInput
arbitraryMulSigSHInputFull :: Network -> Gen ScriptInput
arbitraryMulSigSHInputFull Network
net =
    Gen ScriptOutput
arbitraryMSOutput forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        rdm :: ScriptOutput
rdm@(PayMulSig [PubKeyI]
_ Int
m) -> do
            [TxSignature]
sigs <- forall a b. (a -> b) -> [a] -> [b]
map forall a b c. (a, b, c) -> c
lst3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf Int
m (Network -> Gen (TxHash, SecKey, TxSignature)
arbitraryTxSignature Network
net)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptOutput -> ScriptInput
ScriptHashInput ([TxSignature] -> SimpleInput
SpendMulSig [TxSignature]
sigs) ScriptOutput
rdm
        ScriptOutput
_ -> forall a. HasCallStack => a
undefined

-- | Like 'arbitraryMulSigSHCInput' with no empty signatures.
arbitraryMulSigSHInputFullC :: Network -> Gen ScriptInput
arbitraryMulSigSHInputFullC :: Network -> Gen ScriptInput
arbitraryMulSigSHInputFullC Network
net =
    Gen ScriptOutput
arbitraryMSOutputC forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        rdm :: ScriptOutput
rdm@(PayMulSig [PubKeyI]
_ Int
m) -> do
            [TxSignature]
sigs <- forall a b. (a -> b) -> [a] -> [b]
map forall a b c. (a, b, c) -> c
lst3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf Int
m (Network -> Gen (TxHash, SecKey, TxSignature)
arbitraryTxSignature Network
net)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SimpleInput -> ScriptOutput -> ScriptInput
ScriptHashInput ([TxSignature] -> SimpleInput
SpendMulSig [TxSignature]
sigs) ScriptOutput
rdm
        ScriptOutput
_ -> forall a. HasCallStack => a
undefined