diff --git a/release.nix b/release.nix index 06237ab..4d6cce2 100644 --- a/release.nix +++ b/release.nix @@ -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 diff --git a/src/Network/GRPC/HighLevel/Client.hs b/src/Network/GRPC/HighLevel/Client.hs index fdd6085..3d31b2d 100644 --- a/src/Network/GRPC/HighLevel/Client.hs +++ b/src/Network/GRPC/HighLevel/Client.hs @@ -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_)) = diff --git a/src/Network/GRPC/HighLevel/Server.hs b/src/Network/GRPC/HighLevel/Server.hs index bcb96b4..5d7d0cc 100644 --- a/src/Network/GRPC/HighLevel/Server.hs +++ b/src/Network/GRPC/HighLevel/Server.hs @@ -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 <- diff --git a/src/Network/GRPC/HighLevel/Server/Unregistered.hs b/src/Network/GRPC/HighLevel/Server/Unregistered.hs index cd0e9f1..ebcba72 100644 --- a/src/Network/GRPC/HighLevel/Server/Unregistered.hs +++ b/src/Network/GRPC/HighLevel/Server/Unregistered.hs @@ -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 diff --git a/src/Network/GRPC/LowLevel.hs b/src/Network/GRPC/LowLevel.hs index e305139..dad075d 100644 --- a/src/Network/GRPC/LowLevel.hs +++ b/src/Network/GRPC/LowLevel.hs @@ -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 (..), diff --git a/src/Network/GRPC/LowLevel/Client.hs b/src/Network/GRPC/LowLevel/Client.hs index a13d3ab..8bde6ff 100644 --- a/src/Network/GRPC/LowLevel/Client.hs +++ b/src/Network/GRPC/LowLevel/Client.hs @@ -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 diff --git a/src/Network/GRPC/LowLevel/GRPC.hs b/src/Network/GRPC/LowLevel/GRPC.hs index 203bb9e..ba2bd22 100644 --- a/src/Network/GRPC/LowLevel/GRPC.hs +++ b/src/Network/GRPC/LowLevel/GRPC.hs @@ -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 diff --git a/src/Network/GRPC/LowLevel/Op.hs b/src/Network/GRPC/LowLevel/Op.hs index 7346775..9fae9a6 100644 --- a/src/Network/GRPC/LowLevel/Op.hs +++ b/src/Network/GRPC/LowLevel/Op.hs @@ -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 diff --git a/src/Network/GRPC/LowLevel/Server/Unregistered.hs b/src/Network/GRPC/LowLevel/Server/Unregistered.hs index 192453c..f50d662 100644 --- a/src/Network/GRPC/LowLevel/Server/Unregistered.hs +++ b/src/Network/GRPC/LowLevel/Server/Unregistered.hs @@ -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 diff --git a/src/Network/GRPC/Unsafe.chs b/src/Network/GRPC/Unsafe.chs index e6a7944..1ae4a5d 100644 --- a/src/Network/GRPC/Unsafe.chs +++ b/src/Network/GRPC/Unsafe.chs @@ -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 diff --git a/src/Network/GRPC/Unsafe/ChannelArgs.chs b/src/Network/GRPC/Unsafe/ChannelArgs.chs index f2097f5..d7b898d 100644 --- a/src/Network/GRPC/Unsafe/ChannelArgs.chs +++ b/src/Network/GRPC/Unsafe/ChannelArgs.chs @@ -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 diff --git a/src/Network/GRPC/Unsafe/Metadata.chs b/src/Network/GRPC/Unsafe/Metadata.chs index 87d9352..103faea 100644 --- a/src/Network/GRPC/Unsafe/Metadata.chs +++ b/src/Network/GRPC/Unsafe/Metadata.chs @@ -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) diff --git a/src/Network/GRPC/Unsafe/Security.chs b/src/Network/GRPC/Unsafe/Security.chs index 10727b9..1153816 100644 --- a/src/Network/GRPC/Unsafe/Security.chs +++ b/src/Network/GRPC/Unsafe/Security.chs @@ -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) diff --git a/src/Network/GRPC/Unsafe/Time.chs b/src/Network/GRPC/Unsafe/Time.chs index 2a2b21e..e228f3f 100644 --- a/src/Network/GRPC/Unsafe/Time.chs +++ b/src/Network/GRPC/Unsafe/Time.chs @@ -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 diff --git a/tests/GeneratedTests.hs b/tests/GeneratedTests.hs index 9b0d4c3..e8d1db6 100644 --- a/tests/GeneratedTests.hs +++ b/tests/GeneratedTests.hs @@ -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 diff --git a/tests/LowLevelTests.hs b/tests/LowLevelTests.hs index 1476fe7..7687999 100644 --- a/tests/LowLevelTests.hs +++ b/tests/LowLevelTests.hs @@ -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 diff --git a/tests/LowLevelTests/Op.hs b/tests/LowLevelTests/Op.hs index db53e2d..e8fe67a 100644 --- a/tests/LowLevelTests/Op.hs +++ b/tests/LowLevelTests/Op.hs @@ -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 diff --git a/tests/UnsafeTests.hs b/tests/UnsafeTests.hs index eb743f2..936378a 100644 --- a/tests/UnsafeTests.hs +++ b/tests/UnsafeTests.hs @@ -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