eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-06-26 14:38:35 +02:00
Code Issues Projects Releases Wiki Activity

Rename unreg operations in Network.GRPC.LowLevel.Server.Unregistered

Browse Source
This commit is contained in:
Joel Stanley 2016-06-08 11:50:57 -05:00
parent 27a9a6283a
commit eb1040d07b
2 changed files with 31 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/Network/GRPC/LowLevel/Server/Unregistered.hs
View File

@ -13,40 +13,41 @@ import Network.GRPC.LowLevel.Op
import Network.GRPC.LowLevel.Server import Network.GRPC.LowLevel.Server
import qualified Network.GRPC.Unsafe.Op as C import qualified Network.GRPC.Unsafe.Op as C
serverCreateUnregCall :: Server -> TimeoutSeconds serverCreateCall :: Server -> TimeoutSeconds
-> IO (Either GRPCIOError ServerCall) -> IO (Either GRPCIOError ServerCall)
serverCreateUnregCall Server{..} timeLimit = serverCreateCall Server{..} timeLimit =
serverRequestCall internalServer serverCQ timeLimit serverRequestCall internalServer serverCQ timeLimit
withServerUnregCall :: Server -> TimeoutSeconds withServerCall :: Server -> TimeoutSeconds
-> (ServerCall -> IO (Either GRPCIOError a)) -> (ServerCall -> IO (Either GRPCIOError a))
-> IO (Either GRPCIOError a) -> IO (Either GRPCIOError a)
withServerUnregCall server timeout f = do withServerCall server timeout f = do
createResult <- serverCreateUnregCall server timeout createResult <- serverCreateCall server timeout
case createResult of case createResult of
Left x -> return $ Left x Left x -> return $ Left x
Right call -> f call `finally` logDestroy call Right call -> f call `finally` logDestroy call
where logDestroy c = grpcDebug "withServerCall: destroying." where logDestroy c = grpcDebug "withServerCall: destroying."
>> destroyServerCall c >> destroyServerCall c
-- TODO: This is preliminary. -- | A handler for an unregistered server call; bytestring arguments are the
-- We still need to provide the method name to the handler. -- request body and response body respectively.
type ServerHandler
= ByteString -> MetadataMap -> MethodName
-> IO (ByteString, MetadataMap, StatusDetails)
-- | Handle one unregistered call. -- | Handle one unregistered call.
serverHandleNormalCall :: Server -> TimeoutSeconds serverHandleNormalCall :: Server
-> MetadataMap -> TimeoutSeconds
-- ^ Initial server metadata. -> MetadataMap -- ^ Initial server metadata.
-> (ByteString -> MetadataMap -> MethodName -> ServerHandler
-> IO (ByteString, MetadataMap, StatusDetails)) -> IO (Either GRPCIOError ())
-- ^ Handler function takes a request body and
-- metadata and returns a response body and metadata.
-> IO (Either GRPCIOError ())
serverHandleNormalCall s@Server{..} timeLimit srvMetadata f = do serverHandleNormalCall s@Server{..} timeLimit srvMetadata f = do
withServerUnregCall s timeLimit $ \call -> do withServerCall s timeLimit $ \call -> do
grpcDebug "serverHandleNormalCall: starting batch." grpcDebug "serverHandleCall(U): starting batch."
let recvOps = serverOpsGetNormalCall srvMetadata let recvOps = serverOpsGetNormalCall srvMetadata
opResults <- runServerUnregOps call serverCQ recvOps timeLimit opResults <- runServerUnregOps call serverCQ recvOps timeLimit
case opResults of case opResults of
Left x -> do grpcDebug "serverHandleNormalCall: ops failed; aborting" Left x -> do grpcDebug "serverHandleNormalCall(U): ops failed; aborting"
return $ Left x return $ Left x
Right [OpRecvMessageResult (Just body)] -> do Right [OpRecvMessageResult (Just body)] -> do
requestMeta <- serverCallGetMetadata call requestMeta <- serverCallGetMetadata call
@ -60,8 +61,8 @@ serverHandleNormalCall s@Server{..} timeLimit srvMetadata f = do
respBody respMetadata status details respBody respMetadata status details
respOpsResults <- runServerUnregOps call serverCQ respOps timeLimit respOpsResults <- runServerUnregOps call serverCQ respOps timeLimit
case respOpsResults of case respOpsResults of
Left x -> do grpcDebug "serverHandleNormalCall: resp failed." Left x -> do grpcDebug "serverHandleNormalCall(U): resp failed."
return $ Left x return $ Left x
Right _ -> grpcDebug "serverHandleNormalCall: ops done." Right _ -> grpcDebug "serverHandleNormalCall(U): ops done."
>> return (Right ()) >> return (Right ())
x -> error $ "impossible pattern match: " ++ show x x -> error $ "impossible pattern match: " ++ show x

16
tests/LowLevelTests.hs
View File

@ -5,15 +5,19 @@
module LowLevelTests (lowLevelTests) where module LowLevelTests (lowLevelTests) where
import Control.Concurrent (threadDelay) import Control.Concurrent (threadDelay)
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Monad import Control.Monad
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import qualified Data.Map as M import qualified Data.Map as M
import Network.GRPC.LowLevel import Network.GRPC.LowLevel
import Network.GRPC.LowLevel.Server.Unregistered as U
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit as HU (Assertion, assertEqual, import Test.Tasty.HUnit as HU (Assertion,
assertFailure, testCase, (@?=)) assertEqual,
assertFailure,
testCase,
(@?=))
lowLevelTests :: TestTree lowLevelTests :: TestTree
lowLevelTests = testGroup "Unit tests of low-level Haskell library" lowLevelTests = testGroup "Unit tests of low-level Haskell library"
@ -63,7 +67,7 @@ testServerCreateDestroy =
testServerCall :: TestTree testServerCall :: TestTree
testServerCall = testServerCall =
serverOnlyTest "create/destroy call" [] $ \s -> do serverOnlyTest "create/destroy call" [] $ \s -> do
r <- withServerUnregCall s 1 $ const $ return $ Right () r <- U.withServerCall s 1 $ const $ return $ Right ()
r @?= Left GRPCIOTimeout r @?= Left GRPCIOTimeout
testServerTimeoutNoClient :: TestTree testServerTimeoutNoClient :: TestTree