mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-05 02:39:42 +01:00
Server call deadlines (#28)
* functions for getting call deadline, checking for expiry * server registered calls: populate deadline correctly, isExpired predicate * update debugServerCall
This commit is contained in:
parent
5ba5c8a42a
commit
f6e244912a
7 changed files with 69 additions and 10 deletions
|
@ -133,6 +133,12 @@ gpr_timespec* infinite_deadline(){
|
||||||
return retval;
|
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** metadata_array_create(){
|
||||||
grpc_metadata_array **retval = malloc(sizeof(grpc_metadata_array*));
|
grpc_metadata_array **retval = malloc(sizeof(grpc_metadata_array*));
|
||||||
*retval = malloc(sizeof(grpc_metadata_array));
|
*retval = malloc(sizeof(grpc_metadata_array));
|
||||||
|
|
|
@ -54,6 +54,8 @@ gpr_timespec* millis_to_deadline(int64_t millis);
|
||||||
|
|
||||||
gpr_timespec* infinite_deadline();
|
gpr_timespec* infinite_deadline();
|
||||||
|
|
||||||
|
gpr_timespec* convert_clock_type(gpr_timespec *t, gpr_clock_type to);
|
||||||
|
|
||||||
grpc_metadata_array** metadata_array_create();
|
grpc_metadata_array** metadata_array_create();
|
||||||
|
|
||||||
void metadata_array_destroy(grpc_metadata_array **arr);
|
void metadata_array_destroy(grpc_metadata_array **arr);
|
||||||
|
|
|
@ -35,6 +35,7 @@ GRPC
|
||||||
, serverHandleNormalCall
|
, serverHandleNormalCall
|
||||||
, withServerCall
|
, withServerCall
|
||||||
, serverCallCancel
|
, serverCallCancel
|
||||||
|
, serverCallIsExpired
|
||||||
|
|
||||||
-- * Client
|
-- * Client
|
||||||
, ClientConfig(..)
|
, ClientConfig(..)
|
||||||
|
|
|
@ -12,6 +12,7 @@ import Data.String (IsString)
|
||||||
import Foreign.Marshal.Alloc (free)
|
import Foreign.Marshal.Alloc (free)
|
||||||
import Foreign.Ptr (Ptr, nullPtr)
|
import Foreign.Ptr (Ptr, nullPtr)
|
||||||
import Foreign.Storable (peek)
|
import Foreign.Storable (peek)
|
||||||
|
import System.Clock
|
||||||
|
|
||||||
import qualified Network.GRPC.Unsafe as C
|
import qualified Network.GRPC.Unsafe as C
|
||||||
import qualified Network.GRPC.Unsafe.ByteBuffer as C
|
import qualified Network.GRPC.Unsafe.ByteBuffer as C
|
||||||
|
@ -67,7 +68,8 @@ data ServerCall = ServerCall
|
||||||
requestMetadataRecv :: Ptr C.MetadataArray,
|
requestMetadataRecv :: Ptr C.MetadataArray,
|
||||||
optionalPayload :: Ptr C.ByteBuffer,
|
optionalPayload :: Ptr C.ByteBuffer,
|
||||||
parentPtr :: Maybe (Ptr C.Call),
|
parentPtr :: Maybe (Ptr C.Call),
|
||||||
callDeadline :: C.CTimeSpecPtr
|
callDeadlinePtr :: C.CTimeSpecPtr,
|
||||||
|
callDeadline :: TimeSpec
|
||||||
}
|
}
|
||||||
|
|
||||||
serverCallCancel :: ServerCall -> C.StatusCode -> String -> IO ()
|
serverCallCancel :: ServerCall -> C.StatusCode -> String -> IO ()
|
||||||
|
@ -92,6 +94,11 @@ serverCallGetPayload ServerCall{..} = do
|
||||||
then return Nothing
|
then return Nothing
|
||||||
else Just <$> C.copyByteBufferToByteString bb
|
else Just <$> C.copyByteBufferToByteString bb
|
||||||
|
|
||||||
|
serverCallIsExpired :: ServerCall -> IO Bool
|
||||||
|
serverCallIsExpired sc = do
|
||||||
|
currTime <- getTime Monotonic
|
||||||
|
return $ currTime > (callDeadline sc)
|
||||||
|
|
||||||
debugClientCall :: ClientCall -> IO ()
|
debugClientCall :: ClientCall -> IO ()
|
||||||
{-# INLINE debugClientCall #-}
|
{-# INLINE debugClientCall #-}
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
|
@ -103,7 +110,7 @@ debugClientCall = const $ return ()
|
||||||
|
|
||||||
debugServerCall :: ServerCall -> IO ()
|
debugServerCall :: ServerCall -> IO ()
|
||||||
#ifdef DEBUG
|
#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): server call: " ++ (show ptr)
|
||||||
grpcDebug $ "debugServerCall(R): metadata ptr: "
|
grpcDebug $ "debugServerCall(R): metadata ptr: "
|
||||||
++ show (requestMetadataRecv call)
|
++ show (requestMetadataRecv call)
|
||||||
|
@ -119,7 +126,7 @@ debugServerCall call@(ServerCall (C.Call ptr) _ _ _ _) = do
|
||||||
(C.Call parent) <- peek parentPtr'
|
(C.Call parent) <- peek parentPtr'
|
||||||
grpcDebug $ "debugServerCall(R): parent: " ++ show parent
|
grpcDebug $ "debugServerCall(R): parent: " ++ show parent
|
||||||
grpcDebug $ "debugServerCall(R): deadline ptr: " ++ show (callDeadline call)
|
grpcDebug $ "debugServerCall(R): deadline ptr: " ++ show (callDeadline call)
|
||||||
timespec <- peek (callDeadline call)
|
timespec <- peek (callDeadlinePtr call)
|
||||||
grpcDebug $ "debugServerCall(R): deadline: " ++ show (C.timeSpec timespec)
|
grpcDebug $ "debugServerCall(R): deadline: " ++ show (C.timeSpec timespec)
|
||||||
#else
|
#else
|
||||||
{-# INLINE debugServerCall #-}
|
{-# INLINE debugServerCall #-}
|
||||||
|
@ -144,4 +151,4 @@ destroyServerCall call@ServerCall{..} = do
|
||||||
grpcDebug $ "freeing parentPtr: " ++ show parentPtr
|
grpcDebug $ "freeing parentPtr: " ++ show parentPtr
|
||||||
forM_ parentPtr free
|
forM_ parentPtr free
|
||||||
grpcDebug $ "destroying deadline." ++ show callDeadline
|
grpcDebug $ "destroying deadline." ++ show callDeadline
|
||||||
C.timespecDestroy callDeadline
|
C.timespecDestroy callDeadlinePtr
|
||||||
|
|
|
@ -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.Metadata as C
|
||||||
import qualified Network.GRPC.Unsafe.Op as C
|
import qualified Network.GRPC.Unsafe.Op as C
|
||||||
import qualified Network.GRPC.Unsafe.Time as C
|
import qualified Network.GRPC.Unsafe.Time as C
|
||||||
|
import System.Clock (getTime, Clock(..),
|
||||||
|
TimeSpec(..))
|
||||||
import System.Timeout (timeout)
|
import System.Timeout (timeout)
|
||||||
|
|
||||||
import Network.GRPC.LowLevel.Call
|
import Network.GRPC.LowLevel.Call
|
||||||
|
@ -135,9 +137,8 @@ serverRequestCall :: C.Server
|
||||||
serverRequestCall
|
serverRequestCall
|
||||||
server cq@CompletionQueue{..} timeLimit RegisteredMethod{..} =
|
server cq@CompletionQueue{..} timeLimit RegisteredMethod{..} =
|
||||||
withPermission Push cq $ do
|
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.
|
-- NOTE: the below stuff is freed when we free the call we return.
|
||||||
deadline <- C.secondsToDeadline timeLimit
|
deadlinePtr <- malloc
|
||||||
callPtr <- malloc
|
callPtr <- malloc
|
||||||
metadataArrayPtr <- C.metadataArrayCreate
|
metadataArrayPtr <- C.metadataArrayCreate
|
||||||
metadataArray <- peek metadataArrayPtr
|
metadataArray <- peek metadataArrayPtr
|
||||||
|
@ -145,25 +146,26 @@ serverRequestCall
|
||||||
tag <- newTag cq
|
tag <- newTag cq
|
||||||
grpcDebug $ "serverRequestCall(R): tag is " ++ show tag
|
grpcDebug $ "serverRequestCall(R): tag is " ++ show tag
|
||||||
callError <- C.grpcServerRequestRegisteredCall
|
callError <- C.grpcServerRequestRegisteredCall
|
||||||
server methodHandle callPtr deadline
|
server methodHandle callPtr deadlinePtr
|
||||||
metadataArray bbPtr unsafeCQ unsafeCQ tag
|
metadataArray bbPtr unsafeCQ unsafeCQ tag
|
||||||
grpcDebug $ "serverRequestCall(R): callError: "
|
grpcDebug $ "serverRequestCall(R): callError: "
|
||||||
++ show callError
|
++ show callError
|
||||||
if callError /= C.CallOk
|
if callError /= C.CallOk
|
||||||
then do grpcDebug "serverRequestCall(R): callError. cleaning up"
|
then do grpcDebug "serverRequestCall(R): callError. cleaning up"
|
||||||
failureCleanup deadline callPtr metadataArrayPtr bbPtr
|
failureCleanup deadlinePtr callPtr metadataArrayPtr bbPtr
|
||||||
return $ Left $ GRPCIOCallError callError
|
return $ Left $ GRPCIOCallError callError
|
||||||
else do pluckResult <- pluck cq tag (Just timeLimit)
|
else do pluckResult <- pluck cq tag (Just timeLimit)
|
||||||
grpcDebug "serverRequestCall(R): finished pluck."
|
grpcDebug "serverRequestCall(R): finished pluck."
|
||||||
case pluckResult of
|
case pluckResult of
|
||||||
Left x -> do
|
Left x -> do
|
||||||
grpcDebug "serverRequestCall(R): cleanup pluck err"
|
grpcDebug "serverRequestCall(R): cleanup pluck err"
|
||||||
failureCleanup deadline callPtr metadataArrayPtr bbPtr
|
failureCleanup deadlinePtr callPtr metadataArrayPtr bbPtr
|
||||||
return $ Left x
|
return $ Left x
|
||||||
Right () -> do
|
Right () -> do
|
||||||
rawCall <- peek callPtr
|
rawCall <- peek callPtr
|
||||||
|
deadline <- convertDeadline deadlinePtr
|
||||||
let assembledCall = ServerCall rawCall metadataArrayPtr
|
let assembledCall = ServerCall rawCall metadataArrayPtr
|
||||||
bbPtr Nothing deadline
|
bbPtr Nothing deadlinePtr deadline
|
||||||
return $ Right assembledCall
|
return $ Right assembledCall
|
||||||
--TODO: the gRPC library appears to hold onto these pointers for a random
|
--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.
|
-- amount of time, even after returning from the only call that uses them.
|
||||||
|
@ -178,6 +180,12 @@ serverRequestCall
|
||||||
free callPtr
|
free callPtr
|
||||||
C.metadataArrayDestroy metadataArrayPtr
|
C.metadataArrayDestroy metadataArrayPtr
|
||||||
free bbPtr
|
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
|
-- | Register the server's completion queue. Must be done before the server is
|
||||||
-- started.
|
-- started.
|
||||||
|
|
|
@ -56,3 +56,11 @@ withDeadlineSeconds i = bracket (secondsToDeadline i) timespecDestroy
|
||||||
|
|
||||||
withInfiniteDeadline :: (CTimeSpecPtr -> IO a) -> IO a
|
withInfiniteDeadline :: (CTimeSpecPtr -> IO a) -> IO a
|
||||||
withInfiniteDeadline = bracket infiniteDeadline timespecDestroy
|
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
|
||||||
|
|
|
@ -38,6 +38,7 @@ lowLevelTests = testGroup "Unit tests of low-level Haskell library"
|
||||||
, testServerCancel
|
, testServerCancel
|
||||||
, testGoaway
|
, testGoaway
|
||||||
, testSlowServer
|
, testSlowServer
|
||||||
|
, testServerCallExpirationCheck
|
||||||
]
|
]
|
||||||
|
|
||||||
testGRPCBracket :: TestTree
|
testGRPCBracket :: TestTree
|
||||||
|
@ -243,6 +244,28 @@ testSlowServer =
|
||||||
return ("", mempty, StatusOk, StatusDetails "")
|
return ("", mempty, StatusOk, StatusDetails "")
|
||||||
return ()
|
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
|
-- Utilities and helpers
|
||||||
|
|
||||||
|
@ -328,3 +351,7 @@ stdTestServer = TestServer . stdServerConf
|
||||||
|
|
||||||
stdServerConf :: [(MethodName, GRPCMethodType)] -> ServerConfig
|
stdServerConf :: [(MethodName, GRPCMethodType)] -> ServerConfig
|
||||||
stdServerConf = ServerConfig "localhost" 50051
|
stdServerConf = ServerConfig "localhost" 50051
|
||||||
|
|
||||||
|
|
||||||
|
threadDelaySecs :: Int -> IO ()
|
||||||
|
threadDelaySecs = threadDelay . (* 10^(6::Int))
|
||||||
|
|
Loading…
Reference in a new issue