gRPC-haskell/core/tests/LowLevelTests/Op.hs

104 lines
3.1 KiB
Haskell
Raw Permalink Normal View History

2021-03-08 22:44:36 +01:00
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
2021-03-08 22:44:36 +01:00
{-# LANGUAGE RecordWildCards #-}
module LowLevelTests.Op where
2021-03-08 22:44:36 +01:00
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.ByteString (ByteString)
import Network.GRPC.LowLevel
import Network.GRPC.LowLevel.Call
import Network.GRPC.LowLevel.Client
import Network.GRPC.LowLevel.Op
import Network.GRPC.LowLevel.Server
import Test.Tasty
import Test.Tasty.HUnit as HU (testCase, (@?=))
lowLevelOpTests :: TestTree
2021-03-08 22:44:36 +01:00
lowLevelOpTests =
testGroup
"Synchronous unit tests of low-level Op interface"
[testCancelFromServer]
testCancelFromServer :: TestTree
testCancelFromServer =
testCase "Client/Server - client receives server cancellation" $
2021-03-08 22:44:36 +01:00
runSerialTest $ \grpc ->
withClientServerUnaryCall grpc $
\(Client {..}, Server {}, ClientCall {..}, sc@ServerCall {}) -> do
2021-03-08 22:44:36 +01:00
serverCallCancel sc StatusPermissionDenied "TestStatus"
clientRes <- runOps unsafeCC clientCQ clientRecvOps
case clientRes of
Left x -> error $ "Client recv error: " ++ show x
Right [_, _, OpRecvStatusOnClientResult _ code _details] -> do
code @?= StatusPermissionDenied
return $ Right ()
wrong -> error $ "Unexpected op results: " ++ show wrong
runSerialTest :: (GRPC -> IO (Either GRPCIOError ())) -> IO ()
runSerialTest f =
2021-03-08 22:44:36 +01:00
withGRPC f >>= \case
Left x -> error $ show x
Right () -> return ()
2021-03-08 22:44:36 +01:00
withClientServerUnaryCall ::
GRPC ->
( ( Client,
Server,
ClientCall,
ServerCall ByteString
) ->
IO (Either GRPCIOError a)
) ->
IO (Either GRPCIOError a)
withClientServerUnaryCall grpc f = do
withClient grpc clientConf $ \c -> do
Joel/highlevelv2 (#40) * Tweak runOps param order, inline common op sequences, clean up serverHandleNormalCall * More ops sequence inlining for clarity, experimenting with Managed * Checkpoint: preliminary support for all streaming modes; much cleanup/refactoring and api design still needed * Use mempty for default StatusDetails; tweak bad status matching mechanism * Preliminary user-facing, server-streaming, low-level api and test * renaming wibbles * Preliminary user-facing, client-streaming, low-level api and test * Move sendMsgs comb to Network.GRPC.LowLevel.Op; misc cleanup/DCR * Modify bidi streaming to omit request payload * Add transformers dep * Preliminary user-facing low-level bidirectional streaming api and test * Fix missing peek import * Remove TimeoutSeconds params on streaming mode functions * Fix serverHandleNormalCall rebase wart * Fix rebase warts; minor hlint fixes and wibbles * Post-rebase tweaks to optional payload use in serverRequestCall (i.e., now respects payloadHandling again) * Cleanup/refactor serverRequestCall * Fix comment * Change ServerRWHandler type so that handler does not have to invoke a finalizer * Change ServerReaderHandler type so that handler does not have to invoke a finalizer * Simplify serverWriter interface and ServerWriterHandler structure * Simplify serverRW (get rid of exec param), improve bidi streaming tests * Use ExceptT in serverRW impl * Change ServerRWHandler type to pass recv/send operations. * Renaming * Define ClientRWHandler, pass recv/send ops * wibbles * Use ExceptT in clientRW impl * Add DataKinded phantom typing to RegisteredMethod; misc cleanup * Simplify sendMsgs interface; add SingleSend type and related helpers * Rename SingleSend to SendSingle, use ExceptT to clean up {client,server}Writer and sendMsgs * More ExceptT cleanup in clientWriter * Factor out reusable bits of clientWriter * Shrink ServerReaderHandler * Delete stale comments * begin high-level server interface * update to datakind representation * clean up * move method type info to type level, parametrize ServerCall by payload * convert for writer handler * start switching over to Message-based handlers * begin work on highlevel example * comment out old code * parametrize StreamSend * parametrize StreamRecv * conversion for ServerReaderHandler * finish handler conversions * Add high level version and payload checking to echo-client * Decouple server CQs from call-bound CQs (registered methods); use more consistent naming conventions * Decouple server/call-bound CQs for unregistered methods; refactor U.serverRequestCall; misc cleanup * Make convertRecv total; formatting wibbles
2016-07-12 20:28:21 +02:00
crm <- clientRegisterMethodNormal c "/foo"
2021-03-08 22:44:36 +01:00
withServer grpc serverConf $ \s -> do
ccVar <- newEmptyMVar
bracket newEmptyMVar (\v -> putMVar v ()) $ \finished -> do
_ <- forkIO $
void $
withClientCall c crm 10 $ \cc -> do
putMVar ccVar cc
-- NOTE: We need to send client ops here or else `withServerCall` hangs,
-- because registered methods try to do recv ops immediately when
-- created. If later we want to send payloads or metadata, we'll need
-- to tweak this.
_clientRes <- runOps (unsafeCC cc) (clientCQ c) clientEmptySendOps
takeMVar finished
pure (Right ())
Preliminary streaming mode support (client streaming, server streaming, bidirectional) (#37) * Tweak runOps param order, inline common op sequences, clean up serverHandleNormalCall * More ops sequence inlining for clarity, experimenting with Managed * Checkpoint: preliminary support for all streaming modes; much cleanup/refactoring and api design still needed * Use mempty for default StatusDetails; tweak bad status matching mechanism * Preliminary user-facing, server-streaming, low-level api and test * renaming wibbles * Preliminary user-facing, client-streaming, low-level api and test * Move sendMsgs comb to Network.GRPC.LowLevel.Op; misc cleanup/DCR * Modify bidi streaming to omit request payload * Add transformers dep * Preliminary user-facing low-level bidirectional streaming api and test * Fix missing peek import * Remove TimeoutSeconds params on streaming mode functions * Fix serverHandleNormalCall rebase wart * Fix rebase warts; minor hlint fixes and wibbles * Post-rebase tweaks to optional payload use in serverRequestCall (i.e., now respects payloadHandling again) * Cleanup/refactor serverRequestCall * Fix comment * Change ServerRWHandler type so that handler does not have to invoke a finalizer * Change ServerReaderHandler type so that handler does not have to invoke a finalizer * Simplify serverWriter interface and ServerWriterHandler structure * Simplify serverRW (get rid of exec param), improve bidi streaming tests * Use ExceptT in serverRW impl * Change ServerRWHandler type to pass recv/send operations. * Renaming * Define ClientRWHandler, pass recv/send ops * wibbles * Use ExceptT in clientRW impl * Add DataKinded phantom typing to RegisteredMethod; misc cleanup * Simplify sendMsgs interface; add SingleSend type and related helpers * Rename SingleSend to SendSingle, use ExceptT to clean up {client,server}Writer and sendMsgs * More ExceptT cleanup in clientWriter * Factor out reusable bits of clientWriter * Shrink ServerReaderHandler * Delete stale comments * Use common machinery for all streaming modes; make handler types more consistent * wibbles
2016-07-06 15:59:38 +02:00
let srm = head (normalMethods s)
2021-03-08 22:44:36 +01:00
cc <- takeMVar ccVar
withServerCall s srm $ \sc ->
f (c, s, cc, sc)
2016-06-23 23:35:11 +02:00
serverConf :: ServerConfig
serverConf = ServerConfig "localhost" 50051 [("/foo")] [] [] [] [] Nothing
2016-06-23 23:35:11 +02:00
clientConf :: ClientConfig
clientConf = ClientConfig "localhost" 50051 [] Nothing Nothing
2016-06-23 23:35:11 +02:00
clientEmptySendOps :: [Op]
2021-03-08 22:44:36 +01:00
clientEmptySendOps =
[ OpSendInitialMetadata mempty,
OpSendMessage "",
OpSendCloseFromClient
]
2016-06-23 23:35:11 +02:00
clientRecvOps :: [Op]
2021-03-08 22:44:36 +01:00
clientRecvOps =
[ OpRecvInitialMetadata,
OpRecvMessage,
OpRecvStatusOnClient
]
2016-06-23 23:35:11 +02:00
serverEmptyRecvOps :: [Op]
2021-03-08 22:44:36 +01:00
serverEmptyRecvOps =
[ OpSendInitialMetadata mempty,
OpRecvMessage,
OpRecvCloseOnServer
]