From 27a9a6283a0a1946c727b53d2a106b2812e2bd5f Mon Sep 17 00:00:00 2001 From: Joel Stanley Date: Wed, 8 Jun 2016 11:41:58 -0500 Subject: [PATCH] Rename unreg operations in Network.GRPC.LowLevel.Call.Unregistered --- examples/echo/echo-server/Main.hs | 20 ++--- grpc-haskell.cabal | 2 +- src/Network/GRPC/LowLevel.hs | 4 - .../GRPC/LowLevel/Call/Unregistered.hs | 77 +++++++++---------- src/Network/GRPC/LowLevel/CompletionQueue.hs | 12 +-- src/Network/GRPC/LowLevel/Op.hs | 6 +- .../GRPC/LowLevel/Server/Unregistered.hs | 33 +++----- 7 files changed, 69 insertions(+), 85 deletions(-) diff --git a/examples/echo/echo-server/Main.hs b/examples/echo/echo-server/Main.hs index 30d8b2b..3a28d25 100644 --- a/examples/echo/echo-server/Main.hs +++ b/examples/echo/echo-server/Main.hs @@ -1,18 +1,20 @@ +{-# LANGUAGE OverloadedLists #-} {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-unused-binds #-} -import Control.Concurrent.Async (async, wait) -import Control.Monad (forever) -import Data.ByteString (ByteString) -import qualified Data.Map as M -import Network.GRPC.LowLevel - +import Control.Concurrent.Async (async, wait) +import Control.Monad (forever) +import Data.ByteString (ByteString) +import Network.GRPC.LowLevel +import qualified Network.GRPC.LowLevel.Server.Unregistered as U serverMeta :: MetadataMap -serverMeta = M.fromList [("test_meta", "test_meta_value")] +serverMeta = [("test_meta", "test_meta_value")] handler :: ByteString -> MetadataMap -> MethodName -> IO (ByteString, MetadataMap, StatusDetails) -handler reqBody reqMeta method = do +handler reqBody _reqMeta _method = do --putStrLn $ "Got request for method: " ++ show method --putStrLn $ "Got metadata: " ++ show reqMeta return (reqBody, serverMeta, StatusDetails "") @@ -20,7 +22,7 @@ handler reqBody reqMeta method = do unregMain :: IO () unregMain = withGRPC $ \grpc -> do withServer grpc (ServerConfig "localhost" 50051 []) $ \server -> forever $ do - result <- serverHandleNormalCall server 15 serverMeta handler + result <- U.serverHandleNormalCall server 15 serverMeta handler case result of Left x -> putStrLn $ "handle call result error: " ++ show x Right _ -> return () diff --git a/grpc-haskell.cabal b/grpc-haskell.cabal index 0386528..eb76638 100644 --- a/grpc-haskell.cabal +++ b/grpc-haskell.cabal @@ -42,12 +42,12 @@ library Network.GRPC.Unsafe.Op Network.GRPC.Unsafe Network.GRPC.LowLevel + Network.GRPC.LowLevel.Server.Unregistered other-modules: Network.GRPC.LowLevel.CompletionQueue Network.GRPC.LowLevel.GRPC Network.GRPC.LowLevel.Op Network.GRPC.LowLevel.Server - Network.GRPC.LowLevel.Server.Unregistered Network.GRPC.LowLevel.Call Network.GRPC.LowLevel.Call.Unregistered Network.GRPC.LowLevel.Client diff --git a/src/Network/GRPC/LowLevel.hs b/src/Network/GRPC/LowLevel.hs index 26b8f52..af91fbb 100644 --- a/src/Network/GRPC/LowLevel.hs +++ b/src/Network/GRPC/LowLevel.hs @@ -30,12 +30,9 @@ GRPC , ServerConfig(..) , Server , ServerRegCall -, ServerUnregCall , registeredMethods , withServer , serverHandleNormalRegisteredCall -, serverHandleNormalCall -, withServerUnregCall , withServerRegisteredCall -- * Client @@ -61,7 +58,6 @@ GRPC import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.Server -import Network.GRPC.LowLevel.Server.Unregistered import Network.GRPC.LowLevel.CompletionQueue import Network.GRPC.LowLevel.Op import Network.GRPC.LowLevel.Client diff --git a/src/Network/GRPC/LowLevel/Call/Unregistered.hs b/src/Network/GRPC/LowLevel/Call/Unregistered.hs index de6fb36..60307ef 100644 --- a/src/Network/GRPC/LowLevel/Call/Unregistered.hs +++ b/src/Network/GRPC/LowLevel/Call/Unregistered.hs @@ -3,16 +3,12 @@ module Network.GRPC.LowLevel.Call.Unregistered where import Control.Monad -import Data.ByteString (ByteString) -import Data.String (IsString) import Foreign.Marshal.Alloc (free) -import Foreign.Ptr (Ptr, nullPtr) +import Foreign.Ptr (Ptr) import Foreign.Storable (peek) import qualified Network.GRPC.Unsafe as C -import qualified Network.GRPC.Unsafe.ByteBuffer as C import qualified Network.GRPC.Unsafe.Metadata as C -import qualified Network.GRPC.Unsafe.Time as C import Network.GRPC.LowLevel.Call import Network.GRPC.LowLevel.GRPC (MetadataMap, grpcDebug) @@ -20,56 +16,57 @@ import Network.GRPC.LowLevel.GRPC (MetadataMap, grpcDebug) -- | Represents one unregistered GRPC call on the server. -- Contains pointers to all the C state needed to respond to an unregistered -- call. -data ServerUnregCall = ServerUnregCall - {internalServerUnregCall :: C.Call, - requestMetadataRecvUnreg :: Ptr C.MetadataArray, - parentPtrUnreg :: Maybe (Ptr C.Call), - callDetails :: C.CallDetails} +data ServerCall = ServerCall + { internalServerCall :: C.Call + , requestMetadataRecv :: Ptr C.MetadataArray + , parentPtr :: Maybe (Ptr C.Call) + , callDetails :: C.CallDetails + } -serverUnregCallGetMetadata :: ServerUnregCall -> IO MetadataMap -serverUnregCallGetMetadata ServerUnregCall{..} = do - marray <- peek requestMetadataRecvUnreg +serverCallGetMetadata :: ServerCall -> IO MetadataMap +serverCallGetMetadata ServerCall{..} = do + marray <- peek requestMetadataRecv C.getAllMetadataArray marray -serverUnregCallGetMethodName :: ServerUnregCall -> IO MethodName -serverUnregCallGetMethodName ServerUnregCall{..} = +serverCallGetMethodName :: ServerCall -> IO MethodName +serverCallGetMethodName ServerCall{..} = MethodName <$> C.callDetailsGetMethod callDetails -serverUnregCallGetHost :: ServerUnregCall -> IO Host -serverUnregCallGetHost ServerUnregCall{..} = +serverCallGetHost :: ServerCall -> IO Host +serverCallGetHost ServerCall{..} = Host <$> C.callDetailsGetHost callDetails -debugServerUnregCall :: ServerUnregCall -> IO () +debugServerCall :: ServerCall -> IO () #ifdef DEBUG -debugServerUnregCall call@(ServerUnregCall (C.Call ptr) _ _ _) = do - grpcDebug $ "debugServerUnregCall: server call: " ++ (show ptr) - grpcDebug $ "debugServerUnregCall: metadata ptr: " - ++ show (requestMetadataRecvUnreg call) - metadataArr <- peek (requestMetadataRecvUnreg call) +debugServerCall call@(ServerCall (C.Call ptr) _ _ _) = do + grpcDebug $ "debugServerCall(U): server call: " ++ (show ptr) + grpcDebug $ "debugServerCall(U): metadata ptr: " + ++ show (requestMetadataRecv call) + metadataArr <- peek (requestMetadataRecv call) metadata <- C.getAllMetadataArray metadataArr - grpcDebug $ "debugServerUnregCall: metadata received: " ++ (show metadata) - forM_ (parentPtrUnreg call) $ \parentPtr' -> do - grpcDebug $ "debugServerRegCall: parent ptr: " ++ show parentPtr' + grpcDebug $ "debugServerCall(U): metadata received: " ++ (show metadata) + forM_ (parentPtr call) $ \parentPtr' -> do + grpcDebug $ "debugServerCall(U): parent ptr: " ++ show parentPtr' (C.Call parent) <- peek parentPtr' - grpcDebug $ "debugServerRegCall: parent: " ++ show parent - grpcDebug $ "debugServerUnregCall: callDetails ptr: " + grpcDebug $ "debugServerCall(U): parent: " ++ show parent + grpcDebug $ "debugServerCall(U): callDetails ptr: " ++ show (callDetails call) --TODO: need functions for getting data out of call_details. #else -{-# INLINE debugServerUnregCall #-} -debugServerUnregCall = const $ return () +{-# INLINE debugServerCall #-} +debugServerCall = const $ return () #endif -destroyServerUnregCall :: ServerUnregCall -> IO () -destroyServerUnregCall call@ServerUnregCall{..} = do - grpcDebug "destroyServerUnregCall: entered." - debugServerUnregCall call +destroyServerCall :: ServerCall -> IO () +destroyServerCall call@ServerCall{..} = do + grpcDebug "destroyServerCall(U): entered." + debugServerCall call grpcDebug $ "Destroying server-side call object: " - ++ show internalServerUnregCall - C.grpcCallDestroy internalServerUnregCall - grpcDebug $ "destroying metadata array: " ++ show requestMetadataRecvUnreg - C.metadataArrayDestroy requestMetadataRecvUnreg - grpcDebug $ "freeing parentPtrUnreg: " ++ show parentPtrUnreg - forM_ parentPtrUnreg free + ++ show internalServerCall + C.grpcCallDestroy internalServerCall + grpcDebug $ "destroying metadata array: " ++ show requestMetadataRecv + C.metadataArrayDestroy requestMetadataRecv + grpcDebug $ "freeing parentPtr: " ++ show parentPtr + forM_ parentPtr free grpcDebug $ "destroying call details: " ++ show callDetails C.destroyCallDetails callDetails diff --git a/src/Network/GRPC/LowLevel/CompletionQueue.hs b/src/Network/GRPC/LowLevel/CompletionQueue.hs index 2b63978..44ebddb 100644 --- a/src/Network/GRPC/LowLevel/CompletionQueue.hs +++ b/src/Network/GRPC/LowLevel/CompletionQueue.hs @@ -47,7 +47,7 @@ import qualified Network.GRPC.Unsafe.Time as C import System.Timeout (timeout) import Network.GRPC.LowLevel.Call -import Network.GRPC.LowLevel.Call.Unregistered +import qualified Network.GRPC.LowLevel.Call.Unregistered as U import Network.GRPC.LowLevel.GRPC -- NOTE: the concurrency requirements for a CompletionQueue are a little @@ -310,7 +310,7 @@ serverRequestRegisteredCall free bbPtr serverRequestCall :: C.Server -> CompletionQueue -> TimeoutSeconds - -> IO (Either GRPCIOError ServerUnregCall) + -> IO (Either GRPCIOError U.ServerCall) serverRequestCall server cq@CompletionQueue{..} timeLimit = withPermission Push cq $ do callPtr <- malloc @@ -337,10 +337,10 @@ serverRequestCall server cq@CompletionQueue{..} timeLimit = return $ Left x Right () -> do rawCall <- peek callPtr - let call = ServerUnregCall rawCall - metadataArrayPtr - Nothing - callDetails + let call = U.ServerCall rawCall + metadataArrayPtr + Nothing + callDetails return $ Right call --TODO: the gRPC library appears to hold onto these pointers for a random diff --git a/src/Network/GRPC/LowLevel/Op.hs b/src/Network/GRPC/LowLevel/Op.hs index b654605..9d71bb1 100644 --- a/src/Network/GRPC/LowLevel/Op.hs +++ b/src/Network/GRPC/LowLevel/Op.hs @@ -20,7 +20,7 @@ import qualified Network.GRPC.Unsafe.Metadata as C import qualified Network.GRPC.Unsafe.Op as C import Network.GRPC.LowLevel.Call -import Network.GRPC.LowLevel.Call.Unregistered +import Network.GRPC.LowLevel.Call.Unregistered as U import Network.GRPC.LowLevel.CompletionQueue import Network.GRPC.LowLevel.GRPC @@ -243,12 +243,12 @@ runServerRegOps :: ServerRegCall -> IO (Either GRPCIOError [OpRecvResult]) runServerRegOps = runOps . internalServerRegCall -runServerUnregOps :: ServerUnregCall +runServerUnregOps :: U.ServerCall -> CompletionQueue -> [Op] -> TimeoutSeconds -> IO (Either GRPCIOError [OpRecvResult]) -runServerUnregOps = runOps . internalServerUnregCall +runServerUnregOps = runOps . U.internalServerCall -- | Like 'runServerOps', but for client-side calls. runClientOps :: ClientCall diff --git a/src/Network/GRPC/LowLevel/Server/Unregistered.hs b/src/Network/GRPC/LowLevel/Server/Unregistered.hs index d9bcb0c..e5f630c 100644 --- a/src/Network/GRPC/LowLevel/Server/Unregistered.hs +++ b/src/Network/GRPC/LowLevel/Server/Unregistered.hs @@ -2,35 +2,24 @@ module Network.GRPC.LowLevel.Server.Unregistered where -import Control.Exception (bracket, finally) -import Control.Monad +import Control.Exception (finally) import Data.ByteString (ByteString) -import Foreign.Ptr (nullPtr) -import qualified Network.GRPC.Unsafe as C -import qualified Network.GRPC.Unsafe.Op as C - -import Network.GRPC.LowLevel.Call +import Network.GRPC.LowLevel.Call (MethodName) import Network.GRPC.LowLevel.Call.Unregistered -import Network.GRPC.LowLevel.CompletionQueue (CompletionQueue, - TimeoutSeconds, - createCompletionQueue, - pluck, - serverRegisterCompletionQueue, - serverRequestCall, - serverRequestRegisteredCall, - serverShutdownAndNotify, - shutdownCompletionQueue) +import Network.GRPC.LowLevel.CompletionQueue (TimeoutSeconds, + serverRequestCall) import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.Op import Network.GRPC.LowLevel.Server +import qualified Network.GRPC.Unsafe.Op as C serverCreateUnregCall :: Server -> TimeoutSeconds - -> IO (Either GRPCIOError ServerUnregCall) + -> IO (Either GRPCIOError ServerCall) serverCreateUnregCall Server{..} timeLimit = serverRequestCall internalServer serverCQ timeLimit withServerUnregCall :: Server -> TimeoutSeconds - -> (ServerUnregCall -> IO (Either GRPCIOError a)) + -> (ServerCall -> IO (Either GRPCIOError a)) -> IO (Either GRPCIOError a) withServerUnregCall server timeout f = do createResult <- serverCreateUnregCall server timeout @@ -38,7 +27,7 @@ withServerUnregCall server timeout f = do Left x -> return $ Left x Right call -> f call `finally` logDestroy call where logDestroy c = grpcDebug "withServerCall: destroying." - >> destroyServerUnregCall c + >> destroyServerCall c -- TODO: This is preliminary. -- We still need to provide the method name to the handler. @@ -60,10 +49,10 @@ serverHandleNormalCall s@Server{..} timeLimit srvMetadata f = do Left x -> do grpcDebug "serverHandleNormalCall: ops failed; aborting" return $ Left x Right [OpRecvMessageResult (Just body)] -> do - requestMeta <- serverUnregCallGetMetadata call + requestMeta <- serverCallGetMetadata call grpcDebug $ "got client metadata: " ++ show requestMeta - methodName <- serverUnregCallGetMethodName call - hostName <- serverUnregCallGetHost call + methodName <- serverCallGetMethodName call + hostName <- serverCallGetHost call grpcDebug $ "call_details host is: " ++ show hostName (respBody, respMetadata, details) <- f body requestMeta methodName let status = C.GrpcStatusOk