Rename unreg operations in Network.GRPC.LowLevel.Call.Unregistered

This commit is contained in:
Joel Stanley 2016-06-08 11:41:58 -05:00
parent 386568463a
commit 27a9a6283a
7 changed files with 69 additions and 85 deletions

View file

@ -1,18 +1,20 @@
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
import Control.Concurrent.Async (async, wait) import Control.Concurrent.Async (async, wait)
import Control.Monad (forever) import Control.Monad (forever)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.Map as M import Network.GRPC.LowLevel
import Network.GRPC.LowLevel import qualified Network.GRPC.LowLevel.Server.Unregistered as U
serverMeta :: MetadataMap serverMeta :: MetadataMap
serverMeta = M.fromList [("test_meta", "test_meta_value")] serverMeta = [("test_meta", "test_meta_value")]
handler :: ByteString -> MetadataMap -> MethodName handler :: ByteString -> MetadataMap -> MethodName
-> IO (ByteString, MetadataMap, StatusDetails) -> IO (ByteString, MetadataMap, StatusDetails)
handler reqBody reqMeta method = do handler reqBody _reqMeta _method = do
--putStrLn $ "Got request for method: " ++ show method --putStrLn $ "Got request for method: " ++ show method
--putStrLn $ "Got metadata: " ++ show reqMeta --putStrLn $ "Got metadata: " ++ show reqMeta
return (reqBody, serverMeta, StatusDetails "") return (reqBody, serverMeta, StatusDetails "")
@ -20,7 +22,7 @@ handler reqBody reqMeta method = do
unregMain :: IO () unregMain :: IO ()
unregMain = withGRPC $ \grpc -> do unregMain = withGRPC $ \grpc -> do
withServer grpc (ServerConfig "localhost" 50051 []) $ \server -> forever $ 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 case result of
Left x -> putStrLn $ "handle call result error: " ++ show x Left x -> putStrLn $ "handle call result error: " ++ show x
Right _ -> return () Right _ -> return ()

View file

@ -42,12 +42,12 @@ library
Network.GRPC.Unsafe.Op Network.GRPC.Unsafe.Op
Network.GRPC.Unsafe Network.GRPC.Unsafe
Network.GRPC.LowLevel Network.GRPC.LowLevel
Network.GRPC.LowLevel.Server.Unregistered
other-modules: other-modules:
Network.GRPC.LowLevel.CompletionQueue Network.GRPC.LowLevel.CompletionQueue
Network.GRPC.LowLevel.GRPC Network.GRPC.LowLevel.GRPC
Network.GRPC.LowLevel.Op Network.GRPC.LowLevel.Op
Network.GRPC.LowLevel.Server Network.GRPC.LowLevel.Server
Network.GRPC.LowLevel.Server.Unregistered
Network.GRPC.LowLevel.Call Network.GRPC.LowLevel.Call
Network.GRPC.LowLevel.Call.Unregistered Network.GRPC.LowLevel.Call.Unregistered
Network.GRPC.LowLevel.Client Network.GRPC.LowLevel.Client

View file

@ -30,12 +30,9 @@ GRPC
, ServerConfig(..) , ServerConfig(..)
, Server , Server
, ServerRegCall , ServerRegCall
, ServerUnregCall
, registeredMethods , registeredMethods
, withServer , withServer
, serverHandleNormalRegisteredCall , serverHandleNormalRegisteredCall
, serverHandleNormalCall
, withServerUnregCall
, withServerRegisteredCall , withServerRegisteredCall
-- * Client -- * Client
@ -61,7 +58,6 @@ GRPC
import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.GRPC
import Network.GRPC.LowLevel.Server import Network.GRPC.LowLevel.Server
import Network.GRPC.LowLevel.Server.Unregistered
import Network.GRPC.LowLevel.CompletionQueue import Network.GRPC.LowLevel.CompletionQueue
import Network.GRPC.LowLevel.Op import Network.GRPC.LowLevel.Op
import Network.GRPC.LowLevel.Client import Network.GRPC.LowLevel.Client

View file

@ -3,16 +3,12 @@
module Network.GRPC.LowLevel.Call.Unregistered where module Network.GRPC.LowLevel.Call.Unregistered where
import Control.Monad import Control.Monad
import Data.ByteString (ByteString)
import Data.String (IsString)
import Foreign.Marshal.Alloc (free) import Foreign.Marshal.Alloc (free)
import Foreign.Ptr (Ptr, nullPtr) import Foreign.Ptr (Ptr)
import Foreign.Storable (peek) import Foreign.Storable (peek)
import qualified Network.GRPC.Unsafe as C 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.Metadata as C
import qualified Network.GRPC.Unsafe.Time as C
import Network.GRPC.LowLevel.Call import Network.GRPC.LowLevel.Call
import Network.GRPC.LowLevel.GRPC (MetadataMap, grpcDebug) 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. -- | Represents one unregistered GRPC call on the server.
-- Contains pointers to all the C state needed to respond to an unregistered -- Contains pointers to all the C state needed to respond to an unregistered
-- call. -- call.
data ServerUnregCall = ServerUnregCall data ServerCall = ServerCall
{internalServerUnregCall :: C.Call, { internalServerCall :: C.Call
requestMetadataRecvUnreg :: Ptr C.MetadataArray, , requestMetadataRecv :: Ptr C.MetadataArray
parentPtrUnreg :: Maybe (Ptr C.Call), , parentPtr :: Maybe (Ptr C.Call)
callDetails :: C.CallDetails} , callDetails :: C.CallDetails
}
serverUnregCallGetMetadata :: ServerUnregCall -> IO MetadataMap serverCallGetMetadata :: ServerCall -> IO MetadataMap
serverUnregCallGetMetadata ServerUnregCall{..} = do serverCallGetMetadata ServerCall{..} = do
marray <- peek requestMetadataRecvUnreg marray <- peek requestMetadataRecv
C.getAllMetadataArray marray C.getAllMetadataArray marray
serverUnregCallGetMethodName :: ServerUnregCall -> IO MethodName serverCallGetMethodName :: ServerCall -> IO MethodName
serverUnregCallGetMethodName ServerUnregCall{..} = serverCallGetMethodName ServerCall{..} =
MethodName <$> C.callDetailsGetMethod callDetails MethodName <$> C.callDetailsGetMethod callDetails
serverUnregCallGetHost :: ServerUnregCall -> IO Host serverCallGetHost :: ServerCall -> IO Host
serverUnregCallGetHost ServerUnregCall{..} = serverCallGetHost ServerCall{..} =
Host <$> C.callDetailsGetHost callDetails Host <$> C.callDetailsGetHost callDetails
debugServerUnregCall :: ServerUnregCall -> IO () debugServerCall :: ServerCall -> IO ()
#ifdef DEBUG #ifdef DEBUG
debugServerUnregCall call@(ServerUnregCall (C.Call ptr) _ _ _) = do debugServerCall call@(ServerCall (C.Call ptr) _ _ _) = do
grpcDebug $ "debugServerUnregCall: server call: " ++ (show ptr) grpcDebug $ "debugServerCall(U): server call: " ++ (show ptr)
grpcDebug $ "debugServerUnregCall: metadata ptr: " grpcDebug $ "debugServerCall(U): metadata ptr: "
++ show (requestMetadataRecvUnreg call) ++ show (requestMetadataRecv call)
metadataArr <- peek (requestMetadataRecvUnreg call) metadataArr <- peek (requestMetadataRecv call)
metadata <- C.getAllMetadataArray metadataArr metadata <- C.getAllMetadataArray metadataArr
grpcDebug $ "debugServerUnregCall: metadata received: " ++ (show metadata) grpcDebug $ "debugServerCall(U): metadata received: " ++ (show metadata)
forM_ (parentPtrUnreg call) $ \parentPtr' -> do forM_ (parentPtr call) $ \parentPtr' -> do
grpcDebug $ "debugServerRegCall: parent ptr: " ++ show parentPtr' grpcDebug $ "debugServerCall(U): parent ptr: " ++ show parentPtr'
(C.Call parent) <- peek parentPtr' (C.Call parent) <- peek parentPtr'
grpcDebug $ "debugServerRegCall: parent: " ++ show parent grpcDebug $ "debugServerCall(U): parent: " ++ show parent
grpcDebug $ "debugServerUnregCall: callDetails ptr: " grpcDebug $ "debugServerCall(U): callDetails ptr: "
++ show (callDetails call) ++ show (callDetails call)
--TODO: need functions for getting data out of call_details. --TODO: need functions for getting data out of call_details.
#else #else
{-# INLINE debugServerUnregCall #-} {-# INLINE debugServerCall #-}
debugServerUnregCall = const $ return () debugServerCall = const $ return ()
#endif #endif
destroyServerUnregCall :: ServerUnregCall -> IO () destroyServerCall :: ServerCall -> IO ()
destroyServerUnregCall call@ServerUnregCall{..} = do destroyServerCall call@ServerCall{..} = do
grpcDebug "destroyServerUnregCall: entered." grpcDebug "destroyServerCall(U): entered."
debugServerUnregCall call debugServerCall call
grpcDebug $ "Destroying server-side call object: " grpcDebug $ "Destroying server-side call object: "
++ show internalServerUnregCall ++ show internalServerCall
C.grpcCallDestroy internalServerUnregCall C.grpcCallDestroy internalServerCall
grpcDebug $ "destroying metadata array: " ++ show requestMetadataRecvUnreg grpcDebug $ "destroying metadata array: " ++ show requestMetadataRecv
C.metadataArrayDestroy requestMetadataRecvUnreg C.metadataArrayDestroy requestMetadataRecv
grpcDebug $ "freeing parentPtrUnreg: " ++ show parentPtrUnreg grpcDebug $ "freeing parentPtr: " ++ show parentPtr
forM_ parentPtrUnreg free forM_ parentPtr free
grpcDebug $ "destroying call details: " ++ show callDetails grpcDebug $ "destroying call details: " ++ show callDetails
C.destroyCallDetails callDetails C.destroyCallDetails callDetails

View file

@ -47,7 +47,7 @@ import qualified Network.GRPC.Unsafe.Time as C
import System.Timeout (timeout) import System.Timeout (timeout)
import Network.GRPC.LowLevel.Call 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 import Network.GRPC.LowLevel.GRPC
-- NOTE: the concurrency requirements for a CompletionQueue are a little -- NOTE: the concurrency requirements for a CompletionQueue are a little
@ -310,7 +310,7 @@ serverRequestRegisteredCall
free bbPtr free bbPtr
serverRequestCall :: C.Server -> CompletionQueue -> TimeoutSeconds serverRequestCall :: C.Server -> CompletionQueue -> TimeoutSeconds
-> IO (Either GRPCIOError ServerUnregCall) -> IO (Either GRPCIOError U.ServerCall)
serverRequestCall server cq@CompletionQueue{..} timeLimit = serverRequestCall server cq@CompletionQueue{..} timeLimit =
withPermission Push cq $ do withPermission Push cq $ do
callPtr <- malloc callPtr <- malloc
@ -337,10 +337,10 @@ serverRequestCall server cq@CompletionQueue{..} timeLimit =
return $ Left x return $ Left x
Right () -> do Right () -> do
rawCall <- peek callPtr rawCall <- peek callPtr
let call = ServerUnregCall rawCall let call = U.ServerCall rawCall
metadataArrayPtr metadataArrayPtr
Nothing Nothing
callDetails callDetails
return $ Right call return $ Right call
--TODO: the gRPC library appears to hold onto these pointers for a random --TODO: the gRPC library appears to hold onto these pointers for a random

View file

@ -20,7 +20,7 @@ import qualified Network.GRPC.Unsafe.Metadata as C
import qualified Network.GRPC.Unsafe.Op as C import qualified Network.GRPC.Unsafe.Op as C
import Network.GRPC.LowLevel.Call 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.CompletionQueue
import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.GRPC
@ -243,12 +243,12 @@ runServerRegOps :: ServerRegCall
-> IO (Either GRPCIOError [OpRecvResult]) -> IO (Either GRPCIOError [OpRecvResult])
runServerRegOps = runOps . internalServerRegCall runServerRegOps = runOps . internalServerRegCall
runServerUnregOps :: ServerUnregCall runServerUnregOps :: U.ServerCall
-> CompletionQueue -> CompletionQueue
-> [Op] -> [Op]
-> TimeoutSeconds -> TimeoutSeconds
-> IO (Either GRPCIOError [OpRecvResult]) -> IO (Either GRPCIOError [OpRecvResult])
runServerUnregOps = runOps . internalServerUnregCall runServerUnregOps = runOps . U.internalServerCall
-- | Like 'runServerOps', but for client-side calls. -- | Like 'runServerOps', but for client-side calls.
runClientOps :: ClientCall runClientOps :: ClientCall

View file

@ -2,35 +2,24 @@
module Network.GRPC.LowLevel.Server.Unregistered where module Network.GRPC.LowLevel.Server.Unregistered where
import Control.Exception (bracket, finally) import Control.Exception (finally)
import Control.Monad
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Foreign.Ptr (nullPtr) import Network.GRPC.LowLevel.Call (MethodName)
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.Unregistered import Network.GRPC.LowLevel.Call.Unregistered
import Network.GRPC.LowLevel.CompletionQueue (CompletionQueue, import Network.GRPC.LowLevel.CompletionQueue (TimeoutSeconds,
TimeoutSeconds, serverRequestCall)
createCompletionQueue,
pluck,
serverRegisterCompletionQueue,
serverRequestCall,
serverRequestRegisteredCall,
serverShutdownAndNotify,
shutdownCompletionQueue)
import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.GRPC
import Network.GRPC.LowLevel.Op import Network.GRPC.LowLevel.Op
import Network.GRPC.LowLevel.Server import Network.GRPC.LowLevel.Server
import qualified Network.GRPC.Unsafe.Op as C
serverCreateUnregCall :: Server -> TimeoutSeconds serverCreateUnregCall :: Server -> TimeoutSeconds
-> IO (Either GRPCIOError ServerUnregCall) -> IO (Either GRPCIOError ServerCall)
serverCreateUnregCall Server{..} timeLimit = serverCreateUnregCall Server{..} timeLimit =
serverRequestCall internalServer serverCQ timeLimit serverRequestCall internalServer serverCQ timeLimit
withServerUnregCall :: Server -> TimeoutSeconds withServerUnregCall :: Server -> TimeoutSeconds
-> (ServerUnregCall -> IO (Either GRPCIOError a)) -> (ServerCall -> IO (Either GRPCIOError a))
-> IO (Either GRPCIOError a) -> IO (Either GRPCIOError a)
withServerUnregCall server timeout f = do withServerUnregCall server timeout f = do
createResult <- serverCreateUnregCall server timeout createResult <- serverCreateUnregCall server timeout
@ -38,7 +27,7 @@ withServerUnregCall server timeout f = do
Left x -> return $ Left x Left x -> return $ Left x
Right call -> f call `finally` logDestroy call Right call -> f call `finally` logDestroy call
where logDestroy c = grpcDebug "withServerCall: destroying." where logDestroy c = grpcDebug "withServerCall: destroying."
>> destroyServerUnregCall c >> destroyServerCall c
-- TODO: This is preliminary. -- TODO: This is preliminary.
-- We still need to provide the method name to the handler. -- 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" Left x -> do grpcDebug "serverHandleNormalCall: ops failed; aborting"
return $ Left x return $ Left x
Right [OpRecvMessageResult (Just body)] -> do Right [OpRecvMessageResult (Just body)] -> do
requestMeta <- serverUnregCallGetMetadata call requestMeta <- serverCallGetMetadata call
grpcDebug $ "got client metadata: " ++ show requestMeta grpcDebug $ "got client metadata: " ++ show requestMeta
methodName <- serverUnregCallGetMethodName call methodName <- serverCallGetMethodName call
hostName <- serverUnregCallGetHost call hostName <- serverCallGetHost call
grpcDebug $ "call_details host is: " ++ show hostName grpcDebug $ "call_details host is: " ++ show hostName
(respBody, respMetadata, details) <- f body requestMeta methodName (respBody, respMetadata, details) <- f body requestMeta methodName
let status = C.GrpcStatusOk let status = C.GrpcStatusOk