THRIFT-3347 Improve cross test servers and clients
Client: TestSuite, C++, Perl, NodeJS, c_glib, Haskell, Python
Patch: Nobuaki Sukegawa <nsukeg@gmail.com>
This closes #621
diff --git a/test/hs/TestClient.hs b/test/hs/TestClient.hs
index 6c25f5b..057a560 100644
--- a/test/hs/TestClient.hs
+++ b/test/hs/TestClient.hs
@@ -26,19 +26,24 @@
import Data.List.Split
import Data.String
import Network
+import Network.URI
import System.Environment
import System.Exit
import System.Posix.Unistd
+import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import qualified Data.Vector as Vector
+import qualified System.IO as IO
import ThriftTest_Iface
import ThriftTest_Types
import qualified ThriftTest_Client as Client
import Thrift.Transport
+import Thrift.Transport.Framed
import Thrift.Transport.Handle
+import Thrift.Transport.HttpClient
import Thrift.Protocol
import Thrift.Protocol.Binary
import Thrift.Protocol.Compact
@@ -50,11 +55,34 @@
, domainSocket :: String
, transport :: String
, protocol :: ProtocolType
+ -- TODO: Haskell lib does not have SSL support
, ssl :: Bool
, testLoops :: Int
}
deriving (Show, Eq)
+data TransportType = Buffered IO.Handle
+ | Framed (FramedTransport IO.Handle)
+ | Http HttpClient
+ | NoTransport String
+
+getTransport :: String -> String -> Int -> (IO TransportType)
+getTransport "buffered" host port = do
+ h <- hOpen (host, PortNumber $ fromIntegral port)
+ IO.hSetBuffering h $ IO.BlockBuffering Nothing
+ return $ Buffered h
+getTransport "framed" host port = do
+ h <- hOpen (host, PortNumber $ fromIntegral port)
+ t <- openFramedTransport h
+ return $ Framed t
+getTransport "http" host port = let uriStr = "http://" ++ host ++ ":" ++ show port in
+ case parseURI uriStr of
+ Nothing -> do return (NoTransport $ "Failed to parse URI: " ++ uriStr)
+ Just(uri) -> do
+ t <- openHttpClient uri
+ return $ Http t
+getTransport t host port = do return (NoTransport $ "Unsupported transport: " ++ t)
+
data ProtocolType = Binary
| Compact
| JSON
@@ -71,7 +99,7 @@
{ port = 9090
, domainSocket = ""
, host = "localhost"
- , transport = "framed"
+ , transport = "buffered"
, protocol = Binary
, ssl = False
, testLoops = 1
@@ -83,29 +111,46 @@
putStrLn "Starting Tests"
-- VOID Test
+ putStrLn "testVoid"
Client.testVoid prot
-- String Test
+ putStrLn "testString"
s <- Client.testString prot "Test"
when (s /= "Test") exitFailure
+ -- Bool Test
+ putStrLn "testBool"
+ bool <- Client.testBool prot True
+ when (not bool) exitFailure
+ putStrLn "testBool"
+ bool <- Client.testBool prot False
+ when (bool) exitFailure
+
-- Byte Test
+ putStrLn "testByte"
byte <- Client.testByte prot 1
when (byte /= 1) exitFailure
-- I32 Test
+ putStrLn "testI32"
i32 <- Client.testI32 prot (-1)
when (i32 /= -1) exitFailure
-- I64 Test
+ putStrLn "testI64"
i64 <- Client.testI64 prot (-34359738368)
when (i64 /= -34359738368) exitFailure
-- Double Test
+ putStrLn "testDouble"
dub <- Client.testDouble prot (-5.2098523)
when (abs (dub + 5.2098523) > 0.001) exitFailure
- -- TODO: call Client.testBinary
+ -- Binary Test
+ putStrLn "testBinary"
+ bin <- Client.testBinary prot (LBS.pack . reverse $ [-128..127])
+ when ((reverse [-128..127]) /= LBS.unpack bin) exitFailure
-- Struct Test
let structIn = Xtruct{ xtruct_string_thing = "Zero"
@@ -113,6 +158,7 @@
, xtruct_i32_thing = -3
, xtruct_i64_thing = -5
}
+ putStrLn "testStruct"
structOut <- Client.testStruct prot structIn
when (structIn /= structOut) exitFailure
@@ -121,68 +167,83 @@
, xtruct2_struct_thing = structIn
, xtruct2_i32_thing = 5
}
+ putStrLn "testNest"
nestOut <- Client.testNest prot nestIn
when (nestIn /= nestOut) exitSuccess
-- Map Test
let mapIn = Map.fromList $ map (\i -> (i, i-10)) [1..5]
+ putStrLn "testMap"
mapOut <- Client.testMap prot mapIn
when (mapIn /= mapOut) exitSuccess
-- Set Test
let setIn = Set.fromList [-2..3]
+ putStrLn "testSet"
setOut <- Client.testSet prot setIn
when (setIn /= setOut) exitFailure
-- List Test
let listIn = Vector.fromList [-2..3]
+ putStrLn "testList"
listOut <- Client.testList prot listIn
when (listIn /= listOut) exitFailure
-- Enum Test
+ putStrLn "testEnum"
numz1 <- Client.testEnum prot ONE
when (numz1 /= ONE) exitFailure
+ putStrLn "testEnum"
numz2 <- Client.testEnum prot TWO
when (numz2 /= TWO) exitFailure
+ putStrLn "testEnum"
numz5 <- Client.testEnum prot FIVE
when (numz5 /= FIVE) exitFailure
-- Typedef Test
+ putStrLn "testTypedef"
uid <- Client.testTypedef prot 309858235082523
when (uid /= 309858235082523) exitFailure
-- Nested Map Test
+ putStrLn "testMapMap"
_ <- Client.testMapMap prot 1
-- Exception Test
+ putStrLn "testException"
exn1 <- try $ Client.testException prot "Xception"
case exn1 of
Left (Xception _ _) -> return ()
_ -> putStrLn (show exn1) >> exitFailure
+ putStrLn "testException"
exn2 <- try $ Client.testException prot "TException"
case exn2 of
Left (_ :: SomeException) -> return ()
Right _ -> exitFailure
+ putStrLn "testException"
exn3 <- try $ Client.testException prot "success"
case exn3 of
Left (_ :: SomeException) -> exitFailure
Right _ -> return ()
-- Multi Exception Test
+ putStrLn "testMultiException"
multi1 <- try $ Client.testMultiException prot "Xception" "test 1"
case multi1 of
Left (Xception _ _) -> return ()
_ -> exitFailure
+ putStrLn "testMultiException"
multi2 <- try $ Client.testMultiException prot "Xception2" "test 2"
case multi2 of
Left (Xception2 _ _) -> return ()
_ -> exitFailure
+ putStrLn "testMultiException"
multi3 <- try $ Client.testMultiException prot "success" "test 3"
case multi3 of
Left (_ :: SomeException) -> exitFailure
@@ -195,12 +256,20 @@
case options of
Nothing -> showHelp
Just Options{..} -> do
- handle <- hOpen (host, PortNumber $ fromIntegral port)
- let client = case protocol of
- Binary -> runClient $ BinaryProtocol handle
- Compact -> runClient $ CompactProtocol handle
- JSON -> runClient $ JSONProtocol handle
- replicateM_ testLoops client
+ trans <- Main.getTransport transport host port
+ case trans of
+ Buffered t -> runTest testLoops protocol t
+ Framed t -> runTest testLoops protocol t
+ Http t -> runTest testLoops protocol t
+ NoTransport err -> putStrLn err
+ where
+ makeClient p t = case p of
+ Binary -> runClient $ BinaryProtocol t
+ Compact -> runClient $ CompactProtocol t
+ JSON -> runClient $ JSONProtocol t
+ runTest loops p t = do
+ let client = makeClient p t
+ replicateM_ loops client
putStrLn "COMPLETED SUCCESSFULLY"
parseFlags :: [String] -> Options -> Maybe Options
@@ -228,7 +297,7 @@
\ --port arg (=9090) Port number to connect\n\
\ --domain-socket arg Domain Socket (e.g. /tmp/ThriftTest.thrift),\n\
\ instead of host and port\n\
- \ --transport arg (=buffered) Transport: buffered, framed, http, evhttp\n\
+ \ --transport arg (=buffered) Transport: buffered, framed, http\n\
\ --protocol arg (=binary) Protocol: binary, compact, json\n\
\ --ssl Encrypted Transport using SSL\n\
- \ -n [ --testloops ] arg (=1) Number of Tests"
\ No newline at end of file
+ \ -n [ --testloops ] arg (=1) Number of Tests"