Drop distinction between runServerOps and runClientOps

This commit is contained in:
Joel Stanley 2016-06-08 15:03:35 -05:00
parent 8069ebba07
commit 4780a0c8ed
5 changed files with 44 additions and 59 deletions

View file

@ -47,8 +47,6 @@ GRPC
, withClientCall
-- * Ops
, runClientOps
, runServerOps
, Op(..)
, OpRecvResult(..)

View file

@ -153,12 +153,13 @@ clientRequest client@(Client{..}) rm@(RegisteredMethod{..})
Normal -> withClientCall client rm timeLimit $ \call -> do
grpcDebug "clientRequest(R): created call."
debugClientCall call
let call' = unClientCall call
-- NOTE: sendOps and recvOps *must* be in separate batches or
-- the client hangs when the server can't be reached.
let sendOps = [OpSendInitialMetadata meta
, OpSendMessage body
, OpSendCloseFromClient]
sendRes <- runClientOps call clientCQ sendOps timeLimit
sendRes <- runOps call' clientCQ sendOps timeLimit
case sendRes of
Left x -> do grpcDebug "clientRequest(R) : batch error."
return $ Left x
@ -166,7 +167,7 @@ clientRequest client@(Client{..}) rm@(RegisteredMethod{..})
let recvOps = [OpRecvInitialMetadata,
OpRecvMessage,
OpRecvStatusOnClient]
recvRes <- runClientOps call clientCQ recvOps timeLimit
recvRes <- runOps call' clientCQ recvOps timeLimit
case recvRes of
Left x -> do
grpcDebug "clientRequest(R): batch error."

View file

@ -48,23 +48,22 @@ withClientCall client method timeout f = do
>> destroyClientCall c
-- | Makes a normal (non-streaming) request without needing to register a method
-- first. Probably only useful for testing. TODO: This is preliminary, like
-- 'clientRegisteredRequest'.
-- first. Probably only useful for testing.
clientRequest :: Client
-> MethodName
-- ^ Method name, e.g. "/foo"
-> TimeoutSeconds
-- ^ "Number of seconds until request times out"
-> ByteString
-- ^ Request body.
-> MetadataMap
-- ^ Request metadata.
-> IO (Either GRPCIOError NormalRequestResult)
-> MethodName
-- ^ Method name, e.g. "/foo"
-> TimeoutSeconds
-- ^ "Number of seconds until request times out"
-> ByteString
-- ^ Request body.
-> MetadataMap
-- ^ Request metadata.
-> IO (Either GRPCIOError NormalRequestResult)
clientRequest client@Client{..} meth timeLimit body meta =
fmap join $ do
withClientCall client meth timeLimit $ \call -> do
let ops = clientNormalRequestOps body meta
results <- runClientOps call clientCQ ops timeLimit
results <- runOps (unClientCall call) clientCQ ops timeLimit
grpcDebug "clientRequest(U): ops ran."
case results of
Left x -> return $ Left x

View file

@ -181,21 +181,37 @@ resultFromOpContext _ = do
grpcDebug "resultFromOpContext: saw non-result op type."
return Nothing
--TODO: the list of 'Op's type is less specific than it could be. There are only
-- a few different sequences of 'Op's we will see in practice. Once we figure
-- out what those are, we should create a more specific sum type. However, since
-- ops can fail, the list of 'OpRecvResult' returned by 'runOps' can vary in
-- their contents and are perhaps less amenable to simplification.
-- In the meantime, from looking at the core tests, it looks like it is safe to
-- say that we always get a GRPC_CALL_ERROR_TOO_MANY_OPERATIONS error if we use
-- the same 'Op' twice in the same batch, so we might want to change the list to
-- a set. I don't think order matters within a batch. Need to check.
-- | For a given call, run the given 'Op's on the given completion queue 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
-- 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
-- registered call, because gRPC handles that for us.
-- TODO: the list of 'Op's type is less specific than it could be. There are
-- only a few different sequences of 'Op's we will see in practice. Once we
-- figure out what those are, we should create a more specific sum
-- type. However, since ops can fail, the list of 'OpRecvResult' returned by
-- 'runOps' can vary in their contents and are perhaps less amenable to
-- simplification. In the meantime, from looking at the core tests, it looks
-- like it is safe to say that we always get a
-- GRPC_CALL_ERROR_TOO_MANY_OPERATIONS error if we use the same 'Op' twice in
-- the same batch, so we might want to change the list to a set. I don't think
-- order matters within a batch. Need to check.
runOps :: C.Call
-> CompletionQueue
-> [Op]
-> TimeoutSeconds
-> IO (Either GRPCIOError [OpRecvResult])
-- ^ 'Call' that this batch is associated with. One call can be
-- associated with many batches.
-> CompletionQueue
-- ^ Queue on which our tag will be placed once our ops are done
-- running.
-> [Op]
-- ^ The list of 'Op's to execute.
-> TimeoutSeconds
-- ^ How long to block waiting for the tag to appear on the queue. If
-- we time out, the result of this action will be @CallBatchError
-- BatchTimeout@.
-> IO (Either GRPCIOError [OpRecvResult])
runOps call cq ops timeLimit =
let l = length ops in
withOpArray l $ \opArray -> do
@ -218,35 +234,6 @@ runOps call cq ops timeLimit =
fmap (Right . catMaybes) $ mapM resultFromOpContext contexts
Left err -> return $ Left err
-- | For a given server call, run the given 'Op's on the given completion queue
-- 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
-- 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
-- registered call, because gRPC handles that for us.
runServerOps :: ServerCall
-- ^ 'Call' that this batch is associated with. One call can be
-- associated with many batches.
-> CompletionQueue
-- ^ Queue on which our tag will be placed once our ops are done
-- running.
-> [Op]
-- ^ The list of 'Op's to execute.
-> TimeoutSeconds
-- ^ How long to block waiting for the tag to appear on the
-- queue. If we time out, the result of this action will be
-- @CallBatchError BatchTimeout@.
-> IO (Either GRPCIOError [OpRecvResult])
runServerOps = runOps . unServerCall
-- | Like 'runServerOps', but for client-side calls.
runClientOps :: ClientCall
-> CompletionQueue
-> [Op]
-> TimeoutSeconds
-> IO (Either GRPCIOError [OpRecvResult])
runClientOps = runOps . unClientCall
-- | If response status info is present in the given 'OpRecvResult's, returns
-- a tuple of trailing metadata, status code, and status details.
extractStatusInfo :: [OpRecvResult]

View file

@ -217,7 +217,7 @@ serverHandleNormalCall s@Server{..} rm timeLimit srvMetadata f = do
let status = C.GrpcStatusOk
let respOps = serverOpsSendNormalRegisteredResponse
respBody initMeta trailingMeta status details
respOpsResults <- runServerOps call serverCQ respOps timeLimit
respOpsResults <- runOps (unServerCall call) serverCQ respOps timeLimit
grpcDebug "serverHandleNormalCall(R): finished response ops."
case respOpsResults of
Left x -> return $ Left x