From 07ed314d243a26ef34080c379d5a2acd17c77a52 Mon Sep 17 00:00:00 2001 From: Joel Stanley Date: Tue, 24 May 2016 14:34:23 -0700 Subject: [PATCH] Relocate preliminary payload tests to LowLevelTests module --- tests/LowLevelTests.hs | 148 +++++++++++++++++++++++++++++++++++++- tests/Properties.hs | 159 ++--------------------------------------- 2 files changed, 150 insertions(+), 157 deletions(-) diff --git a/tests/LowLevelTests.hs b/tests/LowLevelTests.hs index 41bebec..c438c20 100644 --- a/tests/LowLevelTests.hs +++ b/tests/LowLevelTests.hs @@ -2,12 +2,22 @@ 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) +import Test.Tasty.HUnit as HU ((@?=), testCase) +import Control.Concurrent.Async +import Foreign.Marshal.Alloc +import Foreign.Ptr +import Foreign.Storable +import Network.GRPC.Unsafe +import Network.GRPC.Unsafe.ByteBuffer +import Network.GRPC.Unsafe.Constants +import Network.GRPC.Unsafe.Metadata +import Network.GRPC.Unsafe.Op +import Network.GRPC.Unsafe.Time + lowLevelTests :: TestTree lowLevelTests = testGroup "Unit tests of low-level Haskell library" @@ -21,6 +31,7 @@ lowLevelTests = testGroup "Unit tests of low-level Haskell library" -- , testClientRequestNoServer --TODO: succeeds when no other tests run. , testServerAwaitNoClient -- , testPayloadLowLevelUnregistered --TODO: succeeds when no other tests run. + , testPayload ] dummyMeta :: M.Map ByteString ByteString @@ -156,3 +167,136 @@ testWithClientCall = case result of Left err -> error $ show err Right _ -> return () + +assertCqEventComplete :: Event -> IO () +assertCqEventComplete e = do + eventCompletionType e HU.@?= OpComplete + eventSuccess e HU.@?= True + +testPayloadClient :: IO () +testPayloadClient = do + client <- grpcInsecureChannelCreate "localhost:50051" nullPtr reserved + cq <- grpcCompletionQueueCreate reserved + withMetadataArrayPtr $ \initialMetadataRecv -> do + withMetadataArrayPtr $ \trailingMetadataRecv -> do + withByteBufferPtr $ \clientRecvBB -> do + deadline <- secondsToDeadline 5 + pluckDeadline <- secondsToDeadline 10 + clientCall <- grpcChannelCreateCall + client (Call nullPtr) propagateDefaults cq + "/foo" "localhost" deadline reserved + --send request + withOpArray 6 $ \ops -> do + opSendInitialMetadataEmpty ops 0 + withByteStringAsByteBuffer "hello world" $ \requestPayload -> do + opSendMessage ops 1 requestPayload + opSendCloseClient ops 2 + opRecvInitialMetadata ops 3 initialMetadataRecv + opRecvMessage ops 4 clientRecvBB + statusCodePtr <- createStatusCodePtr + let cstringCapacity = 32 + cStringPtr <- malloc + cstring <- mallocBytes cstringCapacity + poke cStringPtr cstring + opRecvStatusClient ops 5 trailingMetadataRecv statusCodePtr + cStringPtr + cstringCapacity + --send client request + requestError <- grpcCallStartBatch clientCall ops 6 (tag 1) reserved + clientRequestCqEvent <- grpcCompletionQueuePluck + cq (tag 1) pluckDeadline reserved + assertCqEventComplete clientRequestCqEvent + requestError HU.@?= CallOk + free cstring + free cStringPtr + destroyStatusCodePtr statusCodePtr + --verify response received + responseRecv <- peek clientRecvBB + responseRecvBS <- copyByteBufferToByteString responseRecv + responseRecvBS HU.@?= "hello you" + grpcCompletionQueueShutdown cq + grpcCallDestroy clientCall + --TODO: the grpc test drains the cq here + grpcCompletionQueueDestroy cq + grpcChannelDestroy client + +testPayloadServer :: IO () +testPayloadServer = do + server <- grpcServerCreate nullPtr reserved + cq <- grpcCompletionQueueCreate reserved + grpcServerRegisterCompletionQueue server cq reserved + _ <- grpcServerAddInsecureHttp2Port server "localhost:50051" + grpcServerStart server + serverCallPtr <- malloc + withMetadataArrayPtr $ \requestMetadataRecv -> do + withByteBufferPtr $ \recvBufferPtr -> do + callDetails <- createCallDetails + requestMetadataRecv' <- peek requestMetadataRecv + recvRequestError <- grpcServerRequestCall + server serverCallPtr callDetails + requestMetadataRecv' cq cq (tag 101) + pluckDeadline' <- secondsToDeadline 10 + requestCallCqEvent <- grpcCompletionQueuePluck cq (tag 101) + pluckDeadline' + reserved + assertCqEventComplete requestCallCqEvent + recvRequestError HU.@?= CallOk + destroyCallDetails callDetails + --receive request + withOpArray 2 $ \recvOps -> do + opSendInitialMetadataEmpty recvOps 0 + opRecvMessage recvOps 1 recvBufferPtr + serverCall <- peek serverCallPtr + recvBatchError <- grpcCallStartBatch serverCall recvOps 2 + (tag 102) reserved + recvBatchError HU.@?= CallOk + pluckDeadline'' <- secondsToDeadline 10 + recvCqEvent <- grpcCompletionQueuePluck cq (tag 102) + pluckDeadline'' + reserved + assertCqEventComplete recvCqEvent + --send response + withOpArray 3 $ \respOps -> do + withByteStringAsByteBuffer "hello you" $ \respbb -> do + cancelledPtr <- malloc + opRecvCloseServer respOps 0 cancelledPtr + opSendMessage respOps 1 respbb + opSendStatusServer respOps 2 0 (MetadataKeyValPtr nullPtr) + GrpcStatusOk "ok" + serverCall <- peek serverCallPtr + respBatchError <- grpcCallStartBatch serverCall respOps 3 + (tag 103) reserved + respBatchError HU.@?= CallOk + pluckDeadline''' <- secondsToDeadline 10 + respCqEvent <- grpcCompletionQueuePluck cq (tag 103) + pluckDeadline''' + reserved + assertCqEventComplete respCqEvent + --verify data was received + serverRecv <- peek recvBufferPtr + serverRecvBS <- copyByteBufferToByteString serverRecv + serverRecvBS HU.@?= "hello world" + --shut down + grpcServerShutdownAndNotify server cq (tag 0) + pluckDeadline'''' <- secondsToDeadline 10 + shutdownEvent <- grpcCompletionQueuePluck cq (tag 0) pluckDeadline'''' + reserved + assertCqEventComplete shutdownEvent + grpcServerCancelAllCalls server + grpcServerDestroy server + grpcCompletionQueueShutdown cq + grpcCompletionQueueDestroy cq + free serverCallPtr + +-- | Straightforward translation of the gRPC core test end2end/tests/payload.c +-- This is intended to test the low-level C bindings, so we use only a few +-- minimal abstractions on top of it. +testPayload :: TestTree +testPayload = testCase "low-level C bindings request/response " $ do + grpcInit + withAsync testPayloadServer $ \a1 -> do + withAsync testPayloadClient $ \a2 -> do + wait a1 + wait a2 + grpcShutdown + putStrLn "Done." diff --git a/tests/Properties.hs b/tests/Properties.hs index a6345f2..395c038 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -1,160 +1,9 @@ -{-# LANGUAGE OverloadedStrings #-} - -import Control.Concurrent.Async -import Foreign.Marshal.Alloc -import Foreign.Ptr -import Foreign.Storable -import Network.GRPC.Unsafe -import Network.GRPC.Unsafe.ByteBuffer -import Network.GRPC.Unsafe.Constants -import Network.GRPC.Unsafe.Metadata -import Network.GRPC.Unsafe.Op -import Network.GRPC.Unsafe.Time -import Test.Tasty -import Test.Tasty.HUnit as HU - import LowLevelTests +import Test.Tasty import UnsafeTests -assertCqEventComplete :: Event -> IO () -assertCqEventComplete e = do - eventCompletionType e HU.@?= OpComplete - eventSuccess e HU.@?= True - -testPayloadClient :: IO () -testPayloadClient = do - client <- grpcInsecureChannelCreate "localhost:50051" nullPtr reserved - cq <- grpcCompletionQueueCreate reserved - withMetadataArrayPtr $ \initialMetadataRecv -> do - withMetadataArrayPtr $ \trailingMetadataRecv -> do - withByteBufferPtr $ \clientRecvBB -> do - deadline <- secondsToDeadline 5 - pluckDeadline <- secondsToDeadline 10 - clientCall <- grpcChannelCreateCall - client (Call nullPtr) propagateDefaults cq - "/foo" "localhost" deadline reserved - --send request - withOpArray 6 $ \ops -> do - opSendInitialMetadataEmpty ops 0 - withByteStringAsByteBuffer "hello world" $ \requestPayload -> do - opSendMessage ops 1 requestPayload - opSendCloseClient ops 2 - opRecvInitialMetadata ops 3 initialMetadataRecv - opRecvMessage ops 4 clientRecvBB - statusCodePtr <- createStatusCodePtr - let cstringCapacity = 32 - cStringPtr <- malloc - cstring <- mallocBytes cstringCapacity - poke cStringPtr cstring - opRecvStatusClient ops 5 trailingMetadataRecv statusCodePtr - cStringPtr - cstringCapacity - --send client request - requestError <- grpcCallStartBatch clientCall ops 6 (tag 1) reserved - clientRequestCqEvent <- grpcCompletionQueuePluck - cq (tag 1) pluckDeadline reserved - assertCqEventComplete clientRequestCqEvent - requestError HU.@?= CallOk - free cstring - free cStringPtr - destroyStatusCodePtr statusCodePtr - --verify response received - responseRecv <- peek clientRecvBB - responseRecvBS <- copyByteBufferToByteString responseRecv - responseRecvBS HU.@?= "hello you" - grpcCompletionQueueShutdown cq - grpcCallDestroy clientCall - --TODO: the grpc test drains the cq here - grpcCompletionQueueDestroy cq - grpcChannelDestroy client - -testPayloadServer :: IO () -testPayloadServer = do - server <- grpcServerCreate nullPtr reserved - cq <- grpcCompletionQueueCreate reserved - grpcServerRegisterCompletionQueue server cq reserved - _ <- grpcServerAddInsecureHttp2Port server "localhost:50051" - grpcServerStart server - serverCallPtr <- malloc - withMetadataArrayPtr $ \requestMetadataRecv -> do - withByteBufferPtr $ \recvBufferPtr -> do - callDetails <- createCallDetails - requestMetadataRecv' <- peek requestMetadataRecv - recvRequestError <- grpcServerRequestCall - server serverCallPtr callDetails - requestMetadataRecv' cq cq (tag 101) - pluckDeadline' <- secondsToDeadline 10 - requestCallCqEvent <- grpcCompletionQueuePluck cq (tag 101) - pluckDeadline' - reserved - assertCqEventComplete requestCallCqEvent - recvRequestError HU.@?= CallOk - destroyCallDetails callDetails - --receive request - withOpArray 2 $ \recvOps -> do - opSendInitialMetadataEmpty recvOps 0 - opRecvMessage recvOps 1 recvBufferPtr - serverCall <- peek serverCallPtr - recvBatchError <- grpcCallStartBatch serverCall recvOps 2 - (tag 102) reserved - recvBatchError HU.@?= CallOk - pluckDeadline'' <- secondsToDeadline 10 - recvCqEvent <- grpcCompletionQueuePluck cq (tag 102) - pluckDeadline'' - reserved - assertCqEventComplete recvCqEvent - --send response - withOpArray 3 $ \respOps -> do - withByteStringAsByteBuffer "hello you" $ \respbb -> do - cancelledPtr <- malloc - opRecvCloseServer respOps 0 cancelledPtr - opSendMessage respOps 1 respbb - opSendStatusServer respOps 2 0 (MetadataKeyValPtr nullPtr) - GrpcStatusOk "ok" - serverCall <- peek serverCallPtr - respBatchError <- grpcCallStartBatch serverCall respOps 3 - (tag 103) reserved - respBatchError HU.@?= CallOk - pluckDeadline''' <- secondsToDeadline 10 - respCqEvent <- grpcCompletionQueuePluck cq (tag 103) - pluckDeadline''' - reserved - assertCqEventComplete respCqEvent - --verify data was received - serverRecv <- peek recvBufferPtr - serverRecvBS <- copyByteBufferToByteString serverRecv - serverRecvBS HU.@?= "hello world" - --shut down - grpcServerShutdownAndNotify server cq (tag 0) - pluckDeadline'''' <- secondsToDeadline 10 - shutdownEvent <- grpcCompletionQueuePluck cq (tag 0) pluckDeadline'''' - reserved - assertCqEventComplete shutdownEvent - grpcServerCancelAllCalls server - grpcServerDestroy server - grpcCompletionQueueShutdown cq - grpcCompletionQueueDestroy cq - free serverCallPtr - --- | Straightforward translation of the gRPC core test end2end/tests/payload.c --- This is intended to test the low-level C bindings, so we use only a few --- minimal abstractions on top of it. -testPayload :: TestTree -testPayload = testCase "low-level C bindings request/response " $ do - grpcInit - withAsync testPayloadServer $ \a1 -> do - withAsync testPayloadClient $ \a2 -> do - wait a1 - wait a2 - grpcShutdown - putStrLn "Done." - -allTests :: TestTree -allTests = testGroup "All tests" - [ testPayload - , unsafeTests +main :: IO () +main = defaultMain $ testGroup "GRPC Unit Tests" + [ unsafeTests , lowLevelTests ] - -main :: IO () -main = defaultMain allTests