eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-11-23 11:39:43 +01: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

39
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))
-- ^ Handler function takes a request body and
-- metadata and returns a response body and metadata.
-> IO (Either GRPCIOError ()) -> 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

10
tests/LowLevelTests.hs
View file

@ -11,9 +11,13 @@ 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