mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2025-01-27 11:24:58 +01:00
Remove forgotten duplicate.
This commit is contained in:
Christian Lavoie
parent
065632ac66
commit
cc67b403af
1 changed files with 0 additions and 203 deletions
|
|
@ -1,203 +0,0 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
|
||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
||||||
|
|
||||||
module UnsafeTests (unsafeTests, unsafeProperties) where
|
|
||||||
|
|
||||||
import Control.Exception (bracket_)
|
|
||||||
import Control.Monad
|
|
||||||
import qualified Data.ByteString as B
|
|
||||||
import Foreign.Marshal.Alloc
|
|
||||||
import Foreign.Storable
|
|
||||||
import GHC.Exts
|
|
||||||
import Network.GRPC.LowLevel.GRPC (threadDelaySecs)
|
|
||||||
import Network.GRPC.Unsafe
|
|
||||||
import Network.GRPC.Unsafe.ByteBuffer
|
|
||||||
import Network.GRPC.Unsafe.ChannelArgs
|
|
||||||
import Network.GRPC.Unsafe.Metadata
|
|
||||||
import Network.GRPC.Unsafe.Security
|
|
||||||
import Network.GRPC.Unsafe.Slice
|
|
||||||
import Network.GRPC.Unsafe.Time
|
|
||||||
import System.Clock
|
|
||||||
import Test.QuickCheck.Gen as QC
|
|
||||||
import Test.QuickCheck.Property as QC
|
|
||||||
import Test.Tasty
|
|
||||||
import Test.Tasty.HUnit as HU (testCase, (@?=))
|
|
||||||
import Test.Tasty.QuickCheck as QC
|
|
||||||
|
|
||||||
unsafeTests :: TestTree
|
|
||||||
unsafeTests = testGroup "Unit tests for unsafe C bindings"
|
|
||||||
[ roundtripSliceUnit "\NULabc\NUL"
|
|
||||||
, roundtripSliceUnit largeByteString
|
|
||||||
, roundtripByteBufferUnit largeByteString
|
|
||||||
, roundtripTimeSpec (TimeSpec 123 123)
|
|
||||||
, testMetadata
|
|
||||||
, testNow
|
|
||||||
, testCreateDestroyMetadata
|
|
||||||
, testCreateDestroyMetadataKeyVals
|
|
||||||
, testCreateDestroyDeadline
|
|
||||||
, testCreateDestroyChannelArgs
|
|
||||||
, testCreateDestroyClientCreds
|
|
||||||
, testCreateDestroyServerCreds
|
|
||||||
]
|
|
||||||
|
|
||||||
unsafeProperties :: TestTree
|
|
||||||
unsafeProperties = testGroup "QuickCheck properties for unsafe C bindings"
|
|
||||||
[ roundtripSliceQC
|
|
||||||
, roundtripByteBufferQC
|
|
||||||
, roundtripMetadataQC
|
|
||||||
, metadataIsList
|
|
||||||
]
|
|
||||||
|
|
||||||
instance Arbitrary B.ByteString where
|
|
||||||
arbitrary = B.pack <$> arbitrary
|
|
||||||
|
|
||||||
instance Arbitrary MetadataMap where
|
|
||||||
arbitrary = do
|
|
||||||
--keys are not allowed to contain \NUL, but values are.
|
|
||||||
ks <- arbitrary `suchThat` all (B.notElem 0)
|
|
||||||
let l = length ks
|
|
||||||
vs <- vector l
|
|
||||||
return $ fromList (zip ks vs)
|
|
||||||
|
|
||||||
roundtripMetadataKeyVals :: MetadataMap -> IO MetadataMap
|
|
||||||
roundtripMetadataKeyVals m = do
|
|
||||||
(kvPtr, l) <- createMetadata m
|
|
||||||
m' <- getAllMetadata kvPtr l
|
|
||||||
metadataFree kvPtr
|
|
||||||
return m'
|
|
||||||
|
|
||||||
roundtripMetadataQC :: TestTree
|
|
||||||
roundtripMetadataQC = QC.testProperty "Metadata roundtrip" $
|
|
||||||
\m -> QC.ioProperty $ do m' <- roundtripMetadataKeyVals m
|
|
||||||
return $ m === m'
|
|
||||||
|
|
||||||
metadataIsList :: TestTree
|
|
||||||
metadataIsList = QC.testProperty "Metadata IsList instance" $
|
|
||||||
\(md :: MetadataMap) -> md == (fromList $ toList md)
|
|
||||||
|
|
||||||
largeByteString :: B.ByteString
|
|
||||||
largeByteString = B.pack $ take (32*1024*1024) $ cycle [97..99]
|
|
||||||
|
|
||||||
roundtripSlice :: B.ByteString -> IO B.ByteString
|
|
||||||
roundtripSlice bs = do
|
|
||||||
slice <- byteStringToSlice bs
|
|
||||||
unslice <- sliceToByteString slice
|
|
||||||
freeSlice slice
|
|
||||||
return unslice
|
|
||||||
|
|
||||||
roundtripSliceQC :: TestTree
|
|
||||||
roundtripSliceQC = QC.testProperty "Slice roundtrip: QuickCheck" $
|
|
||||||
\bs -> QC.ioProperty $ do bs' <- roundtripSlice bs
|
|
||||||
return $ bs == bs'
|
|
||||||
|
|
||||||
roundtripSliceUnit :: B.ByteString -> TestTree
|
|
||||||
roundtripSliceUnit bs = testCase "ByteString slice roundtrip" $ do
|
|
||||||
unslice <- roundtripSlice bs
|
|
||||||
unslice HU.@?= bs
|
|
||||||
|
|
||||||
roundtripByteBuffer :: B.ByteString -> IO B.ByteString
|
|
||||||
roundtripByteBuffer bs = do
|
|
||||||
slice <- byteStringToSlice bs
|
|
||||||
buffer <- grpcRawByteBufferCreate slice 1
|
|
||||||
reader <- byteBufferReaderCreate buffer
|
|
||||||
readSlice <- grpcByteBufferReaderReadall reader
|
|
||||||
bs' <- sliceToByteString readSlice
|
|
||||||
freeSlice slice
|
|
||||||
byteBufferReaderDestroy reader
|
|
||||||
grpcByteBufferDestroy buffer
|
|
||||||
freeSlice readSlice
|
|
||||||
return bs'
|
|
||||||
|
|
||||||
roundtripByteBufferQC :: TestTree
|
|
||||||
roundtripByteBufferQC = QC.testProperty "ByteBuffer roundtrip: QuickCheck" $
|
|
||||||
\bs -> QC.ioProperty $ do bs' <- roundtripByteBuffer bs
|
|
||||||
return $ bs == bs'
|
|
||||||
|
|
||||||
roundtripByteBufferUnit :: B.ByteString -> TestTree
|
|
||||||
roundtripByteBufferUnit bs = testCase "ByteBuffer roundtrip" $ do
|
|
||||||
bs' <- roundtripByteBuffer bs
|
|
||||||
bs' HU.@?= bs
|
|
||||||
|
|
||||||
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 ()
|
|
||||||
|
|
||||||
testCreateDestroyClientCreds :: TestTree
|
|
||||||
testCreateDestroyClientCreds = testCase "Create/destroy client credentials" $
|
|
||||||
grpc $ withChannelCredentials Nothing Nothing Nothing $ const $ return ()
|
|
||||||
|
|
||||||
testCreateDestroyServerCreds :: TestTree
|
|
||||||
testCreateDestroyServerCreds = testCase "Create/destroy server credentials" $
|
|
||||||
grpc $ withServerCredentials Nothing
|
|
||||||
"tests/ssl/testServerKey.pem"
|
|
||||||
"tests/ssl/testServerCert.pem"
|
|
||||||
SslDontRequestClientCertificate
|
|
||||||
$ 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
|
|
||||||
|
|
||||||
_nowarnUnused :: a
|
|
||||||
_nowarnUnused = assertCqEventComplete `undefined` threadDelaySecs
|
|
||||||
Loading…
Add table
Reference in a new issue