gRPC-haskell/tests/LowLevelTests.hs

{-# LANGUAGE OverloadedStrings #-}

module LowLevelTests where

import           Control.Concurrent.Async (withAsync, wait)
import           Data.ByteString (ByteString)
import qualified Data.Map as M
import           Network.GRPC.LowLevel
import           Test.Tasty
import           Test.Tasty.HUnit ((@?=), testCase)

lowLevelTests :: TestTree
lowLevelTests = testGroup "Unit tests of low-level Haskell library"
  [ testGRPCBracket
  , testCompletionQueueCreateDestroy
  , testServerCreateDestroy
  , testClientCreateDestroy
  , testWithServerCall
  , testWithClientCall
  -- , testPayloadLowLevel --TODO: currently crashing from free on unalloced ptr
  -- , testClientRequestNoServer --TODO: succeeds when no other tests run.
  , testServerAwaitNoClient
  -- , testPayloadLowLevelUnregistered --TODO: succeeds when no other tests run.
  ]

dummyMeta :: M.Map ByteString ByteString
dummyMeta = M.fromList [("foo","bar")]

testGRPCBracket :: TestTree
testGRPCBracket = testCase "No errors starting and stopping GRPC" $
                  withGRPC $ const $ return ()

testCompletionQueueCreateDestroy :: TestTree
testCompletionQueueCreateDestroy =
  testCase "No errors creating and destroying a CQ" $ withGRPC $ \grpc ->
    withCompletionQueue grpc $ const (return ())

testServerCreateDestroy :: TestTree
testServerCreateDestroy =
  testCase "No errors when starting and stopping a server" $
  withGRPC $ \grpc -> withServer grpc (ServerConfig "localhost" 50051 [])
                                 (const $ return ())

testClientCreateDestroy :: TestTree
testClientCreateDestroy =
  testCase "No errors when starting and stopping a client" $
  withGRPC $ \grpc -> withClient grpc (ClientConfig "localhost" 50051)
                                 (const $ return ())

testPayloadLowLevelServer :: GRPC -> IO ()
testPayloadLowLevelServer grpc = do
  let conf = (ServerConfig "localhost" 50051 [("/foo", "localhost", Normal)])
  withServer grpc conf $ \server -> do
    let method = head (registeredMethods server)
    result <- serverHandleNormalRegisteredCall server method 11 M.empty $
                \reqBody reqMeta -> return ("reply test", dummyMeta, dummyMeta)
    case result of
      Left err -> error $ show err
      Right _ -> return ()

testPayloadLowLevelClient :: GRPC -> IO ()
testPayloadLowLevelClient grpc =
  withClient grpc (ClientConfig "localhost" 50051) $ \client -> do
    method <- clientRegisterMethod client "/foo" "localhost" Normal
    putStrLn "registered method on client."
    reqResult <- clientRegisteredRequest client method 10 "Hello!" M.empty
    case reqResult of
      Left x -> error $ "Client got error: " ++ show x
      Right (NormalRequestResult respBody initMeta trailingMeta respCode) -> do
        respBody @?= "reply test"
        respCode @?= GrpcStatusOk

testPayloadLowLevelClientUnregistered :: GRPC -> IO ()
testPayloadLowLevelClientUnregistered grpc = do
  withClient grpc (ClientConfig "localhost" 50051) $ \client -> do
    reqResult <- clientRequest client "/foo" "localhost" 10 "Hello!" M.empty
    case reqResult of
      Left x -> error $ "Client got error: " ++ show x
      Right (NormalRequestResult respBody initMeta trailingMeta respCode) -> do
        respBody @?= "reply test"
        respCode @?= GrpcStatusOk

testPayloadLowLevelServerUnregistered :: GRPC -> IO ()
testPayloadLowLevelServerUnregistered grpc = do
  withServer grpc (ServerConfig "localhost" 50051 []) $ \server -> do
    result <- serverHandleNormalCall server 11 M.empty $
                \reqBody reqMeta -> return ("reply test", M.empty)
    case result of
      Left x -> error $ show x
      Right _ -> return ()

testClientRequestNoServer :: TestTree
testClientRequestNoServer = testCase "request times out when no server " $ do
  withGRPC $ \grpc -> do
    withClient grpc (ClientConfig "localhost" 50051) $ \client -> do
      method <- clientRegisterMethod client "/foo" "localhost" Normal
      reqResult <- clientRegisteredRequest client method 1 "Hello" M.empty
      reqResult @?= (Left GRPCIOTimeout)

testServerAwaitNoClient :: TestTree
testServerAwaitNoClient = testCase "server wait times out when no client " $ do
  withGRPC $ \grpc -> do
    let conf = (ServerConfig "localhost" 50051 [("/foo", "localhost", Normal)])
    withServer grpc conf $ \server -> do
      let method = head (registeredMethods server)
      result <- serverHandleNormalRegisteredCall server method 1 M.empty $
                  \_ _ -> return ("", M.empty, M.empty)
      result @?= Left GRPCIOTimeout

testServerUnregisteredAwaitNoClient :: TestTree
testServerUnregisteredAwaitNoClient =
  testCase "server wait times out when no client -- unregistered method " $ do
    withGRPC $ \grpc -> do
      let conf = ServerConfig "localhost" 50051 []
      withServer grpc conf $ \server -> do
        result <- serverHandleNormalCall server 10 M.empty $
                    \_ _ -> return ("", M.empty)
        case result of
          Left err -> error $ show err
          Right _ -> return ()

testPayloadLowLevel :: TestTree
testPayloadLowLevel = testCase "LowLevel Haskell library request/response " $ do
  withGRPC $ \grpc -> do
    withAsync (testPayloadLowLevelServer grpc) $ \a1 -> do
      withAsync (testPayloadLowLevelClient grpc) $ \a2 -> do
        wait a1
        wait a2

testPayloadLowLevelUnregistered :: TestTree
testPayloadLowLevelUnregistered =
  testCase "LowLevel Haskell library unregistered request/response " $ do
    withGRPC $ \grpc -> do
      withAsync (testPayloadLowLevelServerUnregistered grpc) $ \a1 ->
        withAsync (testPayloadLowLevelClientUnregistered grpc) $ \a2 -> do
          wait a1
          wait a2

testWithServerCall :: TestTree
testWithServerCall =
  testCase "Creating and destroying a call: no errors. " $
    withGRPC $ \grpc -> do
      let conf = ServerConfig "localhost" 50051 []
      withServer grpc conf $ \server -> do
        result <- withServerCall server 1 $ const $ return $ Right ()
        result @?= Left GRPCIOTimeout

testWithClientCall :: TestTree
testWithClientCall =
  testCase "Creating and destroying a client call: no errors. " $
    withGRPC $ \grpc -> do
      let conf = ClientConfig "localhost" 50051
      withClient grpc conf $ \client -> do
        result <- withClientCall client "foo" "localhost" 10 $
                    const $ return $ Right ()
        case result of
          Left err -> error $ show err
          Right _ -> return ()