From 4780a0c8ed6c9b0cde52ff5d19cd8b10b58a93f9 Mon Sep 17 00:00:00 2001 From: Joel Stanley Date: Wed, 8 Jun 2016 15:03:35 -0500 Subject: [PATCH] Drop distinction between runServerOps and runClientOps --- src/Network/GRPC/LowLevel.hs | 2 - src/Network/GRPC/LowLevel/Client.hs | 5 +- .../GRPC/LowLevel/Client/Unregistered.hs | 23 +++--- src/Network/GRPC/LowLevel/Op.hs | 71 ++++++++----------- src/Network/GRPC/LowLevel/Server.hs | 2 +- 5 files changed, 44 insertions(+), 59 deletions(-) diff --git a/src/Network/GRPC/LowLevel.hs b/src/Network/GRPC/LowLevel.hs index 7485fda..3976d07 100644 --- a/src/Network/GRPC/LowLevel.hs +++ b/src/Network/GRPC/LowLevel.hs @@ -47,8 +47,6 @@ GRPC , withClientCall -- * Ops -, runClientOps -, runServerOps , Op(..) , OpRecvResult(..) diff --git a/src/Network/GRPC/LowLevel/Client.hs b/src/Network/GRPC/LowLevel/Client.hs index bbb2e8b..44d78a1 100644 --- a/src/Network/GRPC/LowLevel/Client.hs +++ b/src/Network/GRPC/LowLevel/Client.hs @@ -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." diff --git a/src/Network/GRPC/LowLevel/Client/Unregistered.hs b/src/Network/GRPC/LowLevel/Client/Unregistered.hs index 03b6082..1623801 100644 --- a/src/Network/GRPC/LowLevel/Client/Unregistered.hs +++ b/src/Network/GRPC/LowLevel/Client/Unregistered.hs @@ -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 diff --git a/src/Network/GRPC/LowLevel/Op.hs b/src/Network/GRPC/LowLevel/Op.hs index ce17f1d..b4fa0a6 100644 --- a/src/Network/GRPC/LowLevel/Op.hs +++ b/src/Network/GRPC/LowLevel/Op.hs @@ -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] diff --git a/src/Network/GRPC/LowLevel/Server.hs b/src/Network/GRPC/LowLevel/Server.hs index b55151f..aaca99b 100644 --- a/src/Network/GRPC/LowLevel/Server.hs +++ b/src/Network/GRPC/LowLevel/Server.hs @@ -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