2016-06-08 19:45:47 +02:00
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
|
|
|
|
|
|
module Network.GRPC.LowLevel.CompletionQueue.Unregistered where
|
|
|
|
|
|
|
|
import Control.Concurrent (forkIO)
|
|
|
|
import Foreign.Marshal.Alloc (free, malloc)
|
|
|
|
import Foreign.Storable (peek)
|
|
|
|
import Network.GRPC.LowLevel.Call
|
|
|
|
import qualified Network.GRPC.LowLevel.Call.Unregistered as U
|
|
|
|
import Network.GRPC.LowLevel.CompletionQueue.Internal
|
|
|
|
import Network.GRPC.LowLevel.GRPC
|
|
|
|
import qualified Network.GRPC.Unsafe as C
|
|
|
|
import qualified Network.GRPC.Unsafe.Constants as C
|
|
|
|
import qualified Network.GRPC.Unsafe.Metadata as C
|
|
|
|
import qualified Network.GRPC.Unsafe.Time as C
|
|
|
|
|
|
|
|
channelCreateCall :: C.Channel
|
|
|
|
-> C.Call
|
|
|
|
-> C.PropagationMask
|
|
|
|
-> CompletionQueue
|
|
|
|
-> MethodName
|
|
|
|
-> Endpoint
|
|
|
|
-> C.CTimeSpecPtr
|
|
|
|
-> IO (Either GRPCIOError ClientCall)
|
|
|
|
channelCreateCall chan parent mask cq@CompletionQueue{..} meth endpt deadline =
|
|
|
|
withPermission Push cq $ do
|
|
|
|
call <- C.grpcChannelCreateCall chan parent mask unsafeCQ
|
|
|
|
(unMethodName meth) (unEndpoint endpt) deadline C.reserved
|
|
|
|
return $ Right $ ClientCall call
|
|
|
|
|
|
|
|
|
2016-06-08 21:38:01 +02:00
|
|
|
serverRequestCall :: C.Server
|
|
|
|
-> CompletionQueue
|
|
|
|
-> TimeoutSeconds
|
|
|
|
-> IO (Either GRPCIOError U.ServerCall)
|
2016-06-08 19:45:47 +02:00
|
|
|
serverRequestCall server cq@CompletionQueue{..} timeLimit =
|
|
|
|
withPermission Push cq $ do
|
|
|
|
callPtr <- malloc
|
|
|
|
grpcDebug $ "serverRequestCall: callPtr is " ++ show callPtr
|
|
|
|
callDetails <- C.createCallDetails
|
|
|
|
metadataArrayPtr <- C.metadataArrayCreate
|
|
|
|
metadataArray <- peek metadataArrayPtr
|
|
|
|
tag <- newTag cq
|
|
|
|
callError <- C.grpcServerRequestCall server callPtr callDetails
|
|
|
|
metadataArray unsafeCQ unsafeCQ tag
|
|
|
|
grpcDebug $ "serverRequestCall: callError was " ++ show callError
|
|
|
|
if callError /= C.CallOk
|
|
|
|
then do grpcDebug "serverRequestCall: got call error; cleaning up."
|
|
|
|
failureCleanup callPtr callDetails metadataArrayPtr
|
|
|
|
return $ Left $ GRPCIOCallError callError
|
2016-06-15 19:30:17 +02:00
|
|
|
else do pluckResult <- pluck cq tag (Just timeLimit)
|
2016-06-08 19:45:47 +02:00
|
|
|
grpcDebug $ "serverRequestCall: pluckResult was "
|
|
|
|
++ show pluckResult
|
|
|
|
case pluckResult of
|
|
|
|
Left x -> do
|
|
|
|
grpcDebug "serverRequestCall: pluck error; cleaning up."
|
|
|
|
failureCleanup callPtr callDetails
|
|
|
|
metadataArrayPtr
|
|
|
|
return $ Left x
|
|
|
|
Right () -> do
|
|
|
|
rawCall <- peek callPtr
|
|
|
|
let call = U.ServerCall rawCall
|
|
|
|
metadataArrayPtr
|
|
|
|
Nothing
|
|
|
|
callDetails
|
|
|
|
return $ Right call
|
|
|
|
|
|
|
|
--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.
|
|
|
|
-- This results in malloc errors if
|
|
|
|
-- gRPC tries to modify them after we free them. To work around it,
|
|
|
|
-- we sleep for a while before freeing the objects. We should find a
|
|
|
|
-- permanent solution that's more robust.
|
|
|
|
where failureCleanup callPtr callDetails metadataArrayPtr = forkIO $ do
|
|
|
|
threadDelaySecs 30
|
|
|
|
grpcDebug "serverRequestCall: doing delayed cleanup."
|
|
|
|
free callPtr
|
|
|
|
C.destroyCallDetails callDetails
|
|
|
|
C.metadataArrayDestroy metadataArrayPtr
|
|
|
|
return ()
|