mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-23 03:29:42 +01:00
Drop distinction between runServerOps and runClientOps
This commit is contained in:
parent
8069ebba07
commit
4780a0c8ed
5 changed files with 44 additions and 59 deletions
|
@ -47,8 +47,6 @@ GRPC
|
|||
, withClientCall
|
||||
|
||||
-- * Ops
|
||||
, runClientOps
|
||||
, runServerOps
|
||||
, Op(..)
|
||||
, OpRecvResult(..)
|
||||
|
||||
|
|
|
@ -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."
|
||||
|
|
|
@ -48,8 +48,7 @@ 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"
|
||||
|
@ -64,7 +63,7 @@ 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
|
||||
|
|
|
@ -181,20 +181,36 @@ 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
|
||||
-- ^ '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
|
||||
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue