mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-05 10:49:42 +01:00
e4a28e9e4b
* 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
135 lines
4.2 KiB
Haskell
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))
|