Apply same pluck permission region fix to unregistered serverRequestCall

This commit is contained in:
Joel Stanley 2016-07-11 12:53:19 -05:00
parent ca1d5a7205
commit 4ae3936ac9

View file

@ -36,36 +36,37 @@ serverRequestCall server cq@CompletionQueue{..} =
withPermission Push cq $ withPermission Push cq $
bracket malloc free $ \callPtr -> bracket malloc free $ \callPtr ->
C.withMetadataArrayPtr $ \metadataArrayPtr -> C.withMetadataArrayPtr $ \metadataArrayPtr ->
C.withCallDetails $ \callDetails -> do C.withCallDetails $ \callDetails ->
grpcDebug $ "serverRequestCall: callPtr is " ++ show callPtr withPermission Pluck cq $ do
metadataArray <- peek metadataArrayPtr grpcDebug $ "serverRequestCall: callPtr is " ++ show callPtr
tag <- newTag cq metadataArray <- peek metadataArrayPtr
callError <- C.grpcServerRequestCall server callPtr callDetails tag <- newTag cq
metadataArray unsafeCQ unsafeCQ tag callError <- C.grpcServerRequestCall server callPtr callDetails
grpcDebug $ "serverRequestCall: callError was " ++ show callError metadataArray unsafeCQ unsafeCQ tag
if callError /= C.CallOk grpcDebug $ "serverRequestCall: callError was " ++ show callError
then do grpcDebug "serverRequestCall: got call error; cleaning up." if callError /= C.CallOk
return $ Left $ GRPCIOCallError callError then do grpcDebug "serverRequestCall: got call error; cleaning up."
else do pluckResult <- pluck cq tag Nothing return $ Left $ GRPCIOCallError callError
grpcDebug $ "serverRequestCall: pluckResult was " else do pluckResult <- pluck cq tag Nothing
++ show pluckResult grpcDebug $ "serverRequestCall: pluckResult was "
case pluckResult of ++ show pluckResult
Left x -> do case pluckResult of
grpcDebug "serverRequestCall: pluck error." Left x -> do
return $ Left x grpcDebug "serverRequestCall: pluck error."
Right () -> do return $ Left x
rawCall <- peek callPtr Right () -> do
metadata <- C.getAllMetadataArray metadataArray rawCall <- peek callPtr
deadline <- getDeadline callDetails metadata <- C.getAllMetadataArray metadataArray
method <- getMethod callDetails deadline <- getDeadline callDetails
host <- getHost callDetails method <- getMethod callDetails
let call = U.ServerCall rawCall host <- getHost callDetails
metadata let call = U.ServerCall rawCall
Nothing metadata
deadline Nothing
method deadline
host method
return $ Right call host
return $ Right call
where getDeadline callDetails = do where getDeadline callDetails = do
C.timeSpec <$> C.callDetailsGetDeadline callDetails C.timeSpec <$> C.callDetailsGetDeadline callDetails