eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-11-26 21:19:43 +01:00
Code Issues Projects Releases Wiki Activity

Server call deadlines (#28)

Browse source 
* functions for getting call deadline, checking for expiry

* server registered calls: populate deadline correctly, isExpired predicate

* update debugServerCall
This commit is contained in:
Connor Clark 2016-06-16 12:45:55 -07:00 committed by Joel Stanley
parent 5ba5c8a42a
commit f6e244912a
7 changed files with 69 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
cbits/grpc_haskell.c
View file

@ -133,6 +133,12 @@ gpr_timespec* infinite_deadline(){
return retval;
}
gpr_timespec* convert_clock_type(gpr_timespec *t, gpr_clock_type to){
gpr_timespec *retval = malloc(sizeof(gpr_timespec));
*retval = gpr_convert_clock_type(*t, to);
return retval;
}
grpc_metadata_array** metadata_array_create(){
grpc_metadata_array **retval = malloc(sizeof(grpc_metadata_array*));
*retval = malloc(sizeof(grpc_metadata_array));

2
include/grpc_haskell.h
View file

@ -54,6 +54,8 @@ gpr_timespec* millis_to_deadline(int64_t millis);
gpr_timespec* infinite_deadline();
gpr_timespec* convert_clock_type(gpr_timespec *t, gpr_clock_type to);
grpc_metadata_array** metadata_array_create();
void metadata_array_destroy(grpc_metadata_array **arr);

1
src/Network/GRPC/LowLevel.hs
View file

@ -35,6 +35,7 @@ GRPC
, serverHandleNormalCall
, withServerCall
, serverCallCancel
, serverCallIsExpired
-- * Client
, ClientConfig(..)

15
src/Network/GRPC/LowLevel/Call.hs
View file

@ -12,6 +12,7 @@ import Data.String (IsString)
import Foreign.Marshal.Alloc (free)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (peek)
import System.Clock
import qualified Network.GRPC.Unsafe as C
import qualified Network.GRPC.Unsafe.ByteBuffer as C
@ -67,7 +68,8 @@ data ServerCall = ServerCall
requestMetadataRecv :: Ptr C.MetadataArray,
optionalPayload :: Ptr C.ByteBuffer,
parentPtr :: Maybe (Ptr C.Call),
callDeadline :: C.CTimeSpecPtr
callDeadlinePtr :: C.CTimeSpecPtr,
callDeadline :: TimeSpec
}
serverCallCancel :: ServerCall -> C.StatusCode -> String -> IO ()
@ -92,6 +94,11 @@ serverCallGetPayload ServerCall{..} = do
then return Nothing
else Just <$> C.copyByteBufferToByteString bb
serverCallIsExpired :: ServerCall -> IO Bool
serverCallIsExpired sc = do
currTime <- getTime Monotonic
return $ currTime > (callDeadline sc)
debugClientCall :: ClientCall -> IO ()
{-# INLINE debugClientCall #-}
#ifdef DEBUG
@ -103,7 +110,7 @@ debugClientCall = const $ return ()
debugServerCall :: ServerCall -> IO ()
#ifdef DEBUG
debugServerCall call@(ServerCall (C.Call ptr) _ _ _ _) = do
debugServerCall call@(ServerCall (C.Call ptr) _ _ _ _ _) = do
grpcDebug $ "debugServerCall(R): server call: " ++ (show ptr)
grpcDebug $ "debugServerCall(R): metadata ptr: "
++ show (requestMetadataRecv call)
@ -119,7 +126,7 @@ debugServerCall call@(ServerCall (C.Call ptr) _ _ _ _) = do
(C.Call parent) <- peek parentPtr'
grpcDebug $ "debugServerCall(R): parent: " ++ show parent
grpcDebug $ "debugServerCall(R): deadline ptr: " ++ show (callDeadline call)
timespec <- peek (callDeadline call)
timespec <- peek (callDeadlinePtr call)
grpcDebug $ "debugServerCall(R): deadline: " ++ show (C.timeSpec timespec)
#else
{-# INLINE debugServerCall #-}
@ -144,4 +151,4 @@ destroyServerCall call@ServerCall{..} = do
grpcDebug $ "freeing parentPtr: " ++ show parentPtr
forM_ parentPtr free
grpcDebug $ "destroying deadline." ++ show callDeadline
C.timespecDestroy callDeadline
C.timespecDestroy callDeadlinePtr

20
src/Network/GRPC/LowLevel/CompletionQueue.hs
View file

@ -44,6 +44,8 @@ import qualified Network.GRPC.Unsafe.Constants as C
import qualified Network.GRPC.Unsafe.Metadata as C
import qualified Network.GRPC.Unsafe.Op as C
import qualified Network.GRPC.Unsafe.Time as C
import System.Clock (getTime, Clock(..),
TimeSpec(..))
import System.Timeout (timeout)
import Network.GRPC.LowLevel.Call
@ -135,9 +137,8 @@ serverRequestCall :: C.Server
serverRequestCall
server cq@CompletionQueue{..} timeLimit RegisteredMethod{..} =
withPermission Push cq $ do
-- TODO: Is gRPC supposed to populate this deadline?
-- NOTE: the below stuff is freed when we free the call we return.
deadline <- C.secondsToDeadline timeLimit
deadlinePtr <- malloc
callPtr <- malloc
metadataArrayPtr <- C.metadataArrayCreate
metadataArray <- peek metadataArrayPtr
@ -145,25 +146,26 @@ serverRequestCall
tag <- newTag cq
grpcDebug $ "serverRequestCall(R): tag is " ++ show tag
callError <- C.grpcServerRequestRegisteredCall
server methodHandle callPtr deadline
server methodHandle callPtr deadlinePtr
metadataArray bbPtr unsafeCQ unsafeCQ tag
grpcDebug $ "serverRequestCall(R): callError: "
++ show callError
if callError /= C.CallOk
then do grpcDebug "serverRequestCall(R): callError. cleaning up"
failureCleanup deadline callPtr metadataArrayPtr bbPtr
failureCleanup deadlinePtr callPtr metadataArrayPtr bbPtr
return $ Left $ GRPCIOCallError callError
else do pluckResult <- pluck cq tag (Just timeLimit)
grpcDebug "serverRequestCall(R): finished pluck."
case pluckResult of
Left x -> do
grpcDebug "serverRequestCall(R): cleanup pluck err"
failureCleanup deadline callPtr metadataArrayPtr bbPtr
failureCleanup deadlinePtr callPtr metadataArrayPtr bbPtr
return $ Left x
Right () -> do
rawCall <- peek callPtr
deadline <- convertDeadline deadlinePtr
let assembledCall = ServerCall rawCall metadataArrayPtr
bbPtr Nothing deadline
bbPtr Nothing deadlinePtr deadline
return $ Right assembledCall
--TODO: the gRPC library appears to hold onto these pointers for a random
-- amount of time, even after returning from the only call that uses them.
@ -178,6 +180,12 @@ serverRequestCall
free callPtr
C.metadataArrayDestroy metadataArrayPtr
free bbPtr
convertDeadline deadline = do
--gRPC gives us a deadline that is just a delta, so we convert it
--to a proper deadline.
deadline' <- C.timeSpec <$> peek deadline
now <- getTime Monotonic
return $ now + deadline'
-- | Register the server's completion queue. Must be done before the server is
-- started.

8
src/Network/GRPC/Unsafe/Time.chs
View file

@ -56,3 +56,11 @@ withDeadlineSeconds i = bracket (secondsToDeadline i) timespecDestroy
withInfiniteDeadline :: (CTimeSpecPtr -> IO a) -> IO a
withInfiniteDeadline = bracket infiniteDeadline timespecDestroy
{#fun convert_clock_type as ^ {`CTimeSpecPtr', `ClockType'} -> `CTimeSpecPtr'#}
withConvertedClockType :: CTimeSpecPtr -> ClockType
-> (CTimeSpecPtr -> IO a)
-> IO a
withConvertedClockType cptr ctype = bracket (convertClockType cptr ctype)
timespecDestroy

27
tests/LowLevelTests.hs
View file

@ -38,6 +38,7 @@ lowLevelTests = testGroup "Unit tests of low-level Haskell library"
, testServerCancel
, testGoaway
, testSlowServer
, testServerCallExpirationCheck
]
testGRPCBracket :: TestTree
@ -243,6 +244,28 @@ testSlowServer =
return ("", mempty, StatusOk, StatusDetails "")
return ()
testServerCallExpirationCheck :: TestTree
testServerCallExpirationCheck =
csTest "Check for call expiration" client server [("/foo", Normal)]
where
client c = do
rm <- clientRegisterMethod c "/foo" Normal
result <- clientRequest c rm 3 "" mempty
return ()
server s = do
let rm = head (registeredMethods s)
serverHandleNormalCall s rm 5 mempty $ \c _ _ -> do
exp1 <- serverCallIsExpired c
assertBool "Call isn't expired when handler starts" $ not exp1
threadDelaySecs 1
exp2 <- serverCallIsExpired c
assertBool "Call isn't expired after 1 second" $ not exp2
threadDelaySecs 3
exp3 <- serverCallIsExpired c
assertBool "Call is expired after 4 seconds" exp3
return ("", mempty, StatusDetails "")
return ()
--------------------------------------------------------------------------------
-- Utilities and helpers
@ -328,3 +351,7 @@ stdTestServer = TestServer . stdServerConf
stdServerConf :: [(MethodName, GRPCMethodType)] -> ServerConfig
stdServerConf = ServerConfig "localhost" 50051
threadDelaySecs :: Int -> IO ()
threadDelaySecs = threadDelay . (* 10^(6::Int))