eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-06-26 14:38:35 +02:00
Code Issues Projects Releases Wiki Activity

Add runClientServer boilerplate reducer

Browse Source
This commit is contained in:
Joel Stanley 2016-05-25 10:34:03 -07:00
parent 562ca8c27c
commit c9d06c9ec7
1 changed files with 25 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
tests/LowLevelTests.hs
View File

@ -37,13 +37,6 @@ lowLevelTests = testGroup "Unit tests of low-level Haskell library"
dummyMeta :: M.Map ByteString ByteString
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 = gtc "Start/stop GRPC" nop
@ -141,19 +134,13 @@ testServerUnregisteredAwaitNoClient =
testPayloadLowLevel :: TestTree
testPayloadLowLevel =
gtc "Client/Server - low-level (registered) request/response" $ \grpc -> do
withAsync (testPayloadLowLevelServer grpc) $ \a1 -> do
withAsync (testPayloadLowLevelClient grpc) $ \a2 -> do
wait a1
wait a2
gtc "Client/Server - low-level (registered) request/response" $
runClientServer testPayloadLowLevelClient testPayloadLowLevelServer
testPayloadLowLevelUnregistered :: TestTree
testPayloadLowLevelUnregistered =
gtc "Client/Server - low-level unregistered request/response" $ \grpc -> do
withAsync (testPayloadLowLevelServerUnregistered grpc) $ \a1 ->
withAsync (testPayloadLowLevelClientUnregistered grpc) $ \a2 -> do
wait a1
wait a2
gtc "Client/Server - low-level unregistered request/response" $
runClientServer testPayloadLowLevelClientUnregistered testPayloadLowLevelServerUnregistered
testWithServerCall :: TestTree
testWithServerCall =
@ -179,8 +166,8 @@ assertCqEventComplete e = do
eventCompletionType e HU.@?= OpComplete
eventSuccess e HU.@?= True
testPayloadClient :: IO ()
testPayloadClient = do
testPayloadClient :: GRPC -> IO ()
testPayloadClient _grpc = do
client <- grpcInsecureChannelCreate "localhost:50051" nullPtr reserved
cq <- grpcCompletionQueueCreate reserved
withMetadataArrayPtr $ \initialMetadataRecv -> do
@ -226,8 +213,8 @@ testPayloadClient = do
grpcCompletionQueueDestroy cq
grpcChannelDestroy client
testPayloadServer :: IO ()
testPayloadServer = do
testPayloadServer :: GRPC -> IO ()
testPayloadServer _grpc = do
server <- grpcServerCreate nullPtr reserved
cq <- grpcCompletionQueueCreate reserved
grpcServerRegisterCompletionQueue server cq reserved
@ -300,8 +287,22 @@ testPayloadServer = do
-- minimal abstractions on top of it.
testPayload :: TestTree
testPayload =
gtc "Client/Server - End-to-end request/response" $ \_ ->
withAsync testPayloadServer $ \a1 -> do
withAsync testPayloadClient $ \a2 -> do
gtc "Client/Server - End-to-end request/response" $
runClientServer testPayloadClient testPayloadServer
--------------------------------------------------------------------------------
-- Utility functions
-- | 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 ())
runClientServer :: (GRPC -> IO ()) -> (GRPC -> IO ()) -> GRPC -> IO ()
runClientServer client server grpc = do
withAsync (server grpc) $ \a1 -> do
withAsync (client grpc) $ \a2 -> do
wait a1
wait a2