gRPC-haskell/tests/LowLevelTests/Op.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

81 lines
3.1 KiB
Haskell

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module LowLevelTests.Op where
import Data.ByteString (ByteString, isPrefixOf)
import Test.Tasty
import Test.Tasty.HUnit as HU (testCase, (@?=),
assertBool)
import Network.GRPC.LowLevel
import Network.GRPC.LowLevel.Call
import Network.GRPC.LowLevel.Client
import Network.GRPC.LowLevel.Server
import Network.GRPC.LowLevel.Op
lowLevelOpTests :: TestTree
lowLevelOpTests = testGroup "Synchronous unit tests of low-level Op interface"
[testCancelFromServer]
testCancelFromServer :: TestTree
testCancelFromServer =
testCase "Client/Server - client receives server cancellation" $
runSerialTest $ \grpc ->
withClientServerUnaryCall grpc $
\(Client{..}, Server{..}, ClientCall{..}, sc@ServerCall{..}) -> do
serverCallCancel sc StatusPermissionDenied "TestStatus"
clientRes <- runOps unsafeCC clientCQ clientRecvOps
case clientRes of
Left x -> error $ "Client recv error: " ++ show x
Right [_,_,OpRecvStatusOnClientResult _ code details] -> do
code @?= StatusPermissionDenied
return $ Right ()
wrong -> error $ "Unexpected op results: " ++ show wrong
runSerialTest :: (GRPC -> IO (Either GRPCIOError ())) -> IO ()
runSerialTest f =
withGRPC f >>= \case Left x -> error $ show x
Right () -> return ()
withClientServerUnaryCall :: GRPC
-> ((Client, Server, ClientCall,
ServerCall ByteString)
-> IO (Either GRPCIOError a))
-> IO (Either GRPCIOError a)
withClientServerUnaryCall grpc f = do
withClient grpc clientConf $ \c -> do
crm <- clientRegisterMethodNormal c "/foo"
withServer grpc serverConf $ \s ->
withClientCall c crm 10 $ \cc -> do
let srm = head (normalMethods s)
-- NOTE: We need to send client ops here or else `withServerCall` hangs,
-- because registered methods try to do recv ops immediately when
-- created. If later we want to send payloads or metadata, we'll need
-- to tweak this.
_clientRes <- runOps (unsafeCC cc) (clientCQ c) clientEmptySendOps
withServerCall s srm $ \sc ->
f (c, s, cc, sc)
serverConf :: ServerConfig
serverConf = ServerConfig "localhost" 50051 [("/foo")] [] [] [] [] Nothing
clientConf :: ClientConfig
clientConf = ClientConfig "localhost" 50051 [] Nothing
clientEmptySendOps :: [Op]
clientEmptySendOps = [OpSendInitialMetadata mempty,
OpSendMessage "",
OpSendCloseFromClient]
clientRecvOps :: [Op]
clientRecvOps = [OpRecvInitialMetadata,
OpRecvMessage,
OpRecvStatusOnClient]
serverEmptyRecvOps :: [Op]
serverEmptyRecvOps = [OpSendInitialMetadata mempty,
OpRecvMessage,
OpRecvCloseOnServer]