diff --git a/grpc-haskell.cabal b/grpc-haskell.cabal index 233a189..0958f0d 100644 --- a/grpc-haskell.cabal +++ b/grpc-haskell.cabal @@ -124,7 +124,8 @@ test-suite test hs-source-dirs: tests main-is: Properties.hs type: exitcode-stdio-1.0 - extensions: CPP + default-extensions: CPP if flag(debug) - GHC-Options: -DDEBUG + CPP-Options: -DDEBUG + CC-Options: -DGRPC_HASKELL_DEBUG diff --git a/src/Network/GRPC/LowLevel/Call.hs b/src/Network/GRPC/LowLevel/Call.hs index bd222c1..6d30014 100644 --- a/src/Network/GRPC/LowLevel/Call.hs +++ b/src/Network/GRPC/LowLevel/Call.hs @@ -10,14 +10,10 @@ import Control.Monad import Data.ByteString (ByteString) import Data.String (IsString) import Foreign.Marshal.Alloc (free) -import Foreign.Ptr (Ptr, nullPtr) -import Foreign.Storable (peek) +import Foreign.Ptr (Ptr) import System.Clock import qualified Network.GRPC.Unsafe as C -import qualified Network.GRPC.Unsafe.ByteBuffer as C -import qualified Network.GRPC.Unsafe.Metadata as C -import qualified Network.GRPC.Unsafe.Time as C import qualified Network.GRPC.Unsafe.Op as C import Network.GRPC.LowLevel.GRPC (MetadataMap, grpcDebug) diff --git a/src/Network/GRPC/LowLevel/Call/Unregistered.hs b/src/Network/GRPC/LowLevel/Call/Unregistered.hs index 253c272..9e724a5 100644 --- a/src/Network/GRPC/LowLevel/Call/Unregistered.hs +++ b/src/Network/GRPC/LowLevel/Call/Unregistered.hs @@ -5,13 +5,11 @@ module Network.GRPC.LowLevel.Call.Unregistered where import Control.Monad import Foreign.Marshal.Alloc (free) import Foreign.Ptr (Ptr) -import Foreign.Storable (peek) import System.Clock (TimeSpec) import Network.GRPC.LowLevel.Call (Host (..), MethodName (..)) import Network.GRPC.LowLevel.GRPC (MetadataMap, grpcDebug) import qualified Network.GRPC.Unsafe as C -import qualified Network.GRPC.Unsafe.Metadata as C import qualified Network.GRPC.Unsafe.Op as C -- | Represents one unregistered GRPC call on the server. diff --git a/src/Network/GRPC/LowLevel/CompletionQueue.hs b/src/Network/GRPC/LowLevel/CompletionQueue.hs index 0bac639..aefb5b1 100644 --- a/src/Network/GRPC/LowLevel/CompletionQueue.hs +++ b/src/Network/GRPC/LowLevel/CompletionQueue.hs @@ -29,7 +29,6 @@ module Network.GRPC.LowLevel.CompletionQueue ) where -import Control.Concurrent (forkIO) import Control.Concurrent.STM (atomically, check) import Control.Concurrent.STM.TVar (newTVarIO, readTVar, writeTVar) @@ -45,15 +44,13 @@ import qualified Network.GRPC.Unsafe.Constants as C import qualified Network.GRPC.Unsafe.Metadata as C import qualified Network.GRPC.Unsafe.Op as C import qualified Network.GRPC.Unsafe.Time as C -import System.Clock (getTime, Clock(..), - TimeSpec(..)) +import System.Clock (getTime, Clock(..)) import System.Timeout (timeout) import Network.GRPC.LowLevel.Call import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.CompletionQueue.Internal import qualified Network.GRPC.Unsafe.ByteBuffer as C -import qualified Network.GRPC.Unsafe.Metadata as C withCompletionQueue :: GRPC -> (CompletionQueue -> IO a) -> IO a withCompletionQueue grpc = bracket (createCompletionQueue grpc) diff --git a/src/Network/GRPC/LowLevel/CompletionQueue/Unregistered.hs b/src/Network/GRPC/LowLevel/CompletionQueue/Unregistered.hs index f7b28f6..1ddbd1a 100644 --- a/src/Network/GRPC/LowLevel/CompletionQueue/Unregistered.hs +++ b/src/Network/GRPC/LowLevel/CompletionQueue/Unregistered.hs @@ -2,7 +2,6 @@ module Network.GRPC.LowLevel.CompletionQueue.Unregistered where -import Control.Concurrent (forkIO) import Control.Exception (bracket) import Foreign.Marshal.Alloc (free, malloc) import Foreign.Storable (peek) diff --git a/src/Network/GRPC/LowLevel/Op.hs b/src/Network/GRPC/LowLevel/Op.hs index fc1d0ac..e34fc2d 100644 --- a/src/Network/GRPC/LowLevel/Op.hs +++ b/src/Network/GRPC/LowLevel/Op.hs @@ -13,7 +13,6 @@ import Foreign.Marshal.Alloc (free, malloc, mallocBytes) import Foreign.Ptr (Ptr, nullPtr) import Foreign.Storable (peek, poke) -import Network.GRPC.LowLevel.Call import Network.GRPC.LowLevel.CompletionQueue import Network.GRPC.LowLevel.GRPC import qualified Network.GRPC.Unsafe as C (Call) diff --git a/src/Network/GRPC/LowLevel/Server.hs b/src/Network/GRPC/LowLevel/Server.hs index 9022b26..073a4c4 100644 --- a/src/Network/GRPC/LowLevel/Server.hs +++ b/src/Network/GRPC/LowLevel/Server.hs @@ -8,10 +8,8 @@ module Network.GRPC.LowLevel.Server where import Control.Exception (bracket, finally) import Control.Monad import Data.ByteString (ByteString) -import Foreign.Ptr (nullPtr) import Network.GRPC.LowLevel.Call import Network.GRPC.LowLevel.CompletionQueue (CompletionQueue, - TimeoutSeconds, createCompletionQueue, pluck, serverRegisterCompletionQueue, diff --git a/src/Network/GRPC/LowLevel/Server/Unregistered.hs b/src/Network/GRPC/LowLevel/Server/Unregistered.hs index ccba940..02766de 100644 --- a/src/Network/GRPC/LowLevel/Server/Unregistered.hs +++ b/src/Network/GRPC/LowLevel/Server/Unregistered.hs @@ -4,9 +4,7 @@ module Network.GRPC.LowLevel.Server.Unregistered where import Control.Exception (finally) import Data.ByteString (ByteString) -import Network.GRPC.LowLevel.Call (MethodName) import Network.GRPC.LowLevel.Call.Unregistered -import Network.GRPC.LowLevel.CompletionQueue (TimeoutSeconds) import Network.GRPC.LowLevel.CompletionQueue.Unregistered (serverRequestCall) import Network.GRPC.LowLevel.GRPC import Network.GRPC.LowLevel.Op (Op(..), OpRecvResult (..), runOps) diff --git a/src/Network/GRPC/Unsafe/ChannelArgs.chs b/src/Network/GRPC/Unsafe/ChannelArgs.chs index 7aa9918..0490e42 100644 --- a/src/Network/GRPC/Unsafe/ChannelArgs.chs +++ b/src/Network/GRPC/Unsafe/ChannelArgs.chs @@ -5,7 +5,6 @@ module Network.GRPC.Unsafe.ChannelArgs where import Control.Exception import Control.Monad import Foreign.Storable -import Foreign.Ptr (nullPtr) import Foreign.Marshal.Alloc (malloc, free) #include diff --git a/tests/LowLevelTests/Op.hs b/tests/LowLevelTests/Op.hs index 6e6c5c8..59a6e63 100644 --- a/tests/LowLevelTests/Op.hs +++ b/tests/LowLevelTests/Op.hs @@ -5,10 +5,7 @@ module LowLevelTests.Op where import Control.Concurrent (threadDelay) -import Control.Concurrent.Async -import Control.Monad -import Data.ByteString (ByteString, isPrefixOf) -import qualified Data.Map as M +import Data.ByteString (isPrefixOf) import Foreign.Storable (peek) import Test.Tasty import Test.Tasty.HUnit as HU (testCase, (@?=), @@ -31,7 +28,7 @@ testCancelWhileHandling = testCase "Client/Server - cancel after handler starts does nothing" $ runSerialTest $ \grpc -> withClientServerUnaryCall grpc $ - \(c@Client{..}, s@Server{..}, cc@ClientCall{..}, sc@ServerCall{..}) -> do + \(Client{..}, Server{..}, cc@ClientCall{..}, ServerCall{..}) -> do withOpArrayAndCtxts serverEmptyRecvOps $ \(opArray, ctxts) -> do tag <- newTag serverCQ startBatch serverCQ unServerCall opArray 3 tag @@ -50,7 +47,7 @@ testCancelFromServer = testCase "Client/Server - client receives server cancellation" $ runSerialTest $ \grpc -> withClientServerUnaryCall grpc $ - \(c@Client{..}, s@Server{..}, cc@ClientCall{..}, sc@ServerCall{..}) -> do + \(Client{..}, Server{..}, ClientCall{..}, sc@ServerCall{..}) -> do serverCallCancel sc StatusPermissionDenied "TestStatus" clientRes <- runOps unClientCall clientCQ clientRecvOps case clientRes of @@ -62,6 +59,7 @@ testCancelFromServer = || isPrefixOf "Received RST_STREAM" details return $ Right () + wrong -> error $ "Unexpected op results: " ++ show wrong runSerialTest :: (GRPC -> IO (Either GRPCIOError ())) -> IO () @@ -83,22 +81,27 @@ withClientServerUnaryCall grpc f = do -- because registered methods try to do recv ops immediately when -- created. If later we want to send payloads or metadata, we'll need -- to tweak this. - clientRes <- runOps (unClientCall cc) (clientCQ c) clientEmptySendOps + _clientRes <- runOps (unClientCall cc) (clientCQ c) clientEmptySendOps withServerCall s srm $ \sc -> f (c, s, cc, sc) +serverConf :: ServerConfig serverConf = ServerConfig "localhost" 50051 [("/foo", Normal)] [] +clientConf :: ClientConfig clientConf = ClientConfig "localhost" 50051 [] +clientEmptySendOps :: [Op] clientEmptySendOps = [OpSendInitialMetadata mempty, OpSendMessage "", OpSendCloseFromClient] +clientRecvOps :: [Op] clientRecvOps = [OpRecvInitialMetadata, OpRecvMessage, OpRecvStatusOnClient] +serverEmptyRecvOps :: [Op] serverEmptyRecvOps = [OpSendInitialMetadata mempty, OpRecvMessage, OpRecvCloseOnServer]