Remove a bunch of compilation warnings. (#9)

* Remove a bunch of compilation warnings

* Fix typo in `cabal configure` invocation
This commit is contained in:
intractable 2017-03-16 12:42:51 -05:00 committed by GitHub
parent 081be2af78
commit 5caae587e5
18 changed files with 57 additions and 71 deletions

View file

@ -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

View file

@ -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_)) =

View file

@ -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 <-

View file

@ -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

View file

@ -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 (..),

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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)

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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