eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-06-02 02:53:37 +02:00
Code Issues Projects Releases Wiki Activity

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

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
examples/echo/echo-server/Main.hs
View File

@ -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 ()

2
grpc-haskell.cabal
View File

@ -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

4
src/Network/GRPC/LowLevel.hs
View File

@ -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

77
src/Network/GRPC/LowLevel/Call/Unregistered.hs
View File

@ -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

12
src/Network/GRPC/LowLevel/CompletionQueue.hs
View File

@ -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

6
src/Network/GRPC/LowLevel/Op.hs
View File

@ -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

33
src/Network/GRPC/LowLevel/Server/Unregistered.hs
View File

@ -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