mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-23 11:39:43 +01:00
high-level server: add initial metadata to options (#53)
This commit is contained in:
parent
334e78de27
commit
b3d0b8a4a7
2 changed files with 12 additions and 8 deletions
|
@ -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 =
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue