mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-26 21:19:43 +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
|
, withClientCall
|
||||||
|
|
||||||
-- * Ops
|
-- * Ops
|
||||||
, runClientOps
|
|
||||||
, runServerOps
|
|
||||||
, Op(..)
|
, Op(..)
|
||||||
, OpRecvResult(..)
|
, OpRecvResult(..)
|
||||||
|
|
||||||
|
|
|
@ -153,12 +153,13 @@ clientRequest client@(Client{..}) rm@(RegisteredMethod{..})
|
||||||
Normal -> withClientCall client rm timeLimit $ \call -> do
|
Normal -> withClientCall client rm timeLimit $ \call -> do
|
||||||
grpcDebug "clientRequest(R): created call."
|
grpcDebug "clientRequest(R): created call."
|
||||||
debugClientCall call
|
debugClientCall call
|
||||||
|
let call' = unClientCall 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.
|
||||||
let sendOps = [OpSendInitialMetadata meta
|
let sendOps = [OpSendInitialMetadata meta
|
||||||
, OpSendMessage body
|
, OpSendMessage body
|
||||||
, OpSendCloseFromClient]
|
, OpSendCloseFromClient]
|
||||||
sendRes <- runClientOps call clientCQ sendOps timeLimit
|
sendRes <- runOps call' clientCQ sendOps timeLimit
|
||||||
case sendRes of
|
case sendRes of
|
||||||
Left x -> do grpcDebug "clientRequest(R) : batch error."
|
Left x -> do grpcDebug "clientRequest(R) : batch error."
|
||||||
return $ Left x
|
return $ Left x
|
||||||
|
@ -166,7 +167,7 @@ clientRequest client@(Client{..}) rm@(RegisteredMethod{..})
|
||||||
let recvOps = [OpRecvInitialMetadata,
|
let recvOps = [OpRecvInitialMetadata,
|
||||||
OpRecvMessage,
|
OpRecvMessage,
|
||||||
OpRecvStatusOnClient]
|
OpRecvStatusOnClient]
|
||||||
recvRes <- runClientOps call clientCQ recvOps timeLimit
|
recvRes <- runOps call' clientCQ recvOps timeLimit
|
||||||
case recvRes of
|
case recvRes of
|
||||||
Left x -> do
|
Left x -> do
|
||||||
grpcDebug "clientRequest(R): batch error."
|
grpcDebug "clientRequest(R): batch error."
|
||||||
|
|
|
@ -48,8 +48,7 @@ withClientCall client method timeout f = do
|
||||||
>> 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
|
||||||
-- first. Probably only useful for testing. TODO: This is preliminary, like
|
-- first. Probably only useful for testing.
|
||||||
-- 'clientRegisteredRequest'.
|
|
||||||
clientRequest :: Client
|
clientRequest :: Client
|
||||||
-> MethodName
|
-> MethodName
|
||||||
-- ^ Method name, e.g. "/foo"
|
-- ^ Method name, e.g. "/foo"
|
||||||
|
@ -64,7 +63,7 @@ clientRequest client@Client{..} meth timeLimit body meta =
|
||||||
fmap join $ do
|
fmap join $ do
|
||||||
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 <- runOps (unClientCall call) clientCQ ops timeLimit
|
||||||
grpcDebug "clientRequest(U): ops ran."
|
grpcDebug "clientRequest(U): ops ran."
|
||||||
case results of
|
case results of
|
||||||
Left x -> return $ Left x
|
Left x -> return $ Left x
|
||||||
|
|
|
@ -181,20 +181,36 @@ resultFromOpContext _ = do
|
||||||
grpcDebug "resultFromOpContext: saw non-result op type."
|
grpcDebug "resultFromOpContext: saw non-result op type."
|
||||||
return Nothing
|
return Nothing
|
||||||
|
|
||||||
--TODO: the list of 'Op's type is less specific than it could be. There are only
|
-- | For a given call, run the given 'Op's on the given completion queue with
|
||||||
-- a few different sequences of 'Op's we will see in practice. Once we figure
|
-- the given tag. Blocks until the ops are complete or the given number of
|
||||||
-- out what those are, we should create a more specific sum type. However, since
|
-- seconds have elapsed. TODO: now that we distinguish between different types
|
||||||
-- ops can fail, the list of 'OpRecvResult' returned by 'runOps' can vary in
|
-- of calls at the type level, we could try to limit the input 'Op's more
|
||||||
-- their contents and are perhaps less amenable to simplification.
|
-- appropriately. E.g., we don't use an 'OpRecvInitialMetadata' when receiving a
|
||||||
-- In the meantime, from looking at the core tests, it looks like it is safe to
|
-- registered call, because gRPC handles that for us.
|
||||||
-- 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
|
-- TODO: the list of 'Op's type is less specific than it could be. There are
|
||||||
-- a set. I don't think order matters within a batch. Need to check.
|
-- 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
|
runOps :: C.Call
|
||||||
|
-- ^ 'Call' that this batch is associated with. One call can be
|
||||||
|
-- associated with many batches.
|
||||||
-> CompletionQueue
|
-> CompletionQueue
|
||||||
|
-- ^ Queue on which our tag will be placed once our ops are done
|
||||||
|
-- running.
|
||||||
-> [Op]
|
-> [Op]
|
||||||
|
-- ^ The list of 'Op's to execute.
|
||||||
-> TimeoutSeconds
|
-> 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])
|
-> IO (Either GRPCIOError [OpRecvResult])
|
||||||
runOps call cq ops timeLimit =
|
runOps call cq ops timeLimit =
|
||||||
let l = length ops in
|
let l = length ops in
|
||||||
|
@ -218,35 +234,6 @@ 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 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
|
-- | 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.
|
||||||
extractStatusInfo :: [OpRecvResult]
|
extractStatusInfo :: [OpRecvResult]
|
||||||
|
|
|
@ -217,7 +217,7 @@ serverHandleNormalCall s@Server{..} rm timeLimit srvMetadata f = do
|
||||||
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 <- runServerOps call serverCQ respOps timeLimit
|
respOpsResults <- runOps (unServerCall call) serverCQ respOps timeLimit
|
||||||
grpcDebug "serverHandleNormalCall(R): 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
|
||||||
|
|
Loading…
Reference in a new issue