From 19fcec84d8d7d21e796c7624e521b60d28ee21ed Mon Sep 17 00:00:00 2001 From: Daniel Baumann Date: Sun, 7 Apr 2024 20:45:59 +0200 Subject: Adding upstream version 16.2.11+ds. Signed-off-by: Daniel Baumann --- src/jaegertracing/thrift/test/hs/CMakeLists.txt | 114 ++++++++ .../thrift/test/hs/ConstantsDemo_Main.hs | 68 +++++ .../thrift/test/hs/DebugProtoTest_Main.hs | 172 ++++++++++++ src/jaegertracing/thrift/test/hs/Include_Main.hs | 7 + src/jaegertracing/thrift/test/hs/Makefile.am | 50 ++++ src/jaegertracing/thrift/test/hs/TestClient.hs | 306 ++++++++++++++++++++ src/jaegertracing/thrift/test/hs/TestServer.hs | 312 +++++++++++++++++++++ .../thrift/test/hs/ThriftTestUtils.hs | 65 +++++ .../thrift/test/hs/ThriftTest_Main.hs | 214 ++++++++++++++ src/jaegertracing/thrift/test/hs/run-test.sh | 43 +++ 10 files changed, 1351 insertions(+) create mode 100644 src/jaegertracing/thrift/test/hs/CMakeLists.txt create mode 100644 src/jaegertracing/thrift/test/hs/ConstantsDemo_Main.hs create mode 100644 src/jaegertracing/thrift/test/hs/DebugProtoTest_Main.hs create mode 100644 src/jaegertracing/thrift/test/hs/Include_Main.hs create mode 100644 src/jaegertracing/thrift/test/hs/Makefile.am create mode 100644 src/jaegertracing/thrift/test/hs/TestClient.hs create mode 100644 src/jaegertracing/thrift/test/hs/TestServer.hs create mode 100644 src/jaegertracing/thrift/test/hs/ThriftTestUtils.hs create mode 100644 src/jaegertracing/thrift/test/hs/ThriftTest_Main.hs create mode 100755 src/jaegertracing/thrift/test/hs/run-test.sh (limited to 'src/jaegertracing/thrift/test/hs') diff --git a/src/jaegertracing/thrift/test/hs/CMakeLists.txt b/src/jaegertracing/thrift/test/hs/CMakeLists.txt new file mode 100644 index 000000000..eaca3fa04 --- /dev/null +++ b/src/jaegertracing/thrift/test/hs/CMakeLists.txt @@ -0,0 +1,114 @@ +# +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. +# + +set(hs_test_gen + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ConstantsDemo_Consts.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ConstantsDemo_Types.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/DebugProtoTest_Consts.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/DebugProtoTest_Types.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/EmptyService_Client.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/EmptyService.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/EmptyService_Iface.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Include_Consts.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Include_Types.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Inherited_Client.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Inherited.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Inherited_Iface.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ReverseOrderService_Client.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ReverseOrderService.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ReverseOrderService_Iface.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/SecondService_Client.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/SecondService.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/SecondService_Iface.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ServiceForExceptionWithAMap_Client.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ServiceForExceptionWithAMap.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ServiceForExceptionWithAMap_Iface.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Srv_Client.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Srv.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Srv_Iface.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ThriftTest_Client.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ThriftTest_Consts.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ThriftTest.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ThriftTest_Iface.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/ThriftTest_Types.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Yowza_Client.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Yowza.hs + ${CMAKE_CURRENT_BINARY_DIR}/gen-hs/Yowza_Iface.hs +) + +set(hs_crosstest_apps + ${CMAKE_CURRENT_BINARY_DIR}/TestServer + ${CMAKE_CURRENT_BINARY_DIR}/TestClient +) +set(hs_crosstest_args + -igen-hs + -odir=${CMAKE_CURRENT_BINARY_DIR} + -hidir=${CMAKE_CURRENT_BINARY_DIR} +) + +if (CMAKE_BUILD_TYPE STREQUAL "Debug") + set(hs_optimize -O0) +else() + set(hs_optimize -O1) +endif() + +add_custom_command( + OUTPUT ${hs_crosstest_apps} + COMMAND ${GHC} ${hs_optimize} ${hs_crosstest_args} ${CMAKE_CURRENT_SOURCE_DIR}/TestServer.hs -o TestServer + COMMAND ${GHC} ${hs_optimize} ${hs_crosstest_args} ${CMAKE_CURRENT_SOURCE_DIR}/TestClient.hs -o TestClient + DEPENDS ${hs_test_gen} haskell_library TestServer.hs TestClient.hs +) +add_custom_target(haskell_crosstest ALL + COMMENT "Building Haskell cross test executables" + DEPENDS ${hs_crosstest_apps} +) + +set(hs_test_sources + ConstantsDemo_Main.hs + DebugProtoTest_Main.hs + Include_Main.hs + ThriftTest_Main.hs +) +set(hs_test_args + -Wall + -XScopedTypeVariables + -i${PROJECT_SOURCE_DIR}/lib/hs/src + -i${CMAKE_CURRENT_BINARY_DIR}/gen-hs +) +add_custom_target(haskell_tests ALL DEPENDS ${hs_test_gen}) +foreach(SRC ${hs_test_sources}) + get_filename_component(BASE ${SRC} NAME_WE) + add_test(NAME HaskellTests-${BASE} + COMMAND ${RUN_HASKELL} ${hs_test_args} ${SRC} + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}) +endforeach() + +set(hs_test_gen_sources + ${PROJECT_SOURCE_DIR}/test/ConstantsDemo.thrift + ${PROJECT_SOURCE_DIR}/test/DebugProtoTest.thrift + ${PROJECT_SOURCE_DIR}/test/ThriftTest.thrift + ${PROJECT_SOURCE_DIR}/test/Include.thrift +) +add_custom_command(OUTPUT ${hs_test_gen} + COMMAND ${THRIFT_COMPILER} --gen hs ${PROJECT_SOURCE_DIR}/test/ConstantsDemo.thrift + COMMAND ${THRIFT_COMPILER} --gen hs ${PROJECT_SOURCE_DIR}/test/DebugProtoTest.thrift + COMMAND ${THRIFT_COMPILER} --gen hs ${PROJECT_SOURCE_DIR}/test/ThriftTest.thrift + COMMAND ${THRIFT_COMPILER} --gen hs ${PROJECT_SOURCE_DIR}/test/Include.thrift + DEPENDS ${hs_test_gen_sources} +) diff --git a/src/jaegertracing/thrift/test/hs/ConstantsDemo_Main.hs b/src/jaegertracing/thrift/test/hs/ConstantsDemo_Main.hs new file mode 100644 index 000000000..28de4f7ea --- /dev/null +++ b/src/jaegertracing/thrift/test/hs/ConstantsDemo_Main.hs @@ -0,0 +1,68 @@ +-- +-- Licensed to the Apache Software Foundation (ASF) under one +-- or more contributor license agreements. See the NOTICE file +-- distributed with this work for additional information +-- regarding copyright ownership. The ASF licenses this file +-- to you under the Apache License, Version 2.0 (the +-- "License"); you may not use this file except in compliance +-- with the License. You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, +-- software distributed under the License is distributed on an +-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +-- KIND, either express or implied. See the License for the +-- specific language governing permissions and limitations +-- under the License. +-- + +module Main where + + +import qualified Control.Exception +import qualified Network + +import Thrift.Protocol.Binary +import Thrift.Server +import Thrift.Transport.Handle + +import qualified ThriftTestUtils + +import qualified Yowza +import qualified Yowza_Client as Client +import qualified Yowza_Iface as Iface + + +data YowzaHandler = YowzaHandler +instance Iface.Yowza_Iface YowzaHandler where + blingity _ = do + ThriftTestUtils.serverLog "SERVER: Got blingity" + return () + + blangity _ = do + ThriftTestUtils.serverLog "SERVER: Got blangity" + return $ 31 + + +client :: (String, Network.PortID) -> IO () +client addr = do + to <- hOpen addr + let ps = (BinaryProtocol to, BinaryProtocol to) + + Client.blingity ps + + rv <- Client.blangity ps + ThriftTestUtils.clientLog $ show rv + + tClose to + +server :: Network.PortNumber -> IO () +server port = do + ThriftTestUtils.serverLog "Ready..." + (runBasicServer YowzaHandler Yowza.process port) + `Control.Exception.catch` + (\(TransportExn s _) -> error $ "FAILURE: " ++ show s) + +main :: IO () +main = ThriftTestUtils.runTest server client diff --git a/src/jaegertracing/thrift/test/hs/DebugProtoTest_Main.hs b/src/jaegertracing/thrift/test/hs/DebugProtoTest_Main.hs new file mode 100644 index 000000000..97d4347c2 --- /dev/null +++ b/src/jaegertracing/thrift/test/hs/DebugProtoTest_Main.hs @@ -0,0 +1,172 @@ +-- +-- Licensed to the Apache Software Foundation (ASF) under one +-- or more contributor license agreements. See the NOTICE file +-- distributed with this work for additional information +-- regarding copyright ownership. The ASF licenses this file +-- to you under the Apache License, Version 2.0 (the +-- "License"); you may not use this file except in compliance +-- with the License. You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, +-- software distributed under the License is distributed on an +-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +-- KIND, either express or implied. See the License for the +-- specific language governing permissions and limitations +-- under the License. +-- + +{-# LANGUAGE OverloadedStrings #-} + +module Main where + + +import qualified Control.Exception +import qualified Data.ByteString.Lazy as DBL +import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set +import qualified Data.Vector as Vector +import qualified Network + +import Thrift.Protocol.Binary +import Thrift.Server +import Thrift.Transport.Handle + +import qualified ThriftTestUtils + +import qualified DebugProtoTest_Types as Types +import qualified Inherited +import qualified Inherited_Client as IClient +import qualified Inherited_Iface as IIface +import qualified Srv_Client as SClient +import qualified Srv_Iface as SIface + +-- we don't actually need this import, but force it to check the code generator exports proper Haskell syntax +import qualified Srv() + + +data InheritedHandler = InheritedHandler +instance SIface.Srv_Iface InheritedHandler where + janky _ arg = do + ThriftTestUtils.serverLog $ "Got janky method call: " ++ show arg + return $ 31 + + voidMethod _ = do + ThriftTestUtils.serverLog "Got voidMethod method call" + return () + + primitiveMethod _ = do + ThriftTestUtils.serverLog "Got primitiveMethod call" + return $ 42 + + structMethod _ = do + ThriftTestUtils.serverLog "Got structMethod call" + return $ Types.CompactProtoTestStruct { + Types.compactProtoTestStruct_a_byte = 0x01, + Types.compactProtoTestStruct_a_i16 = 0x02, + Types.compactProtoTestStruct_a_i32 = 0x03, + Types.compactProtoTestStruct_a_i64 = 0x04, + Types.compactProtoTestStruct_a_double = 0.1, + Types.compactProtoTestStruct_a_string = "abcdef", + Types.compactProtoTestStruct_a_binary = DBL.empty, + Types.compactProtoTestStruct_true_field = True, + Types.compactProtoTestStruct_false_field = False, + Types.compactProtoTestStruct_empty_struct_field = Types.Empty, + + Types.compactProtoTestStruct_byte_list = Vector.empty, + Types.compactProtoTestStruct_i16_list = Vector.empty, + Types.compactProtoTestStruct_i32_list = Vector.empty, + Types.compactProtoTestStruct_i64_list = Vector.empty, + Types.compactProtoTestStruct_double_list = Vector.empty, + Types.compactProtoTestStruct_string_list = Vector.empty, + Types.compactProtoTestStruct_binary_list = Vector.empty, + Types.compactProtoTestStruct_boolean_list = Vector.empty, + Types.compactProtoTestStruct_struct_list = Vector.empty, + + Types.compactProtoTestStruct_byte_set = Set.empty, + Types.compactProtoTestStruct_i16_set = Set.empty, + Types.compactProtoTestStruct_i32_set = Set.empty, + Types.compactProtoTestStruct_i64_set = Set.empty, + Types.compactProtoTestStruct_double_set = Set.empty, + Types.compactProtoTestStruct_string_set = Set.empty, + Types.compactProtoTestStruct_binary_set = Set.empty, + Types.compactProtoTestStruct_boolean_set = Set.empty, + Types.compactProtoTestStruct_struct_set = Set.empty, + + Types.compactProtoTestStruct_byte_byte_map = Map.empty, + Types.compactProtoTestStruct_i16_byte_map = Map.empty, + Types.compactProtoTestStruct_i32_byte_map = Map.empty, + Types.compactProtoTestStruct_i64_byte_map = Map.empty, + Types.compactProtoTestStruct_double_byte_map = Map.empty, + Types.compactProtoTestStruct_string_byte_map = Map.empty, + Types.compactProtoTestStruct_binary_byte_map = Map.empty, + Types.compactProtoTestStruct_boolean_byte_map = Map.empty, + + Types.compactProtoTestStruct_byte_i16_map = Map.empty, + Types.compactProtoTestStruct_byte_i32_map = Map.empty, + Types.compactProtoTestStruct_byte_i64_map = Map.empty, + Types.compactProtoTestStruct_byte_double_map = Map.empty, + Types.compactProtoTestStruct_byte_string_map = Map.empty, + Types.compactProtoTestStruct_byte_binary_map = Map.empty, + Types.compactProtoTestStruct_byte_boolean_map = Map.empty, + + Types.compactProtoTestStruct_list_byte_map = Map.empty, + Types.compactProtoTestStruct_set_byte_map = Map.empty, + Types.compactProtoTestStruct_map_byte_map = Map.empty, + + Types.compactProtoTestStruct_byte_map_map = Map.empty, + Types.compactProtoTestStruct_byte_set_map = Map.empty, + Types.compactProtoTestStruct_byte_list_map = Map.empty, + + Types.compactProtoTestStruct_field500 = 500, + Types.compactProtoTestStruct_field5000 = 5000, + Types.compactProtoTestStruct_field20000 = 20000 } + + methodWithDefaultArgs _ arg = do + ThriftTestUtils.serverLog $ "Got methodWithDefaultArgs: " ++ show arg + return () + + onewayMethod _ = do + ThriftTestUtils.serverLog "Got onewayMethod" + +instance IIface.Inherited_Iface InheritedHandler where + identity _ arg = do + ThriftTestUtils.serverLog $ "Got identity method: " ++ show arg + return arg + +client :: (String, Network.PortID) -> IO () +client addr = do + to <- hOpen addr + let p = BinaryProtocol to + let ps = (p,p) + + v1 <- SClient.janky ps 42 + ThriftTestUtils.clientLog $ show v1 + + SClient.voidMethod ps + + v2 <- SClient.primitiveMethod ps + ThriftTestUtils.clientLog $ show v2 + + v3 <- SClient.structMethod ps + ThriftTestUtils.clientLog $ show v3 + + SClient.methodWithDefaultArgs ps 42 + + SClient.onewayMethod ps + + v4 <- IClient.identity ps 42 + ThriftTestUtils.clientLog $ show v4 + + return () + +server :: Network.PortNumber -> IO () +server port = do + ThriftTestUtils.serverLog "Ready..." + (runBasicServer InheritedHandler Inherited.process port) + `Control.Exception.catch` + (\(TransportExn s _) -> error $ "FAILURE: " ++ show s) + +main :: IO () +main = ThriftTestUtils.runTest server client diff --git a/src/jaegertracing/thrift/test/hs/Include_Main.hs b/src/jaegertracing/thrift/test/hs/Include_Main.hs new file mode 100644 index 000000000..d3977a157 --- /dev/null +++ b/src/jaegertracing/thrift/test/hs/Include_Main.hs @@ -0,0 +1,7 @@ +module Main where + +import Include_Types +import ThriftTest_Types + +main :: IO () +main = putStrLn ("Includes work: " ++ (show (IncludeTest $ Bools True False))) diff --git a/src/jaegertracing/thrift/test/hs/Makefile.am b/src/jaegertracing/thrift/test/hs/Makefile.am new file mode 100644 index 000000000..817070d8f --- /dev/null +++ b/src/jaegertracing/thrift/test/hs/Makefile.am @@ -0,0 +1,50 @@ +# +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. +# + +stubs: $(THRIFT) ../ConstantsDemo.thrift ../DebugProtoTest.thrift ../ThriftTest.thrift ../Include.thrift + $(THRIFT) --gen hs ../ConstantsDemo.thrift + $(THRIFT) --gen hs ../DebugProtoTest.thrift + $(THRIFT) --gen hs ../ThriftTest.thrift + $(THRIFT) --gen hs ../Include.thrift + +check: stubs + sh run-test.sh ConstantsDemo + sh run-test.sh DebugProtoTest + sh run-test.sh ThriftTest + sh run-test.sh Include + +clean-local: + $(RM) -r gen-hs/ + $(RM) *.hi + $(RM) *.o + $(RM) TestClient + $(RM) TestServer + +dist-hook: + $(RM) -r $(distdir)/gen-hs/ + $(RM) $(distdir)/*.hi + $(RM) $(distdir)/*.o + $(RM) $(destdir)/TestClient + $(RM) $(destdir)/TestServer + +all-local: stubs + ghc -igen-hs TestServer.hs + ghc -igen-hs TestClient.hs + +precross: all-local diff --git a/src/jaegertracing/thrift/test/hs/TestClient.hs b/src/jaegertracing/thrift/test/hs/TestClient.hs new file mode 100644 index 000000000..93fb591b3 --- /dev/null +++ b/src/jaegertracing/thrift/test/hs/TestClient.hs @@ -0,0 +1,306 @@ +-- +-- Licensed to the Apache Software Foundation (ASF) under one +-- or more contributor license agreements. See the NOTICE file +-- distributed with this work for additional information +-- regarding copyright ownership. The ASF licenses this file +-- to you under the Apache License, Version 2.0 (the +-- "License"); you may not use this file except in compliance +-- with the License. You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, +-- software distributed under the License is distributed on an +-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +-- KIND, either express or implied. See the License for the +-- specific language governing permissions and limitations +-- under the License. +-- + +{-# LANGUAGE OverloadedStrings, RecordWildCards, ScopedTypeVariables #-} +module Main where + +import Control.Exception +import Control.Monad +import Data.Functor +import Data.List.Split +import Data.String +import Network +import Network.URI +import System.Environment +import System.Exit +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 +import Thrift.Protocol.Header +import Thrift.Protocol.JSON + +data Options = Options + { host :: String + , port :: Int + , 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 + | Header + deriving (Show, Eq) + +getProtocol :: String -> ProtocolType +getProtocol "binary" = Binary +getProtocol "compact" = Compact +getProtocol "json" = JSON +getProtocol "header" = Header +getProtocol p = error $ "Unsupported Protocol: " ++ p + +defaultOptions :: Options +defaultOptions = Options + { port = 9090 + , domainSocket = "" + , host = "localhost" + , transport = "buffered" + , protocol = Binary + , ssl = False + , testLoops = 1 + } + +runClient :: Protocol p => p -> IO () +runClient p = do + let prot = (p,p) + 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 + + -- 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" + , xtruct_byte_thing = 1 + , xtruct_i32_thing = -3 + , xtruct_i64_thing = -5 + } + putStrLn "testStruct" + structOut <- Client.testStruct prot structIn + when (structIn /= structOut) exitFailure + + -- Nested Struct Test + let nestIn = Xtruct2{ xtruct2_byte_thing = 1 + , xtruct2_struct_thing = structIn + , xtruct2_i32_thing = 5 + } + putStrLn "testNest" + nestOut <- Client.testNest prot nestIn + when (nestIn /= nestOut) exitFailure + + -- Map Test + let mapIn = Map.fromList $ map (\i -> (i, i-10)) [1..5] + putStrLn "testMap" + mapOut <- Client.testMap prot mapIn + when (mapIn /= mapOut) exitFailure + + -- 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 + Right _ -> return () + + +main :: IO () +main = do + options <- flip parseFlags defaultOptions <$> getArgs + case options of + Nothing -> showHelp + Just Options{..} -> do + 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 + Header -> createHeaderProtocol t t >>= runClient + runTest loops p t = do + let client = makeClient p t + replicateM_ loops client + putStrLn "COMPLETED SUCCESSFULLY" + +parseFlags :: [String] -> Options -> Maybe Options +parseFlags (flag : flags) opts = do + let pieces = splitOn "=" flag + case pieces of + "--port" : arg : _ -> parseFlags flags opts{ port = read arg } + "--domain-socket" : arg : _ -> parseFlags flags opts{ domainSocket = read arg } + "--host" : arg : _ -> parseFlags flags opts{ host = arg } + "--transport" : arg : _ -> parseFlags flags opts{ transport = arg } + "--protocol" : arg : _ -> parseFlags flags opts{ protocol = getProtocol arg } + "-n" : arg : _ -> parseFlags flags opts{ testLoops = read arg } + "--h" : _ -> Nothing + "--help" : _ -> Nothing + "--ssl" : _ -> parseFlags flags opts{ ssl = True } + "--processor-events" : _ -> parseFlags flags opts + _ -> Nothing +parseFlags [] opts = Just opts + +showHelp :: IO () +showHelp = putStrLn + "Allowed options:\n\ + \ -h [ --help ] produce help message\n\ + \ --host arg (=localhost) Host to connect\n\ + \ --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\n\ + \ --protocol arg (=binary) Protocol: binary, compact, json\n\ + \ --ssl Encrypted Transport using SSL\n\ + \ -n [ --testloops ] arg (=1) Number of Tests" diff --git a/src/jaegertracing/thrift/test/hs/TestServer.hs b/src/jaegertracing/thrift/test/hs/TestServer.hs new file mode 100644 index 000000000..b7731ab1c --- /dev/null +++ b/src/jaegertracing/thrift/test/hs/TestServer.hs @@ -0,0 +1,312 @@ +-- +-- Licensed to the Apache Software Foundation (ASF) under one +-- or more contributor license agreements. See the NOTICE file +-- distributed with this work for additional information +-- regarding copyright ownership. The ASF licenses this file +-- to you under the Apache License, Version 2.0 (the +-- "License"); you may not use this file except in compliance +-- with the License. You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, +-- software distributed under the License is distributed on an +-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +-- KIND, either express or implied. See the License for the +-- specific language governing permissions and limitations +-- under the License. +-- + +{-# LANGUAGE OverloadedStrings,RecordWildCards #-} +module Main where + +import Control.Exception +import Control.Monad +import Data.Functor +import Data.HashMap.Strict (HashMap) +import Data.List +import Data.List.Split +import Data.String +import Network +import System.Environment +import System.Exit +import System.IO +import Control.Concurrent (threadDelay) +import qualified System.IO as IO +import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set +import qualified Data.Text.Lazy as Text +import qualified Data.Vector as Vector + +import ThriftTest +import ThriftTest_Iface +import ThriftTest_Types + +import Thrift +import Thrift.Server +import Thrift.Transport.Framed +import Thrift.Transport.Handle +import Thrift.Protocol.Binary +import Thrift.Protocol.Compact +import Thrift.Protocol.Header +import Thrift.Protocol.JSON + +data Options = Options + { port :: Int + , domainSocket :: String + , serverType :: ServerType + , transport :: String + , protocol :: ProtocolType + , ssl :: Bool + , workers :: Int + } + +data ServerType = Simple + | ThreadPool + | Threaded + | NonBlocking + deriving (Show, Eq) + +instance IsString ServerType where + fromString "simple" = Simple + fromString "thread-pool" = ThreadPool + fromString "threaded" = Threaded + fromString "nonblocking" = NonBlocking + fromString _ = error "not a valid server type" + +data TransportType = Buffered (Socket -> (IO IO.Handle)) + | Framed (Socket -> (IO (FramedTransport IO.Handle))) + | NoTransport String + +getTransport :: String -> TransportType +getTransport "buffered" = Buffered $ \s -> do + (h, _, _) <- (accept s) + IO.hSetBuffering h $ IO.BlockBuffering Nothing + return h +getTransport "framed" = Framed $ \s -> do + (h, _, _) <- (accept s) + openFramedTransport h +getTransport t = NoTransport $ "Unsupported transport: " ++ t + +data ProtocolType = Binary + | Compact + | JSON + | Header + +getProtocol :: String -> ProtocolType +getProtocol "binary" = Binary +getProtocol "compact" = Compact +getProtocol "json" = JSON +getProtocol "header" = Header +getProtocol p = error $"Unsupported Protocol: " ++ p + +defaultOptions :: Options +defaultOptions = Options + { port = 9090 + , domainSocket = "" + , serverType = Threaded + , transport = "buffered" + , protocol = Binary + -- TODO: Haskell lib does not have SSL support + , ssl = False + , workers = 4 + } + +stringifyMap :: (Show a, Show b) => Map.HashMap a b -> String +stringifyMap = Data.List.intercalate ", " . Data.List.map joinKV . Map.toList + where joinKV (k, v) = show k ++ " => " ++ show v + +stringifySet :: Show a => Set.HashSet a -> String +stringifySet = Data.List.intercalate ", " . Data.List.map show . Set.toList + +stringifyList :: Show a => Vector.Vector a -> String +stringifyList = Data.List.intercalate ", " . Data.List.map show . Vector.toList + +data TestHandler = TestHandler +instance ThriftTest_Iface TestHandler where + testVoid _ = System.IO.putStrLn "testVoid()" + + testString _ s = do + System.IO.putStrLn $ "testString(" ++ show s ++ ")" + return s + + testBool _ x = do + System.IO.putStrLn $ "testBool(" ++ show x ++ ")" + return x + + testByte _ x = do + System.IO.putStrLn $ "testByte(" ++ show x ++ ")" + return x + + testI32 _ x = do + System.IO.putStrLn $ "testI32(" ++ show x ++ ")" + return x + + testI64 _ x = do + System.IO.putStrLn $ "testI64(" ++ show x ++ ")" + return x + + testDouble _ x = do + System.IO.putStrLn $ "testDouble(" ++ show x ++ ")" + return x + + testBinary _ x = do + System.IO.putStrLn $ "testBinary(" ++ show x ++ ")" + return x + + testStruct _ struct@Xtruct{..} = do + System.IO.putStrLn $ "testStruct({" ++ show xtruct_string_thing + ++ ", " ++ show xtruct_byte_thing + ++ ", " ++ show xtruct_i32_thing + ++ ", " ++ show xtruct_i64_thing + ++ "})" + return struct + + testNest _ nest@Xtruct2{..} = do + let Xtruct{..} = xtruct2_struct_thing + System.IO.putStrLn $ "testNest({" ++ show xtruct2_byte_thing + ++ "{, " ++ show xtruct_string_thing + ++ ", " ++ show xtruct_byte_thing + ++ ", " ++ show xtruct_i32_thing + ++ ", " ++ show xtruct_i64_thing + ++ "}, " ++ show xtruct2_i32_thing + return nest + + testMap _ m = do + System.IO.putStrLn $ "testMap({" ++ stringifyMap m ++ "})" + return m + + testStringMap _ m = do + System.IO.putStrLn $ "testStringMap(" ++ stringifyMap m ++ "})" + return m + + testSet _ x = do + System.IO.putStrLn $ "testSet({" ++ stringifySet x ++ "})" + return x + + testList _ x = do + System.IO.putStrLn $ "testList(" ++ stringifyList x ++ "})" + return x + + testEnum _ x = do + System.IO.putStrLn $ "testEnum(" ++ show x ++ ")" + return x + + testTypedef _ x = do + System.IO.putStrLn $ "testTypedef(" ++ show x ++ ")" + return x + + testMapMap _ x = do + System.IO.putStrLn $ "testMapMap(" ++ show x ++ ")" + return $ Map.fromList [ (-4, Map.fromList [ (-4, -4) + , (-3, -3) + , (-2, -2) + , (-1, -1) + ]) + , (4, Map.fromList [ (1, 1) + , (2, 2) + , (3, 3) + , (4, 4) + ]) + ] + + testInsanity _ x = do + System.IO.putStrLn "testInsanity()" + return $ Map.fromList [ (1, Map.fromList [ (TWO , x) + , (THREE, x) + ]) + , (2, Map.fromList [ (SIX, default_Insanity) + ]) + ] + + testMulti _ byte i32 i64 _ _ _ = do + System.IO.putStrLn "testMulti()" + return Xtruct{ xtruct_string_thing = Text.pack "Hello2" + , xtruct_byte_thing = byte + , xtruct_i32_thing = i32 + , xtruct_i64_thing = i64 + } + + testException _ s = do + System.IO.putStrLn $ "testException(" ++ show s ++ ")" + case s of + "Xception" -> throw $ Xception 1001 s + "TException" -> throw ThriftException + _ -> return () + + testMultiException _ s1 s2 = do + System.IO.putStrLn $ "testMultiException(" ++ show s1 ++ ", " ++ show s2 ++ ")" + case s1 of + "Xception" -> throw $ Xception 1001 "This is an Xception" + "Xception2" -> throw $ Xception2 2002 $ Xtruct "This is an Xception2" 0 0 0 + "TException" -> throw ThriftException + _ -> return default_Xtruct{ xtruct_string_thing = s2 } + + testOneway _ i = do + System.IO.putStrLn $ "testOneway(" ++ show i ++ "): Sleeping..." + threadDelay $ (fromIntegral i) * 1000000 + System.IO.putStrLn $ "testOneway(" ++ show i ++ "): done sleeping!" + +main :: IO () +main = do + options <- flip parseFlags defaultOptions <$> getArgs + case options of + Nothing -> showHelp + Just Options{..} -> do + case Main.getTransport transport of + Buffered f -> runServer protocol f port + Framed f -> runServer protocol f port + NoTransport err -> putStrLn err + System.IO.putStrLn $ "Starting \"" ++ show serverType ++ "\" server (" ++ + show transport ++ ") listen on: " ++ domainSocket ++ show port + where + acceptor p f socket = do + t <- f socket + return (p t, p t) + + headerAcceptor f socket = do + t <- f socket + p <- createHeaderProtocol1 t + return (p, p) + + doRunServer p f = do + runThreadedServer (acceptor p f) TestHandler ThriftTest.process . PortNumber . fromIntegral + + runServer p f port = case p of + Binary -> doRunServer BinaryProtocol f port + Compact -> doRunServer CompactProtocol f port + JSON -> doRunServer JSONProtocol f port + Header -> runThreadedServer (headerAcceptor f) TestHandler ThriftTest.process (PortNumber $ fromIntegral port) + +parseFlags :: [String] -> Options -> Maybe Options +parseFlags (flag : flags) opts = do + let pieces = splitOn "=" flag + case pieces of + "--port" : arg : _ -> parseFlags flags opts{ port = read arg } + "--domain-socket" : arg : _ -> parseFlags flags opts{ domainSocket = read arg } + "--server-type" : arg : _ -> parseFlags flags opts{ serverType = fromString arg } + "--transport" : arg : _ -> parseFlags flags opts{ transport = arg } + "--protocol" : arg : _ -> parseFlags flags opts{ protocol = getProtocol arg } + "--workers" : arg : _ -> parseFlags flags opts{ workers = read arg } + "-n" : arg : _ -> parseFlags flags opts{ workers = read arg } + "--h" : _ -> Nothing + "--help" : _ -> Nothing + "--ssl" : _ -> parseFlags flags opts{ ssl = True } + "--processor-events" : _ -> parseFlags flags opts + _ -> Nothing +parseFlags [] opts = Just opts + +showHelp :: IO () +showHelp = System.IO.putStrLn + "Allowed options:\n\ + \ -h [ --help ] produce help message\n\ + \ --port arg (=9090) Port number to listen\n\ + \ --domain-socket arg Unix Domain Socket (e.g. /tmp/ThriftTest.thrift)\n\ + \ --server-type arg (=simple) type of server, \"simple\", \"thread-pool\",\n\ + \ \"threaded\", or \"nonblocking\"\n\ + \ --transport arg (=buffered) transport: buffered, framed\n\ + \ --protocol arg (=binary) protocol: binary, compact, json\n\ + \ --ssl Encrypted Transport using SSL\n\ + \ --processor-events processor-events\n\ + \ -n [ --workers ] arg (=4) Number of thread pools workers. Only valid for\n\ + \ thread-pool server type" diff --git a/src/jaegertracing/thrift/test/hs/ThriftTestUtils.hs b/src/jaegertracing/thrift/test/hs/ThriftTestUtils.hs new file mode 100644 index 000000000..9c19b56a9 --- /dev/null +++ b/src/jaegertracing/thrift/test/hs/ThriftTestUtils.hs @@ -0,0 +1,65 @@ +-- +-- Licensed to the Apache Software Foundation (ASF) under one +-- or more contributor license agreements. See the NOTICE file +-- distributed with this work for additional information +-- regarding copyright ownership. The ASF licenses this file +-- to you under the Apache License, Version 2.0 (the +-- "License"); you may not use this file except in compliance +-- with the License. You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, +-- software distributed under the License is distributed on an +-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +-- KIND, either express or implied. See the License for the +-- specific language governing permissions and limitations +-- under the License. +-- + +module ThriftTestUtils (ClientFunc, ServerFunc, clientLog, serverLog, testLog, runTest) where + + +import qualified Control.Concurrent +import qualified Network +import qualified System.IO + + +serverPort :: Network.PortNumber +serverPort = 9090 + +serverAddress :: (String, Network.PortID) +serverAddress = ("localhost", Network.PortNumber serverPort) + + +testLog :: String -> IO () +testLog str = do + System.IO.hPutStr System.IO.stdout $ str ++ "\n" + System.IO.hFlush System.IO.stdout + + +clientLog :: String -> IO () +clientLog str = testLog $ "CLIENT: " ++ str + +serverLog :: String -> IO () +serverLog str = testLog $ "SERVER: " ++ str + + +type ServerFunc = Network.PortNumber -> IO () +type ClientFunc = (String, Network.PortID) -> IO () + +runTest :: ServerFunc -> ClientFunc -> IO () +runTest server client = do + _ <- Control.Concurrent.forkIO (server serverPort) + + -- Fairly horrible; this does not 100% guarantees that the other thread + -- has actually opened the socket we need... but not much else we can do + -- without this, the client races the server to the socket, and wins every + -- time + Control.Concurrent.yield + Control.Concurrent.threadDelay $ 500 * 1000 -- unit is in _micro_seconds + Control.Concurrent.yield + + client serverAddress + + testLog "SUCCESS" diff --git a/src/jaegertracing/thrift/test/hs/ThriftTest_Main.hs b/src/jaegertracing/thrift/test/hs/ThriftTest_Main.hs new file mode 100644 index 000000000..670023e29 --- /dev/null +++ b/src/jaegertracing/thrift/test/hs/ThriftTest_Main.hs @@ -0,0 +1,214 @@ +{-# LANGUAGE ScopedTypeVariables #-} +-- +-- Licensed to the Apache Software Foundation (ASF) under one +-- or more contributor license agreements. See the NOTICE file +-- distributed with this work for additional information +-- regarding copyright ownership. The ASF licenses this file +-- to you under the Apache License, Version 2.0 (the +-- "License"); you may not use this file except in compliance +-- with the License. You may obtain a copy of the License at +-- +-- http://www.apache.org/licenses/LICENSE-2.0 +-- +-- Unless required by applicable law or agreed to in writing, +-- software distributed under the License is distributed on an +-- "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +-- KIND, either express or implied. See the License for the +-- specific language governing permissions and limitations +-- under the License. +-- + +{-# LANGUAGE OverloadedStrings #-} + +module Main where + + +import qualified Control.Exception +import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set +import qualified Data.Vector as Vector + +import qualified Network + +import Thrift +import Thrift.Protocol.Binary +import Thrift.Server +import Thrift.Transport.Handle + +import qualified ThriftTestUtils + +import qualified ThriftTest +import qualified ThriftTest_Client as Client +import qualified ThriftTest_Iface as Iface +import qualified ThriftTest_Types as Types + + +data TestHandler = TestHandler +instance Iface.ThriftTest_Iface TestHandler where + testVoid _ = return () + + testString _ s = do + ThriftTestUtils.serverLog $ show s + return s + + testByte _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testI32 _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testI64 _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testDouble _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testBinary _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testStruct _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testNest _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testMap _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testStringMap _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testSet _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testList _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testEnum _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testTypedef _ x = do + ThriftTestUtils.serverLog $ show x + return x + + testMapMap _ _ = do + return (Map.fromList [(1, Map.fromList [(2, 2)])]) + + testInsanity _ x = do + return (Map.fromList [(1, Map.fromList [(Types.ONE, x)])]) + + testMulti _ _ _ _ _ _ _ = do + return (Types.Xtruct "" 0 0 0) + + testException _ _ = do + Control.Exception.throw (Types.Xception 1 "bya") + + testMultiException _ _ _ = do + Control.Exception.throw (Types.Xception 1 "xyz") + + testOneway _ i = do + ThriftTestUtils.serverLog $ show i + + +client :: (String, Network.PortID) -> IO () +client addr = do + to <- hOpen addr + let ps = (BinaryProtocol to, BinaryProtocol to) + + v1 <- Client.testString ps "bya" + ThriftTestUtils.clientLog $ show v1 + + v2 <- Client.testByte ps 8 + ThriftTestUtils.clientLog $ show v2 + + v3 <- Client.testByte ps (-8) + ThriftTestUtils.clientLog $ show v3 + + v4 <- Client.testI32 ps 32 + ThriftTestUtils.clientLog $ show v4 + + v5 <- Client.testI32 ps (-32) + ThriftTestUtils.clientLog $ show v5 + + v6 <- Client.testI64 ps 64 + ThriftTestUtils.clientLog $ show v6 + + v7 <- Client.testI64 ps (-64) + ThriftTestUtils.clientLog $ show v7 + + v8 <- Client.testDouble ps 3.14 + ThriftTestUtils.clientLog $ show v8 + + v9 <- Client.testDouble ps (-3.14) + ThriftTestUtils.clientLog $ show v9 + + -- TODO: Client.testBinary ... + + v10 <- Client.testMap ps (Map.fromList [(1,1),(2,2),(3,3)]) + ThriftTestUtils.clientLog $ show v10 + + v11 <- Client.testStringMap ps (Map.fromList [("a","123"),("a b","with spaces "),("same","same"),("0","numeric key")]) + ThriftTestUtils.clientLog $ show v11 + + v12 <- Client.testList ps (Vector.fromList [1,2,3,4,5]) + ThriftTestUtils.clientLog $ show v12 + + v13 <- Client.testSet ps (Set.fromList [1,2,3,4,5]) + ThriftTestUtils.clientLog $ show v13 + + v14 <- Client.testStruct ps (Types.Xtruct "hi" 4 5 0) + ThriftTestUtils.clientLog $ show v14 + + (testException ps "bad") `Control.Exception.catch` testExceptionHandler + + (testMultiException ps "ok") `Control.Exception.catch` testMultiExceptionHandler1 + (testMultiException ps "bad") `Control.Exception.catch` testMultiExceptionHandler2 `Control.Exception.catch` testMultiExceptionHandler3 + + -- ( (Client.testMultiException ps "e" "e2">> ThriftTestUtils.clientLog "bad") `Control.Exception.catch` + + tClose to + where testException ps msg = do + _ <- Client.testException ps "e" + ThriftTestUtils.clientLog msg + return () + + testExceptionHandler (e :: Types.Xception) = do + ThriftTestUtils.clientLog $ show e + + testMultiException ps msg = do + _ <- Client.testMultiException ps "e" "e2" + ThriftTestUtils.clientLog msg + return () + + testMultiExceptionHandler1 (e :: Types.Xception) = do + ThriftTestUtils.clientLog $ show e + + testMultiExceptionHandler2 (e :: Types.Xception2) = do + ThriftTestUtils.clientLog $ show e + + testMultiExceptionHandler3 (_ :: Control.Exception.SomeException) = do + ThriftTestUtils.clientLog "ok" + + +server :: Network.PortNumber -> IO () +server port = do + ThriftTestUtils.serverLog "Ready..." + (runBasicServer TestHandler ThriftTest.process port) + `Control.Exception.catch` + (\(TransportExn s _) -> error $ "FAILURE: " ++ s) + + +main :: IO () +main = ThriftTestUtils.runTest server client diff --git a/src/jaegertracing/thrift/test/hs/run-test.sh b/src/jaegertracing/thrift/test/hs/run-test.sh new file mode 100755 index 000000000..ecafc18b0 --- /dev/null +++ b/src/jaegertracing/thrift/test/hs/run-test.sh @@ -0,0 +1,43 @@ +#!/bin/sh + +# +# Licensed to the Apache Software Foundation (ASF) under one +# or more contributor license agreements. See the NOTICE file +# distributed with this work for additional information +# regarding copyright ownership. The ASF licenses this file +# to you under the Apache License, Version 2.0 (the +# "License"); you may not use this file except in compliance +# with the License. You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, +# software distributed under the License is distributed on an +# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY +# KIND, either express or implied. See the License for the +# specific language governing permissions and limitations +# under the License. +# + +if [ "x" = "x$1" ]; then + printf "run-test.sh needs an argument, the name of the test to run. Try 'ThriftTest' or 'ProtoDebugTest'\n" + exit 2 +fi + +# Check some basics +if [ -z $BASE ]; then + BASE=../.. +fi + +# Figure out what file to run has a server +if [ -z $TEST_SOURCE_FILE ]; then + TEST_SOURCE_FILE=$BASE/test/hs/$1_Main.hs +fi + +if [ ! -e $TEST_SOURCE_FILE ]; then + printf "Missing server code file $TEST_SOURCE_FILE \n" + exit 3 +fi + +printf "Running test... \n" +runhaskell -Wall -XScopedTypeVariables -i$BASE/lib/hs/src -igen-hs $TEST_SOURCE_FILE -- cgit v1.2.3