Add runClientServer boilerplate reducer

This commit is contained in:
Joel Stanley 2016-05-25 10:34:03 -07:00
parent 562ca8c27c
commit c9d06c9ec7

View file

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