Rename reg operations in all modules; use qualified imports whenever selecting unregistered variants

This commit is contained in:
Joel Stanley 2016-06-08 14:38:01 -05:00
parent b08ae78dd1
commit 8069ebba07
15 changed files with 240 additions and 223 deletions

View file

@ -1,19 +1,20 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-}
import Control.Monad import Control.Monad
import Network.GRPC.LowLevel import Network.GRPC.LowLevel
import qualified Network.GRPC.LowLevel.Client.Unregistered as U
echoMethod = MethodName "/echo.Echo/DoEcho" echoMethod = MethodName "/echo.Echo/DoEcho"
unregistered c = do unregistered c = do
clientRequest c echoMethod 1 "hi" mempty U.clientRequest c echoMethod 1 "hi" mempty
registered c = do registered c = do
meth <- clientRegisterMethod c echoMethod Normal meth <- clientRegisterMethod c echoMethod Normal
clientRegisteredRequest c meth 1 "hi" mempty clientRequest c meth 1 "hi" mempty
run f = withGRPC $ \g -> withClient g (ClientConfig "localhost" 50051) $ \c -> run f = withGRPC $ \g -> withClient g (ClientConfig "localhost" 50051) $ \c ->
f c >>= \case f c >>= \case

View file

@ -33,7 +33,7 @@ regMain = withGRPC $ \grpc -> do
withServer grpc (ServerConfig "localhost" 50051 methods) $ \server -> withServer grpc (ServerConfig "localhost" 50051 methods) $ \server ->
forever $ do forever $ do
let method = head (registeredMethods server) let method = head (registeredMethods server)
result <- serverHandleNormalRegisteredCall server method 15 serverMeta $ result <- serverHandleNormalCall server method 15 serverMeta $
\reqBody _reqMeta -> return (reqBody, serverMeta, serverMeta, \reqBody _reqMeta -> return (reqBody, serverMeta, serverMeta,
StatusDetails "") StatusDetails "")
case result of case result of
@ -43,7 +43,7 @@ regMain = withGRPC $ \grpc -> do
-- | loop to fork n times -- | loop to fork n times
regLoop :: Server -> RegisteredMethod -> IO () regLoop :: Server -> RegisteredMethod -> IO ()
regLoop server method = forever $ do regLoop server method = forever $ do
result <- serverHandleNormalRegisteredCall server method 15 serverMeta $ result <- serverHandleNormalCall server method 15 serverMeta $
\reqBody _reqMeta -> return (reqBody, serverMeta, serverMeta, \reqBody _reqMeta -> return (reqBody, serverMeta, serverMeta,
StatusDetails "") StatusDetails "")
case result of case result of

View file

@ -43,6 +43,7 @@ library
Network.GRPC.Unsafe Network.GRPC.Unsafe
Network.GRPC.LowLevel Network.GRPC.LowLevel
Network.GRPC.LowLevel.Server.Unregistered Network.GRPC.LowLevel.Server.Unregistered
Network.GRPC.LowLevel.Client.Unregistered
other-modules: other-modules:
Network.GRPC.LowLevel.CompletionQueue Network.GRPC.LowLevel.CompletionQueue
Network.GRPC.LowLevel.CompletionQueue.Internal Network.GRPC.LowLevel.CompletionQueue.Internal
@ -54,7 +55,6 @@ library
Network.GRPC.LowLevel.Call Network.GRPC.LowLevel.Call
Network.GRPC.LowLevel.Call.Unregistered Network.GRPC.LowLevel.Call.Unregistered
Network.GRPC.LowLevel.Client Network.GRPC.LowLevel.Client
Network.GRPC.LowLevel.Client.Unregistered
extra-libraries: extra-libraries:
grpc grpc
includes: includes:

View file

@ -29,11 +29,11 @@ GRPC
-- * Server -- * Server
, ServerConfig(..) , ServerConfig(..)
, Server , Server
, ServerRegCall , ServerCall
, registeredMethods , registeredMethods
, withServer , withServer
, serverHandleNormalRegisteredCall , serverHandleNormalCall
, withServerRegisteredCall , withServerCall
-- * Client -- * Client
, ClientConfig(..) , ClientConfig(..)
@ -43,13 +43,12 @@ GRPC
, clientConnectivity , clientConnectivity
, withClient , withClient
, clientRegisterMethod , clientRegisterMethod
, clientRegisteredRequest
, clientRequest , clientRequest
, withClientCall , withClientCall
-- * Ops -- * Ops
, runClientOps , runClientOps
, runServerRegOps , runServerOps
, Op(..) , Op(..)
, OpRecvResult(..) , OpRecvResult(..)
@ -60,7 +59,6 @@ import Network.GRPC.LowLevel.Server
import Network.GRPC.LowLevel.CompletionQueue import Network.GRPC.LowLevel.CompletionQueue
import Network.GRPC.LowLevel.Op import Network.GRPC.LowLevel.Op
import Network.GRPC.LowLevel.Client import Network.GRPC.LowLevel.Client
import Network.GRPC.LowLevel.Client.Unregistered
import Network.GRPC.LowLevel.Call import Network.GRPC.LowLevel.Call
import Network.GRPC.Unsafe (ConnectivityState(..)) import Network.GRPC.Unsafe (ConnectivityState(..))

View file

@ -54,32 +54,31 @@ data RegisteredMethod = RegisteredMethod {methodType :: GRPCMethodType,
-- | Represents one GRPC call (i.e. request) on the client. -- | Represents one GRPC call (i.e. request) on the client.
-- This is used to associate send/receive 'Op's with a request. -- This is used to associate send/receive 'Op's with a request.
data ClientCall = ClientCall {internalClientCall :: C.Call} data ClientCall = ClientCall { unClientCall :: C.Call }
-- | Represents one registered GRPC call on the server. -- | Represents one registered GRPC call on the server. Contains pointers to all
-- Contains pointers to all the C state needed to respond to a registered call. -- the C state needed to respond to a registered call.
data ServerRegCall = ServerRegCall data ServerCall = ServerCall
{internalServerRegCall :: C.Call, { unServerCall :: C.Call,
requestMetadataRecvReg :: Ptr C.MetadataArray, requestMetadataRecv :: Ptr C.MetadataArray,
optionalPayload :: Ptr C.ByteBuffer, optionalPayload :: Ptr C.ByteBuffer,
parentPtrReg :: Maybe (Ptr C.Call), parentPtr :: Maybe (Ptr C.Call),
callDeadline :: C.CTimeSpecPtr callDeadline :: C.CTimeSpecPtr
} }
serverRegCallGetMetadata :: ServerRegCall -> IO MetadataMap serverCallGetMetadata :: ServerCall -> IO MetadataMap
serverRegCallGetMetadata ServerRegCall{..} = do serverCallGetMetadata ServerCall{..} = do
marray <- peek requestMetadataRecvReg marray <- peek requestMetadataRecv
C.getAllMetadataArray marray C.getAllMetadataArray marray
-- | Extract the client request body from the given registered call, if present. -- | Extract the client request body from the given call, if present. TODO: the
-- TODO: the reason this returns @Maybe ByteString@ is because the gRPC library -- reason this returns @Maybe ByteString@ is because the gRPC library calls the
-- calls the underlying out parameter "optional_payload". I am not sure exactly -- underlying out parameter "optional_payload". I am not sure exactly in what
-- in what cases it won't be present. The C++ library checks a -- cases it won't be present. The C++ library checks a has_request_payload_ bool
-- has_request_payload_ bool and passes in nullptr to request_registered_call -- and passes in nullptr to request_registered_call if the bool is false, so we
-- if the bool is false, so we may be able to do the payload present/absent -- may be able to do the payload present/absent check earlier.
-- check earlier. serverCallGetPayload :: ServerCall -> IO (Maybe ByteString)
serverRegCallGetPayload :: ServerRegCall -> IO (Maybe ByteString) serverCallGetPayload ServerCall{..} = do
serverRegCallGetPayload ServerRegCall{..} = do
bb@(C.ByteBuffer rawPtr) <- peek optionalPayload bb@(C.ByteBuffer rawPtr) <- peek optionalPayload
if rawPtr == nullPtr if rawPtr == nullPtr
then return Nothing then return Nothing
@ -94,48 +93,47 @@ debugClientCall (ClientCall (C.Call ptr)) =
debugClientCall = const $ return () debugClientCall = const $ return ()
#endif #endif
debugServerRegCall :: ServerRegCall -> IO () debugServerCall :: ServerCall -> IO ()
#ifdef DEBUG #ifdef DEBUG
debugServerRegCall call@(ServerRegCall (C.Call ptr) _ _ _ _) = do debugServerCall call@(ServerCall (C.Call ptr) _ _ _ _) = do
grpcDebug $ "debugServerRegCall: server call: " ++ (show ptr) grpcDebug $ "debugServerCall(R): server call: " ++ (show ptr)
grpcDebug $ "debugServerRegCall: metadata ptr: " grpcDebug $ "debugServerCall(R): metadata ptr: "
++ show (requestMetadataRecvReg call) ++ show (requestMetadataRecv call)
metadataArr <- peek (requestMetadataRecvReg call) metadataArr <- peek (requestMetadataRecv call)
metadata <- C.getAllMetadataArray metadataArr metadata <- C.getAllMetadataArray metadataArr
grpcDebug $ "debugServerRegCall: metadata received: " ++ (show metadata) grpcDebug $ "debugServerCall(R): metadata received: " ++ (show metadata)
grpcDebug $ "debugServerRegCall: payload ptr: " ++ show (optionalPayload call) grpcDebug $ "debugServerCall(R): payload ptr: " ++ show (optionalPayload call)
payload <- peek (optionalPayload call) payload <- peek (optionalPayload call)
bs <- C.copyByteBufferToByteString payload bs <- C.copyByteBufferToByteString payload
grpcDebug $ "debugServerRegCall: payload contents: " ++ show bs grpcDebug $ "debugServerCall(R): payload contents: " ++ show bs
forM_ (parentPtrReg call) $ \parentPtr' -> do forM_ (parentPtr call) $ \parentPtr' -> do
grpcDebug $ "debugServerRegCall: parent ptr: " ++ show parentPtr' grpcDebug $ "debugServerCall(R): parent ptr: " ++ show parentPtr'
(C.Call parent) <- peek parentPtr' (C.Call parent) <- peek parentPtr'
grpcDebug $ "debugServerRegCall: parent: " ++ show parent grpcDebug $ "debugServerCall(R): parent: " ++ show parent
grpcDebug $ "debugServerRegCall: deadline ptr: " ++ show (callDeadline call) grpcDebug $ "debugServerCall(R): deadline ptr: " ++ show (callDeadline call)
timespec <- peek (callDeadline call) timespec <- peek (callDeadline call)
grpcDebug $ "debugServerRegCall: deadline: " ++ show (C.timeSpec timespec) grpcDebug $ "debugServerCall(R): deadline: " ++ show (C.timeSpec timespec)
#else #else
{-# INLINE debugServerRegCall #-} {-# INLINE debugServerCall #-}
debugServerRegCall = const $ return () debugServerCall = const $ return ()
#endif #endif
destroyClientCall :: ClientCall -> IO () destroyClientCall :: ClientCall -> IO ()
destroyClientCall ClientCall{..} = do destroyClientCall ClientCall{..} = do
grpcDebug "Destroying client-side call object." grpcDebug "Destroying client-side call object."
C.grpcCallDestroy internalClientCall C.grpcCallDestroy unClientCall
destroyServerRegCall :: ServerRegCall -> IO () destroyServerCall :: ServerCall -> IO ()
destroyServerRegCall call@ServerRegCall{..} = do destroyServerCall call@ServerCall{..} = do
grpcDebug "destroyServerRegCall: entered." grpcDebug "destroyServerCall(R): entered."
debugServerRegCall call debugServerCall call
grpcDebug $ "Destroying server-side call object: " grpcDebug $ "Destroying server-side call object: " ++ show unServerCall
++ show internalServerRegCall C.grpcCallDestroy unServerCall
C.grpcCallDestroy internalServerRegCall grpcDebug $ "destroying metadata array: " ++ show requestMetadataRecv
grpcDebug $ "destroying metadata array: " ++ show requestMetadataRecvReg C.metadataArrayDestroy requestMetadataRecv
C.metadataArrayDestroy requestMetadataRecvReg
grpcDebug $ "destroying optional payload" ++ show optionalPayload grpcDebug $ "destroying optional payload" ++ show optionalPayload
C.destroyReceivingByteBuffer optionalPayload C.destroyReceivingByteBuffer optionalPayload
grpcDebug $ "freeing parentPtr: " ++ show parentPtrReg grpcDebug $ "freeing parentPtr: " ++ show parentPtr
forM_ parentPtrReg free forM_ parentPtr free
grpcDebug $ "destroying deadline." ++ show callDeadline grpcDebug $ "destroying deadline." ++ show callDeadline
C.timespecDestroy callDeadline C.timespecDestroy callDeadline

View file

@ -3,21 +3,19 @@
module Network.GRPC.LowLevel.Call.Unregistered where module Network.GRPC.LowLevel.Call.Unregistered where
import Control.Monad import Control.Monad
import Foreign.Marshal.Alloc (free) import Foreign.Marshal.Alloc (free)
import Foreign.Ptr (Ptr) import Foreign.Ptr (Ptr)
import Foreign.Storable (peek) import Foreign.Storable (peek)
import Network.GRPC.LowLevel.Call (Host (..), MethodName (..))
import qualified Network.GRPC.Unsafe as C import Network.GRPC.LowLevel.GRPC (MetadataMap, grpcDebug)
import qualified Network.GRPC.Unsafe.Metadata as C import qualified Network.GRPC.Unsafe as C
import qualified Network.GRPC.Unsafe.Metadata as C
import Network.GRPC.LowLevel.Call
import Network.GRPC.LowLevel.GRPC (MetadataMap, grpcDebug)
-- | Represents one unregistered GRPC call on the server. -- | Represents one unregistered GRPC call on the server.
-- Contains pointers to all the C state needed to respond to an unregistered -- Contains pointers to all the C state needed to respond to an unregistered
-- call. -- call.
data ServerCall = ServerCall data ServerCall = ServerCall
{ internalServerCall :: C.Call { unServerCall :: C.Call
, requestMetadataRecv :: Ptr C.MetadataArray , requestMetadataRecv :: Ptr C.MetadataArray
, parentPtr :: Maybe (Ptr C.Call) , parentPtr :: Maybe (Ptr C.Call)
, callDetails :: C.CallDetails , callDetails :: C.CallDetails
@ -61,9 +59,8 @@ destroyServerCall :: ServerCall -> IO ()
destroyServerCall call@ServerCall{..} = do destroyServerCall call@ServerCall{..} = do
grpcDebug "destroyServerCall(U): entered." grpcDebug "destroyServerCall(U): entered."
debugServerCall call debugServerCall call
grpcDebug $ "Destroying server-side call object: " grpcDebug $ "Destroying server-side call object: " ++ show unServerCall
++ show internalServerCall C.grpcCallDestroy unServerCall
C.grpcCallDestroy internalServerCall
grpcDebug $ "destroying metadata array: " ++ show requestMetadataRecv grpcDebug $ "destroying metadata array: " ++ show requestMetadataRecv
C.metadataArrayDestroy requestMetadataRecv C.metadataArrayDestroy requestMetadataRecv
grpcDebug $ "freeing parentPtr: " ++ show parentPtr grpcDebug $ "freeing parentPtr: " ++ show parentPtr

View file

@ -58,7 +58,7 @@ clientConnectivity Client{..} =
C.grpcChannelCheckConnectivityState clientChannel False C.grpcChannelCheckConnectivityState clientChannel False
-- | Register a method on the client so that we can call it with -- | Register a method on the client so that we can call it with
-- 'clientRegisteredRequest'. -- 'clientRequest'.
clientRegisterMethod :: Client clientRegisterMethod :: Client
-> MethodName -> MethodName
-- ^ method name, e.g. "/foo" -- ^ method name, e.g. "/foo"
@ -74,27 +74,30 @@ clientRegisterMethod _ _ _ = error "Streaming methods not yet implemented."
-- | Create a new call on the client for a registered method. -- | Create a new call on the client for a registered method.
-- Returns 'Left' if the CQ is shutting down or if the job to create a call -- Returns 'Left' if the CQ is shutting down or if the job to create a call
-- timed out. -- timed out.
clientCreateRegisteredCall :: Client -> RegisteredMethod -> TimeoutSeconds clientCreateCall :: Client
-> IO (Either GRPCIOError ClientCall) -> RegisteredMethod
clientCreateRegisteredCall Client{..} RegisteredMethod{..} timeout = do -> TimeoutSeconds
-> IO (Either GRPCIOError ClientCall)
clientCreateCall Client{..} RegisteredMethod{..} timeout = do
let parentCall = C.Call nullPtr --Unsure what this does. null is safe, though. let parentCall = C.Call nullPtr --Unsure what this does. null is safe, though.
C.withDeadlineSeconds timeout $ \deadline -> do C.withDeadlineSeconds timeout $ \deadline -> do
channelCreateRegisteredCall clientChannel parentCall C.propagateDefaults channelCreateCall clientChannel parentCall C.propagateDefaults
clientCQ methodHandle deadline clientCQ methodHandle deadline
-- TODO: the error-handling refactor made this quite ugly. It could be fixed -- TODO: the error-handling refactor made this quite ugly. It could be fixed
-- by switching to ExceptT IO. -- by switching to ExceptT IO.
-- | Handles safe creation and cleanup of a client call -- | Handles safe creation and cleanup of a client call
withClientRegisteredCall :: Client -> RegisteredMethod -> TimeoutSeconds withClientCall :: Client
-> (ClientCall -> RegisteredMethod
-> IO (Either GRPCIOError a)) -> TimeoutSeconds
-> IO (Either GRPCIOError a) -> (ClientCall -> IO (Either GRPCIOError a))
withClientRegisteredCall client regmethod timeout f = do -> IO (Either GRPCIOError a)
createResult <- clientCreateRegisteredCall client regmethod timeout withClientCall client regmethod timeout f = do
createResult <- clientCreateCall client regmethod timeout
case createResult of case createResult of
Left x -> return $ Left x Left x -> return $ Left x
Right call -> f call `finally` logDestroy call Right call -> f call `finally` logDestroy call
where logDestroy c = grpcDebug "withClientRegisteredCall: destroying." where logDestroy c = grpcDebug "withClientCall(R): destroying."
>> destroyClientCall c >> destroyClientCall c
data NormalRequestResult = NormalRequestResult data NormalRequestResult = NormalRequestResult
@ -131,25 +134,24 @@ compileNormalRequestResults x =
-- server's response. TODO: This is preliminary until we figure out how many -- server's response. TODO: This is preliminary until we figure out how many
-- different variations on sending request ops will be needed for full gRPC -- different variations on sending request ops will be needed for full gRPC
-- functionality. -- functionality.
clientRegisteredRequest :: Client clientRequest :: Client
-> RegisteredMethod -> RegisteredMethod
-> TimeoutSeconds -> TimeoutSeconds
-- ^ Timeout of both the grpc_call and the -- ^ Timeout of both the grpc_call and the max time to wait for
-- max time to wait for the completion of the batch. -- the completion of the batch. TODO: I think we will need to
-- TODO: I think we will need to decouple the -- decouple the lifetime of the call from the queue deadline once
-- lifetime of the call from the queue deadline once -- we expose functionality for streaming calls, where one call
-- we expose functionality for streaming calls, where -- object persists across many batches.
-- one call object persists across many batches. -> ByteString
-> ByteString -- ^ The body of the request
-- ^ The body of the request. -> MetadataMap
-> MetadataMap -- ^ Metadata to send with the request
-- ^ Metadata to send with the request. -> IO (Either GRPCIOError NormalRequestResult)
-> IO (Either GRPCIOError NormalRequestResult) clientRequest client@(Client{..}) rm@(RegisteredMethod{..})
clientRegisteredRequest client@(Client{..}) rm@(RegisteredMethod{..}) timeLimit body meta =
timeLimit body meta =
fmap join $ case methodType of fmap join $ case methodType of
Normal -> withClientRegisteredCall client rm timeLimit $ \call -> do Normal -> withClientCall client rm timeLimit $ \call -> do
grpcDebug "clientRegisteredRequest: created call." grpcDebug "clientRequest(R): created call."
debugClientCall call debugClientCall call
-- NOTE: sendOps and recvOps *must* be in separate batches or -- NOTE: sendOps and recvOps *must* be in separate batches or
-- the client hangs when the server can't be reached. -- the client hangs when the server can't be reached.
@ -158,7 +160,7 @@ clientRegisteredRequest client@(Client{..}) rm@(RegisteredMethod{..})
, OpSendCloseFromClient] , OpSendCloseFromClient]
sendRes <- runClientOps call clientCQ sendOps timeLimit sendRes <- runClientOps call clientCQ sendOps timeLimit
case sendRes of case sendRes of
Left x -> do grpcDebug "clientRegisteredRequest: batch error." Left x -> do grpcDebug "clientRequest(R) : batch error."
return $ Left x return $ Left x
Right rs -> do Right rs -> do
let recvOps = [OpRecvInitialMetadata, let recvOps = [OpRecvInitialMetadata,
@ -167,7 +169,7 @@ clientRegisteredRequest client@(Client{..}) rm@(RegisteredMethod{..})
recvRes <- runClientOps call clientCQ recvOps timeLimit recvRes <- runClientOps call clientCQ recvOps timeLimit
case recvRes of case recvRes of
Left x -> do Left x -> do
grpcDebug "clientRegisteredRequest: batch error." grpcDebug "clientRequest(R): batch error."
return $ Left x return $ Left x
Right rs' -> do Right rs' -> do
return $ Right $ compileNormalRequestResults (rs ++ rs') return $ Right $ compileNormalRequestResults (rs ++ rs')

View file

@ -11,7 +11,11 @@ import qualified Network.GRPC.Unsafe.Constants as C
import qualified Network.GRPC.Unsafe.Time as C import qualified Network.GRPC.Unsafe.Time as C
import Network.GRPC.LowLevel.Call import Network.GRPC.LowLevel.Call
import Network.GRPC.LowLevel.Client import Network.GRPC.LowLevel.Client (Client (..),
NormalRequestResult (..),
clientEndpoint,
clientNormalRequestOps,
compileNormalRequestResults)
import Network.GRPC.LowLevel.CompletionQueue (TimeoutSeconds) import Network.GRPC.LowLevel.CompletionQueue (TimeoutSeconds)
import qualified Network.GRPC.LowLevel.CompletionQueue.Unregistered as U import qualified Network.GRPC.LowLevel.CompletionQueue.Unregistered as U
import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.GRPC
@ -40,7 +44,7 @@ withClientCall client method timeout f = do
case createResult of case createResult of
Left x -> return $ Left x Left x -> return $ Left x
Right call -> f call `finally` logDestroy call Right call -> f call `finally` logDestroy call
where logDestroy c = grpcDebug "withClientCall: destroying." where logDestroy c = grpcDebug "withClientCall(U): destroying."
>> destroyClientCall c >> destroyClientCall c
-- | Makes a normal (non-streaming) request without needing to register a method -- | Makes a normal (non-streaming) request without needing to register a method
@ -61,7 +65,7 @@ clientRequest client@Client{..} meth timeLimit body meta =
withClientCall client meth timeLimit $ \call -> do withClientCall client meth timeLimit $ \call -> do
let ops = clientNormalRequestOps body meta let ops = clientNormalRequestOps body meta
results <- runClientOps call clientCQ ops timeLimit results <- runClientOps call clientCQ ops timeLimit
grpcDebug "clientRequest: ops ran." grpcDebug "clientRequest(U): ops ran."
case results of case results of
Left x -> return $ Left x Left x -> return $ Left x
Right rs -> return $ Right $ compileNormalRequestResults rs Right rs -> return $ Right $ compileNormalRequestResults rs

View file

@ -19,12 +19,12 @@ module Network.GRPC.LowLevel.CompletionQueue
, shutdownCompletionQueue , shutdownCompletionQueue
, pluck , pluck
, startBatch , startBatch
, channelCreateRegisteredCall , channelCreateCall
, TimeoutSeconds , TimeoutSeconds
, isEventSuccessful , isEventSuccessful
, serverRegisterCompletionQueue , serverRegisterCompletionQueue
, serverShutdownAndNotify , serverShutdownAndNotify
, serverRequestRegisteredCall , serverRequestCall
, newTag , newTag
) )
where where
@ -104,14 +104,17 @@ shutdownCompletionQueue (CompletionQueue{..}) = do
C.QueueTimeout -> drainLoop C.QueueTimeout -> drainLoop
C.OpComplete -> drainLoop C.OpComplete -> drainLoop
channelCreateRegisteredCall :: C.Channel -> C.Call -> C.PropagationMask channelCreateCall :: C.Channel
-> CompletionQueue -> C.CallHandle -> C.Call
-> C.CTimeSpecPtr -> C.PropagationMask
-> IO (Either GRPCIOError ClientCall) -> CompletionQueue
channelCreateRegisteredCall -> C.CallHandle
-> C.CTimeSpecPtr
-> IO (Either GRPCIOError ClientCall)
channelCreateCall
chan parent mask cq@CompletionQueue{..} handle deadline = chan parent mask cq@CompletionQueue{..} handle deadline =
withPermission Push cq $ do withPermission Push cq $ do
grpcDebug $ "channelCreateRegisteredCall: call with " grpcDebug $ "channelCreateCall: call with "
++ concat (intersperse " " [show chan, show parent, show mask, ++ concat (intersperse " " [show chan, show parent, show mask,
show unsafeCQ, show handle, show unsafeCQ, show handle,
show deadline]) show deadline])
@ -120,10 +123,13 @@ channelCreateRegisteredCall
return $ Right $ ClientCall call return $ Right $ ClientCall call
-- | Create the call object to handle a registered call. -- | Create the call object to handle a registered call.
serverRequestRegisteredCall :: C.Server -> CompletionQueue -> TimeoutSeconds serverRequestCall :: C.Server
-> RegisteredMethod -> MetadataMap -> CompletionQueue
-> IO (Either GRPCIOError ServerRegCall) -> TimeoutSeconds
serverRequestRegisteredCall -> RegisteredMethod
-> MetadataMap
-> IO (Either GRPCIOError ServerCall)
serverRequestCall
server cq@CompletionQueue{..} timeLimit RegisteredMethod{..} initMeta = server cq@CompletionQueue{..} timeLimit RegisteredMethod{..} initMeta =
withPermission Push cq $ do withPermission Push cq $ do
-- TODO: Is gRPC supposed to populate this deadline? -- TODO: Is gRPC supposed to populate this deadline?
@ -146,28 +152,28 @@ serverRequestRegisteredCall
callError <- C.grpcServerRequestRegisteredCall callError <- C.grpcServerRequestRegisteredCall
server methodHandle callPtr deadline server methodHandle callPtr deadline
metadataArray bbPtr unsafeCQ unsafeCQ tag metadataArray bbPtr unsafeCQ unsafeCQ tag
grpcDebug $ "serverRequestRegisteredCall: callError: " grpcDebug $ "serverRequestCall(R): callError: "
++ show callError ++ show callError
if callError /= C.CallOk if callError /= C.CallOk
then do grpcDebug "serverRequestRegisteredCall: callError. cleaning up" then do grpcDebug "serverRequestCall(R): callError. cleaning up"
failureCleanup deadline callPtr metadataArrayPtr bbPtr failureCleanup deadline callPtr metadataArrayPtr bbPtr
return $ Left $ GRPCIOCallError callError return $ Left $ GRPCIOCallError callError
else do pluckResult <- pluck cq tag timeLimit else do pluckResult <- pluck cq tag timeLimit
grpcDebug "serverRequestRegisteredCall: finished pluck." grpcDebug "serverRequestCall(R): finished pluck."
case pluckResult of case pluckResult of
Left x -> do Left x -> do
grpcDebug "serverRequestRegisteredCall: cleanup pluck err" grpcDebug "serverRequestCall(R): cleanup pluck err"
failureCleanup deadline callPtr metadataArrayPtr bbPtr failureCleanup deadline callPtr metadataArrayPtr bbPtr
return $ Left x return $ Left x
Right () -> do Right () -> do
rawCall <- peek callPtr rawCall <- peek callPtr
let assembledCall = ServerRegCall rawCall metadataArrayPtr let assembledCall = ServerCall rawCall metadataArrayPtr
bbPtr Nothing deadline bbPtr Nothing deadline
return $ Right assembledCall return $ Right assembledCall
-- TODO: see TODO for failureCleanup in serverRequestCall. -- TODO: see TODO for failureCleanup in serverRequestCall.
where failureCleanup deadline callPtr metadataArrayPtr bbPtr = forkIO $ do where failureCleanup deadline callPtr metadataArrayPtr bbPtr = forkIO $ do
threadDelaySecs 30 threadDelaySecs 30
grpcDebug "serverRequestRegisteredCall: doing delayed cleanup." grpcDebug "serverRequestCall(R): doing delayed cleanup."
C.timespecDestroy deadline C.timespecDestroy deadline
free callPtr free callPtr
C.metadataArrayDestroy metadataArrayPtr C.metadataArrayDestroy metadataArrayPtr

View file

@ -29,8 +29,10 @@ channelCreateCall chan parent mask cq@CompletionQueue{..} meth endpt deadline =
return $ Right $ ClientCall call return $ Right $ ClientCall call
serverRequestCall :: C.Server -> CompletionQueue -> TimeoutSeconds serverRequestCall :: C.Server
-> IO (Either GRPCIOError U.ServerCall) -> CompletionQueue
-> TimeoutSeconds
-> IO (Either GRPCIOError U.ServerCall)
serverRequestCall server cq@CompletionQueue{..} timeLimit = serverRequestCall server cq@CompletionQueue{..} timeLimit =
withPermission Push cq $ do withPermission Push cq $ do
callPtr <- malloc callPtr <- malloc

View file

@ -4,23 +4,22 @@
module Network.GRPC.LowLevel.Op where module Network.GRPC.LowLevel.Op where
import Control.Exception import Control.Exception
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.Map.Strict as M import qualified Data.Map.Strict as M
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Foreign.C.String (CString) import Foreign.C.String (CString)
import Foreign.C.Types (CInt) import Foreign.C.Types (CInt)
import Foreign.Marshal.Alloc (free, malloc, import Foreign.Marshal.Alloc (free, malloc,
mallocBytes) mallocBytes)
import Foreign.Ptr (Ptr, nullPtr) import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (peek, poke) import Foreign.Storable (peek, poke)
import qualified Network.GRPC.Unsafe as C (Call)
import qualified Network.GRPC.Unsafe.ByteBuffer as C
import qualified Network.GRPC.Unsafe.Metadata as C
import qualified Network.GRPC.Unsafe.Op as C
import Network.GRPC.LowLevel.Call import Network.GRPC.LowLevel.Call
import Network.GRPC.LowLevel.CompletionQueue import Network.GRPC.LowLevel.CompletionQueue
import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.GRPC
import qualified Network.GRPC.Unsafe as C (Call)
import qualified Network.GRPC.Unsafe.ByteBuffer as C
import qualified Network.GRPC.Unsafe.Metadata as C
import qualified Network.GRPC.Unsafe.Op as C
-- | Sum describing all possible send and receive operations that can be batched -- | Sum describing all possible send and receive operations that can be batched
-- and executed by gRPC. Usually these are processed in a handful of -- and executed by gRPC. Usually these are processed in a handful of
@ -219,26 +218,26 @@ runOps call cq ops timeLimit =
fmap (Right . catMaybes) $ mapM resultFromOpContext contexts fmap (Right . catMaybes) $ mapM resultFromOpContext contexts
Left err -> return $ Left err Left err -> return $ Left err
-- | For a given call, run the given 'Op's on the given completion queue with -- | For a given server call, run the given 'Op's on the given completion queue
-- the given tag. Blocks until the ops are complete or the given number of -- with the given tag. Blocks until the ops are complete or the given number of
-- seconds have elapsed. TODO: now that we distinguish between different types -- seconds have elapsed. TODO: now that we distinguish between different types
-- of calls at the type level, we could try to limit the input 'Op's more -- of calls at the type level, we could try to limit the input 'Op's more
-- appropriately. E.g., we don't use an 'OpRecvInitialMetadata' when receiving a -- appropriately. E.g., we don't use an 'OpRecvInitialMetadata' when receiving a
-- registered call, because gRPC handles that for us. -- registered call, because gRPC handles that for us.
runServerRegOps :: ServerRegCall runServerOps :: ServerCall
-- ^ 'Call' that this batch is associated with. One call can be -- ^ 'Call' that this batch is associated with. One call can be
-- associated with many batches. -- associated with many batches.
-> CompletionQueue -> CompletionQueue
-- ^ Queue on which our tag will be placed once our ops are done -- ^ Queue on which our tag will be placed once our ops are done
-- running. -- running.
-> [Op] -> [Op]
-- ^ The list of 'Op's to execute. -- ^ The list of 'Op's to execute.
-> TimeoutSeconds -> TimeoutSeconds
-- ^ How long to block waiting for the tag to appear on the -- ^ How long to block waiting for the tag to appear on the
--queue. If we time out, the result of this action will be -- queue. If we time out, the result of this action will be
-- @CallBatchError BatchTimeout@. -- @CallBatchError BatchTimeout@.
-> IO (Either GRPCIOError [OpRecvResult]) -> IO (Either GRPCIOError [OpRecvResult])
runServerRegOps = runOps . internalServerRegCall runServerOps = runOps . unServerCall
-- | Like 'runServerOps', but for client-side calls. -- | Like 'runServerOps', but for client-side calls.
runClientOps :: ClientCall runClientOps :: ClientCall
@ -246,7 +245,7 @@ runClientOps :: ClientCall
-> [Op] -> [Op]
-> TimeoutSeconds -> TimeoutSeconds
-> IO (Either GRPCIOError [OpRecvResult]) -> IO (Either GRPCIOError [OpRecvResult])
runClientOps = runOps . internalClientCall runClientOps = runOps . unClientCall
-- | If response status info is present in the given 'OpRecvResult's, returns -- | If response status info is present in the given 'OpRecvResult's, returns
-- a tuple of trailing metadata, status code, and status details. -- a tuple of trailing metadata, status code, and status details.

View file

@ -10,4 +10,4 @@ runServerOps :: U.ServerCall
-> [Op] -> [Op]
-> TimeoutSeconds -> TimeoutSeconds
-> IO (Either GRPCIOError [OpRecvResult]) -> IO (Either GRPCIOError [OpRecvResult])
runServerOps = runOps . U.internalServerCall runServerOps = runOps . U.unServerCall

View file

@ -5,24 +5,23 @@
-- `Network.GRPC.LowLevel.Server.Unregistered`. -- `Network.GRPC.LowLevel.Server.Unregistered`.
module Network.GRPC.LowLevel.Server where module Network.GRPC.LowLevel.Server where
import Control.Exception (bracket, finally) import Control.Exception (bracket, finally)
import Control.Monad import Control.Monad
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Foreign.Ptr (nullPtr) import Foreign.Ptr (nullPtr)
import qualified Network.GRPC.Unsafe as C
import qualified Network.GRPC.Unsafe.Op as C
import Network.GRPC.LowLevel.Call import Network.GRPC.LowLevel.Call
import Network.GRPC.LowLevel.CompletionQueue (CompletionQueue, import Network.GRPC.LowLevel.CompletionQueue (CompletionQueue,
TimeoutSeconds, TimeoutSeconds,
createCompletionQueue, createCompletionQueue,
pluck, pluck,
serverRegisterCompletionQueue, serverRegisterCompletionQueue,
serverRequestRegisteredCall, serverRequestCall,
serverShutdownAndNotify, serverShutdownAndNotify,
shutdownCompletionQueue) shutdownCompletionQueue)
import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.GRPC
import Network.GRPC.LowLevel.Op import Network.GRPC.LowLevel.Op
import qualified Network.GRPC.Unsafe as C
import qualified Network.GRPC.Unsafe.Op as C
-- | Wraps various gRPC state needed to run a server. -- | Wraps various gRPC state needed to run a server.
data Server = Server data Server = Server
@ -123,24 +122,27 @@ serverRegisterMethod _ _ _ _ = error "Streaming methods not implemented yet."
-- | Create a 'Call' with which to wait for the invocation of a registered -- | Create a 'Call' with which to wait for the invocation of a registered
-- method. -- method.
serverCreateRegisteredCall :: Server -> RegisteredMethod -> TimeoutSeconds serverCreateCall :: Server
-> MetadataMap -> RegisteredMethod
-> IO (Either GRPCIOError ServerRegCall) -> TimeoutSeconds
serverCreateRegisteredCall Server{..} rm timeLimit initMeta = -> MetadataMap
serverRequestRegisteredCall internalServer serverCQ timeLimit rm initMeta -> IO (Either GRPCIOError ServerCall)
serverCreateCall Server{..} rm timeLimit initMeta =
serverRequestCall internalServer serverCQ timeLimit rm initMeta
withServerRegisteredCall :: Server -> RegisteredMethod -> TimeoutSeconds withServerCall :: Server
-> MetadataMap -> RegisteredMethod
-> (ServerRegCall -> TimeoutSeconds
-> IO (Either GRPCIOError a)) -> MetadataMap
-> IO (Either GRPCIOError a) -> (ServerCall -> IO (Either GRPCIOError a))
withServerRegisteredCall server regmethod timeout initMeta f = do -> IO (Either GRPCIOError a)
createResult <- serverCreateRegisteredCall server regmethod timeout initMeta withServerCall server regmethod timeout initMeta f = do
createResult <- serverCreateCall server regmethod timeout initMeta
case createResult of case createResult of
Left x -> return $ Left x Left x -> return $ Left x
Right call -> f call `finally` logDestroy call Right call -> f call `finally` logDestroy call
where logDestroy c = grpcDebug "withServerRegisteredCall: destroying." where logDestroy c = grpcDebug "withServerRegisteredCall: destroying."
>> destroyServerRegCall c >> destroyServerCall c
-- | Sequence of 'Op's needed to receive a normal (non-streaming) call. -- | Sequence of 'Op's needed to receive a normal (non-streaming) call.
serverOpsGetNormalCall :: MetadataMap -> [Op] serverOpsGetNormalCall :: MetadataMap -> [Op]
@ -174,44 +176,49 @@ serverOpsSendNormalRegisteredResponse
OpSendMessage body, OpSendMessage body,
OpSendStatusFromServer trailingMeta code details] OpSendStatusFromServer trailingMeta code details]
-- | A handler for an registered server call; bytestring parameter is request
-- body, with the bytestring response body in the result tuple. The first
-- metadata parameter refers to the request metadata, with the two metadata
-- values in the result tuple being the initial and trailing metadata
-- respectively.
-- TODO: make a more rigid type for this with a Maybe MetadataMap for the
-- trailing meta, and use it for both kinds of call handlers.
type ServerHandler
= ByteString -> MetadataMap
-> IO (ByteString, MetadataMap, MetadataMap, StatusDetails)
-- TODO: we will want to replace this with some more general concept that also -- TODO: we will want to replace this with some more general concept that also
-- works with streaming calls in the future. -- works with streaming calls in the future.
-- | Wait for and then handle a normal (non-streaming) call. -- | Wait for and then handle a normal (non-streaming) call.
serverHandleNormalRegisteredCall :: Server serverHandleNormalCall :: Server
-> RegisteredMethod -> RegisteredMethod
-> TimeoutSeconds -> TimeoutSeconds
-> MetadataMap -> MetadataMap
-- ^ Initial server metadata -- ^ Initial server metadata
-> (ByteString -> MetadataMap -> ServerHandler
-> IO (ByteString, -> IO (Either GRPCIOError ())
MetadataMap, serverHandleNormalCall s@Server{..} rm timeLimit srvMetadata f = do
MetadataMap,
StatusDetails))
-- ^ Handler function takes a request body and
-- metadata and returns a response body and
-- metadata.
-> IO (Either GRPCIOError ())
serverHandleNormalRegisteredCall s@Server{..} rm timeLimit srvMetadata f = do
-- TODO: we use this timeLimit twice, so the max time spent is 2*timeLimit. -- TODO: we use this timeLimit twice, so the max time spent is 2*timeLimit.
-- Should we just hard-code time limits instead? Not sure if client -- Should we just hard-code time limits instead? Not sure if client
-- programmer cares, since this function will likely just be put in a loop -- programmer cares, since this function will likely just be put in a loop
-- anyway. -- anyway.
withServerRegisteredCall s rm timeLimit srvMetadata $ \call -> do withServerCall s rm timeLimit srvMetadata $ \call -> do
grpcDebug "serverHandleNormalRegisteredCall: starting batch." grpcDebug "serverHandleNormalCall(R): starting batch."
debugServerRegCall call debugServerCall call
payload <- serverRegCallGetPayload call payload <- serverCallGetPayload call
case payload of case payload of
--TODO: what should we do with an empty payload? Have the handler take --TODO: what should we do with an empty payload? Have the handler take
-- @Maybe ByteString@? Need to figure out when/why payload would be empty. -- @Maybe ByteString@? Need to figure out when/why payload would be empty.
Nothing -> error "serverHandleNormalRegisteredCall: payload empty." Nothing -> error "serverHandleNormalCall(R): payload empty."
Just requestBody -> do Just requestBody -> do
requestMeta <- serverRegCallGetMetadata call requestMeta <- serverCallGetMetadata call
(respBody, initMeta, trailingMeta, details) <- f requestBody requestMeta (respBody, initMeta, trailingMeta, details) <- f requestBody requestMeta
let status = C.GrpcStatusOk let status = C.GrpcStatusOk
let respOps = serverOpsSendNormalRegisteredResponse let respOps = serverOpsSendNormalRegisteredResponse
respBody initMeta trailingMeta status details respBody initMeta trailingMeta status details
respOpsResults <- runServerRegOps call serverCQ respOps timeLimit respOpsResults <- runServerOps call serverCQ respOps timeLimit
grpcDebug "serverHandleNormalRegisteredCall: finished response ops." grpcDebug "serverHandleNormalCall(R): finished response ops."
case respOpsResults of case respOpsResults of
Left x -> return $ Left x Left x -> return $ Left x
Right _ -> return $ Right () Right _ -> return $ Right ()

View file

@ -11,7 +11,9 @@ import qualified Network.GRPC.LowLevel.CompletionQueue.Unregistered as U
import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.GRPC
import Network.GRPC.LowLevel.Op (OpRecvResult (..)) import Network.GRPC.LowLevel.Op (OpRecvResult (..))
import qualified Network.GRPC.LowLevel.Op.Unregistered as U import qualified Network.GRPC.LowLevel.Op.Unregistered as U
import Network.GRPC.LowLevel.Server import Network.GRPC.LowLevel.Server (Server (..),
serverOpsGetNormalCall,
serverOpsSendNormalResponse)
import qualified Network.GRPC.Unsafe.Op as C import qualified Network.GRPC.Unsafe.Op as C
serverCreateCall :: Server -> TimeoutSeconds serverCreateCall :: Server -> TimeoutSeconds
@ -44,7 +46,7 @@ serverHandleNormalCall :: Server
-> IO (Either GRPCIOError ()) -> IO (Either GRPCIOError ())
serverHandleNormalCall s@Server{..} timeLimit srvMetadata f = do serverHandleNormalCall s@Server{..} timeLimit srvMetadata f = do
withServerCall s timeLimit $ \call -> do withServerCall s timeLimit $ \call -> do
grpcDebug "serverHandleCall(U): starting batch." grpcDebug "serverHandleNormalCall(U): starting batch."
let recvOps = serverOpsGetNormalCall srvMetadata let recvOps = serverOpsGetNormalCall srvMetadata
opResults <- U.runServerOps call serverCQ recvOps timeLimit opResults <- U.runServerOps call serverCQ recvOps timeLimit
case opResults of case opResults of

View file

@ -11,7 +11,8 @@ import Control.Monad
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.Map as M import qualified Data.Map as M
import Network.GRPC.LowLevel import Network.GRPC.LowLevel
import Network.GRPC.LowLevel.Server.Unregistered as U import qualified Network.GRPC.LowLevel.Client.Unregistered as U
import qualified Network.GRPC.LowLevel.Server.Unregistered as U
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit as HU (Assertion, import Test.Tasty.HUnit as HU (Assertion,
assertEqual, assertEqual,
@ -50,14 +51,14 @@ testClientCreateDestroy =
testClientCall :: TestTree testClientCall :: TestTree
testClientCall = testClientCall =
clientOnlyTest "create/destroy call" $ \c -> do clientOnlyTest "create/destroy call" $ \c -> do
r <- withClientCall c "foo" 10 $ const $ return $ Right () r <- U.withClientCall c "/foo" 10 $ const $ return $ Right ()
r @?= Right () r @?= Right ()
testClientTimeoutNoServer :: TestTree testClientTimeoutNoServer :: TestTree
testClientTimeoutNoServer = testClientTimeoutNoServer =
clientOnlyTest "request timeout when server DNE" $ \c -> do clientOnlyTest "request timeout when server DNE" $ \c -> do
rm <- clientRegisterMethod c "/foo" Normal rm <- clientRegisterMethod c "/foo" Normal
r <- clientRegisteredRequest c rm 1 "Hello" mempty r <- clientRequest c rm 1 "Hello" mempty
r @?= Left GRPCIOTimeout r @?= Left GRPCIOTimeout
testServerCreateDestroy :: TestTree testServerCreateDestroy :: TestTree
@ -74,7 +75,7 @@ testServerTimeoutNoClient :: TestTree
testServerTimeoutNoClient = testServerTimeoutNoClient =
serverOnlyTest "wait timeout when client DNE" [("/foo", Normal)] $ \s -> do serverOnlyTest "wait timeout when client DNE" [("/foo", Normal)] $ \s -> do
let rm = head (registeredMethods s) let rm = head (registeredMethods s)
r <- serverHandleNormalRegisteredCall s rm 1 mempty $ \_ _ -> r <- serverHandleNormalCall s rm 1 mempty $ \_ _ ->
return ("", mempty, mempty, StatusDetails "details") return ("", mempty, mempty, StatusDetails "details")
r @?= Left GRPCIOTimeout r @?= Left GRPCIOTimeout
@ -89,13 +90,13 @@ testWrongEndpoint =
-- further -- further
client c = do client c = do
rm <- clientRegisterMethod c "/bar" Normal rm <- clientRegisterMethod c "/bar" Normal
r <- clientRegisteredRequest c rm 1 "Hello!" mempty r <- clientRequest c rm 1 "Hello!" mempty
r @?= Left (GRPCIOBadStatusCode GrpcStatusDeadlineExceeded r @?= Left (GRPCIOBadStatusCode GrpcStatusDeadlineExceeded
(StatusDetails "Deadline Exceeded")) (StatusDetails "Deadline Exceeded"))
server s = do server s = do
length (registeredMethods s) @?= 1 length (registeredMethods s) @?= 1
let rm = head (registeredMethods s) let rm = head (registeredMethods s)
r <- serverHandleNormalRegisteredCall s rm 10 mempty $ \_ _ -> do r <- serverHandleNormalCall s rm 10 mempty $ \_ _ -> do
return ("reply test", dummyMeta, dummyMeta, StatusDetails "details string") return ("reply test", dummyMeta, dummyMeta, StatusDetails "details string")
r @?= Right () r @?= Right ()
@ -112,7 +113,7 @@ testPayload =
clientMD = [("foo_key", "foo_val"), ("bar_key", "bar_val")] clientMD = [("foo_key", "foo_val"), ("bar_key", "bar_val")]
client c = do client c = do
rm <- clientRegisterMethod c "/foo" Normal rm <- clientRegisterMethod c "/foo" Normal
clientRegisteredRequest c rm 10 "Hello!" clientMD >>= do clientRequest c rm 10 "Hello!" clientMD >>= do
checkReqRslt $ \NormalRequestResult{..} -> do checkReqRslt $ \NormalRequestResult{..} -> do
rspCode @?= GrpcStatusOk rspCode @?= GrpcStatusOk
rspBody @?= "reply test" rspBody @?= "reply test"
@ -122,7 +123,7 @@ testPayload =
server s = do server s = do
length (registeredMethods s) @?= 1 length (registeredMethods s) @?= 1
let rm = head (registeredMethods s) let rm = head (registeredMethods s)
r <- serverHandleNormalRegisteredCall s rm 11 mempty $ \reqBody reqMD -> do r <- serverHandleNormalCall s rm 11 mempty $ \reqBody reqMD -> do
reqBody @?= "Hello!" reqBody @?= "Hello!"
checkMD "Server metadata mismatch" clientMD reqMD checkMD "Server metadata mismatch" clientMD reqMD
return ("reply test", dummyMeta, dummyMeta, StatusDetails "details string") return ("reply test", dummyMeta, dummyMeta, StatusDetails "details string")
@ -133,13 +134,13 @@ testPayloadUnregistered =
csTest "unregistered normal request/response" client server [] csTest "unregistered normal request/response" client server []
where where
client c = do client c = do
clientRequest c "/foo" 10 "Hello!" mempty >>= do U.clientRequest c "/foo" 10 "Hello!" mempty >>= do
checkReqRslt $ \NormalRequestResult{..} -> do checkReqRslt $ \NormalRequestResult{..} -> do
rspCode @?= GrpcStatusOk rspCode @?= GrpcStatusOk
rspBody @?= "reply test" rspBody @?= "reply test"
details @?= "details string" details @?= "details string"
server s = do server s = do
r <- serverHandleNormalCall s 11 mempty $ \body _md meth -> do r <- U.serverHandleNormalCall s 11 mempty $ \body _md meth -> do
body @?= "Hello!" body @?= "Hello!"
meth @?= "/foo" meth @?= "/foo"
return ("reply test", mempty, "details string") return ("reply test", mempty, "details string")