gRPC-haskell/tests/LowLevelTests/Op.hs
Connor Clark 9113e416e7 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 11:28:21 -07:00

85 lines
3.2 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module LowLevelTests.Op where
import Data.ByteString (ByteString, isPrefixOf)
import Test.Tasty
import Test.Tasty.HUnit as HU (testCase, (@?=),
assertBool)
import Network.GRPC.LowLevel
import Network.GRPC.LowLevel.Call
import Network.GRPC.LowLevel.Client
import Network.GRPC.LowLevel.Server
import Network.GRPC.LowLevel.Op
lowLevelOpTests :: TestTree
lowLevelOpTests = testGroup "Synchronous unit tests of low-level Op interface"
[testCancelFromServer]
testCancelFromServer :: TestTree
testCancelFromServer =
testCase "Client/Server - client receives server cancellation" $
runSerialTest $ \grpc ->
withClientServerUnaryCall grpc $
\(Client{..}, Server{..}, ClientCall{..}, sc@ServerCall{..}) -> do
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
assertBool "Received status details or RST_STREAM error" $
details == "TestStatus"
||
isPrefixOf "Received RST_STREAM" details
return $ Right ()
wrong -> error $ "Unexpected op results: " ++ show wrong
runSerialTest :: (GRPC -> IO (Either GRPCIOError ())) -> IO ()
runSerialTest f =
withGRPC f >>= \case Left x -> error $ show x
Right () -> return ()
withClientServerUnaryCall :: GRPC
-> ((Client, Server, ClientCall,
ServerCall ByteString)
-> IO (Either GRPCIOError a))
-> IO (Either GRPCIOError a)
withClientServerUnaryCall grpc f = do
withClient grpc clientConf $ \c -> do
crm <- clientRegisterMethodNormal c "/foo"
withServer grpc serverConf $ \s ->
withClientCall c crm 10 $ \cc -> do
let srm = head (normalMethods s)
-- 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
withServerCall s srm $ \sc ->
f (c, s, cc, sc)
serverConf :: ServerConfig
serverConf = ServerConfig "localhost" 50051 [("/foo")] [] [] [] []
clientConf :: ClientConfig
clientConf = ClientConfig "localhost" 50051 []
clientEmptySendOps :: [Op]
clientEmptySendOps = [OpSendInitialMetadata mempty,
OpSendMessage "",
OpSendCloseFromClient]
clientRecvOps :: [Op]
clientRecvOps = [OpRecvInitialMetadata,
OpRecvMessage,
OpRecvStatusOnClient]
serverEmptyRecvOps :: [Op]
serverEmptyRecvOps = [OpSendInitialMetadata mempty,
OpRecvMessage,
OpRecvCloseOnServer]