{-| Arbitrary types for Network.Haskoin.Script -} module Network.Haskoin.Test.Script ( ArbitraryScriptOp(..) , ArbitraryScript(..) , ArbitraryIntScriptOp(..) , ArbitraryPushDataType(..) , ArbitraryTxSignature(..) , ArbitrarySigHash(..) , ArbitraryValidSigHash(..) , ArbitraryMSParam(..) , ArbitraryScriptOutput(..) , ArbitrarySimpleOutput(..) , ArbitraryPKOutput(..) , ArbitraryPKHashOutput(..) , ArbitraryMSOutput(..) , ArbitraryMSCOutput(..) , ArbitrarySHOutput(..) , ArbitraryScriptInput(..) , ArbitrarySimpleInput(..) , ArbitraryPKInput(..) , ArbitraryPKHashInput(..) , ArbitraryPKHashCInput(..) , ArbitraryMSInput(..) , ArbitrarySHInput(..) , ArbitraryMulSigSHCInput(..) ) where import Test.QuickCheck ( Arbitrary , arbitrary , oneof , choose , vectorOf , elements ) import Data.Bits (testBit) import Network.Haskoin.Transaction.Types import Network.Haskoin.Test.Crypto import Network.Haskoin.Script import Network.Haskoin.Crypto -- | Arbitrary Script with random script ops newtype ArbitraryScript = ArbitraryScript Script deriving (Eq, Show, Read) instance Arbitrary ArbitraryScript where arbitrary = do vs <- arbitrary return $ ArbitraryScript $ Script $ map f vs where f (ArbitraryScriptOp op) = op -- | Arbitrary ScriptOp (push operations have random data) newtype ArbitraryScriptOp = ArbitraryScriptOp ScriptOp deriving (Eq, Show, Read) instance Arbitrary ArbitraryScriptOp where arbitrary = ArbitraryScriptOp <$> oneof [ -- Pushing Data arbitrary >>= \(ArbitraryNotNullByteString bs) -> return $ opPushData bs ,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 -- Flow control ,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 -- Stack operations ,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 -- Splice ,return OP_CAT ,return OP_SUBSTR ,return OP_LEFT ,return OP_RIGHT ,return OP_SIZE -- Bitwise logic ,return OP_INVERT ,return OP_AND ,return OP_OR ,return OP_XOR ,return OP_EQUAL ,return OP_EQUALVERIFY ,return OP_RESERVED1 ,return OP_RESERVED2 -- Arithmetic ,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 -- Crypto ,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 -- Expansion ,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 -- Other ,return OP_PUBKEYHASH ,return OP_PUBKEY ,return $ OP_INVALIDOPCODE 0xff ] -- | Arbtirary ScriptOp with a value in [OP_1 .. OP_16] newtype ArbitraryIntScriptOp = ArbitraryIntScriptOp ScriptOp deriving (Eq, Show) instance Arbitrary ArbitraryIntScriptOp where arbitrary = 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 ] -- | Arbitrary PushDataType newtype ArbitraryPushDataType = ArbitraryPushDataType PushDataType deriving (Eq, Show, Read) instance Arbitrary ArbitraryPushDataType where arbitrary = ArbitraryPushDataType <$> elements [ OPCODE, OPDATA1, OPDATA2, OPDATA4 ] -- | Arbitrary SigHash (including invalid/unknown sighash codes) newtype ArbitrarySigHash = ArbitrarySigHash SigHash deriving (Eq, Show, Read) instance Arbitrary ArbitrarySigHash where arbitrary = ArbitrarySigHash <$> oneof [ SigAll <$> arbitrary , SigNone <$> arbitrary , SigSingle <$> arbitrary , f ] where f = do -- avoid valid SigHash bytes w <- elements $ 0x00 : 0x80 : [0x04..0x7f] ++ [0x84..0xff] return $ SigUnknown (testBit w 7) w -- | Arbitrary valid SigHash newtype ArbitraryValidSigHash = ArbitraryValidSigHash SigHash deriving (Eq, Show, Read) instance Arbitrary ArbitraryValidSigHash where arbitrary = ArbitraryValidSigHash <$> oneof [ SigAll <$> arbitrary , SigNone <$> arbitrary , SigSingle <$> arbitrary ] -- | Arbitrary message hash, private key and corresponding TxSignature. The -- signature is generated deterministically using a random message and a -- random private key. data ArbitraryTxSignature = ArbitraryTxSignature TxHash PrvKey TxSignature deriving (Eq, Show, Read) instance Arbitrary ArbitraryTxSignature where arbitrary = do ArbitrarySignature msg key sig <- arbitrary ArbitrarySigHash sh <- arbitrary let txsig = TxSignature sig sh return $ ArbitraryTxSignature (TxHash msg) key txsig -- | Arbitrary m of n parameters data ArbitraryMSParam = ArbitraryMSParam Int Int deriving (Eq, Show, Read) instance Arbitrary ArbitraryMSParam where arbitrary = do m <- choose (1,16) n <- choose (m,16) return $ ArbitraryMSParam m n -- | Arbitrary ScriptOutput (Can by any valid type) newtype ArbitraryScriptOutput = ArbitraryScriptOutput ScriptOutput deriving (Eq, Show, Read) instance Arbitrary ArbitraryScriptOutput where arbitrary = ArbitraryScriptOutput <$> oneof [ arbitrary >>= \(ArbitraryPKOutput o) -> return o , arbitrary >>= \(ArbitraryPKHashOutput o) -> return o , arbitrary >>= \(ArbitraryMSOutput o) -> return o , arbitrary >>= \(ArbitrarySHOutput o) -> return o ] -- | Arbitrary ScriptOutput of type PayPK, PayPKHash or PayMS -- (Not PayScriptHash) newtype ArbitrarySimpleOutput = ArbitrarySimpleOutput ScriptOutput deriving (Eq, Show, Read) instance Arbitrary ArbitrarySimpleOutput where arbitrary = ArbitrarySimpleOutput <$> oneof [ arbitrary >>= \(ArbitraryPKOutput o) -> return o , arbitrary >>= \(ArbitraryPKHashOutput o) -> return o , arbitrary >>= \(ArbitraryMSOutput o) -> return o ] -- | Arbitrary ScriptOutput of type PayPK newtype ArbitraryPKOutput = ArbitraryPKOutput ScriptOutput deriving (Eq, Show, Read) instance Arbitrary ArbitraryPKOutput where arbitrary = do ArbitraryPubKey _ key <- arbitrary return $ ArbitraryPKOutput $ PayPK key -- | Arbitrary ScriptOutput of type PayPKHash newtype ArbitraryPKHashOutput = ArbitraryPKHashOutput ScriptOutput deriving (Eq, Show, Read) instance Arbitrary ArbitraryPKHashOutput where arbitrary = do ArbitraryPubKeyAddress a <- arbitrary return $ ArbitraryPKHashOutput $ PayPKHash a -- | Arbitrary ScriptOutput of type PayMS newtype ArbitraryMSOutput = ArbitraryMSOutput ScriptOutput deriving (Eq, Show, Read) instance Arbitrary ArbitraryMSOutput where arbitrary = do ArbitraryMSParam m n <- arbitrary keys <- map f <$> vectorOf n arbitrary return $ ArbitraryMSOutput $ PayMulSig keys m where f (ArbitraryPubKey _ key) = key -- | Arbitrary ScriptOutput of type PayMS containing only compressed keys newtype ArbitraryMSCOutput = ArbitraryMSCOutput ScriptOutput deriving (Eq, Show, Read) instance Arbitrary ArbitraryMSCOutput where arbitrary = do ArbitraryMSParam m n <- arbitrary keys <- map f <$> vectorOf n arbitrary return $ ArbitraryMSCOutput $ PayMulSig keys m where f (ArbitraryPubKeyC _ key) = toPubKeyG key -- | Arbitrary ScriptOutput of type PayScriptHash newtype ArbitrarySHOutput = ArbitrarySHOutput ScriptOutput deriving (Eq, Show, Read) instance Arbitrary ArbitrarySHOutput where arbitrary = do ArbitraryScriptAddress a <- arbitrary return $ ArbitrarySHOutput $ PayScriptHash a -- | Arbitrary ScriptInput newtype ArbitraryScriptInput = ArbitraryScriptInput ScriptInput deriving (Eq, Show, Read) instance Arbitrary ArbitraryScriptInput where arbitrary = ArbitraryScriptInput <$> oneof [ arbitrary >>= \(ArbitraryPKInput i) -> return i , arbitrary >>= \(ArbitraryPKHashInput i) -> return i , arbitrary >>= \(ArbitraryMSInput i) -> return i , arbitrary >>= \(ArbitrarySHInput i) -> return i ] -- | Arbitrary ScriptInput of type SpendPK, SpendPKHash or SpendMulSig -- (not ScriptHashInput) newtype ArbitrarySimpleInput = ArbitrarySimpleInput ScriptInput deriving (Eq, Show, Read) instance Arbitrary ArbitrarySimpleInput where arbitrary = ArbitrarySimpleInput <$> oneof [ arbitrary >>= \(ArbitraryPKInput i) -> return i , arbitrary >>= \(ArbitraryPKHashInput i) -> return i , arbitrary >>= \(ArbitraryMSInput i) -> return i ] -- | Arbitrary ScriptInput of type SpendPK newtype ArbitraryPKInput = ArbitraryPKInput ScriptInput deriving (Eq, Show, Read) instance Arbitrary ArbitraryPKInput where arbitrary = ArbitraryPKInput . RegularInput . SpendPK <$> (arbitrary >>= \(ArbitraryTxSignature _ _ sig) -> return sig) -- | Arbitrary ScriptInput of type SpendPK newtype ArbitraryPKHashInput = ArbitraryPKHashInput ScriptInput deriving (Eq, Show, Read) instance Arbitrary ArbitraryPKHashInput where arbitrary = do sig <- arbitrary >>= \(ArbitraryTxSignature _ _ sig) -> return sig ArbitraryPubKey _ key <- arbitrary return $ ArbitraryPKHashInput $ RegularInput $ SpendPKHash sig key -- | Arbitrary ScriptInput of type SpendPK with a compressed public key newtype ArbitraryPKHashCInput = ArbitraryPKHashCInput ScriptInput deriving (Eq, Show, Read) instance Arbitrary ArbitraryPKHashCInput where arbitrary = do sig <- arbitrary >>= \(ArbitraryTxSignature _ _ sig) -> return sig ArbitraryPubKeyC _ key <- arbitrary return $ ArbitraryPKHashCInput $ RegularInput $ SpendPKHash sig $ toPubKeyG key -- | Arbitrary ScriptInput of type SpendMulSig newtype ArbitraryMSInput = ArbitraryMSInput ScriptInput deriving (Eq, Show, Read) instance Arbitrary ArbitraryMSInput where arbitrary = do ArbitraryMSParam m _ <- arbitrary sigs <- vectorOf m f return $ ArbitraryMSInput $ RegularInput $ SpendMulSig sigs where f = arbitrary >>= \(ArbitraryTxSignature _ _ sig) -> return sig -- | Arbitrary ScriptInput of type ScriptHashInput newtype ArbitrarySHInput = ArbitrarySHInput ScriptInput deriving (Eq, Show, Read) instance Arbitrary ArbitrarySHInput where arbitrary = do ArbitrarySimpleInput i <- arbitrary ArbitrarySimpleOutput o <- arbitrary return $ ArbitrarySHInput $ ScriptHashInput (getRegularInput i) o -- | Arbitrary ScriptInput of type ScriptHashInput containing a RedeemScript -- of type PayMulSig and an input of type SpendMulSig. Only compressed keys -- are used. newtype ArbitraryMulSigSHCInput = ArbitraryMulSigSHCInput ScriptInput deriving (Eq, Show, Read) instance Arbitrary ArbitraryMulSigSHCInput where arbitrary = do ArbitraryMSCOutput rdm@(PayMulSig _ m) <- arbitrary sigs <- vectorOf m f return $ ArbitraryMulSigSHCInput $ ScriptHashInput (SpendMulSig sigs) rdm where f = arbitrary >>= \(ArbitraryTxSignature _ _ sig) -> return sig