eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-11-26 21:19:43 +01:00
Code Issues Projects Releases Wiki Activity

Minor consistency refactors to test case declaration code

Browse source
This commit is contained in:
Joel Stanley 2016-05-25 10:19:40 -07:00
parent 2262860af1
commit 562ca8c27c
1 changed files with 59 additions and 64 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

123
tests/LowLevelTests.hs
View file

@ -37,26 +37,30 @@ lowLevelTests = testGroup "Unit tests of low-level Haskell library"
dummyMeta :: M.Map ByteString ByteString dummyMeta :: M.Map ByteString ByteString
dummyMeta = M.fromList [("foo","bar")] dummyMeta = M.fromList [("foo","bar")]
-- | Boilerplate for naming a GRPC unit test
gtc :: TestName -> (GRPC -> IO ()) -> TestTree
gtc nm = testCase nm . withGRPC
nop :: Monad m => a -> m ()
nop = const (return ())
testGRPCBracket :: TestTree testGRPCBracket :: TestTree
testGRPCBracket = testCase "Start/stop GRPC" $ testGRPCBracket = gtc "Start/stop GRPC" nop
withGRPC $ const $ return ()
testCompletionQueueCreateDestroy :: TestTree testCompletionQueueCreateDestroy :: TestTree
testCompletionQueueCreateDestroy = testCompletionQueueCreateDestroy =
testCase "Create/destroy completion queue" $ withGRPC $ \grpc -> gtc "Create/destroy completion queue" $ \grpc -> do
withCompletionQueue grpc $ const (return ()) withCompletionQueue grpc nop
testServerCreateDestroy :: TestTree testServerCreateDestroy :: TestTree
testServerCreateDestroy = testServerCreateDestroy =
testCase "Server - start/stop" $ gtc "Server - start/stop" $ \grpc -> do
withGRPC $ \grpc -> withServer grpc (ServerConfig "localhost" 50051 []) withServer grpc (ServerConfig "localhost" 50051 []) nop
(const $ return ())
testClientCreateDestroy :: TestTree testClientCreateDestroy :: TestTree
testClientCreateDestroy = testClientCreateDestroy =
testCase "Client - start/stop" $ gtc "Client - start/stop" $ \grpc -> do
withGRPC $ \grpc -> withClient grpc (ClientConfig "localhost" 50051) withClient grpc (ClientConfig "localhost" 50051) nop
(const $ return ())
testPayloadLowLevelServer :: GRPC -> IO () testPayloadLowLevelServer :: GRPC -> IO ()
testPayloadLowLevelServer grpc = do testPayloadLowLevelServer grpc = do
@ -108,74 +112,67 @@ testPayloadLowLevelServerUnregistered grpc = do
testClientRequestNoServer :: TestTree testClientRequestNoServer :: TestTree
testClientRequestNoServer = testClientRequestNoServer =
testCase "Client - request timeout when server DNE" $ gtc "Client - request timeout when server DNE" $ \grpc -> do
withGRPC $ \grpc -> do withClient grpc (ClientConfig "localhost" 50051) $ \client -> do
withClient grpc (ClientConfig "localhost" 50051) $ \client -> do method <- clientRegisterMethod client "/foo" "localhost" Normal
method <- clientRegisterMethod client "/foo" "localhost" Normal reqResult <- clientRegisteredRequest client method 1 "Hello" M.empty
reqResult <- clientRegisteredRequest client method 1 "Hello" M.empty reqResult @?= (Left GRPCIOTimeout)
reqResult @?= (Left GRPCIOTimeout)
testServerAwaitNoClient :: TestTree testServerAwaitNoClient :: TestTree
testServerAwaitNoClient = testServerAwaitNoClient =
testCase "Server - registered call handler timeout" $ gtc "Server - registered call handler timeout" $ \grpc -> do
withGRPC $ \grpc -> do let conf = (ServerConfig "localhost" 50051 [("/foo", "localhost", Normal)])
let conf = (ServerConfig "localhost" 50051 [("/foo", "localhost", Normal)]) withServer grpc conf $ \server -> do
withServer grpc conf $ \server -> do let method = head (registeredMethods server)
let method = head (registeredMethods server) result <- serverHandleNormalRegisteredCall server method 1 M.empty $
result <- serverHandleNormalRegisteredCall server method 1 M.empty $ \_ _ -> return ("", M.empty, M.empty, StatusDetails "details")
\_ _ -> return ("", M.empty, M.empty, StatusDetails "details") result @?= Left GRPCIOTimeout
result @?= Left GRPCIOTimeout
testServerUnregisteredAwaitNoClient :: TestTree testServerUnregisteredAwaitNoClient :: TestTree
testServerUnregisteredAwaitNoClient = testServerUnregisteredAwaitNoClient =
testCase "Server - unregistered call handler timeout" $ gtc "Server - unregistered call handler timeout" $ \grpc -> do
withGRPC $ \grpc -> do let conf = ServerConfig "localhost" 50051 []
let conf = ServerConfig "localhost" 50051 [] withServer grpc conf $ \server -> do
withServer grpc conf $ \server -> do result <- serverHandleNormalCall server 10 M.empty $
result <- serverHandleNormalCall server 10 M.empty $ \_ _ -> return ("", M.empty, StatusDetails "")
\_ _ -> return ("", M.empty, StatusDetails "") case result of
case result of Left err -> error $ show err
Left err -> error $ show err Right _ -> return ()
Right _ -> return ()
testPayloadLowLevel :: TestTree testPayloadLowLevel :: TestTree
testPayloadLowLevel = testPayloadLowLevel =
testCase "Client/Server - low-level (registered) request/response" $ gtc "Client/Server - low-level (registered) request/response" $ \grpc -> do
withGRPC $ \grpc -> do withAsync (testPayloadLowLevelServer grpc) $ \a1 -> do
withAsync (testPayloadLowLevelServer grpc) $ \a1 -> do withAsync (testPayloadLowLevelClient grpc) $ \a2 -> do
withAsync (testPayloadLowLevelClient grpc) $ \a2 -> do wait a1
wait a1 wait a2
wait a2
testPayloadLowLevelUnregistered :: TestTree testPayloadLowLevelUnregistered :: TestTree
testPayloadLowLevelUnregistered = testPayloadLowLevelUnregistered =
testCase "Client/Server - low-level unregistered request/response" $ do gtc "Client/Server - low-level unregistered request/response" $ \grpc -> do
withGRPC $ \grpc -> do withAsync (testPayloadLowLevelServerUnregistered grpc) $ \a1 ->
withAsync (testPayloadLowLevelServerUnregistered grpc) $ \a1 -> withAsync (testPayloadLowLevelClientUnregistered grpc) $ \a2 -> do
withAsync (testPayloadLowLevelClientUnregistered grpc) $ \a2 -> do wait a1
wait a1 wait a2
wait a2
testWithServerCall :: TestTree testWithServerCall :: TestTree
testWithServerCall = testWithServerCall =
testCase "Server - Create/destroy call" $ gtc "Server - Create/destroy call" $ \grpc -> do
withGRPC $ \grpc -> do let conf = ServerConfig "localhost" 50051 []
let conf = ServerConfig "localhost" 50051 [] withServer grpc conf $ \server -> do
withServer grpc conf $ \server -> do result <- withServerCall server 1 $ const $ return $ Right ()
result <- withServerCall server 1 $ const $ return $ Right () result @?= Left GRPCIOTimeout
result @?= Left GRPCIOTimeout
testWithClientCall :: TestTree testWithClientCall :: TestTree
testWithClientCall = testWithClientCall =
testCase "Client - Create/destroy call" $ gtc "Client - Create/destroy call" $ \grpc -> do
withGRPC $ \grpc -> do let conf = ClientConfig "localhost" 50051
let conf = ClientConfig "localhost" 50051 withClient grpc conf $ \client -> do
withClient grpc conf $ \client -> do result <- withClientCall client "foo" "localhost" 10 $
result <- withClientCall client "foo" "localhost" 10 $ const $ return $ Right ()
const $ return $ Right () case result of
case result of Left err -> error $ show err
Left err -> error $ show err Right _ -> return ()
Right _ -> return ()
assertCqEventComplete :: Event -> IO () assertCqEventComplete :: Event -> IO ()
assertCqEventComplete e = do assertCqEventComplete e = do
@ -302,11 +299,9 @@ testPayloadServer = do
-- This is intended to test the low-level C bindings, so we use only a few -- This is intended to test the low-level C bindings, so we use only a few
-- minimal abstractions on top of it. -- minimal abstractions on top of it.
testPayload :: TestTree testPayload :: TestTree
testPayload = testCase "Client/Server - End-to-end request/response" $ do testPayload =
grpcInit gtc "Client/Server - End-to-end request/response" $ \_ ->
withAsync testPayloadServer $ \a1 -> do withAsync testPayloadServer $ \a1 -> do
withAsync testPayloadClient $ \a2 -> do withAsync testPayloadClient $ \a2 -> do
wait a1 wait a1
wait a2 wait a2
grpcShutdown
putStrLn "Done."