gRPC-haskell/examples/echo/echo-server/Main.hs
Connor Clark ce56953b24 Various example/benchmarking code (#16)
* initial echo client/server examples

* registered and unregistered versions of the example client

* ignore pyc files

* cpp echo code, flag to build examples

* threaded server example
2016-06-03 10:34:09 -07:00

64 lines
2.3 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent.Async (async, wait)
import Control.Monad (forever)
import Data.ByteString (ByteString)
import qualified Data.Map as M
import Network.GRPC.LowLevel
serverMeta :: MetadataMap
serverMeta = M.fromList [("test_meta", "test_meta_value")]
handler :: ByteString -> MetadataMap -> MethodName
-> IO (ByteString, MetadataMap, StatusDetails)
handler reqBody reqMeta method = do
--putStrLn $ "Got request for method: " ++ show method
--putStrLn $ "Got metadata: " ++ show reqMeta
return (reqBody, serverMeta, StatusDetails "")
unregMain :: IO ()
unregMain = withGRPC $ \grpc -> do
withServer grpc (ServerConfig "localhost" 50051 []) $ \server -> forever $ do
result <- serverHandleNormalCall server 15 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 (registeredMethods server)
result <- serverHandleNormalRegisteredCall server method 15 serverMeta $
\reqBody _reqMeta -> return (reqBody, serverMeta, serverMeta,
StatusDetails "")
case result of
Left x -> putStrLn $ "registered call result error: " ++ show x
Right _ -> return ()
-- | loop to fork n times
regLoop :: Server -> RegisteredMethod -> IO ()
regLoop server method = forever $ do
result <- serverHandleNormalRegisteredCall server method 15 serverMeta $
\reqBody _reqMeta -> return (reqBody, serverMeta, serverMeta,
StatusDetails "")
case result of
Left x -> putStrLn $ "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 (registeredMethods server)
tid1 <- async $ regLoop server method
tid2 <- async $ regLoop server method
wait tid1
wait tid2
return ()
main :: IO ()
main = regMainThreaded