{-# LANGUAGE LambdaCase #-}
module Network.Haskoin.Test.Script where
import Crypto.Secp256k1
import Data.Maybe
import Data.Word
import Network.Haskoin.Address
import Network.Haskoin.Constants
import Network.Haskoin.Keys.Common
import Network.Haskoin.Script
import Network.Haskoin.Test.Address
import Network.Haskoin.Test.Crypto
import Network.Haskoin.Test.Keys
import Network.Haskoin.Test.Util
import Network.Haskoin.Transaction.Common
import Network.Haskoin.Util
import Test.QuickCheck
arbitraryScript :: Gen Script
arbitraryScript = Script <$> listOf arbitraryScriptOp
arbitraryScriptOp :: Gen ScriptOp
arbitraryScriptOp =
oneof
[ opPushData <$> arbitraryBS1
, return OP_0
, return OP_1NEGATE
, return OP_RESERVED
, return OP_1
, return OP_2
, return OP_3
, return OP_4
, return OP_5
, return OP_6
, return OP_7
, return OP_8
, return OP_9
, return OP_10
, return OP_11
, return OP_12
, return OP_13
, return OP_14
, return OP_15
, return OP_16
, return OP_NOP
, return OP_VER
, return OP_IF
, return OP_NOTIF
, return OP_VERIF
, return OP_VERNOTIF
, return OP_ELSE
, return OP_ENDIF
, return OP_VERIFY
, return OP_RETURN
, return OP_TOALTSTACK
, return OP_FROMALTSTACK
, return OP_IFDUP
, return OP_DEPTH
, return OP_DROP
, return OP_DUP
, return OP_NIP
, return OP_OVER
, return OP_PICK
, return OP_ROLL
, return OP_ROT
, return OP_SWAP
, return OP_TUCK
, return OP_2DROP
, return OP_2DUP
, return OP_3DUP
, return OP_2OVER
, return OP_2ROT
, return OP_2SWAP
, return OP_CAT
, return OP_SUBSTR
, return OP_LEFT
, return OP_RIGHT
, return OP_SIZE
, return OP_INVERT
, return OP_AND
, return OP_OR
, return OP_XOR
, return OP_EQUAL
, return OP_EQUALVERIFY
, return OP_RESERVED1
, return OP_RESERVED2
, return OP_1ADD
, return OP_1SUB
, return OP_2MUL
, return OP_2DIV
, return OP_NEGATE
, return OP_ABS
, return OP_NOT
, return OP_0NOTEQUAL
, return OP_ADD
, return OP_SUB
, return OP_MUL
, return OP_DIV
, return OP_MOD
, return OP_LSHIFT
, return OP_RSHIFT
, return OP_BOOLAND
, return OP_BOOLOR
, return OP_NUMEQUAL
, return OP_NUMEQUALVERIFY
, return OP_NUMNOTEQUAL
, return OP_LESSTHAN
, return OP_GREATERTHAN
, return OP_LESSTHANOREQUAL
, return OP_GREATERTHANOREQUAL
, return OP_MIN
, return OP_MAX
, return OP_WITHIN
, return OP_RIPEMD160
, return OP_SHA1
, return OP_SHA256
, return OP_HASH160
, return OP_HASH256
, return OP_CODESEPARATOR
, return OP_CHECKSIG
, return OP_CHECKSIGVERIFY
, return OP_CHECKMULTISIG
, return OP_CHECKMULTISIGVERIFY
, return OP_NOP1
, return OP_NOP2
, return OP_NOP3
, return OP_NOP4
, return OP_NOP5
, return OP_NOP6
, return OP_NOP7
, return OP_NOP8
, return OP_NOP9
, return OP_NOP10
, return OP_PUBKEYHASH
, return OP_PUBKEY
, return $ OP_INVALIDOPCODE 0xff
]
arbitraryIntScriptOp :: Gen ScriptOp
arbitraryIntScriptOp =
elements
[ OP_1, OP_2, OP_3, OP_4
, OP_5, OP_6, OP_7, OP_8
, OP_9, OP_10, OP_11, OP_12
, OP_13, OP_14, OP_15, OP_16
]
arbitraryPushDataType :: Gen PushDataType
arbitraryPushDataType = elements [OPCODE, OPDATA1, OPDATA2, OPDATA4]
arbitrarySigHash :: Gen SigHash
arbitrarySigHash = fromIntegral <$> (arbitrary :: Gen Word32)
arbitraryValidSigHash :: Network -> Gen SigHash
arbitraryValidSigHash net = do
sh <- elements [sigHashAll, sigHashNone, sigHashSingle]
f1 <-
elements $
if isJust (getSigHashForkId net)
then [id, setForkIdFlag]
else [id]
f2 <- elements [id, setAnyoneCanPayFlag]
return $ f1 $ f2 sh
arbitraryTxSignature :: Network -> Gen (TxHash, SecKey, TxSignature)
arbitraryTxSignature net = do
(m, key, sig) <- arbitrarySignature
sh <- (fromIntegral <$> (arbitrary :: Gen Word8)) `suchThat` filterBad
let txsig = TxSignature sig sh
return (TxHash m, key, txsig)
where
filterBad sh = not $
isSigHashUnknown sh ||
isNothing (getSigHashForkId net) && hasForkIdFlag sh
arbitraryTxSignatureEmpty :: Network -> Gen TxSignature
arbitraryTxSignatureEmpty net =
frequency [ (1, return TxSignatureEmpty)
, (10, lst3 <$> arbitraryTxSignature net)
]
arbitraryMSParam :: Gen (Int, Int)
arbitraryMSParam = do
m <- choose (1,16)
n <- choose (m,16)
return (m, n)
arbitraryScriptOutput :: Network -> Gen ScriptOutput
arbitraryScriptOutput net =
oneof $
[ arbitraryPKOutput
, arbitraryPKHashOutput
, arbitraryMSOutput
, arbitrarySHOutput
, arbitraryDCOutput
] ++
if getSegWit net
then [arbitraryWPKHashOutput, arbitraryWSHOutput]
else []
arbitrarySimpleOutput :: Gen ScriptOutput
arbitrarySimpleOutput =
oneof
[ arbitraryPKOutput
, arbitraryPKHashOutput
, arbitraryMSOutput
]
arbitraryPKOutput :: Gen ScriptOutput
arbitraryPKOutput = PayPK . snd <$> arbitraryKeyPair
arbitraryPKHashOutput :: Gen ScriptOutput
arbitraryPKHashOutput = PayPKHash <$> arbitraryHash160
arbitraryWPKHashOutput :: Gen ScriptOutput
arbitraryWPKHashOutput = PayWitnessPKHash <$> arbitraryHash160
arbitraryWSHOutput :: Gen ScriptOutput
arbitraryWSHOutput = PayWitnessScriptHash <$> arbitraryHash256
arbitraryMSOutput :: Gen ScriptOutput
arbitraryMSOutput = do
(m, n) <- arbitraryMSParam
keys <- map snd <$> vectorOf n arbitraryKeyPair
return $ PayMulSig keys m
arbitraryMSOutputC :: Gen ScriptOutput
arbitraryMSOutputC = do
(m, n) <- arbitraryMSParam
keys <-
map snd <$>
vectorOf n (arbitraryKeyPair `suchThat` (pubKeyCompressed . snd))
return $ PayMulSig keys m
arbitrarySHOutput :: Gen ScriptOutput
arbitrarySHOutput = PayScriptHash . getAddrHash160 <$> arbitraryScriptAddress
arbitraryDCOutput :: Gen ScriptOutput
arbitraryDCOutput = DataCarrier <$> arbitraryBS1
arbitraryScriptInput :: Network -> Gen ScriptInput
arbitraryScriptInput net =
oneof
[ arbitraryPKInput net
, arbitraryPKHashInput net
, arbitraryMSInput net
, arbitrarySHInput net
]
arbitrarySimpleInput :: Network -> Gen ScriptInput
arbitrarySimpleInput net =
oneof
[ arbitraryPKInput net
, arbitraryPKHashInput net
, arbitraryMSInput net
]
arbitraryPKInput :: Network -> Gen ScriptInput
arbitraryPKInput net = RegularInput . SpendPK <$> arbitraryTxSignatureEmpty net
arbitraryPKHashInput :: Network -> Gen ScriptInput
arbitraryPKHashInput net = do
sig <- arbitraryTxSignatureEmpty net
key <- snd <$> arbitraryKeyPair
return $ RegularInput $ SpendPKHash sig key
arbitraryPKHashInputFull :: Network -> Gen ScriptInput
arbitraryPKHashInputFull net = do
sig <- lst3 <$> arbitraryTxSignature net
key <- snd <$> arbitraryKeyPair
return $ RegularInput $ SpendPKHash sig key
arbitraryPKHashInputFullC :: Network -> Gen ScriptInput
arbitraryPKHashInputFullC net = do
sig <- lst3 <$> arbitraryTxSignature net
key <- fmap snd $ arbitraryKeyPair `suchThat` (pubKeyCompressed . snd)
return $ RegularInput $ SpendPKHash sig key
arbitraryMSInput :: Network -> Gen ScriptInput
arbitraryMSInput net = do
m <- fst <$> arbitraryMSParam
sigs <- vectorOf m (arbitraryTxSignatureEmpty net)
return $ RegularInput $ SpendMulSig sigs
arbitrarySHInput :: Network -> Gen ScriptInput
arbitrarySHInput net = do
i <- arbitrarySimpleInput net
ScriptHashInput (getRegularInput i) <$> arbitrarySimpleOutput
arbitraryMulSigSHInput :: Network -> Gen ScriptInput
arbitraryMulSigSHInput net =
arbitraryMSOutput >>= \case
rdm@(PayMulSig _ m) -> do
sigs <- vectorOf m (arbitraryTxSignatureEmpty net)
return $ ScriptHashInput (SpendMulSig sigs) rdm
_ -> undefined
arbitraryMulSigSHInputC :: Network -> Gen ScriptInput
arbitraryMulSigSHInputC net =
arbitraryMSOutputC >>= \case
rdm@(PayMulSig _ m) -> do
sigs <- vectorOf m (arbitraryTxSignatureEmpty net)
return $ ScriptHashInput (SpendMulSig sigs) rdm
_ -> undefined
arbitraryMulSigSHInputFull :: Network -> Gen ScriptInput
arbitraryMulSigSHInputFull net =
arbitraryMSOutput >>= \case
rdm@(PayMulSig _ m) -> do
sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)
return $ ScriptHashInput (SpendMulSig sigs) rdm
_ -> undefined
arbitraryMulSigSHInputFullC :: Network -> Gen ScriptInput
arbitraryMulSigSHInputFullC net =
arbitraryMSOutputC >>= \case
rdm@(PayMulSig _ m) -> do
sigs <- map lst3 <$> vectorOf m (arbitraryTxSignature net)
return $ ScriptHashInput (SpendMulSig sigs) rdm
_ -> undefined