mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-23 03:29:42 +01:00
Rename unreg operations in Network.GRPC.LowLevel.Call.Unregistered
This commit is contained in:
parent
386568463a
commit
27a9a6283a
7 changed files with 69 additions and 85 deletions
|
@ -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 ()
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue