diff --git a/src/Network/GRPC/LowLevel/Server/Unregistered.hs b/src/Network/GRPC/LowLevel/Server/Unregistered.hs index e5f630c..0c8273f 100644 --- a/src/Network/GRPC/LowLevel/Server/Unregistered.hs +++ b/src/Network/GRPC/LowLevel/Server/Unregistered.hs @@ -13,40 +13,41 @@ import Network.GRPC.LowLevel.Op import Network.GRPC.LowLevel.Server import qualified Network.GRPC.Unsafe.Op as C -serverCreateUnregCall :: Server -> TimeoutSeconds +serverCreateCall :: Server -> TimeoutSeconds -> IO (Either GRPCIOError ServerCall) -serverCreateUnregCall Server{..} timeLimit = +serverCreateCall Server{..} timeLimit = serverRequestCall internalServer serverCQ timeLimit -withServerUnregCall :: Server -> TimeoutSeconds +withServerCall :: Server -> TimeoutSeconds -> (ServerCall -> IO (Either GRPCIOError a)) -> IO (Either GRPCIOError a) -withServerUnregCall server timeout f = do - createResult <- serverCreateUnregCall server timeout +withServerCall server timeout f = do + createResult <- serverCreateCall server timeout case createResult of Left x -> return $ Left x Right call -> f call `finally` logDestroy call where logDestroy c = grpcDebug "withServerCall: destroying." >> destroyServerCall c --- TODO: This is preliminary. --- We still need to provide the method name to the handler. +-- | A handler for an unregistered server call; bytestring arguments are the +-- request body and response body respectively. +type ServerHandler + = ByteString -> MetadataMap -> MethodName + -> IO (ByteString, MetadataMap, StatusDetails) + -- | Handle one unregistered call. -serverHandleNormalCall :: Server -> TimeoutSeconds - -> MetadataMap - -- ^ Initial server metadata. - -> (ByteString -> MetadataMap -> MethodName - -> IO (ByteString, MetadataMap, StatusDetails)) - -- ^ Handler function takes a request body and - -- metadata and returns a response body and metadata. - -> IO (Either GRPCIOError ()) +serverHandleNormalCall :: Server + -> TimeoutSeconds + -> MetadataMap -- ^ Initial server metadata. + -> ServerHandler + -> IO (Either GRPCIOError ()) serverHandleNormalCall s@Server{..} timeLimit srvMetadata f = do - withServerUnregCall s timeLimit $ \call -> do - grpcDebug "serverHandleNormalCall: starting batch." + withServerCall s timeLimit $ \call -> do + grpcDebug "serverHandleCall(U): starting batch." let recvOps = serverOpsGetNormalCall srvMetadata opResults <- runServerUnregOps call serverCQ recvOps timeLimit case opResults of - Left x -> do grpcDebug "serverHandleNormalCall: ops failed; aborting" + Left x -> do grpcDebug "serverHandleNormalCall(U): ops failed; aborting" return $ Left x Right [OpRecvMessageResult (Just body)] -> do requestMeta <- serverCallGetMetadata call @@ -60,8 +61,8 @@ serverHandleNormalCall s@Server{..} timeLimit srvMetadata f = do respBody respMetadata status details respOpsResults <- runServerUnregOps call serverCQ respOps timeLimit case respOpsResults of - Left x -> do grpcDebug "serverHandleNormalCall: resp failed." + Left x -> do grpcDebug "serverHandleNormalCall(U): resp failed." return $ Left x - Right _ -> grpcDebug "serverHandleNormalCall: ops done." + Right _ -> grpcDebug "serverHandleNormalCall(U): ops done." >> return (Right ()) x -> error $ "impossible pattern match: " ++ show x diff --git a/tests/LowLevelTests.hs b/tests/LowLevelTests.hs index 361bf33..2e0032c 100644 --- a/tests/LowLevelTests.hs +++ b/tests/LowLevelTests.hs @@ -5,15 +5,19 @@ module LowLevelTests (lowLevelTests) where -import Control.Concurrent (threadDelay) +import Control.Concurrent (threadDelay) import Control.Concurrent.Async import Control.Monad -import Data.ByteString (ByteString) -import qualified Data.Map as M +import Data.ByteString (ByteString) +import qualified Data.Map as M import Network.GRPC.LowLevel +import Network.GRPC.LowLevel.Server.Unregistered as U import Test.Tasty -import Test.Tasty.HUnit as HU (Assertion, assertEqual, - assertFailure, testCase, (@?=)) +import Test.Tasty.HUnit as HU (Assertion, + assertEqual, + assertFailure, + testCase, + (@?=)) lowLevelTests :: TestTree lowLevelTests = testGroup "Unit tests of low-level Haskell library" @@ -63,7 +67,7 @@ testServerCreateDestroy = testServerCall :: TestTree testServerCall = serverOnlyTest "create/destroy call" [] $ \s -> do - r <- withServerUnregCall s 1 $ const $ return $ Right () + r <- U.withServerCall s 1 $ const $ return $ Right () r @?= Left GRPCIOTimeout testServerTimeoutNoClient :: TestTree