mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-06-02 02:53:37 +02:00
add option to set logging function (#71)
* add option to set logging function * Add documentation to ServerOptions
This commit is contained in:
Connor Clark
GitHub Enterprise
parent
3366dde7ab
commit
01fac2d5a6
|
|
@ -98,60 +98,74 @@ handlerMethodName (ClientStreamHandler m _) = m
|
|||
handlerMethodName (ServerStreamHandler m _) = m
|
||||
handlerMethodName (BiDiStreamHandler m _) = m
|
||||
|
||||
logMsg :: String -> IO ()
|
||||
logMsg = hPutStrLn stderr
|
||||
|
||||
-- | Handles errors that result from trying to handle a call on the server.
|
||||
-- For each error, takes a different action depending on the severity in the
|
||||
-- context of handling a server call. This also tries to give an indication of
|
||||
-- whether the error is our fault or user error.
|
||||
handleCallError :: Either GRPCIOError a -> IO ()
|
||||
handleCallError (Right _) = return ()
|
||||
handleCallError (Left GRPCIOTimeout) =
|
||||
handleCallError :: (String -> IO ())
|
||||
-- ^ logging function
|
||||
-> Either GRPCIOError a
|
||||
-> IO ()
|
||||
handleCallError _ (Right _) = return ()
|
||||
handleCallError _ (Left GRPCIOTimeout) =
|
||||
-- Probably a benign timeout (such as a client disappearing), noop for now.
|
||||
return ()
|
||||
handleCallError (Left GRPCIOShutdown) =
|
||||
handleCallError _ (Left GRPCIOShutdown) =
|
||||
-- Server shutting down. Benign.
|
||||
return ()
|
||||
handleCallError (Left (GRPCIODecodeError e)) =
|
||||
handleCallError logMsg (Left (GRPCIODecodeError e)) =
|
||||
logMsg $ "Decoding error: " ++ show e
|
||||
handleCallError (Left (GRPCIOHandlerException e)) =
|
||||
handleCallError logMsg (Left (GRPCIOHandlerException e)) =
|
||||
logMsg $ "Handler exception caught: " ++ show e
|
||||
handleCallError (Left x) =
|
||||
handleCallError logMsg (Left x) =
|
||||
logMsg $ show x ++ ": This probably indicates a bug in gRPC-haskell. Please report this error."
|
||||
|
||||
loopWError :: Int
|
||||
-> ServerOptions
|
||||
-> IO (Either GRPCIOError a)
|
||||
-> IO ()
|
||||
loopWError i f = do
|
||||
loopWError i o@ServerOptions{..} f = do
|
||||
when (i `mod` 100 == 0) $ putStrLn $ "i = " ++ show i
|
||||
f >>= handleCallError
|
||||
loopWError (i + 1) f
|
||||
f >>= handleCallError optLogger
|
||||
loopWError (i + 1) o f
|
||||
|
||||
-- TODO: options for setting initial/trailing metadata
|
||||
handleLoop :: Server
|
||||
-> ServerOptions
|
||||
-> (Handler a, RegisteredMethod a)
|
||||
-> IO ()
|
||||
handleLoop s (UnaryHandler _ f, rm) =
|
||||
loopWError 0 $ serverHandleNormalCall s rm mempty $ convertServerHandler f
|
||||
handleLoop s (ClientStreamHandler _ f, rm) =
|
||||
loopWError 0 $ serverReader s rm mempty $ convertServerReaderHandler f
|
||||
handleLoop s (ServerStreamHandler _ f, rm) =
|
||||
loopWError 0 $ serverWriter s rm mempty $ convertServerWriterHandler f
|
||||
handleLoop s (BiDiStreamHandler _ f, rm) =
|
||||
loopWError 0 $ serverRW s rm mempty $ convertServerRWHandler f
|
||||
handleLoop s o (UnaryHandler _ f, rm) =
|
||||
loopWError 0 o $ serverHandleNormalCall s rm mempty $ convertServerHandler f
|
||||
handleLoop s o (ClientStreamHandler _ f, rm) =
|
||||
loopWError 0 o $ serverReader s rm mempty $ convertServerReaderHandler f
|
||||
handleLoop s o (ServerStreamHandler _ f, rm) =
|
||||
loopWError 0 o $ serverWriter s rm mempty $ convertServerWriterHandler f
|
||||
handleLoop s o (BiDiStreamHandler _ f, rm) =
|
||||
loopWError 0 o $ serverRW s rm mempty $ convertServerRWHandler f
|
||||
|
||||
data ServerOptions = ServerOptions
|
||||
{ optNormalHandlers :: [Handler 'Normal]
|
||||
-- ^ Handlers for unary (non-streaming) calls.
|
||||
, optClientStreamHandlers :: [Handler 'ClientStreaming]
|
||||
-- ^ Handlers for client streaming calls.
|
||||
, optServerStreamHandlers :: [Handler 'ServerStreaming]
|
||||
-- ^ Handlers for server streaming calls.
|
||||
, optBiDiStreamHandlers :: [Handler 'BiDiStreaming]
|
||||
-- ^ Handlers for bidirectional streaming calls.
|
||||
, optServerPort :: Port
|
||||
-- ^ Port on which to listen for requests.
|
||||
, optUseCompression :: Bool
|
||||
-- ^ Whether to use compression when communicating with the client.
|
||||
, optUserAgentPrefix :: String
|
||||
-- ^ Optional custom prefix to add to the user agent string.
|
||||
, optUserAgentSuffix :: String
|
||||
-- ^ Optional custom suffix to add to the user agent string.
|
||||
, optInitialMetadata :: MetadataMap
|
||||
-- ^ Metadata to send at the beginning of each call.
|
||||
, optSSLConfig :: Maybe ServerSSLConfig
|
||||
-- ^ Security configuration.
|
||||
, optLogger :: String -> IO ()
|
||||
-- ^ Logging function to use to log errors in handling calls.
|
||||
}
|
||||
|
||||
defaultOptions :: ServerOptions
|
||||
|
|
@ -166,6 +180,7 @@ defaultOptions = ServerOptions
|
|||
, optUserAgentSuffix = ""
|
||||
, optInitialMetadata = mempty
|
||||
, optSSLConfig = Nothing
|
||||
, optLogger = hPutStrLn stderr
|
||||
}
|
||||
|
||||
serverLoop :: ServerOptions -> IO ()
|
||||
|
|
|
|||
|
|
@ -8,9 +8,9 @@
|
|||
|
||||
module Network.GRPC.HighLevel.Server.Unregistered where
|
||||
|
||||
import Control.Arrow
|
||||
import Control.Concurrent
|
||||
import Control.Concurrent.Async (async, wait)
|
||||
import Control.Arrow
|
||||
import qualified Control.Exception as CE
|
||||
import Control.Monad
|
||||
import Data.Foldable (find)
|
||||
|
|
@ -21,13 +21,14 @@ import qualified Network.GRPC.LowLevel.Call.Unregistered as U
|
|||
import qualified Network.GRPC.LowLevel.Server.Unregistered as U
|
||||
|
||||
dispatchLoop :: Server
|
||||
-> (String -> IO ())
|
||||
-> MetadataMap
|
||||
-> [Handler 'Normal]
|
||||
-> [Handler 'ClientStreaming]
|
||||
-> [Handler 'ServerStreaming]
|
||||
-> [Handler 'BiDiStreaming]
|
||||
-> IO ()
|
||||
dispatchLoop s md hN hC hS hB =
|
||||
dispatchLoop s logger md hN hC hS hB =
|
||||
forever $ U.withServerCallAsync s $ \sc ->
|
||||
case findHandler sc allHandlers of
|
||||
Just (AnyHandler ah) -> case ah of
|
||||
|
|
@ -62,7 +63,7 @@ dispatchLoop s md hN hC hS hB =
|
|||
return (mempty, mempty, StatusNotFound, StatusDetails "unknown method")
|
||||
|
||||
handleError :: IO a -> IO ()
|
||||
handleError = (handleCallError . left herr =<<) . CE.try
|
||||
handleError = (handleCallError logger . left herr =<<) . CE.try
|
||||
where herr (e :: CE.SomeException) = GRPCIOHandlerException (show e)
|
||||
|
||||
serverLoop :: ServerOptions -> IO ()
|
||||
|
|
@ -72,6 +73,7 @@ serverLoop ServerOptions{..} = do
|
|||
tid <- async $ withGRPC $ \grpc ->
|
||||
withServer grpc config $ \server -> do
|
||||
dispatchLoop server
|
||||
optLogger
|
||||
optInitialMetadata
|
||||
optNormalHandlers
|
||||
optClientStreamHandlers
|
||||
|
|
|
|||
|
|
@ -3,29 +3,29 @@
|
|||
|
||||
module UnsafeTests (unsafeTests, unsafeProperties) where
|
||||
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Exception (bracket_)
|
||||
import Control.Concurrent (threadDelay)
|
||||
import Control.Exception (bracket_)
|
||||
import Control.Monad
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString as B
|
||||
import Foreign.Marshal.Alloc
|
||||
import Foreign.Storable
|
||||
import GHC.Exts
|
||||
import Network.GRPC.LowLevel.GRPC (threadDelaySecs)
|
||||
import Network.GRPC.LowLevel.GRPC (threadDelaySecs)
|
||||
import Network.GRPC.Unsafe
|
||||
import Network.GRPC.Unsafe.ByteBuffer
|
||||
import Network.GRPC.Unsafe.ChannelArgs
|
||||
import Network.GRPC.Unsafe.Metadata
|
||||
import Network.GRPC.Unsafe.Security
|
||||
import Network.GRPC.Unsafe.Slice
|
||||
import Network.GRPC.Unsafe.Time
|
||||
import Network.GRPC.Unsafe.ChannelArgs
|
||||
import Network.GRPC.Unsafe.Security
|
||||
import System.Clock
|
||||
import Test.QuickCheck.Gen as QC
|
||||
import Test.QuickCheck.Property as QC
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit as HU (testCase, (@?=),
|
||||
assertBool)
|
||||
import Test.Tasty.QuickCheck as QC
|
||||
import Test.Tasty.HUnit as HU (testCase, (@?=))
|
||||
import Test.QuickCheck.Gen as QC
|
||||
import Test.QuickCheck.Property as QC
|
||||
import Test.Tasty.HUnit as HU (assertBool, testCase,
|
||||
(@?=))
|
||||
import Test.Tasty.HUnit as HU (testCase, (@?=))
|
||||
import Test.Tasty.QuickCheck as QC
|
||||
|
||||
unsafeTests :: TestTree
|
||||
unsafeTests = testGroup "Unit tests for unsafe C bindings"
|
||||
|
|
@ -64,8 +64,8 @@ instance Arbitrary MetadataMap where
|
|||
|
||||
roundtripMetadataKeyVals :: MetadataMap -> IO MetadataMap
|
||||
roundtripMetadataKeyVals m = do
|
||||
kvPtr <- createMetadata m
|
||||
m' <- getAllMetadata kvPtr (length $ toList m)
|
||||
(kvPtr, l) <- createMetadata m
|
||||
m' <- getAllMetadata kvPtr l
|
||||
metadataFree kvPtr
|
||||
return m'
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user