From e9f6340e4021e5fe34aa96f3d80c42dd8bd34456 Mon Sep 17 00:00:00 2001 From: Connor Clark Date: Fri, 24 Jun 2016 08:10:46 -0700 Subject: [PATCH] Fix up parent calls (#36) * remove parentPtr from server calls * remove parentPtr from ServerCall, add new withClientCallParent --- src/Network/GRPC/LowLevel.hs | 1 + src/Network/GRPC/LowLevel/Call.hs | 9 +---- src/Network/GRPC/LowLevel/Client.hs | 36 ++++++++++++++++---- src/Network/GRPC/LowLevel/CompletionQueue.hs | 9 ++--- 4 files changed, 36 insertions(+), 19 deletions(-) diff --git a/src/Network/GRPC/LowLevel.hs b/src/Network/GRPC/LowLevel.hs index aa1127e..d4e4ced 100644 --- a/src/Network/GRPC/LowLevel.hs +++ b/src/Network/GRPC/LowLevel.hs @@ -51,6 +51,7 @@ GRPC , clientRegisterMethod , clientRequest , withClientCall +, withClientCallParent , clientCallCancel -- * Ops diff --git a/src/Network/GRPC/LowLevel/Call.hs b/src/Network/GRPC/LowLevel/Call.hs index 6d30014..bceb2e0 100644 --- a/src/Network/GRPC/LowLevel/Call.hs +++ b/src/Network/GRPC/LowLevel/Call.hs @@ -63,7 +63,6 @@ data ServerCall = ServerCall { unServerCall :: C.Call, requestMetadataRecv :: MetadataMap, optionalPayload :: Maybe ByteString, - parentPtr :: Maybe (Ptr C.Call), callDeadline :: TimeSpec } @@ -87,15 +86,11 @@ debugClientCall = const $ return () debugServerCall :: ServerCall -> IO () #ifdef DEBUG -debugServerCall call@(ServerCall (C.Call ptr) _ _ _ _) = do +debugServerCall call@(ServerCall (C.Call ptr) _ _ _) = do grpcDebug $ "debugServerCall(R): server call: " ++ (show ptr) grpcDebug $ "debugServerCall(R): metadata ptr: " ++ show (requestMetadataRecv call) grpcDebug $ "debugServerCall(R): payload ptr: " ++ show (optionalPayload call) - forM_ (parentPtr call) $ \parentPtr' -> do - grpcDebug $ "debugServerCall(R): parent ptr: " ++ show parentPtr' - (C.Call parent) <- peek parentPtr' - grpcDebug $ "debugServerCall(R): parent: " ++ show parent grpcDebug $ "debugServerCall(R): deadline ptr: " ++ show (callDeadline call) #else {-# INLINE debugServerCall #-} @@ -113,5 +108,3 @@ destroyServerCall call@ServerCall{..} = do debugServerCall call grpcDebug $ "Destroying server-side call object: " ++ show unServerCall C.grpcCallDestroy unServerCall - grpcDebug $ "freeing parentPtr: " ++ show parentPtr - forM_ parentPtr free diff --git a/src/Network/GRPC/LowLevel/Client.hs b/src/Network/GRPC/LowLevel/Client.hs index be43bb6..d9e1359 100644 --- a/src/Network/GRPC/LowLevel/Client.hs +++ b/src/Network/GRPC/LowLevel/Client.hs @@ -89,22 +89,44 @@ clientCreateCall :: Client -> RegisteredMethod -> TimeoutSeconds -> IO (Either GRPCIOError ClientCall) -clientCreateCall Client{..} RegisteredMethod{..} timeout = do - let parentCall = C.Call nullPtr --Unsure what this does. null is safe, though. +clientCreateCall c rm ts = clientCreateCallParent c rm ts Nothing + +-- | For servers that act as clients to other gRPC servers, this version creates +-- a client call with an optional parent server call. This allows for cascading +-- call cancellation from the `ServerCall` to the `ClientCall`. +clientCreateCallParent :: Client + -> RegisteredMethod + -> TimeoutSeconds + -> (Maybe ServerCall) + -- ^ Optional parent call for cascading cancellation. + -> IO (Either GRPCIOError ClientCall) +clientCreateCallParent Client{..} RegisteredMethod{..} timeout parent = do C.withDeadlineSeconds timeout $ \deadline -> do - channelCreateCall clientChannel parentCall C.propagateDefaults + channelCreateCall clientChannel parent C.propagateDefaults clientCQ methodHandle deadline --- TODO: the error-handling refactor made this quite ugly. It could be fixed --- by switching to ExceptT IO. -- | Handles safe creation and cleanup of a client call withClientCall :: Client -> RegisteredMethod -> TimeoutSeconds -> (ClientCall -> IO (Either GRPCIOError a)) -> IO (Either GRPCIOError a) -withClientCall client regmethod timeout f = do - createResult <- clientCreateCall client regmethod timeout +withClientCall client regmethod timeout f = + withClientCallParent client regmethod timeout Nothing f + +-- | Handles safe creation and cleanup of a client call, with an optional parent +-- call parameter. This allows for cancellation to cascade from the parent +-- `ServerCall` to the created `ClientCall`. Obviously, this is only useful if +-- the given gRPC client is also a server. +withClientCallParent :: Client + -> RegisteredMethod + -> TimeoutSeconds + -> (Maybe ServerCall) + -- ^ Optional parent call for cascading cancellation. + -> (ClientCall -> IO (Either GRPCIOError a)) + -> IO (Either GRPCIOError a) +withClientCallParent client regmethod timeout parent f = do + createResult <- clientCreateCallParent client regmethod timeout parent case createResult of Left x -> return $ Left x Right call -> f call `finally` logDestroy call diff --git a/src/Network/GRPC/LowLevel/CompletionQueue.hs b/src/Network/GRPC/LowLevel/CompletionQueue.hs index aefb5b1..8c32bc6 100644 --- a/src/Network/GRPC/LowLevel/CompletionQueue.hs +++ b/src/Network/GRPC/LowLevel/CompletionQueue.hs @@ -111,7 +111,7 @@ shutdownCompletionQueue (CompletionQueue{..}) = do C.OpComplete -> drainLoop channelCreateCall :: C.Channel - -> C.Call + -> (Maybe ServerCall) -> C.PropagationMask -> CompletionQueue -> C.CallHandle @@ -120,11 +120,13 @@ channelCreateCall :: C.Channel channelCreateCall chan parent mask cq@CompletionQueue{..} handle deadline = withPermission Push cq $ do + let parentPtr = maybe (C.Call nullPtr) unServerCall parent grpcDebug $ "channelCreateCall: call with " - ++ concat (intersperse " " [show chan, show parent, show mask, + ++ concat (intersperse " " [show chan, show parentPtr, + show mask, show unsafeCQ, show handle, show deadline]) - call <- C.grpcChannelCreateRegisteredCall chan parent mask unsafeCQ + call <- C.grpcChannelCreateRegisteredCall chan parentPtr mask unsafeCQ handle deadline C.reserved return $ Right $ ClientCall call @@ -167,7 +169,6 @@ serverRequestCall let assembledCall = ServerCall rawCall meta payload - Nothing deadline grpcDebug "serverRequestCall(R): About to return" return $ Right assembledCall