gRPC-haskell/examples/echo/echo-hs/EchoClient.hs

{-# 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           Network.GRPC.HighLevel.Client
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 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