gRPC-haskell/examples/echo/echo-client/Main.hs
Connor Clark 3366dde7ab Connor/security (#68)
* begin security bindings

* secure channel creation

* SSL credentials support

* add client-side ssl support

* ssl test

* read file before passing to channel credentials, free credentials when done creating

* use localhost key/cert for test

* WIP sketch of callbacks for metadata plugins

* conversion from Haskell auth processor to C

* add test for custom server metadata auth processor

* wip auth failure test

* rebase tweak

* working test of custom auth metadata server processor

* improve security docs, clean up

* add unsafe layer client-side auth metadata plugin functionality

* add client config option for custom auth metadata

* WIP client-side metadata auth plugin. Crashing when calling C callback.

* get initial version of client-side metadata plugins working

* replace String with ByteString in a few places, add function for getting AuthProperty

* AuthContext utilities and more documentation

* end-to-end test of client and server auth plugins

* remove redundant tests

* function for parents in unary calls, add deactivated failing test for auth metadata propagation from parent to child

* some cleanup

* tweaks

* more tweaks

* remove unused file

* docs tweak

* consolidate exports

* update protobuf-wire commit
2016-08-17 09:55:06 -07:00

76 lines
3.5 KiB
Haskell

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
import Control.Concurrent.Async
import Control.Monad
import qualified Data.ByteString.Lazy as BL
import Data.Protobuf.Wire.Class
import Data.Protobuf.Wire.Types
import qualified Data.Text as T
import Data.Word
import GHC.Generics (Generic)
import Network.GRPC.LowLevel
import qualified Network.GRPC.LowLevel.Client.Unregistered as U
import System.Random (randomRIO)
echoMethod = MethodName "/echo.Echo/DoEcho"
addMethod = MethodName "/echo.Add/DoAdd"
_unregistered c = U.clientRequest c echoMethod 1 "hi" mempty
regMain = withGRPC $ \g ->
withClient g (ClientConfig "localhost" 50051 [] Nothing) $ \c -> do
rm <- clientRegisterMethodNormal c echoMethod
replicateM_ 100000 $ clientRequest c rm 5 "hi" mempty >>= \case
Left e -> fail $ "Got client error: " ++ show e
Right r
| rspBody r == "hi" -> return ()
| otherwise -> fail $ "Got unexpected payload: " ++ show r
-- NB: If you change these, make sure to change them in the server as well.
-- TODO: Put these in a common location (or just hack around it until CG is working)
data EchoRequest = EchoRequest {message :: T.Text} deriving (Show, Eq, Ord, Generic)
instance Message EchoRequest
data AddRequest = AddRequest {addX :: Fixed Word32, addY :: Fixed Word32} deriving (Show, Eq, Ord, Generic)
instance Message AddRequest
data AddResponse = AddResponse {answer :: Fixed Word32} deriving (Show, Eq, Ord, Generic)
instance Message AddResponse
-- TODO: Create Network.GRPC.HighLevel.Client w/ request variants
highlevelMain = withGRPC $ \g ->
withClient g (ClientConfig "localhost" 50051 [] Nothing) $ \c -> do
rm <- clientRegisterMethodNormal c echoMethod
rmAdd <- clientRegisterMethodNormal c addMethod
let oneThread = replicateM_ 10000 $ body c rm rmAdd
tids <- replicateM 4 (async oneThread)
results <- mapM waitCatch tids
print $ "waitCatch results: " ++ show (sequence results)
where body c rm rmAdd = do
let pay = EchoRequest "hi"
enc = BL.toStrict . toLazyByteString $ pay
clientRequest c rm 5 enc mempty >>= \case
Left e -> fail $ "Got client error: " ++ show e
Right r -> case fromByteString (rspBody r) of
Left e -> fail $ "Got decoding error: " ++ show e
Right dec
| dec == pay -> return ()
| otherwise -> fail $ "Got unexpected payload: " ++ show dec
x <- liftM Fixed $ randomRIO (0,1000)
y <- liftM Fixed $ randomRIO (0,1000)
let addPay = AddRequest x y
addEnc = BL.toStrict . toLazyByteString $ addPay
clientRequest c rmAdd 5 addEnc mempty >>= \case
Left e -> fail $ "Got client error on add request: " ++ show e
Right r -> case fromByteString (rspBody r) of
Left e -> fail $ "failed to decode add response: " ++ show e
Right dec
| dec == AddResponse (x + y) -> return ()
| otherwise -> fail $ "Got wrong add answer: " ++ show dec ++ "expected: " ++ show x ++ " + " ++ show y ++ " = " ++ show (x+y)
main :: IO ()
main = highlevelMain