gRPC-haskell/examples/echo/echo-server/Main.hs

76 lines
2.9 KiB
Haskell
Raw Normal View History

Preliminary streaming mode support (client streaming, server streaming, bidirectional) (#37) * Tweak runOps param order, inline common op sequences, clean up serverHandleNormalCall * More ops sequence inlining for clarity, experimenting with Managed * Checkpoint: preliminary support for all streaming modes; much cleanup/refactoring and api design still needed * Use mempty for default StatusDetails; tweak bad status matching mechanism * Preliminary user-facing, server-streaming, low-level api and test * renaming wibbles * Preliminary user-facing, client-streaming, low-level api and test * Move sendMsgs comb to Network.GRPC.LowLevel.Op; misc cleanup/DCR * Modify bidi streaming to omit request payload * Add transformers dep * Preliminary user-facing low-level bidirectional streaming api and test * Fix missing peek import * Remove TimeoutSeconds params on streaming mode functions * Fix serverHandleNormalCall rebase wart * Fix rebase warts; minor hlint fixes and wibbles * Post-rebase tweaks to optional payload use in serverRequestCall (i.e., now respects payloadHandling again) * Cleanup/refactor serverRequestCall * Fix comment * Change ServerRWHandler type so that handler does not have to invoke a finalizer * Change ServerReaderHandler type so that handler does not have to invoke a finalizer * Simplify serverWriter interface and ServerWriterHandler structure * Simplify serverRW (get rid of exec param), improve bidi streaming tests * Use ExceptT in serverRW impl * Change ServerRWHandler type to pass recv/send operations. * Renaming * Define ClientRWHandler, pass recv/send ops * wibbles * Use ExceptT in clientRW impl * Add DataKinded phantom typing to RegisteredMethod; misc cleanup * Simplify sendMsgs interface; add SingleSend type and related helpers * Rename SingleSend to SendSingle, use ExceptT to clean up {client,server}Writer and sendMsgs * More ExceptT cleanup in clientWriter * Factor out reusable bits of clientWriter * Shrink ServerReaderHandler * Delete stale comments * Use common machinery for all streaming modes; make handler types more consistent * wibbles
2016-07-06 15:59:38 +02:00
{-# 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
Preliminary streaming mode support (client streaming, server streaming, bidirectional) (#37) * Tweak runOps param order, inline common op sequences, clean up serverHandleNormalCall * More ops sequence inlining for clarity, experimenting with Managed * Checkpoint: preliminary support for all streaming modes; much cleanup/refactoring and api design still needed * Use mempty for default StatusDetails; tweak bad status matching mechanism * Preliminary user-facing, server-streaming, low-level api and test * renaming wibbles * Preliminary user-facing, client-streaming, low-level api and test * Move sendMsgs comb to Network.GRPC.LowLevel.Op; misc cleanup/DCR * Modify bidi streaming to omit request payload * Add transformers dep * Preliminary user-facing low-level bidirectional streaming api and test * Fix missing peek import * Remove TimeoutSeconds params on streaming mode functions * Fix serverHandleNormalCall rebase wart * Fix rebase warts; minor hlint fixes and wibbles * Post-rebase tweaks to optional payload use in serverRequestCall (i.e., now respects payloadHandling again) * Cleanup/refactor serverRequestCall * Fix comment * Change ServerRWHandler type so that handler does not have to invoke a finalizer * Change ServerReaderHandler type so that handler does not have to invoke a finalizer * Simplify serverWriter interface and ServerWriterHandler structure * Simplify serverRW (get rid of exec param), improve bidi streaming tests * Use ExceptT in serverRW impl * Change ServerRWHandler type to pass recv/send operations. * Renaming * Define ClientRWHandler, pass recv/send ops * wibbles * Use ExceptT in clientRW impl * Add DataKinded phantom typing to RegisteredMethod; misc cleanup * Simplify sendMsgs interface; add SingleSend type and related helpers * Rename SingleSend to SendSingle, use ExceptT to clean up {client,server}Writer and sendMsgs * More ExceptT cleanup in clientWriter * Factor out reusable bits of clientWriter * Shrink ServerReaderHandler * Delete stale comments * Use common machinery for all streaming modes; make handler types more consistent * wibbles
2016-07-06 15:59:38 +02:00
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
Preliminary streaming mode support (client streaming, server streaming, bidirectional) (#37) * Tweak runOps param order, inline common op sequences, clean up serverHandleNormalCall * More ops sequence inlining for clarity, experimenting with Managed * Checkpoint: preliminary support for all streaming modes; much cleanup/refactoring and api design still needed * Use mempty for default StatusDetails; tweak bad status matching mechanism * Preliminary user-facing, server-streaming, low-level api and test * renaming wibbles * Preliminary user-facing, client-streaming, low-level api and test * Move sendMsgs comb to Network.GRPC.LowLevel.Op; misc cleanup/DCR * Modify bidi streaming to omit request payload * Add transformers dep * Preliminary user-facing low-level bidirectional streaming api and test * Fix missing peek import * Remove TimeoutSeconds params on streaming mode functions * Fix serverHandleNormalCall rebase wart * Fix rebase warts; minor hlint fixes and wibbles * Post-rebase tweaks to optional payload use in serverRequestCall (i.e., now respects payloadHandling again) * Cleanup/refactor serverRequestCall * Fix comment * Change ServerRWHandler type so that handler does not have to invoke a finalizer * Change ServerReaderHandler type so that handler does not have to invoke a finalizer * Simplify serverWriter interface and ServerWriterHandler structure * Simplify serverRW (get rid of exec param), improve bidi streaming tests * Use ExceptT in serverRW impl * Change ServerRWHandler type to pass recv/send operations. * Renaming * Define ClientRWHandler, pass recv/send ops * wibbles * Use ExceptT in clientRW impl * Add DataKinded phantom typing to RegisteredMethod; misc cleanup * Simplify sendMsgs interface; add SingleSend type and related helpers * Rename SingleSend to SendSingle, use ExceptT to clean up {client,server}Writer and sendMsgs * More ExceptT cleanup in clientWriter * Factor out reusable bits of clientWriter * Shrink ServerReaderHandler * Delete stale comments * Use common machinery for all streaming modes; make handler types more consistent * wibbles
2016-07-06 15:59:38 +02:00
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
Preliminary streaming mode support (client streaming, server streaming, bidirectional) (#37) * Tweak runOps param order, inline common op sequences, clean up serverHandleNormalCall * More ops sequence inlining for clarity, experimenting with Managed * Checkpoint: preliminary support for all streaming modes; much cleanup/refactoring and api design still needed * Use mempty for default StatusDetails; tweak bad status matching mechanism * Preliminary user-facing, server-streaming, low-level api and test * renaming wibbles * Preliminary user-facing, client-streaming, low-level api and test * Move sendMsgs comb to Network.GRPC.LowLevel.Op; misc cleanup/DCR * Modify bidi streaming to omit request payload * Add transformers dep * Preliminary user-facing low-level bidirectional streaming api and test * Fix missing peek import * Remove TimeoutSeconds params on streaming mode functions * Fix serverHandleNormalCall rebase wart * Fix rebase warts; minor hlint fixes and wibbles * Post-rebase tweaks to optional payload use in serverRequestCall (i.e., now respects payloadHandling again) * Cleanup/refactor serverRequestCall * Fix comment * Change ServerRWHandler type so that handler does not have to invoke a finalizer * Change ServerReaderHandler type so that handler does not have to invoke a finalizer * Simplify serverWriter interface and ServerWriterHandler structure * Simplify serverRW (get rid of exec param), improve bidi streaming tests * Use ExceptT in serverRW impl * Change ServerRWHandler type to pass recv/send operations. * Renaming * Define ClientRWHandler, pass recv/send ops * wibbles * Use ExceptT in clientRW impl * Add DataKinded phantom typing to RegisteredMethod; misc cleanup * Simplify sendMsgs interface; add SingleSend type and related helpers * Rename SingleSend to SendSingle, use ExceptT to clean up {client,server}Writer and sendMsgs * More ExceptT cleanup in clientWriter * Factor out reusable bits of clientWriter * Shrink ServerReaderHandler * Delete stale comments * Use common machinery for all streaming modes; make handler types more consistent * wibbles
2016-07-06 15:59:38 +02:00
let method = head (normalMethods server)
tids <- replicateM 7 $ async $ do tputStrLn "starting handler"
regLoop server method
waitAnyCancel tids
tputStrLn "finishing"
main :: IO ()
main = regMainThreaded