gRPC-haskell/tests/UnsafeTests.hs
Connor Clark e4a28e9e4b High-level unregistered concurrent interface (#41)
* remove parent ptr from unregistered calls -- unneeded

* begin unregistered high level server loop

* undo changes to highlevel server, add mkConfig for unregistered server

* move call CQ create/destroy into call create/destroy

* async normal call function

* preliminary unregistered server loop for non-streaming methods

* working unregistered highlevel example

* loop counters for benchmarking

* changes for benchmarking, add ruby example server for benchmarking

* async version of withCall, refactor unregistered server loop to handle all method types

* unregistered client streaming

* add remaining streaming modes

* unregistered server streaming test

* unregistered streaming tests

* add error logging

* fix bug in add example

* remove old TODOs

* fix bug: don't assume slices are null-terminated

* add TODO re: unregistered client streaming functions
2016-07-14 09:53:28 -07:00

135 lines
4.2 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module UnsafeTests (unsafeTests) where
import Control.Concurrent (threadDelay)
import Control.Concurrent.Async
import Control.Exception (bracket_)
import Control.Monad
import qualified Data.ByteString as B
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.Slice
import Network.GRPC.Unsafe.Time
import Network.GRPC.Unsafe.ChannelArgs
import System.Clock
import Test.Tasty
import Test.Tasty.HUnit as HU (testCase, (@?=),
assertBool)
unsafeTests :: TestTree
unsafeTests = testGroup "Unit tests for unsafe C bindings"
[ roundtripSlice "Hello, world!"
, roundtripSlice "\NULabc\NUL"
, roundtripByteBuffer "Hwaet! We gardena in geardagum..."
, roundtripSlice largeByteString
, roundtripByteBuffer largeByteString
, roundtripTimeSpec (TimeSpec 123 123)
, testMetadata
, testNow
, testCreateDestroyMetadata
, testCreateDestroyMetadataKeyVals
, testCreateDestroyDeadline
, testCreateDestroyChannelArgs
]
largeByteString :: B.ByteString
largeByteString = B.pack $ take (32*1024*1024) $ cycle [97..99]
roundtripSlice :: B.ByteString -> TestTree
roundtripSlice bs = testCase "ByteString slice roundtrip" $ do
slice <- byteStringToSlice bs
unslice <- sliceToByteString slice
unslice HU.@?= bs
freeSlice slice
roundtripByteBuffer :: B.ByteString -> TestTree
roundtripByteBuffer bs = testCase "ByteBuffer roundtrip" $ do
slice <- byteStringToSlice bs
buffer <- grpcRawByteBufferCreate slice 1
reader <- byteBufferReaderCreate buffer
readSlice <- grpcByteBufferReaderReadall reader
bs' <- sliceToByteString readSlice
bs' HU.@?= bs
-- clean up
freeSlice slice
byteBufferReaderDestroy reader
grpcByteBufferDestroy buffer
freeSlice readSlice
roundtripTimeSpec :: TimeSpec -> TestTree
roundtripTimeSpec t = testCase "CTimeSpec roundtrip" $ do
p <- malloc
let c = CTimeSpec t
poke p c
c' <- peek p
c' @?= c
free p
testMetadata :: TestTree
testMetadata = testCase "Metadata setter/getter roundtrip" $ do
m <- metadataAlloc 3
setMetadataKeyVal "hello" "world" m 0
setMetadataKeyVal "foo" "bar" m 1
setMetadataKeyVal "Haskell" "Curry" m 2
k0 <- getMetadataKey m 0
v0 <- getMetadataVal m 0
k1 <- getMetadataKey m 1
v1 <- getMetadataVal m 1
k2 <- getMetadataKey m 2
v2 <- getMetadataVal m 2
k0 HU.@?= "hello"
v0 HU.@?= "world"
k1 HU.@?= "foo"
v1 HU.@?= "bar"
k2 HU.@?= "Haskell"
v2 HU.@?= "Curry"
metadataFree m
currTimeMillis :: ClockType -> IO Int
currTimeMillis t = do
gprT <- gprNow t
tMillis <- gprTimeToMillis gprT
timespecDestroy gprT
return tMillis
testNow :: TestTree
testNow = testCase "Create/destroy various clock types" $ do
_ <- currTimeMillis GprClockMonotonic
_ <- currTimeMillis GprClockRealtime
_ <- currTimeMillis GprClockPrecise
return ()
testCreateDestroyMetadata :: TestTree
testCreateDestroyMetadata = testCase "Create/destroy metadataArrayPtr" $ do
grpc $ withMetadataArrayPtr $ const $ return ()
testCreateDestroyMetadataKeyVals :: TestTree
testCreateDestroyMetadataKeyVals = testCase "Create/destroy metadata key/values" $ do
grpc $ withMetadataKeyValPtr 10 $ const $ return ()
testCreateDestroyDeadline :: TestTree
testCreateDestroyDeadline = testCase "Create/destroy deadline" $ do
grpc $ withDeadlineSeconds 10 $ const $ return ()
testCreateDestroyChannelArgs :: TestTree
testCreateDestroyChannelArgs = testCase "Create/destroy channel args" $
grpc $ withChannelArgs [CompressionAlgArg GrpcCompressDeflate] $
const $ return ()
assertCqEventComplete :: Event -> IO ()
assertCqEventComplete e = do
eventCompletionType e HU.@?= OpComplete
eventSuccess e HU.@?= True
grpc :: IO a -> IO ()
grpc = bracket_ grpcInit grpcShutdown . void
threadDelaySecs :: Int -> IO ()
threadDelaySecs = threadDelay . (* 10^(6::Int))