mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-26 21:19:43 +01:00
Remove a bunch of compilation warnings. (#9)
* Remove a bunch of compilation warnings * Fix typo in `cabal configure` invocation
This commit is contained in:
parent
081be2af78
commit
5caae587e5
18 changed files with 57 additions and 71 deletions
|
@ -3,7 +3,7 @@
|
||||||
# $ # Consider adding the following command to your `~/.profile`
|
# $ # Consider adding the following command to your `~/.profile`
|
||||||
# $ NIX_PATH="${NIX_PATH}:ssh-config-file=${HOME}/.ssh/config:ssh-auth-sock=${SSH_AUTH_SOCK}"
|
# $ NIX_PATH="${NIX_PATH}:ssh-config-file=${HOME}/.ssh/config:ssh-auth-sock=${SSH_AUTH_SOCK}"
|
||||||
# $ nix-shell -A grpc-haskell.env release.nix
|
# $ nix-shell -A grpc-haskell.env release.nix
|
||||||
# [nix-shell]$ cabal configure --with-gcc=clang --enable tests && cabal build && cabal test
|
# [nix-shell]$ cabal configure --with-gcc=clang --enable-tests && cabal build && cabal test
|
||||||
#
|
#
|
||||||
# This will open up a Nix shell where all of your Haskell tools will work like
|
# This will open up a Nix shell where all of your Haskell tools will work like
|
||||||
# normal, except that all dependencies (including C libraries) are managed by
|
# normal, except that all dependencies (including C libraries) are managed by
|
||||||
|
|
|
@ -38,7 +38,6 @@ import Network.GRPC.HighLevel.Server (convertRecv, convertSend)
|
||||||
|
|
||||||
import Proto3.Suite (Message, toLazyByteString, fromByteString)
|
import Proto3.Suite (Message, toLazyByteString, fromByteString)
|
||||||
import Proto3.Wire.Decode (ParseError)
|
import Proto3.Wire.Decode (ParseError)
|
||||||
import Data.ByteString (ByteString)
|
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
|
|
||||||
newtype RegisteredMethod (mt :: GRPCMethodType) request response
|
newtype RegisteredMethod (mt :: GRPCMethodType) request response
|
||||||
|
@ -115,7 +114,7 @@ clientRequest client (RegisteredMethod method) (ClientReaderRequest req timeout
|
||||||
mkResponse (Right (meta_, rspCode_, details_)) =
|
mkResponse (Right (meta_, rspCode_, details_)) =
|
||||||
ClientReaderResponse meta_ rspCode_ details_
|
ClientReaderResponse meta_ rspCode_ details_
|
||||||
clientRequest client (RegisteredMethod method) (ClientBiDiRequest timeout meta handler) =
|
clientRequest client (RegisteredMethod method) (ClientBiDiRequest timeout meta handler) =
|
||||||
mkResponse <$> LL.clientRW client method timeout meta (\m recv send writesDone -> handler meta (convertRecv recv) (convertSend send) writesDone)
|
mkResponse <$> LL.clientRW client method timeout meta (\_m recv send writesDone -> handler meta (convertRecv recv) (convertSend send) writesDone)
|
||||||
where
|
where
|
||||||
mkResponse (Left ioError_) = ClientError (ClientIOError ioError_)
|
mkResponse (Left ioError_) = ClientError (ClientIOError ioError_)
|
||||||
mkResponse (Right (meta_, rspCode_, details_)) =
|
mkResponse (Right (meta_, rspCode_, details_)) =
|
||||||
|
|
|
@ -41,8 +41,7 @@ type ServerHandler a b =
|
||||||
-> IO (b, MetadataMap, StatusCode, StatusDetails)
|
-> IO (b, MetadataMap, StatusCode, StatusDetails)
|
||||||
|
|
||||||
convertGeneratedServerHandler ::
|
convertGeneratedServerHandler ::
|
||||||
(Message request, Message response)
|
(ServerRequest 'Normal request response -> IO (ServerResponse 'Normal response))
|
||||||
=> (ServerRequest 'Normal request response -> IO (ServerResponse 'Normal response))
|
|
||||||
-> ServerHandler request response
|
-> ServerHandler request response
|
||||||
convertGeneratedServerHandler handler call =
|
convertGeneratedServerHandler handler call =
|
||||||
do let call' = call { payload = () }
|
do let call' = call { payload = () }
|
||||||
|
@ -64,8 +63,7 @@ type ServerReaderHandler a b
|
||||||
-> IO (Maybe b, MetadataMap, StatusCode, StatusDetails)
|
-> IO (Maybe b, MetadataMap, StatusCode, StatusDetails)
|
||||||
|
|
||||||
convertGeneratedServerReaderHandler ::
|
convertGeneratedServerReaderHandler ::
|
||||||
(Message request, Message response)
|
(ServerRequest 'ClientStreaming request response -> IO (ServerResponse 'ClientStreaming response))
|
||||||
=> (ServerRequest 'ClientStreaming request response -> IO (ServerResponse 'ClientStreaming response))
|
|
||||||
-> ServerReaderHandler request response
|
-> ServerReaderHandler request response
|
||||||
convertGeneratedServerReaderHandler handler call recv =
|
convertGeneratedServerReaderHandler handler call recv =
|
||||||
do ServerReaderResponse rsp meta stsCode stsDetails <-
|
do ServerReaderResponse rsp meta stsCode stsDetails <-
|
||||||
|
@ -86,8 +84,7 @@ type ServerWriterHandler a b =
|
||||||
-> IO (MetadataMap, StatusCode, StatusDetails)
|
-> IO (MetadataMap, StatusCode, StatusDetails)
|
||||||
|
|
||||||
convertGeneratedServerWriterHandler ::
|
convertGeneratedServerWriterHandler ::
|
||||||
(Message request, Message response)
|
(ServerRequest 'ServerStreaming request response -> IO (ServerResponse 'ServerStreaming response))
|
||||||
=> (ServerRequest 'ServerStreaming request response -> IO (ServerResponse 'ServerStreaming response))
|
|
||||||
-> ServerWriterHandler request response
|
-> ServerWriterHandler request response
|
||||||
convertGeneratedServerWriterHandler handler call send =
|
convertGeneratedServerWriterHandler handler call send =
|
||||||
do let call' = call { payload = () }
|
do let call' = call { payload = () }
|
||||||
|
@ -112,8 +109,7 @@ type ServerRWHandler a b
|
||||||
-> IO (MetadataMap, StatusCode, StatusDetails)
|
-> IO (MetadataMap, StatusCode, StatusDetails)
|
||||||
|
|
||||||
convertGeneratedServerRWHandler ::
|
convertGeneratedServerRWHandler ::
|
||||||
(Message request, Message response)
|
(ServerRequest 'BiDiStreaming request response -> IO (ServerResponse 'BiDiStreaming response))
|
||||||
=> (ServerRequest 'BiDiStreaming request response -> IO (ServerResponse 'BiDiStreaming response))
|
|
||||||
-> ServerRWHandler request response
|
-> ServerRWHandler request response
|
||||||
convertGeneratedServerRWHandler handler call recv send =
|
convertGeneratedServerRWHandler handler call recv send =
|
||||||
do ServerBiDiResponse meta stsCode stsDetails <-
|
do ServerBiDiResponse meta stsCode stsDetails <-
|
||||||
|
|
|
@ -9,7 +9,6 @@
|
||||||
module Network.GRPC.HighLevel.Server.Unregistered where
|
module Network.GRPC.HighLevel.Server.Unregistered where
|
||||||
|
|
||||||
import Control.Arrow
|
import Control.Arrow
|
||||||
import Control.Concurrent
|
|
||||||
import Control.Concurrent.Async (async, wait)
|
import Control.Concurrent.Async (async, wait)
|
||||||
import qualified Control.Exception as CE
|
import qualified Control.Exception as CE
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
|
|
@ -111,7 +111,6 @@ import Network.GRPC.LowLevel.Server
|
||||||
import Network.GRPC.Unsafe (ConnectivityState (..))
|
import Network.GRPC.Unsafe (ConnectivityState (..))
|
||||||
import Network.GRPC.Unsafe.ChannelArgs (Arg (..), CompressionAlgorithm (..),
|
import Network.GRPC.Unsafe.ChannelArgs (Arg (..), CompressionAlgorithm (..),
|
||||||
CompressionLevel (..))
|
CompressionLevel (..))
|
||||||
import Network.GRPC.Unsafe.ChannelArgs (Arg (..), CompressionAlgorithm (..))
|
|
||||||
import Network.GRPC.Unsafe.Op (StatusCode (..))
|
import Network.GRPC.Unsafe.Op (StatusCode (..))
|
||||||
import Network.GRPC.Unsafe.Security (AuthContext,
|
import Network.GRPC.Unsafe.Security (AuthContext,
|
||||||
AuthMetadataContext (..),
|
AuthMetadataContext (..),
|
||||||
|
|
|
@ -304,6 +304,12 @@ clientWriterCmn (clientCQ -> cq) initMeta f (unsafeCC -> c) =
|
||||||
-> return (mmsg, initMD, trailMD, st, ds)
|
-> return (mmsg, initMD, trailMD, st, ds)
|
||||||
_ -> throwE (GRPCIOInternalUnexpectedRecv "clientWriter")
|
_ -> throwE (GRPCIOInternalUnexpectedRecv "clientWriter")
|
||||||
|
|
||||||
|
pattern CWRFinal :: Maybe ByteString
|
||||||
|
-> MetadataMap
|
||||||
|
-> MetadataMap
|
||||||
|
-> C.StatusCode
|
||||||
|
-> StatusDetails
|
||||||
|
-> [OpRecvResult]
|
||||||
pattern CWRFinal mmsg initMD trailMD st ds
|
pattern CWRFinal mmsg initMD trailMD st ds
|
||||||
<- [ OpRecvInitialMetadataResult initMD
|
<- [ OpRecvInitialMetadataResult initMD
|
||||||
, OpRecvMessageResult mmsg
|
, OpRecvMessageResult mmsg
|
||||||
|
|
|
@ -1,4 +1,5 @@
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
|
|
||||||
|
@ -16,10 +17,6 @@ GRPC
|
||||||
|
|
||||||
import Control.Concurrent (threadDelay, myThreadId)
|
import Control.Concurrent (threadDelay, myThreadId)
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Data.String (IsString)
|
|
||||||
import Data.ByteString (ByteString)
|
|
||||||
import qualified Data.ByteString as B
|
|
||||||
import qualified Data.Map as M
|
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
import qualified Network.GRPC.Unsafe as C
|
import qualified Network.GRPC.Unsafe as C
|
||||||
import qualified Network.GRPC.Unsafe.Op as C
|
import qualified Network.GRPC.Unsafe.Op as C
|
||||||
|
|
|
@ -18,7 +18,6 @@ import Foreign.Marshal.Alloc (free, malloc,
|
||||||
mallocBytes)
|
mallocBytes)
|
||||||
import Foreign.Ptr (Ptr, nullPtr)
|
import Foreign.Ptr (Ptr, nullPtr)
|
||||||
import Foreign.Storable (peek, poke)
|
import Foreign.Storable (peek, poke)
|
||||||
import GHC.Exts (IsList(..))
|
|
||||||
import Network.GRPC.LowLevel.CompletionQueue
|
import Network.GRPC.LowLevel.CompletionQueue
|
||||||
import Network.GRPC.LowLevel.GRPC
|
import Network.GRPC.LowLevel.GRPC
|
||||||
import qualified Network.GRPC.Unsafe as C (Call)
|
import qualified Network.GRPC.Unsafe as C (Call)
|
||||||
|
@ -265,6 +264,7 @@ type RecvSingle a
|
||||||
-> CompletionQueue
|
-> CompletionQueue
|
||||||
-> ExceptT GRPCIOError IO a
|
-> ExceptT GRPCIOError IO a
|
||||||
|
|
||||||
|
pattern RecvMsgRslt :: Maybe ByteString -> Either a [OpRecvResult]
|
||||||
pattern RecvMsgRslt mmsg <- Right [OpRecvMessageResult mmsg]
|
pattern RecvMsgRslt mmsg <- Right [OpRecvMessageResult mmsg]
|
||||||
|
|
||||||
sendSingle :: SendSingle Op
|
sendSingle :: SendSingle Op
|
||||||
|
|
|
@ -5,7 +5,6 @@ module Network.GRPC.LowLevel.Server.Unregistered where
|
||||||
|
|
||||||
import Control.Exception (finally)
|
import Control.Exception (finally)
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Control.Monad.IO.Class
|
|
||||||
import Control.Monad.Trans.Except
|
import Control.Monad.Trans.Except
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import Network.GRPC.LowLevel.Call.Unregistered
|
import Network.GRPC.LowLevel.Call.Unregistered
|
||||||
|
|
|
@ -9,7 +9,6 @@ import Control.Monad
|
||||||
import Data.ByteString (ByteString, useAsCString, packCString)
|
import Data.ByteString (ByteString, useAsCString, packCString)
|
||||||
|
|
||||||
import Foreign.C.String (CString, peekCString)
|
import Foreign.C.String (CString, peekCString)
|
||||||
import Foreign.C.Types
|
|
||||||
import Foreign.Marshal.Alloc (free)
|
import Foreign.Marshal.Alloc (free)
|
||||||
import Foreign.Ptr
|
import Foreign.Ptr
|
||||||
import Foreign.Storable
|
import Foreign.Storable
|
||||||
|
|
|
@ -4,7 +4,6 @@ module Network.GRPC.Unsafe.ChannelArgs where
|
||||||
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.List (find)
|
|
||||||
import Foreign.Marshal.Alloc (malloc, free)
|
import Foreign.Marshal.Alloc (malloc, free)
|
||||||
import Foreign.Storable
|
import Foreign.Storable
|
||||||
|
|
||||||
|
|
|
@ -6,9 +6,7 @@ module Network.GRPC.Unsafe.Metadata where
|
||||||
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Data.ByteString (ByteString, useAsCString, packCString)
|
|
||||||
import Data.Function (on)
|
import Data.Function (on)
|
||||||
import Data.List (sortBy, groupBy, (\\))
|
|
||||||
import Data.ByteString (ByteString, useAsCString,
|
import Data.ByteString (ByteString, useAsCString,
|
||||||
useAsCStringLen, packCString, packCStringLen)
|
useAsCStringLen, packCString, packCStringLen)
|
||||||
import Data.List (sortBy, groupBy)
|
import Data.List (sortBy, groupBy)
|
||||||
|
|
|
@ -8,7 +8,7 @@ module Network.GRPC.Unsafe.Security where
|
||||||
import Control.Exception (bracket)
|
import Control.Exception (bracket)
|
||||||
import Data.ByteString (ByteString, useAsCString, packCString, packCStringLen)
|
import Data.ByteString (ByteString, useAsCString, packCString, packCStringLen)
|
||||||
import Data.Coerce (coerce)
|
import Data.Coerce (coerce)
|
||||||
import Foreign.C.String (CString, withCString)
|
import Foreign.C.String (CString)
|
||||||
import Foreign.C.Types
|
import Foreign.C.Types
|
||||||
import Foreign.Storable
|
import Foreign.Storable
|
||||||
import Foreign.Marshal.Alloc (free)
|
import Foreign.Marshal.Alloc (free)
|
||||||
|
|
|
@ -2,7 +2,6 @@ module Network.GRPC.Unsafe.Time where
|
||||||
|
|
||||||
import Control.Exception (bracket)
|
import Control.Exception (bracket)
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import Foreign.C.Types
|
|
||||||
import Foreign.Storable
|
import Foreign.Storable
|
||||||
import System.Clock
|
import System.Clock
|
||||||
|
|
||||||
|
|
|
@ -7,9 +7,8 @@ import Test.Tasty.HUnit (testCase, (@?=))
|
||||||
|
|
||||||
import Data.String
|
import Data.String
|
||||||
import Proto3.Suite.DotProto.Generate
|
import Proto3.Suite.DotProto.Generate
|
||||||
import qualified Data.Text as T
|
|
||||||
|
|
||||||
import Turtle
|
import Turtle hiding (err)
|
||||||
|
|
||||||
generatedTests :: TestTree
|
generatedTests :: TestTree
|
||||||
generatedTests = testGroup "Code generator tests"
|
generatedTests = testGroup "Code generator tests"
|
||||||
|
@ -23,11 +22,11 @@ testServerGeneration = testCase "server generation" $ do
|
||||||
|
|
||||||
compileSimpleDotProto
|
compileSimpleDotProto
|
||||||
|
|
||||||
exitCode <- proc "tests/simple-server.sh" [hsTmpDir] empty
|
do exitCode <- proc "tests/simple-server.sh" [hsTmpDir] empty
|
||||||
exitCode @?= ExitSuccess
|
exitCode @?= ExitSuccess
|
||||||
|
|
||||||
exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
|
do exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
|
||||||
exitCode @?= ExitSuccess
|
exitCode @?= ExitSuccess
|
||||||
|
|
||||||
runManaged $ do
|
runManaged $ do
|
||||||
serverExitCodeA <- fork (shell (hsTmpDir <> "/simple-server") empty)
|
serverExitCodeA <- fork (shell (hsTmpDir <> "/simple-server") empty)
|
||||||
|
@ -51,11 +50,11 @@ testClientGeneration = testCase "client generation" $ do
|
||||||
|
|
||||||
compileSimpleDotProto
|
compileSimpleDotProto
|
||||||
|
|
||||||
exitCode <- proc "tests/simple-client.sh" [hsTmpDir] empty
|
do exitCode <- proc "tests/simple-client.sh" [hsTmpDir] empty
|
||||||
exitCode @?= ExitSuccess
|
exitCode @?= ExitSuccess
|
||||||
|
|
||||||
exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
|
do exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
|
||||||
exitCode @?= ExitSuccess
|
exitCode @?= ExitSuccess
|
||||||
|
|
||||||
runManaged $ do
|
runManaged $ do
|
||||||
serverExitCodeA <- fork
|
serverExitCodeA <- fork
|
||||||
|
|
|
@ -173,15 +173,15 @@ testSSL =
|
||||||
rspCode @?= StatusOk
|
rspCode @?= StatusOk
|
||||||
rspBody @?= "reply test"
|
rspBody @?= "reply test"
|
||||||
|
|
||||||
serverConf = defServerConf
|
serverConf' = defServerConf
|
||||||
{sslConfig = Just (ServerSSLConfig
|
{ sslConfig = Just (ServerSSLConfig
|
||||||
Nothing
|
Nothing
|
||||||
"tests/ssl/localhost.key"
|
"tests/ssl/localhost.key"
|
||||||
"tests/ssl/localhost.crt"
|
"tests/ssl/localhost.crt"
|
||||||
SslDontRequestClientCertificate
|
SslDontRequestClientCertificate
|
||||||
Nothing)
|
Nothing)
|
||||||
}
|
}
|
||||||
server = TestServer serverConf $ \s -> do
|
server = TestServer serverConf' $ \s -> do
|
||||||
r <- U.serverHandleNormalCall s mempty $ \U.ServerCall{..} body -> do
|
r <- U.serverHandleNormalCall s mempty $ \U.ServerCall{..} body -> do
|
||||||
body @?= "hi"
|
body @?= "hi"
|
||||||
return ("reply test", mempty, StatusOk, "")
|
return ("reply test", mempty, StatusOk, "")
|
||||||
|
@ -219,16 +219,16 @@ testServerAuthProcessorCancel =
|
||||||
else (StatusUnauthenticated, "denied!")
|
else (StatusUnauthenticated, "denied!")
|
||||||
return $ AuthProcessorResult mempty mempty status details
|
return $ AuthProcessorResult mempty mempty status details
|
||||||
|
|
||||||
serverConf = defServerConf
|
serverConf' = defServerConf
|
||||||
{sslConfig = Just (ServerSSLConfig
|
{ sslConfig = Just (ServerSSLConfig
|
||||||
Nothing
|
Nothing
|
||||||
"tests/ssl/localhost.key"
|
"tests/ssl/localhost.key"
|
||||||
"tests/ssl/localhost.crt"
|
"tests/ssl/localhost.crt"
|
||||||
SslDontRequestClientCertificate
|
SslDontRequestClientCertificate
|
||||||
serverProcessor)
|
serverProcessor)
|
||||||
}
|
}
|
||||||
server = TestServer serverConf $ \s -> do
|
server = TestServer serverConf' $ \s -> do
|
||||||
r <- U.serverHandleNormalCall s mempty $ \U.ServerCall{..} body -> do
|
r <- U.serverHandleNormalCall s mempty $ \U.ServerCall{..} _body -> do
|
||||||
checkMD "Handler only sees requests with good metadata"
|
checkMD "Handler only sees requests with good metadata"
|
||||||
[("foo","bar")]
|
[("foo","bar")]
|
||||||
metadata
|
metadata
|
||||||
|
@ -272,15 +272,15 @@ testAuthMetadataTransfer =
|
||||||
checkMD "server plugin sees metadata added by client plugin" expected m
|
checkMD "server plugin sees metadata added by client plugin" expected m
|
||||||
return $ AuthProcessorResult mempty mempty StatusOk ""
|
return $ AuthProcessorResult mempty mempty StatusOk ""
|
||||||
|
|
||||||
serverConf = defServerConf
|
serverConf' = defServerConf
|
||||||
{sslConfig = Just (ServerSSLConfig
|
{ sslConfig = Just (ServerSSLConfig
|
||||||
Nothing
|
Nothing
|
||||||
"tests/ssl/localhost.key"
|
"tests/ssl/localhost.key"
|
||||||
"tests/ssl/localhost.crt"
|
"tests/ssl/localhost.crt"
|
||||||
SslDontRequestClientCertificate
|
SslDontRequestClientCertificate
|
||||||
serverProcessor)
|
serverProcessor)
|
||||||
}
|
}
|
||||||
server = TestServer serverConf $ \s -> do
|
server = TestServer serverConf' $ \s -> do
|
||||||
r <- U.serverHandleNormalCall s mempty $ \U.ServerCall{..} body -> do
|
r <- U.serverHandleNormalCall s mempty $ \U.ServerCall{..} body -> do
|
||||||
body @?= "hi"
|
body @?= "hi"
|
||||||
return ("reply test", mempty, StatusOk, "")
|
return ("reply test", mempty, StatusOk, "")
|
||||||
|
@ -376,7 +376,7 @@ testAuthMetadataPropagate = testCase "auth metadata inherited by children" $ do
|
||||||
|
|
||||||
server2 = withGRPC $ \g -> withServer g server2ServerConf $ \s -> do
|
server2 = withGRPC $ \g -> withServer g server2ServerConf $ \s -> do
|
||||||
let rm = head (normalMethods s)
|
let rm = head (normalMethods s)
|
||||||
serverHandleNormalCall s rm mempty $ \call -> do
|
serverHandleNormalCall s rm mempty $ \_call -> do
|
||||||
return ("server2 reply", mempty, StatusOk, "")
|
return ("server2 reply", mempty, StatusOk, "")
|
||||||
|
|
||||||
testServerCancel :: TestTree
|
testServerCancel :: TestTree
|
||||||
|
|
|
@ -4,10 +4,9 @@
|
||||||
|
|
||||||
module LowLevelTests.Op where
|
module LowLevelTests.Op where
|
||||||
|
|
||||||
import Data.ByteString (ByteString, isPrefixOf)
|
import Data.ByteString (ByteString)
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
import Test.Tasty.HUnit as HU (testCase, (@?=),
|
import Test.Tasty.HUnit as HU (testCase, (@?=))
|
||||||
assertBool)
|
|
||||||
|
|
||||||
import Network.GRPC.LowLevel
|
import Network.GRPC.LowLevel
|
||||||
import Network.GRPC.LowLevel.Call
|
import Network.GRPC.LowLevel.Call
|
||||||
|
@ -29,7 +28,7 @@ testCancelFromServer =
|
||||||
clientRes <- runOps unsafeCC clientCQ clientRecvOps
|
clientRes <- runOps unsafeCC clientCQ clientRecvOps
|
||||||
case clientRes of
|
case clientRes of
|
||||||
Left x -> error $ "Client recv error: " ++ show x
|
Left x -> error $ "Client recv error: " ++ show x
|
||||||
Right [_,_,OpRecvStatusOnClientResult _ code details] -> do
|
Right [_,_,OpRecvStatusOnClientResult _ code _details] -> do
|
||||||
code @?= StatusPermissionDenied
|
code @?= StatusPermissionDenied
|
||||||
return $ Right ()
|
return $ Right ()
|
||||||
wrong -> error $ "Unexpected op results: " ++ show wrong
|
wrong -> error $ "Unexpected op results: " ++ show wrong
|
||||||
|
|
|
@ -1,9 +1,9 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
|
|
||||||
module UnsafeTests (unsafeTests, unsafeProperties) where
|
module UnsafeTests (unsafeTests, unsafeProperties) where
|
||||||
|
|
||||||
import Control.Concurrent (threadDelay)
|
|
||||||
import Control.Exception (bracket_)
|
import Control.Exception (bracket_)
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
|
@ -22,8 +22,6 @@ import System.Clock
|
||||||
import Test.QuickCheck.Gen as QC
|
import Test.QuickCheck.Gen as QC
|
||||||
import Test.QuickCheck.Property as QC
|
import Test.QuickCheck.Property as QC
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
import Test.Tasty.HUnit as HU (assertBool, testCase,
|
|
||||||
(@?=))
|
|
||||||
import Test.Tasty.HUnit as HU (testCase, (@?=))
|
import Test.Tasty.HUnit as HU (testCase, (@?=))
|
||||||
import Test.Tasty.QuickCheck as QC
|
import Test.Tasty.QuickCheck as QC
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue