mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-05 10:49:42 +01:00
9113e416e7
* 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
85 lines
3.2 KiB
Haskell
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]
|