{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Network.GRPC.HighLevel.Server where
import qualified Control.Exception as CE
import Control.Monad
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL
import Network.GRPC.LowLevel
import Numeric.Natural
import Proto3.Suite.Class
import System.IO
type ServerCallMetadata = ServerCall ()
type ServiceServer service = service ServerRequest ServerResponse
data ServerRequest (streamType :: GRPCMethodType) request response where
ServerNormalRequest :: ServerCallMetadata -> request -> ServerRequest 'Normal request response
ServerReaderRequest :: ServerCallMetadata -> StreamRecv request -> ServerRequest 'ClientStreaming request response
ServerWriterRequest :: ServerCallMetadata -> request -> StreamSend response -> ServerRequest 'ServerStreaming request response
ServerBiDiRequest :: ServerCallMetadata -> StreamRecv request -> StreamSend response -> ServerRequest 'BiDiStreaming request response
data ServerResponse (streamType :: GRPCMethodType) response where
ServerNormalResponse :: response -> MetadataMap -> StatusCode -> StatusDetails
-> ServerResponse 'Normal response
ServerReaderResponse :: Maybe response -> MetadataMap -> StatusCode -> StatusDetails
-> ServerResponse 'ClientStreaming response
ServerWriterResponse :: MetadataMap -> StatusCode -> StatusDetails
-> ServerResponse 'ServerStreaming response
ServerBiDiResponse :: MetadataMap -> StatusCode -> StatusDetails
-> ServerResponse 'BiDiStreaming response
type ServerHandler a b =
ServerCall a
-> IO (b, MetadataMap, StatusCode, StatusDetails)
convertGeneratedServerHandler ::
(ServerRequest 'Normal request response -> IO (ServerResponse 'Normal response))
-> ServerHandler request response
convertGeneratedServerHandler :: (ServerRequest 'Normal request response
-> IO (ServerResponse 'Normal response))
-> ServerHandler request response
convertGeneratedServerHandler ServerRequest 'Normal request response
-> IO (ServerResponse 'Normal response)
handler ServerCall request
call =
do let call' :: ServerCall ()
call' = ServerCall request
call { payload :: ()
payload = () }
ServerNormalResponse response
rsp MetadataMap
meta StatusCode
stsCode StatusDetails
stsDetails <-
ServerRequest 'Normal request response
-> IO (ServerResponse 'Normal response)
handler (ServerCall () -> request -> ServerRequest 'Normal request response
forall request response.
ServerCall () -> request -> ServerRequest 'Normal request response
ServerNormalRequest ServerCall ()
call' (ServerCall request -> request
forall a. ServerCall a -> a
payload ServerCall request
call))
(response, MetadataMap, StatusCode, StatusDetails)
-> IO (response, MetadataMap, StatusCode, StatusDetails)
forall (m :: * -> *) a. Monad m => a -> m a
return (response
rsp, MetadataMap
meta, StatusCode
stsCode, StatusDetails
stsDetails)
convertServerHandler :: (Message a, Message b)
=> ServerHandler a b
-> ServerHandlerLL
convertServerHandler :: ServerHandler a b -> ServerHandlerLL
convertServerHandler ServerHandler a b
f ServerCall (MethodPayload 'Normal)
c = case ByteString -> Either ParseError a
forall a. Message a => ByteString -> Either ParseError a
fromByteString (ServerCall ByteString -> ByteString
forall a. ServerCall a -> a
payload ServerCall ByteString
ServerCall (MethodPayload 'Normal)
c) of
Left ParseError
x -> GRPCIOError
-> IO (ByteString, MetadataMap, StatusCode, StatusDetails)
forall a e. Exception e => e -> a
CE.throw (String -> GRPCIOError
GRPCIODecodeError (String -> GRPCIOError) -> String -> GRPCIOError
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
x)
Right a
x -> do (b
y, MetadataMap
tm, StatusCode
sc, StatusDetails
sd) <- ServerHandler a b
f ((ByteString -> a) -> ServerCall ByteString -> ServerCall a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> ByteString -> a
forall a b. a -> b -> a
const a
x) ServerCall ByteString
ServerCall (MethodPayload 'Normal)
c)
(ByteString, MetadataMap, StatusCode, StatusDetails)
-> IO (ByteString, MetadataMap, StatusCode, StatusDetails)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ByteString
forall a. Message a => a -> ByteString
toBS b
y, MetadataMap
tm, StatusCode
sc, StatusDetails
sd)
type ServerReaderHandler a b
= ServerCall (MethodPayload 'ClientStreaming)
-> StreamRecv a
-> IO (Maybe b, MetadataMap, StatusCode, StatusDetails)
convertGeneratedServerReaderHandler ::
(ServerRequest 'ClientStreaming request response -> IO (ServerResponse 'ClientStreaming response))
-> ServerReaderHandler request response
convertGeneratedServerReaderHandler :: (ServerRequest 'ClientStreaming request response
-> IO (ServerResponse 'ClientStreaming response))
-> ServerReaderHandler request response
convertGeneratedServerReaderHandler ServerRequest 'ClientStreaming request response
-> IO (ServerResponse 'ClientStreaming response)
handler ServerCall (MethodPayload 'ClientStreaming)
call StreamRecv request
recv =
do ServerReaderResponse Maybe response
rsp MetadataMap
meta StatusCode
stsCode StatusDetails
stsDetails <-
ServerRequest 'ClientStreaming request response
-> IO (ServerResponse 'ClientStreaming response)
handler (ServerCall ()
-> StreamRecv request
-> ServerRequest 'ClientStreaming request response
forall request response.
ServerCall ()
-> StreamRecv request
-> ServerRequest 'ClientStreaming request response
ServerReaderRequest ServerCall ()
ServerCall (MethodPayload 'ClientStreaming)
call StreamRecv request
recv)
(Maybe response, MetadataMap, StatusCode, StatusDetails)
-> IO (Maybe response, MetadataMap, StatusCode, StatusDetails)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe response
rsp, MetadataMap
meta, StatusCode
stsCode, StatusDetails
stsDetails)
convertServerReaderHandler :: (Message a, Message b)
=> ServerReaderHandler a b
-> ServerReaderHandlerLL
convertServerReaderHandler :: ServerReaderHandler a b -> ServerReaderHandlerLL
convertServerReaderHandler ServerReaderHandler a b
f ServerCall (MethodPayload 'ClientStreaming)
c StreamRecv ByteString
recv =
(Maybe b, MetadataMap, StatusCode, StatusDetails)
-> (Maybe ByteString, MetadataMap, StatusCode, StatusDetails)
forall (f :: * -> *) a b c d.
(Functor f, Message a) =>
(f a, b, c, d) -> (f ByteString, b, c, d)
serialize ((Maybe b, MetadataMap, StatusCode, StatusDetails)
-> (Maybe ByteString, MetadataMap, StatusCode, StatusDetails))
-> IO (Maybe b, MetadataMap, StatusCode, StatusDetails)
-> IO (Maybe ByteString, MetadataMap, StatusCode, StatusDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServerReaderHandler a b
f ServerCall (MethodPayload 'ClientStreaming)
c (StreamRecv ByteString -> StreamRecv a
forall a. Message a => StreamRecv ByteString -> StreamRecv a
convertRecv StreamRecv ByteString
recv)
where
serialize :: (f a, b, c, d) -> (f ByteString, b, c, d)
serialize (f a
mmsg, b
m, c
sc, d
sd) = (a -> ByteString
forall a. Message a => a -> ByteString
toBS (a -> ByteString) -> f a -> f ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
mmsg, b
m, c
sc, d
sd)
type ServerWriterHandler a b =
ServerCall a
-> StreamSend b
-> IO (MetadataMap, StatusCode, StatusDetails)
convertGeneratedServerWriterHandler ::
(ServerRequest 'ServerStreaming request response -> IO (ServerResponse 'ServerStreaming response))
-> ServerWriterHandler request response
convertGeneratedServerWriterHandler :: (ServerRequest 'ServerStreaming request response
-> IO (ServerResponse 'ServerStreaming response))
-> ServerWriterHandler request response
convertGeneratedServerWriterHandler ServerRequest 'ServerStreaming request response
-> IO (ServerResponse 'ServerStreaming response)
handler ServerCall request
call StreamSend response
send =
do let call' :: ServerCall ()
call' = ServerCall request
call { payload :: ()
payload = () }
ServerWriterResponse MetadataMap
meta StatusCode
stsCode StatusDetails
stsDetails <-
ServerRequest 'ServerStreaming request response
-> IO (ServerResponse 'ServerStreaming response)
handler (ServerCall ()
-> request
-> StreamSend response
-> ServerRequest 'ServerStreaming request response
forall request response.
ServerCall ()
-> request
-> StreamSend response
-> ServerRequest 'ServerStreaming request response
ServerWriterRequest ServerCall ()
call' (ServerCall request -> request
forall a. ServerCall a -> a
payload ServerCall request
call) StreamSend response
send)
(MetadataMap, StatusCode, StatusDetails)
-> IO (MetadataMap, StatusCode, StatusDetails)
forall (m :: * -> *) a. Monad m => a -> m a
return (MetadataMap
meta, StatusCode
stsCode, StatusDetails
stsDetails)
convertServerWriterHandler :: (Message a, Message b) =>
ServerWriterHandler a b
-> ServerWriterHandlerLL
convertServerWriterHandler :: ServerWriterHandler a b -> ServerWriterHandlerLL
convertServerWriterHandler ServerWriterHandler a b
f ServerCall (MethodPayload 'ServerStreaming)
c StreamSend ByteString
send =
ServerWriterHandler a b
f (ByteString -> a
forall p. Message p => ByteString -> p
convert (ByteString -> a) -> ServerCall ByteString -> ServerCall a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ServerCall ByteString
ServerCall (MethodPayload 'ServerStreaming)
c) (StreamSend ByteString -> StreamSend b
forall a. Message a => StreamSend ByteString -> StreamSend a
convertSend StreamSend ByteString
send)
where
convert :: ByteString -> p
convert ByteString
bs = case ByteString -> Either ParseError p
forall a. Message a => ByteString -> Either ParseError a
fromByteString ByteString
bs of
Left ParseError
x -> GRPCIOError -> p
forall a e. Exception e => e -> a
CE.throw (String -> GRPCIOError
GRPCIODecodeError (String -> GRPCIOError) -> String -> GRPCIOError
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
x)
Right p
x -> p
x
type ServerRWHandler a b
= ServerCall (MethodPayload 'BiDiStreaming)
-> StreamRecv a
-> StreamSend b
-> IO (MetadataMap, StatusCode, StatusDetails)
convertGeneratedServerRWHandler ::
(ServerRequest 'BiDiStreaming request response -> IO (ServerResponse 'BiDiStreaming response))
-> ServerRWHandler request response
convertGeneratedServerRWHandler :: (ServerRequest 'BiDiStreaming request response
-> IO (ServerResponse 'BiDiStreaming response))
-> ServerRWHandler request response
convertGeneratedServerRWHandler ServerRequest 'BiDiStreaming request response
-> IO (ServerResponse 'BiDiStreaming response)
handler ServerCall (MethodPayload 'BiDiStreaming)
call StreamRecv request
recv StreamSend response
send =
do ServerBiDiResponse MetadataMap
meta StatusCode
stsCode StatusDetails
stsDetails <-
ServerRequest 'BiDiStreaming request response
-> IO (ServerResponse 'BiDiStreaming response)
handler (ServerCall ()
-> StreamRecv request
-> StreamSend response
-> ServerRequest 'BiDiStreaming request response
forall request response.
ServerCall ()
-> StreamRecv request
-> StreamSend response
-> ServerRequest 'BiDiStreaming request response
ServerBiDiRequest ServerCall ()
ServerCall (MethodPayload 'BiDiStreaming)
call StreamRecv request
recv StreamSend response
send)
(MetadataMap, StatusCode, StatusDetails)
-> IO (MetadataMap, StatusCode, StatusDetails)
forall (m :: * -> *) a. Monad m => a -> m a
return (MetadataMap
meta, StatusCode
stsCode, StatusDetails
stsDetails)
convertServerRWHandler :: (Message a, Message b)
=> ServerRWHandler a b
-> ServerRWHandlerLL
convertServerRWHandler :: ServerRWHandler a b -> ServerRWHandlerLL
convertServerRWHandler ServerRWHandler a b
f ServerCall (MethodPayload 'BiDiStreaming)
c StreamRecv ByteString
recv StreamSend ByteString
send =
ServerRWHandler a b
f ServerCall (MethodPayload 'BiDiStreaming)
c (StreamRecv ByteString -> StreamRecv a
forall a. Message a => StreamRecv ByteString -> StreamRecv a
convertRecv StreamRecv ByteString
recv) (StreamSend ByteString -> StreamSend b
forall a. Message a => StreamSend ByteString -> StreamSend a
convertSend StreamSend ByteString
send)
convertRecv :: Message a => StreamRecv ByteString -> StreamRecv a
convertRecv :: StreamRecv ByteString -> StreamRecv a
convertRecv =
(Either GRPCIOError (Maybe ByteString)
-> Either GRPCIOError (Maybe a))
-> StreamRecv ByteString -> StreamRecv a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either GRPCIOError (Maybe ByteString)
-> Either GRPCIOError (Maybe a))
-> StreamRecv ByteString -> StreamRecv a)
-> (Either GRPCIOError (Maybe ByteString)
-> Either GRPCIOError (Maybe a))
-> StreamRecv ByteString
-> StreamRecv a
forall a b. (a -> b) -> a -> b
$ \Either GRPCIOError (Maybe ByteString)
e -> do
Maybe ByteString
msg <- Either GRPCIOError (Maybe ByteString)
e
case Maybe ByteString
msg of
Maybe ByteString
Nothing -> Maybe a -> Either GRPCIOError (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
Just ByteString
bs -> case ByteString -> Either ParseError a
forall a. Message a => ByteString -> Either ParseError a
fromByteString ByteString
bs of
Left ParseError
x -> GRPCIOError -> Either GRPCIOError (Maybe a)
forall a b. a -> Either a b
Left (String -> GRPCIOError
GRPCIODecodeError (String -> GRPCIOError) -> String -> GRPCIOError
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
x)
Right a
x -> Maybe a -> Either GRPCIOError (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
convertSend :: Message a => StreamSend ByteString -> StreamSend a
convertSend :: StreamSend ByteString -> StreamSend a
convertSend StreamSend ByteString
s = StreamSend ByteString
s StreamSend ByteString -> (a -> ByteString) -> StreamSend a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Message a => a -> ByteString
toBS
toBS :: Message a => a -> ByteString
toBS :: a -> ByteString
toBS = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Message a => a -> ByteString
toLazyByteString
data Handler (a :: GRPCMethodType) where
UnaryHandler :: (Message c, Message d) => MethodName -> ServerHandler c d -> Handler 'Normal
ClientStreamHandler :: (Message c, Message d) => MethodName -> ServerReaderHandler c d -> Handler 'ClientStreaming
ServerStreamHandler :: (Message c, Message d) => MethodName -> ServerWriterHandler c d -> Handler 'ServerStreaming
BiDiStreamHandler :: (Message c, Message d) => MethodName -> ServerRWHandler c d -> Handler 'BiDiStreaming
data AnyHandler = forall (a :: GRPCMethodType). AnyHandler (Handler a)
anyHandlerMethodName :: AnyHandler -> MethodName
anyHandlerMethodName :: AnyHandler -> MethodName
anyHandlerMethodName (AnyHandler Handler a
m) = Handler a -> MethodName
forall (a :: GRPCMethodType). Handler a -> MethodName
handlerMethodName Handler a
m
handlerMethodName :: Handler a -> MethodName
handlerMethodName :: Handler a -> MethodName
handlerMethodName (UnaryHandler MethodName
m ServerHandler c d
_) = MethodName
m
handlerMethodName (ClientStreamHandler MethodName
m ServerReaderHandler c d
_) = MethodName
m
handlerMethodName (ServerStreamHandler MethodName
m ServerWriterHandler c d
_) = MethodName
m
handlerMethodName (BiDiStreamHandler MethodName
m ServerRWHandler c d
_) = MethodName
m
handleCallError :: (String -> IO ())
-> Either GRPCIOError a
-> IO ()
handleCallError :: (String -> IO ()) -> Either GRPCIOError a -> IO ()
handleCallError String -> IO ()
_ (Right a
_) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleCallError String -> IO ()
_ (Left GRPCIOError
GRPCIOTimeout) =
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleCallError String -> IO ()
_ (Left GRPCIOError
GRPCIOShutdown) =
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
handleCallError String -> IO ()
logMsg (Left (GRPCIODecodeError String
e)) =
String -> IO ()
logMsg (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Decoding error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
e
handleCallError String -> IO ()
logMsg (Left (GRPCIOHandlerException String
e)) =
String -> IO ()
logMsg (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Handler exception caught: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
e
handleCallError String -> IO ()
logMsg (Left GRPCIOError
x) =
String -> IO ()
logMsg (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ GRPCIOError -> String
forall a. Show a => a -> String
show GRPCIOError
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": This probably indicates a bug in gRPC-haskell. Please report this error."
loopWError :: Int
-> ServerOptions
-> IO (Either GRPCIOError a)
-> IO ()
loopWError :: Int -> ServerOptions -> IO (Either GRPCIOError a) -> IO ()
loopWError Int
i o :: ServerOptions
o@ServerOptions{Bool
String
[Handler 'BiDiStreaming]
[Handler 'ServerStreaming]
[Handler 'ClientStreaming]
[Handler 'Normal]
Maybe Natural
Maybe ServerSSLConfig
Host
Port
MetadataMap
String -> IO ()
optMaxReceiveMessageLength :: ServerOptions -> Maybe Natural
optLogger :: ServerOptions -> String -> IO ()
optSSLConfig :: ServerOptions -> Maybe ServerSSLConfig
optInitialMetadata :: ServerOptions -> MetadataMap
optUserAgentSuffix :: ServerOptions -> String
optUserAgentPrefix :: ServerOptions -> String
optUseCompression :: ServerOptions -> Bool
optServerPort :: ServerOptions -> Port
optServerHost :: ServerOptions -> Host
optBiDiStreamHandlers :: ServerOptions -> [Handler 'BiDiStreaming]
optServerStreamHandlers :: ServerOptions -> [Handler 'ServerStreaming]
optClientStreamHandlers :: ServerOptions -> [Handler 'ClientStreaming]
optNormalHandlers :: ServerOptions -> [Handler 'Normal]
optMaxReceiveMessageLength :: Maybe Natural
optLogger :: String -> IO ()
optSSLConfig :: Maybe ServerSSLConfig
optInitialMetadata :: MetadataMap
optUserAgentSuffix :: String
optUserAgentPrefix :: String
optUseCompression :: Bool
optServerPort :: Port
optServerHost :: Host
optBiDiStreamHandlers :: [Handler 'BiDiStreaming]
optServerStreamHandlers :: [Handler 'ServerStreaming]
optClientStreamHandlers :: [Handler 'ClientStreaming]
optNormalHandlers :: [Handler 'Normal]
..} IO (Either GRPCIOError a)
f = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"i = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
IO (Either GRPCIOError a)
f IO (Either GRPCIOError a)
-> (Either GRPCIOError a -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> IO ()) -> Either GRPCIOError a -> IO ()
forall a. (String -> IO ()) -> Either GRPCIOError a -> IO ()
handleCallError String -> IO ()
optLogger
Int -> ServerOptions -> IO (Either GRPCIOError a) -> IO ()
forall a.
Int -> ServerOptions -> IO (Either GRPCIOError a) -> IO ()
loopWError (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ServerOptions
o IO (Either GRPCIOError a)
f
handleLoop :: Server
-> ServerOptions
-> (Handler a, RegisteredMethod a)
-> IO ()
handleLoop :: Server -> ServerOptions -> (Handler a, RegisteredMethod a) -> IO ()
handleLoop Server
s ServerOptions
o (UnaryHandler MethodName
_ ServerHandler c d
f, RegisteredMethod a
rm) =
Int -> ServerOptions -> IO (Either GRPCIOError ()) -> IO ()
forall a.
Int -> ServerOptions -> IO (Either GRPCIOError a) -> IO ()
loopWError Int
0 ServerOptions
o (IO (Either GRPCIOError ()) -> IO ())
-> IO (Either GRPCIOError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Server
-> RegisteredMethod 'Normal
-> MetadataMap
-> ServerHandlerLL
-> IO (Either GRPCIOError ())
serverHandleNormalCall Server
s RegisteredMethod a
RegisteredMethod 'Normal
rm MetadataMap
forall a. Monoid a => a
mempty (ServerHandlerLL -> IO (Either GRPCIOError ()))
-> ServerHandlerLL -> IO (Either GRPCIOError ())
forall a b. (a -> b) -> a -> b
$ ServerHandler c d -> ServerHandlerLL
forall a b.
(Message a, Message b) =>
ServerHandler a b -> ServerHandlerLL
convertServerHandler ServerHandler c d
f
handleLoop Server
s ServerOptions
o (ClientStreamHandler MethodName
_ ServerReaderHandler c d
f, RegisteredMethod a
rm) =
Int -> ServerOptions -> IO (Either GRPCIOError ()) -> IO ()
forall a.
Int -> ServerOptions -> IO (Either GRPCIOError a) -> IO ()
loopWError Int
0 ServerOptions
o (IO (Either GRPCIOError ()) -> IO ())
-> IO (Either GRPCIOError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Server
-> RegisteredMethod 'ClientStreaming
-> MetadataMap
-> ServerReaderHandlerLL
-> IO (Either GRPCIOError ())
serverReader Server
s RegisteredMethod a
RegisteredMethod 'ClientStreaming
rm MetadataMap
forall a. Monoid a => a
mempty (ServerReaderHandlerLL -> IO (Either GRPCIOError ()))
-> ServerReaderHandlerLL -> IO (Either GRPCIOError ())
forall a b. (a -> b) -> a -> b
$ ServerReaderHandler c d -> ServerReaderHandlerLL
forall a b.
(Message a, Message b) =>
ServerReaderHandler a b -> ServerReaderHandlerLL
convertServerReaderHandler ServerReaderHandler c d
f
handleLoop Server
s ServerOptions
o (ServerStreamHandler MethodName
_ ServerWriterHandler c d
f, RegisteredMethod a
rm) =
Int -> ServerOptions -> IO (Either GRPCIOError ()) -> IO ()
forall a.
Int -> ServerOptions -> IO (Either GRPCIOError a) -> IO ()
loopWError Int
0 ServerOptions
o (IO (Either GRPCIOError ()) -> IO ())
-> IO (Either GRPCIOError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Server
-> RegisteredMethod 'ServerStreaming
-> MetadataMap
-> ServerWriterHandlerLL
-> IO (Either GRPCIOError ())
serverWriter Server
s RegisteredMethod a
RegisteredMethod 'ServerStreaming
rm MetadataMap
forall a. Monoid a => a
mempty (ServerWriterHandlerLL -> IO (Either GRPCIOError ()))
-> ServerWriterHandlerLL -> IO (Either GRPCIOError ())
forall a b. (a -> b) -> a -> b
$ ServerWriterHandler c d -> ServerWriterHandlerLL
forall a b.
(Message a, Message b) =>
ServerWriterHandler a b -> ServerWriterHandlerLL
convertServerWriterHandler ServerWriterHandler c d
f
handleLoop Server
s ServerOptions
o (BiDiStreamHandler MethodName
_ ServerRWHandler c d
f, RegisteredMethod a
rm) =
Int -> ServerOptions -> IO (Either GRPCIOError ()) -> IO ()
forall a.
Int -> ServerOptions -> IO (Either GRPCIOError a) -> IO ()
loopWError Int
0 ServerOptions
o (IO (Either GRPCIOError ()) -> IO ())
-> IO (Either GRPCIOError ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Server
-> RegisteredMethod 'BiDiStreaming
-> MetadataMap
-> ServerRWHandlerLL
-> IO (Either GRPCIOError ())
serverRW Server
s RegisteredMethod a
RegisteredMethod 'BiDiStreaming
rm MetadataMap
forall a. Monoid a => a
mempty (ServerRWHandlerLL -> IO (Either GRPCIOError ()))
-> ServerRWHandlerLL -> IO (Either GRPCIOError ())
forall a b. (a -> b) -> a -> b
$ ServerRWHandler c d -> ServerRWHandlerLL
forall a b.
(Message a, Message b) =>
ServerRWHandler a b -> ServerRWHandlerLL
convertServerRWHandler ServerRWHandler c d
f
data ServerOptions = ServerOptions
{ ServerOptions -> [Handler 'Normal]
optNormalHandlers :: [Handler 'Normal]
, ServerOptions -> [Handler 'ClientStreaming]
optClientStreamHandlers :: [Handler 'ClientStreaming]
, ServerOptions -> [Handler 'ServerStreaming]
optServerStreamHandlers :: [Handler 'ServerStreaming]
, ServerOptions -> [Handler 'BiDiStreaming]
optBiDiStreamHandlers :: [Handler 'BiDiStreaming]
, ServerOptions -> Host
optServerHost :: Host
, ServerOptions -> Port
optServerPort :: Port
, ServerOptions -> Bool
optUseCompression :: Bool
, ServerOptions -> String
optUserAgentPrefix :: String
, ServerOptions -> String
optUserAgentSuffix :: String
, ServerOptions -> MetadataMap
optInitialMetadata :: MetadataMap
, ServerOptions -> Maybe ServerSSLConfig
optSSLConfig :: Maybe ServerSSLConfig
, ServerOptions -> String -> IO ()
optLogger :: String -> IO ()
, ServerOptions -> Maybe Natural
optMaxReceiveMessageLength :: Maybe Natural
}
defaultOptions :: ServerOptions
defaultOptions :: ServerOptions
defaultOptions = ServerOptions :: [Handler 'Normal]
-> [Handler 'ClientStreaming]
-> [Handler 'ServerStreaming]
-> [Handler 'BiDiStreaming]
-> Host
-> Port
-> Bool
-> String
-> String
-> MetadataMap
-> Maybe ServerSSLConfig
-> (String -> IO ())
-> Maybe Natural
-> ServerOptions
ServerOptions
{ optNormalHandlers :: [Handler 'Normal]
optNormalHandlers = []
, optClientStreamHandlers :: [Handler 'ClientStreaming]
optClientStreamHandlers = []
, optServerStreamHandlers :: [Handler 'ServerStreaming]
optServerStreamHandlers = []
, optBiDiStreamHandlers :: [Handler 'BiDiStreaming]
optBiDiStreamHandlers = []
, optServerHost :: Host
optServerHost = Host
"localhost"
, optServerPort :: Port
optServerPort = Port
50051
, optUseCompression :: Bool
optUseCompression = Bool
False
, optUserAgentPrefix :: String
optUserAgentPrefix = String
"grpc-haskell/0.0.0"
, optUserAgentSuffix :: String
optUserAgentSuffix = String
""
, optInitialMetadata :: MetadataMap
optInitialMetadata = MetadataMap
forall a. Monoid a => a
mempty
, optSSLConfig :: Maybe ServerSSLConfig
optSSLConfig = Maybe ServerSSLConfig
forall a. Maybe a
Nothing
, optLogger :: String -> IO ()
optLogger = Handle -> String -> IO ()
hPutStrLn Handle
stderr
, optMaxReceiveMessageLength :: Maybe Natural
optMaxReceiveMessageLength = Maybe Natural
forall a. Maybe a
Nothing
}
serverLoop :: ServerOptions -> IO ()
serverLoop :: ServerOptions -> IO ()
serverLoop ServerOptions
_opts = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Registered method-based serverLoop NYI"