mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-18 09:09:42 +01:00
4a30625a70
* Expose the max receive message length channel argument + unittest
* `ClientError` GADT ctor => `ClientErrorResponse`, expose `ClientError`
Prior to this commit, the name `ClientError` was both:
- The name of a data constructor name for the `ClientResult` GADT
- A name of an internal sum type for capturing different kinds of client
errors
We want to expose the latter to users of the library, and so expose the latter
and rename the former.
* Remove unused `MultiWayIf` lang ext
48 lines
2.1 KiB
Haskell
48 lines
2.1 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
{-# LANGUAGE OverloadedLists #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
|
|
import Control.Monad
|
|
import Data.ByteString (ByteString)
|
|
import Data.Maybe (fromMaybe)
|
|
import qualified Data.Text.Lazy as TL
|
|
import Echo
|
|
import GHC.Generics (Generic)
|
|
import Network.GRPC.HighLevel.Client
|
|
import Network.GRPC.HighLevel.Generated
|
|
import Network.GRPC.LowLevel
|
|
import Options.Generic
|
|
import Prelude hiding (FilePath)
|
|
|
|
data Args = Args
|
|
{ bind :: Maybe ByteString <?> "grpc endpoint hostname (default \"localhost\")"
|
|
, port :: Maybe Int <?> "grpc endpoint port (default 50051)"
|
|
, payload :: Maybe TL.Text <?> "string to echo (default \"hullo!\")"
|
|
} deriving (Generic, Show)
|
|
instance ParseRecord Args
|
|
|
|
main :: IO ()
|
|
main = do
|
|
Args{..} <- getRecord "Runs the echo client"
|
|
let
|
|
pay = fromMaybe "hullo!" . unHelpful $ payload
|
|
rqt = EchoRequest pay
|
|
expected = EchoResponse pay
|
|
cfg = ClientConfig
|
|
(Host . fromMaybe "localhost" . unHelpful $ bind)
|
|
(Port . fromMaybe 50051 . unHelpful $ port)
|
|
[] Nothing
|
|
withGRPC $ \g -> withClient g cfg $ \c -> do
|
|
Echo{..} <- echoClient c
|
|
echoDoEcho (ClientNormalRequest rqt 5 mempty) >>= \case
|
|
ClientNormalResponse rsp _ _ StatusOk _
|
|
| rsp == expected -> return ()
|
|
| otherwise -> fail $ "Got unexpected response: '" ++ show rsp ++ "', expected: '" ++ show expected ++ "'"
|
|
ClientNormalResponse _ _ _ st _ -> fail $ "Got unexpected status " ++ show st ++ " from call, expecting StatusOk"
|
|
ClientErrorResponse e -> fail $ "Got client error: " ++ show e
|
|
putStrLn $ "echo-client success: sent " ++ show pay ++ ", got " ++ show pay
|