eeva/gRPC-haskell
1
0
Fork 0
mirror of https://github.com/unclechu/gRPC-haskell.git synced 2024-12-24 02:39:45 +01:00
Code Issues Projects Releases Wiki Activity

Remove a bunch of compilation warnings. (#9)

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
release.nix
View file

@ -3,7 +3,7 @@
# $ # 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-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
# normal, except that all dependencies (including C libraries) are managed by

3
src/Network/GRPC/HighLevel/Client.hs
View file

@ -38,7 +38,6 @@ import Network.GRPC.HighLevel.Server (convertRecv, convertSend)
import Proto3.Suite (Message, toLazyByteString, fromByteString)
import Proto3.Wire.Decode (ParseError)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL
newtype RegisteredMethod (mt :: GRPCMethodType) request response
@ -115,7 +114,7 @@ clientRequest client (RegisteredMethod method) (ClientReaderRequest req timeout
mkResponse (Right (meta_, rspCode_, details_)) =
ClientReaderResponse meta_ rspCode_ details_
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
mkResponse (Left ioError_) = ClientError (ClientIOError ioError_)
mkResponse (Right (meta_, rspCode_, details_)) =

12
src/Network/GRPC/HighLevel/Server.hs
View file

@ -41,8 +41,7 @@ type ServerHandler a b =
-> IO (b, MetadataMap, StatusCode, StatusDetails)
convertGeneratedServerHandler ::
(Message request, Message response)
=> (ServerRequest 'Normal request response -> IO (ServerResponse 'Normal response))
(ServerRequest 'Normal request response -> IO (ServerResponse 'Normal response))
-> ServerHandler request response
convertGeneratedServerHandler handler call =
do let call' = call { payload = () }
@ -64,8 +63,7 @@ type ServerReaderHandler a b
-> IO (Maybe b, MetadataMap, StatusCode, StatusDetails)
convertGeneratedServerReaderHandler ::
(Message request, Message response)
=> (ServerRequest 'ClientStreaming request response -> IO (ServerResponse 'ClientStreaming response))
(ServerRequest 'ClientStreaming request response -> IO (ServerResponse 'ClientStreaming response))
-> ServerReaderHandler request response
convertGeneratedServerReaderHandler handler call recv =
do ServerReaderResponse rsp meta stsCode stsDetails <-
@ -86,8 +84,7 @@ type ServerWriterHandler a b =
-> IO (MetadataMap, StatusCode, StatusDetails)
convertGeneratedServerWriterHandler ::
(Message request, Message response)
=> (ServerRequest 'ServerStreaming request response -> IO (ServerResponse 'ServerStreaming response))
(ServerRequest 'ServerStreaming request response -> IO (ServerResponse 'ServerStreaming response))
-> ServerWriterHandler request response
convertGeneratedServerWriterHandler handler call send =
do let call' = call { payload = () }
@ -112,8 +109,7 @@ type ServerRWHandler a b
-> IO (MetadataMap, StatusCode, StatusDetails)
convertGeneratedServerRWHandler ::
(Message request, Message response)
=> (ServerRequest 'BiDiStreaming request response -> IO (ServerResponse 'BiDiStreaming response))
(ServerRequest 'BiDiStreaming request response -> IO (ServerResponse 'BiDiStreaming response))
-> ServerRWHandler request response
convertGeneratedServerRWHandler handler call recv send =
do ServerBiDiResponse meta stsCode stsDetails <-

1
src/Network/GRPC/HighLevel/Server/Unregistered.hs
View file

@ -9,7 +9,6 @@
module Network.GRPC.HighLevel.Server.Unregistered where
import Control.Arrow
import Control.Concurrent
import Control.Concurrent.Async (async, wait)
import qualified Control.Exception as CE
import Control.Monad

1
src/Network/GRPC/LowLevel.hs
View file

@ -111,7 +111,6 @@ import Network.GRPC.LowLevel.Server
import Network.GRPC.Unsafe (ConnectivityState (..))
import Network.GRPC.Unsafe.ChannelArgs (Arg (..), CompressionAlgorithm (..),
CompressionLevel (..))
import Network.GRPC.Unsafe.ChannelArgs (Arg (..), CompressionAlgorithm (..))
import Network.GRPC.Unsafe.Op (StatusCode (..))
import Network.GRPC.Unsafe.Security (AuthContext,
AuthMetadataContext (..),

6
src/Network/GRPC/LowLevel/Client.hs
View file

@ -304,6 +304,12 @@ clientWriterCmn (clientCQ -> cq) initMeta f (unsafeCC -> c) =
-> return (mmsg, initMD, trailMD, st, ds)
_ -> throwE (GRPCIOInternalUnexpectedRecv "clientWriter")
pattern CWRFinal :: Maybe ByteString
-> MetadataMap
-> MetadataMap
-> C.StatusCode
-> StatusDetails
-> [OpRecvResult]
pattern CWRFinal mmsg initMD trailMD st ds
<- [ OpRecvInitialMetadataResult initMD
, OpRecvMessageResult mmsg

5
src/Network/GRPC/LowLevel/GRPC.hs
View file

@ -1,4 +1,5 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
@ -16,10 +17,6 @@ GRPC
import Control.Concurrent (threadDelay, myThreadId)
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 qualified Network.GRPC.Unsafe as C
import qualified Network.GRPC.Unsafe.Op as C

2
src/Network/GRPC/LowLevel/Op.hs
View file

@ -18,7 +18,6 @@ import Foreign.Marshal.Alloc (free, malloc,
mallocBytes)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (peek, poke)
import GHC.Exts (IsList(..))
import Network.GRPC.LowLevel.CompletionQueue
import Network.GRPC.LowLevel.GRPC
import qualified Network.GRPC.Unsafe as C (Call)
@ -265,6 +264,7 @@ type RecvSingle a
-> CompletionQueue
-> ExceptT GRPCIOError IO a
pattern RecvMsgRslt :: Maybe ByteString -> Either a [OpRecvResult]
pattern RecvMsgRslt mmsg <- Right [OpRecvMessageResult mmsg]
sendSingle :: SendSingle Op

1
src/Network/GRPC/LowLevel/Server/Unregistered.hs
View file

@ -5,7 +5,6 @@ module Network.GRPC.LowLevel.Server.Unregistered where
import Control.Exception (finally)
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Except
import Data.ByteString (ByteString)
import Network.GRPC.LowLevel.Call.Unregistered

1
src/Network/GRPC/Unsafe.chs
View file

@ -9,7 +9,6 @@ import Control.Monad
import Data.ByteString (ByteString, useAsCString, packCString)
import Foreign.C.String (CString, peekCString)
import Foreign.C.Types
import Foreign.Marshal.Alloc (free)
import Foreign.Ptr
import Foreign.Storable

1
src/Network/GRPC/Unsafe/ChannelArgs.chs
View file

@ -4,7 +4,6 @@ module Network.GRPC.Unsafe.ChannelArgs where
import Control.Exception
import Control.Monad
import Data.List (find)
import Foreign.Marshal.Alloc (malloc, free)
import Foreign.Storable

2
src/Network/GRPC/Unsafe/Metadata.chs
View file

@ -6,9 +6,7 @@ module Network.GRPC.Unsafe.Metadata where
import Control.Exception
import Control.Monad
import Data.ByteString (ByteString, useAsCString, packCString)
import Data.Function (on)
import Data.List (sortBy, groupBy, (\\))
import Data.ByteString (ByteString, useAsCString,
useAsCStringLen, packCString, packCStringLen)
import Data.List (sortBy, groupBy)

2
src/Network/GRPC/Unsafe/Security.chs
View file

@ -8,7 +8,7 @@ module Network.GRPC.Unsafe.Security where
import Control.Exception (bracket)
import Data.ByteString (ByteString, useAsCString, packCString, packCStringLen)
import Data.Coerce (coerce)
import Foreign.C.String (CString, withCString)
import Foreign.C.String (CString)
import Foreign.C.Types
import Foreign.Storable
import Foreign.Marshal.Alloc (free)

1
src/Network/GRPC/Unsafe/Time.chs
View file

@ -2,7 +2,6 @@ module Network.GRPC.Unsafe.Time where
import Control.Exception (bracket)
import Control.Monad
import Foreign.C.Types
import Foreign.Storable
import System.Clock

19
tests/GeneratedTests.hs
View file

@ -7,9 +7,8 @@ import Test.Tasty.HUnit (testCase, (@?=))
import Data.String
import Proto3.Suite.DotProto.Generate
import qualified Data.Text as T
import Turtle
import Turtle hiding (err)
generatedTests :: TestTree
generatedTests = testGroup "Code generator tests"
@ -23,11 +22,11 @@ testServerGeneration = testCase "server generation" $ do
compileSimpleDotProto
exitCode <- proc "tests/simple-server.sh" [hsTmpDir] empty
exitCode @?= ExitSuccess
do exitCode <- proc "tests/simple-server.sh" [hsTmpDir] empty
exitCode @?= ExitSuccess
exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
exitCode @?= ExitSuccess
do exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
exitCode @?= ExitSuccess
runManaged $ do
serverExitCodeA <- fork (shell (hsTmpDir <> "/simple-server") empty)
@ -51,11 +50,11 @@ testClientGeneration = testCase "client generation" $ do
compileSimpleDotProto
exitCode <- proc "tests/simple-client.sh" [hsTmpDir] empty
exitCode @?= ExitSuccess
do exitCode <- proc "tests/simple-client.sh" [hsTmpDir] empty
exitCode @?= ExitSuccess
exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
exitCode @?= ExitSuccess
do exitCode <- proc "tests/protoc.sh" [pyTmpDir] empty
exitCode @?= ExitSuccess
runManaged $ do
serverExitCodeA <- fork

58
tests/LowLevelTests.hs
View file

@ -173,15 +173,15 @@ testSSL =
rspCode @?= StatusOk
rspBody @?= "reply test"
serverConf = defServerConf
{sslConfig = Just (ServerSSLConfig
Nothing
"tests/ssl/localhost.key"
"tests/ssl/localhost.crt"
SslDontRequestClientCertificate
Nothing)
}
server = TestServer serverConf $ \s -> do
serverConf' = defServerConf
{ sslConfig = Just (ServerSSLConfig
Nothing
"tests/ssl/localhost.key"
"tests/ssl/localhost.crt"
SslDontRequestClientCertificate
Nothing)
}
server = TestServer serverConf' $ \s -> do
r <- U.serverHandleNormalCall s mempty $ \U.ServerCall{..} body -> do
body @?= "hi"
return ("reply test", mempty, StatusOk, "")
@ -219,16 +219,16 @@ testServerAuthProcessorCancel =
else (StatusUnauthenticated, "denied!")
return $ AuthProcessorResult mempty mempty status details
serverConf = defServerConf
{sslConfig = Just (ServerSSLConfig
Nothing
"tests/ssl/localhost.key"
"tests/ssl/localhost.crt"
SslDontRequestClientCertificate
serverProcessor)
}
server = TestServer serverConf $ \s -> do
r <- U.serverHandleNormalCall s mempty $ \U.ServerCall{..} body -> do
serverConf' = defServerConf
{ sslConfig = Just (ServerSSLConfig
Nothing
"tests/ssl/localhost.key"
"tests/ssl/localhost.crt"
SslDontRequestClientCertificate
serverProcessor)
}
server = TestServer serverConf' $ \s -> do
r <- U.serverHandleNormalCall s mempty $ \U.ServerCall{..} _body -> do
checkMD "Handler only sees requests with good metadata"
[("foo","bar")]
metadata
@ -272,15 +272,15 @@ testAuthMetadataTransfer =
checkMD "server plugin sees metadata added by client plugin" expected m
return $ AuthProcessorResult mempty mempty StatusOk ""
serverConf = defServerConf
{sslConfig = Just (ServerSSLConfig
Nothing
"tests/ssl/localhost.key"
"tests/ssl/localhost.crt"
SslDontRequestClientCertificate
serverProcessor)
}
server = TestServer serverConf $ \s -> do
serverConf' = defServerConf
{ sslConfig = Just (ServerSSLConfig
Nothing
"tests/ssl/localhost.key"
"tests/ssl/localhost.crt"
SslDontRequestClientCertificate
serverProcessor)
}
server = TestServer serverConf' $ \s -> do
r <- U.serverHandleNormalCall s mempty $ \U.ServerCall{..} body -> do
body @?= "hi"
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
let rm = head (normalMethods s)
serverHandleNormalCall s rm mempty $ \call -> do
serverHandleNormalCall s rm mempty $ \_call -> do
return ("server2 reply", mempty, StatusOk, "")
testServerCancel :: TestTree

7
tests/LowLevelTests/Op.hs
View file

@ -4,10 +4,9 @@
module LowLevelTests.Op where
import Data.ByteString (ByteString, isPrefixOf)
import Data.ByteString (ByteString)
import Test.Tasty
import Test.Tasty.HUnit as HU (testCase, (@?=),
assertBool)
import Test.Tasty.HUnit as HU (testCase, (@?=))
import Network.GRPC.LowLevel
import Network.GRPC.LowLevel.Call
@ -29,7 +28,7 @@ testCancelFromServer =
clientRes <- runOps unsafeCC clientCQ clientRecvOps
case clientRes of
Left x -> error $ "Client recv error: " ++ show x
Right [_,_,OpRecvStatusOnClientResult _ code details] -> do
Right [_,_,OpRecvStatusOnClientResult _ code _details] -> do
code @?= StatusPermissionDenied
return $ Right ()
wrong -> error $ "Unexpected op results: " ++ show wrong

4
tests/UnsafeTests.hs
View file

@ -1,9 +1,9 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module UnsafeTests (unsafeTests, unsafeProperties) where
import Control.Concurrent (threadDelay)
import Control.Exception (bracket_)
import Control.Monad
import qualified Data.ByteString as B
@ -22,8 +22,6 @@ import System.Clock
import Test.QuickCheck.Gen as QC
import Test.QuickCheck.Property as QC
import Test.Tasty
import Test.Tasty.HUnit as HU (assertBool, testCase,
(@?=))
import Test.Tasty.HUnit as HU (testCase, (@?=))
import Test.Tasty.QuickCheck as QC