mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-05 18:59:42 +01:00
c1fa7956c7
* Hellos example: skeleton and server-streaming mode use * Catch IO exceptions in dispatchLoop * Distinguish decoding errors from other errors; convert error calls to explicit throws of GRPCIOErrors * instance Exception GRPCIOError * Add error checks and error messages to hellos cpp client * Change fixed32 to uint32 * Add prelim hellos-client, hellos-server executables * Hellos cpp example: add client-streaming mode use * In unregistered high-level server, aggressively catch all exceptions raised in handlers and promote then to a new GRPCIOError constructor. * Hellos hs example: add client-streaming mode use * Hellos cpp example: add simple bidi mode use * Hellos hs example: add simple bidi mode use * wibbles * Add GRPCIOErrorEq newtype wrapper w/ Eq instance for testing purposes * Refactoring wibbles * README wibbles * DCR * Fix rebase derp * Remove libdl dep, update protobuf github link in hellos cpp Makefile. * Use Data.Coerce.coerce for GRPCIOErrorEq; remove warnings * Report expected/got errors in Haskell hellos client/server * Report expected/got errors in cpp hellos client/server * Add some instructions for running the hellos client/server * Fix warnings * Rename logShow to logMsg and use stderr for logging * Tweak compliation parameters for hellos hs executables; increase constant workload * Remove unnecessary type annotation * Simplify handleError in dispatchLoop * Remove GRPCIOErrorEq and coerce use; change GRPCIOHandlerException type
81 lines
3.1 KiB
Haskell
81 lines
3.1 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
|
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
|
|
|
|
import Control.Monad
|
|
import qualified Data.ByteString.Lazy as BL
|
|
import Data.Protobuf.Wire.Class
|
|
import qualified Data.Text as T
|
|
import Data.Word
|
|
import GHC.Generics (Generic)
|
|
import Network.GRPC.LowLevel
|
|
|
|
helloSS = MethodName "/hellos.Hellos/HelloSS"
|
|
helloCS = MethodName "/hellos.Hellos/HelloCS"
|
|
|
|
data SSRqt = SSRqt { ssName :: T.Text, ssNumReplies :: Word32 } deriving (Show, Eq, Ord, Generic)
|
|
instance Message SSRqt
|
|
data SSRpy = SSRpy { ssGreeting :: T.Text } deriving (Show, Eq, Ord, Generic)
|
|
instance Message SSRpy
|
|
data CSRqt = CSRqt { csMessage :: T.Text } deriving (Show, Eq, Ord, Generic)
|
|
instance Message CSRqt
|
|
data CSRpy = CSRpy { csNumRequests :: Word32 } deriving (Show, Eq, Ord, Generic)
|
|
instance Message CSRpy
|
|
|
|
expect :: (Eq a, Monad m, Show a) => String -> a -> a -> m ()
|
|
expect ctx ex got
|
|
| ex /= got = fail $ ctx ++ " error: expected " ++ show ex ++ ", got " ++ show got
|
|
| otherwise = return ()
|
|
|
|
doHelloSS c = do
|
|
rm <- clientRegisterMethodServerStreaming c helloSS
|
|
let nr = 10
|
|
pay = SSRqt "server streaming mode" nr
|
|
enc = BL.toStrict . toLazyByteString $ pay
|
|
eea <- clientReader c rm 5 enc mempty $ \_md recv -> do
|
|
n :: Int <- go recv 0
|
|
expect "doHelloSS/cnt" (fromIntegral nr) n
|
|
case eea of
|
|
Left e -> fail $ "clientReader error: " ++ show e
|
|
Right (_, st, _)
|
|
| st /= StatusOk -> fail "clientReader: non-OK status"
|
|
| otherwise -> return ()
|
|
where
|
|
expay = "Hello there, server streaming mode!"
|
|
go recv n = recv >>= \case
|
|
Left e -> fail $ "doHelloSS error: " ++ show e
|
|
Right Nothing -> return n
|
|
Right (Just r) -> case fromByteString r of
|
|
Left e -> fail $ "Decoding error: " ++ show e
|
|
Right r' -> do
|
|
expect "doHelloSS/rpy" expay (ssGreeting r')
|
|
go recv (n+1)
|
|
|
|
doHelloCS c = do
|
|
rm <- clientRegisterMethodClientStreaming c helloCS
|
|
let nr = 10
|
|
pay = CSRqt "client streaming payload"
|
|
enc = BL.toStrict . toLazyByteString $ pay
|
|
eea <- clientWriter c rm 10 mempty $ \send ->
|
|
replicateM_ (fromIntegral nr) $ send enc >>= \case
|
|
Left e -> fail $ "doHelloCS: send error: " ++ show e
|
|
Right{} -> return ()
|
|
case eea of
|
|
Left e -> fail $ "clientWriter error: " ++ show e
|
|
Right (Nothing, _, _, _, _) -> fail "clientWriter error: no reply payload"
|
|
Right (Just bs, _init, _trail, st, _dtls)
|
|
| st /= StatusOk -> fail "clientWriter: non-OK status"
|
|
| otherwise -> case fromByteString bs of
|
|
Left e -> fail $ "Decoding error: " ++ show e
|
|
Right dec -> expect "doHelloCS/cnt" nr (csNumRequests dec)
|
|
|
|
highlevelMain = withGRPC $ \g ->
|
|
withClient g (ClientConfig "localhost" 50051 []) $ \c -> do
|
|
doHelloSS c
|
|
doHelloCS c
|
|
|
|
main = highlevelMain
|