mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-27 05:29:43 +01:00
72160cea89
pluckers) would register a CQ notification via grpc_server_request_registered_call prior to obtaining pluck permission, block on acquiring such permission, and thus miss notification of the server call. The bug can could be witnessed with particular interleavings by ensuring that GRPC_MAX_COMPLETION_QUEUE_PLUCKERS server threads are blocked on their own server call notifications, and then using the (GRPC_MAX_COMPLETION_QUEUE_PLUCKERS+1)th server thread to attempt to block on a notification for an additional server call. In order to fix this, we simply extended the pluck permission held window for serverRequestCall, and created a variant of pluck (called pluck') which assumes permission to pluck is already held by the calling thread.
75 lines
2.9 KiB
Haskell
75 lines
2.9 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE OverloadedLists #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
|
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
|
|
|
|
import Control.Concurrent
|
|
import Control.Concurrent.Async
|
|
import Control.Monad
|
|
import Data.ByteString (ByteString)
|
|
import Network.GRPC.LowLevel
|
|
import Network.GRPC.LowLevel.Call
|
|
import qualified Network.GRPC.LowLevel.Server.Unregistered as U
|
|
import qualified Network.GRPC.LowLevel.Call.Unregistered as U
|
|
|
|
serverMeta :: MetadataMap
|
|
serverMeta = [("test_meta", "test_meta_value")]
|
|
|
|
handler :: U.ServerCall
|
|
-> ByteString
|
|
-> IO (ByteString, MetadataMap, StatusCode, StatusDetails)
|
|
handler U.ServerCall{..} reqBody = do
|
|
--putStrLn $ "Got request for method: " ++ show method
|
|
--putStrLn $ "Got metadata: " ++ show reqMeta
|
|
return (reqBody, serverMeta, StatusOk, StatusDetails "")
|
|
|
|
unregMain :: IO ()
|
|
unregMain = withGRPC $ \grpc -> do
|
|
withServer grpc (ServerConfig "localhost" 50051 [] []) $ \server -> forever $ do
|
|
result <- U.serverHandleNormalCall server serverMeta handler
|
|
case result of
|
|
Left x -> putStrLn $ "handle call result error: " ++ show x
|
|
Right _ -> return ()
|
|
|
|
regMain :: IO ()
|
|
regMain = withGRPC $ \grpc -> do
|
|
let methods = [(MethodName "/echo.Echo/DoEcho", Normal)]
|
|
withServer grpc (ServerConfig "localhost" 50051 methods []) $ \server ->
|
|
forever $ do
|
|
let method = head (normalMethods server)
|
|
result <- serverHandleNormalCall server method serverMeta $
|
|
\_call reqBody _reqMeta -> return (reqBody, serverMeta, StatusOk,
|
|
StatusDetails "")
|
|
case result of
|
|
Left x -> putStrLn $ "registered call result error: " ++ show x
|
|
Right _ -> return ()
|
|
|
|
tputStrLn x = do
|
|
tid <- myThreadId
|
|
putStrLn $ "[" ++ show tid ++ "]: " ++ x
|
|
|
|
regLoop :: Server -> RegisteredMethod 'Normal -> IO ()
|
|
regLoop server method = forever $ do
|
|
-- tputStrLn "about to block on call handler"
|
|
result <- serverHandleNormalCall server method serverMeta $
|
|
\_call reqBody _reqMeta ->
|
|
return (reqBody, serverMeta, StatusOk, StatusDetails "")
|
|
case result of
|
|
Left x -> error $! "registered call result error: " ++ show x
|
|
Right _ -> return ()
|
|
|
|
regMainThreaded :: IO ()
|
|
regMainThreaded = do
|
|
withGRPC $ \grpc -> do
|
|
let methods = [(MethodName "/echo.Echo/DoEcho", Normal)]
|
|
withServer grpc (ServerConfig "localhost" 50051 methods []) $ \server -> do
|
|
let method = head (normalMethods server)
|
|
tids <- replicateM 7 $ async $ do tputStrLn "starting handler"
|
|
regLoop server method
|
|
waitAnyCancel tids
|
|
tputStrLn "finishing"
|
|
|
|
main :: IO ()
|
|
main = regMainThreaded
|