1{-# LANGUAGE DeriveDataTypeable #-} 2{-# LANGUAGE OverloadedStrings #-} 3{-# OPTIONS_GHC -fno-warn-missing-fields #-} 4{-# OPTIONS_GHC -fno-warn-missing-signatures #-} 5{-# OPTIONS_GHC -fno-warn-name-shadowing #-} 6{-# OPTIONS_GHC -fno-warn-unused-imports #-} 7{-# OPTIONS_GHC -fno-warn-unused-matches #-} 8 9----------------------------------------------------------------- 10-- Autogenerated by Thrift 11-- -- 12-- DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING 13-- @generated 14----------------------------------------------------------------- 15 16module MyService_Fuzzer (main) where 17import qualified Service_Types 18import qualified MyService_Client as Client 19import qualified Module_Types 20import qualified Includes_Types 21 22import Prelude ( Bool(..), Enum, Float, IO, Double, String, Maybe(..), 23 Eq, Show, Ord, 24 concat, error, fromIntegral, fromEnum, length, map, 25 maybe, not, null, otherwise, return, show, toEnum, 26 enumFromTo, Bounded, minBound, maxBound, seq, succ, 27 pred, enumFrom, enumFromThen, enumFromThenTo, 28 (.), (&&), (||), (==), (++), ($), (-), (>>=), (>>)) 29 30import qualified Control.Applicative as Applicative (ZipList(..)) 31import Control.Applicative ( (<*>) ) 32import qualified Control.DeepSeq as DeepSeq 33import qualified Control.Exception as Exception 34import qualified Control.Monad as Monad ( liftM, ap, when ) 35import qualified Data.ByteString.Lazy as BS 36import Data.Functor ( (<$>) ) 37import qualified Data.Hashable as Hashable 38import qualified Data.Int as Int 39import Data.List 40import qualified Data.Maybe as Maybe (catMaybes) 41import qualified Data.Text.Lazy.Encoding as Encoding ( decodeUtf8, encodeUtf8 ) 42import qualified Data.Text.Lazy as LT 43import qualified Data.Typeable as Typeable ( Typeable ) 44import qualified Data.HashMap.Strict as Map 45import qualified Data.HashSet as Set 46import qualified Data.Vector as Vector 47import qualified Test.QuickCheck.Arbitrary as Arbitrary ( Arbitrary(..) ) 48import qualified Test.QuickCheck as QuickCheck ( elements ) 49 50import qualified Thrift 51import qualified Thrift.Types as Types 52import qualified Thrift.Serializable as Serializable 53import qualified Thrift.Arbitraries as Arbitraries 54 55import qualified Module_Types as Module_Types 56import qualified Includes_Types as Includes_Types 57 58import Prelude ((>>), print) 59import qualified Prelude as P 60import Control.Monad (forM) 61import qualified Data.List as L 62import Data.Maybe (fromJust) 63import qualified Data.Map as Map 64import GHC.Int (Int64, Int32) 65import Data.ByteString.Lazy (ByteString) 66import System.Environment (getArgs) 67import Test.QuickCheck (arbitrary) 68import Test.QuickCheck.Gen (Gen(..)) 69import Thrift.FuzzerSupport 70 71 72handleOptions :: ([Options -> Options], [String], [String]) -> Options 73handleOptions (transformers, (serviceName:[]), []) | serviceName `P.elem` serviceNames 74 = (P.foldl (P.flip ($)) defaultOptions transformers) { opt_service = serviceName } 75handleOptions (_, (serviceName:[]), []) | P.otherwise 76 = P.error $ usage ++ "\nUnknown serviceName " ++ serviceName ++ ", should be one of " ++ (P.show serviceNames) 77handleOptions (_, [], _) = P.error $ usage ++ "\nMissing mandatory serviceName to fuzz." 78handleOptions (_, _a, []) = P.error $ usage ++ "\nToo many serviceNames, pick one." 79handleOptions (_, _, e) = P.error $ usage ++ (P.show e) 80 81main :: IO () 82main = do 83 args <- getArgs 84 let config = handleOptions (getOptions args) 85 fuzz config 86 87selectFuzzer :: Options -> (Options -> IO ()) 88selectFuzzer (Options _host _port service _timeout _framed _verbose) 89 = fromJust $ P.lookup service fuzzerFunctions 90 91fuzz :: Options -> IO () 92fuzz config = (selectFuzzer config) config 93 94-- Dynamic content 95 96-- Configuration via command-line parsing 97 98serviceNames :: [String] 99serviceNames = ["query", "has_arg_docs"] 100 101fuzzerFunctions :: [(String, (Options -> IO ()))] 102fuzzerFunctions = [("query", query_fuzzer), ("has_arg_docs", has_arg_docs_fuzzer)] 103 104-- Random data generation 105inf_Includes_Types_Included :: IO [Includes_Types.Included] 106inf_Includes_Types_Included = infexamples (Arbitrary.arbitrary :: Gen Includes_Types.Included) 107 108inf_Module_Types_MyStruct :: IO [Module_Types.MyStruct] 109inf_Module_Types_MyStruct = infexamples (Arbitrary.arbitrary :: Gen Module_Types.MyStruct) 110 111-- Fuzzers and exception handlers 112query_fuzzer :: Options -> IO () 113query_fuzzer opts = do 114 a1 <- Applicative.ZipList <$> inf_Module_Types_MyStruct 115 a2 <- Applicative.ZipList <$> inf_Includes_Types_Included 116 _ <- P.sequence . Applicative.getZipList $ query_fuzzFunc <$> a1 <*> a2 117 return () 118 where 119 query_fuzzFunc a1 a2 = let param = (a1, a2) in 120 if opt_framed opts 121 then withThriftDo opts (withFramedTransport opts) (query_fuzzOnce param) (query_exceptionHandler param) 122 else withThriftDo opts (withHandle opts) (query_fuzzOnce param) (query_exceptionHandler param) 123 124query_exceptionHandler :: (Show a1, Show a2) => (a1, a2) -> IO () 125query_exceptionHandler (a1, a2) = do 126 P.putStrLn $ "Got exception on data:" 127 P.putStrLn $ "(" ++ show a1 ++ show a2 ++ ")" 128query_fuzzOnce (a1, a2) client = Client.query client a1 a2 >> return () 129 130has_arg_docs_fuzzer :: Options -> IO () 131has_arg_docs_fuzzer opts = do 132 a1 <- Applicative.ZipList <$> inf_Module_Types_MyStruct 133 a2 <- Applicative.ZipList <$> inf_Includes_Types_Included 134 _ <- P.sequence . Applicative.getZipList $ has_arg_docs_fuzzFunc <$> a1 <*> a2 135 return () 136 where 137 has_arg_docs_fuzzFunc a1 a2 = let param = (a1, a2) in 138 if opt_framed opts 139 then withThriftDo opts (withFramedTransport opts) (has_arg_docs_fuzzOnce param) (has_arg_docs_exceptionHandler param) 140 else withThriftDo opts (withHandle opts) (has_arg_docs_fuzzOnce param) (has_arg_docs_exceptionHandler param) 141 142has_arg_docs_exceptionHandler :: (Show a1, Show a2) => (a1, a2) -> IO () 143has_arg_docs_exceptionHandler (a1, a2) = do 144 P.putStrLn $ "Got exception on data:" 145 P.putStrLn $ "(" ++ show a1 ++ show a2 ++ ")" 146has_arg_docs_fuzzOnce (a1, a2) client = Client.has_arg_docs client a1 a2 >> return () 147 148