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

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,
optUseCompression :: Bool,
optUserAgentPrefix :: String,
optUserAgentSuffix :: String}
optUserAgentSuffix :: String,
optInitialMetadata :: MetadataMap}
defaultOptions :: ServerOptions
defaultOptions =
@ -186,7 +187,8 @@ defaultOptions =
optServerPort = 50051,
optUseCompression = False,
optUserAgentPrefix = "grpc-haskell/0.0.0",
optUserAgentSuffix = ""}
optUserAgentSuffix = "",
optInitialMetadata = mempty}
serverLoop :: ServerOptions -> IO ()
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
dispatchLoop :: Server
-> MetadataMap
-> [Handler 'Normal]
-> [Handler 'ClientStreaming]
-> [Handler 'ServerStreaming]
-> [Handler 'BiDiStreaming]
-> IO ()
dispatchLoop server hN hC hS hB =
dispatchLoop server meta hN hC hS hB =
forever $ U.withServerCallAsync server $ \call -> do
case findHandler call allHandlers of
Just (AnyHandler (UnaryHandler _ h)) -> unaryHandler call h
@ -35,7 +36,7 @@ dispatchLoop server hN hC hS hB =
findHandler call = find ((== (U.callMethod call))
. anyHandlerMethodName)
unknownHandler call =
void $ U.serverHandleNormalCall' server call mempty $ \_ _ ->
void $ U.serverHandleNormalCall' server call meta $ \_ _ ->
return (mempty
, mempty
, StatusNotFound
@ -47,7 +48,7 @@ dispatchLoop server hN hC hS hB =
-> IO ()
unaryHandler call h =
handleError $
U.serverHandleNormalCall' server call mempty $ \_call' bs ->
U.serverHandleNormalCall' server call meta $ \_call' bs ->
convertServerHandler h (fmap (const bs) $ U.convertCall call)
csHandler :: (Message a, Message b) =>
U.ServerCall
@ -55,27 +56,28 @@ dispatchLoop server hN hC hS hB =
-> IO ()
csHandler call h =
handleError $
U.serverReader server call mempty (convertServerReaderHandler h)
U.serverReader server call meta (convertServerReaderHandler h)
ssHandler :: (Message a, Message b) =>
U.ServerCall
-> ServerWriterHandler a b
-> IO ()
ssHandler call h =
handleError $
U.serverWriter server call mempty (convertServerWriterHandler h)
U.serverWriter server call meta (convertServerWriterHandler h)
bdHandler :: (Message a, Message b) =>
U.ServerCall
-> ServerRWHandler a b
-> IO ()
bdHandler call h =
handleError $
U.serverRW server call mempty (convertServerRWHandler h)
U.serverRW server call meta (convertServerRWHandler h)
serverLoop :: ServerOptions -> IO ()
serverLoop ServerOptions{..} =
withGRPC $ \grpc ->
withServer grpc config $ \server -> do
dispatchLoop server
optInitialMetadata
optNormalHandlers
optClientStreamHandlers
optServerStreamHandlers