eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-11-27 05:29:43 +01:00
Code Issues Projects Releases Wiki Activity

high-level server: add initial metadata to options (#53)

Browse source
This commit is contained in:
Connor Clark 2016-07-26 13:16:44 -07:00
parent 334e78de27
commit b3d0b8a4a7
2 changed files with 12 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/Network/GRPC/HighLevel/Server.hs
View file

@ -175,7 +175,8 @@ data ServerOptions = ServerOptions
optServerPort :: Port, optServerPort :: Port,
optUseCompression :: Bool, optUseCompression :: Bool,
optUserAgentPrefix :: String, optUserAgentPrefix :: String,
optUserAgentSuffix :: String} optUserAgentSuffix :: String,
optInitialMetadata :: MetadataMap}
defaultOptions :: ServerOptions defaultOptions :: ServerOptions
defaultOptions = defaultOptions =
@ -186,7 +187,8 @@ defaultOptions =
optServerPort = 50051, optServerPort = 50051,
optUseCompression = False, optUseCompression = False,
optUserAgentPrefix = "grpc-haskell/0.0.0", optUserAgentPrefix = "grpc-haskell/0.0.0",
optUserAgentSuffix = ""} optUserAgentSuffix = "",
optInitialMetadata = mempty}
serverLoop :: ServerOptions -> IO () serverLoop :: ServerOptions -> IO ()
serverLoop opts = serverLoop opts =

14
src/Network/GRPC/HighLevel/Server/Unregistered.hs
View file

@ -15,12 +15,13 @@ import qualified Network.GRPC.LowLevel.Server.Unregistered as U
import qualified Network.GRPC.LowLevel.Call.Unregistered as U import qualified Network.GRPC.LowLevel.Call.Unregistered as U
dispatchLoop :: Server dispatchLoop :: Server
-> MetadataMap
-> [Handler 'Normal] -> [Handler 'Normal]
-> [Handler 'ClientStreaming] -> [Handler 'ClientStreaming]
-> [Handler 'ServerStreaming] -> [Handler 'ServerStreaming]
-> [Handler 'BiDiStreaming] -> [Handler 'BiDiStreaming]
-> IO () -> IO ()
dispatchLoop server hN hC hS hB = dispatchLoop server meta hN hC hS hB =
forever $ U.withServerCallAsync server $ \call -> do forever $ U.withServerCallAsync server $ \call -> do
case findHandler call allHandlers of case findHandler call allHandlers of
Just (AnyHandler (UnaryHandler _ h)) -> unaryHandler call h Just (AnyHandler (UnaryHandler _ h)) -> unaryHandler call h
@ -35,7 +36,7 @@ dispatchLoop server hN hC hS hB =
findHandler call = find ((== (U.callMethod call)) findHandler call = find ((== (U.callMethod call))
. anyHandlerMethodName) . anyHandlerMethodName)
unknownHandler call = unknownHandler call =
void $ U.serverHandleNormalCall' server call mempty $ \_ _ -> void $ U.serverHandleNormalCall' server call meta $ \_ _ ->
return (mempty return (mempty
, mempty , mempty
, StatusNotFound , StatusNotFound
@ -47,7 +48,7 @@ dispatchLoop server hN hC hS hB =
-> IO () -> IO ()
unaryHandler call h = unaryHandler call h =
handleError $ handleError $
U.serverHandleNormalCall' server call mempty $ \_call' bs -> U.serverHandleNormalCall' server call meta $ \_call' bs ->
convertServerHandler h (fmap (const bs) $ U.convertCall call) convertServerHandler h (fmap (const bs) $ U.convertCall call)
csHandler :: (Message a, Message b) => csHandler :: (Message a, Message b) =>
U.ServerCall U.ServerCall
@ -55,27 +56,28 @@ dispatchLoop server hN hC hS hB =
-> IO () -> IO ()
csHandler call h = csHandler call h =
handleError $ handleError $
U.serverReader server call mempty (convertServerReaderHandler h) U.serverReader server call meta (convertServerReaderHandler h)
ssHandler :: (Message a, Message b) => ssHandler :: (Message a, Message b) =>
U.ServerCall U.ServerCall
-> ServerWriterHandler a b -> ServerWriterHandler a b
-> IO () -> IO ()
ssHandler call h = ssHandler call h =
handleError $ handleError $
U.serverWriter server call mempty (convertServerWriterHandler h) U.serverWriter server call meta (convertServerWriterHandler h)
bdHandler :: (Message a, Message b) => bdHandler :: (Message a, Message b) =>
U.ServerCall U.ServerCall
-> ServerRWHandler a b -> ServerRWHandler a b
-> IO () -> IO ()
bdHandler call h = bdHandler call h =
handleError $ handleError $
U.serverRW server call mempty (convertServerRWHandler h) U.serverRW server call meta (convertServerRWHandler h)
serverLoop :: ServerOptions -> IO () serverLoop :: ServerOptions -> IO ()
serverLoop ServerOptions{..} = serverLoop ServerOptions{..} =
withGRPC $ \grpc -> withGRPC $ \grpc ->
withServer grpc config $ \server -> do withServer grpc config $ \server -> do
dispatchLoop server dispatchLoop server
optInitialMetadata
optNormalHandlers optNormalHandlers
optClientStreamHandlers optClientStreamHandlers
optServerStreamHandlers optServerStreamHandlers