From 153d200a13f61667d13b482d437732e910edbd65 Mon Sep 17 00:00:00 2001 From: Finley McIlwaine Date: Wed, 28 Aug 2024 07:09:13 -0700 Subject: [PATCH] Remove `rawTestServer`, use `forkServer` instead `rawTestServer` was doing nothing special anymore, and `forkServer` allows us to query the server port as well. We keep `respondWith` around because it is a useful abstraction for modeling broken servers. --- grapesy.cabal | 1 - test-grapesy/Test/Sanity/Disconnect.hs | 36 ++++++++++--- test-grapesy/Test/Util/RawTestServer.hs | 72 ++++++++++--------------- 3 files changed, 56 insertions(+), 53 deletions(-) diff --git a/grapesy.cabal b/grapesy.cabal index 345e9bc..0720c6c 100644 --- a/grapesy.cabal +++ b/grapesy.cabal @@ -353,7 +353,6 @@ test-suite test-grapesy , lens >= 5.0 && < 5.4 , mtl >= 2.2 && < 2.4 , network >= 3.1 && < 3.3 - , network-run >= 0.4 && < 0.5 , prettyprinter >= 1.7 && < 1.8 , prettyprinter-ansi-terminal >= 1.1 && < 1.2 , proto-lens >= 0.7 && < 0.8 diff --git a/test-grapesy/Test/Sanity/Disconnect.hs b/test-grapesy/Test/Sanity/Disconnect.hs index 8a8d17e..280c502 100644 --- a/test-grapesy/Test/Sanity/Disconnect.hs +++ b/test-grapesy/Test/Sanity/Disconnect.hs @@ -35,10 +35,10 @@ import Network.GRPC.Client.Binary qualified as Binary import Network.GRPC.Common import Network.GRPC.Server qualified as Server import Network.GRPC.Server.Binary qualified as Binary +import Network.GRPC.Server.Run import Network.GRPC.Spec import Proto.API.Trivial import Test.Util -import Test.Util.RawTestServer tests :: TestTree tests = testGroup "Test.Sanity.Disconnect" [ @@ -67,19 +67,29 @@ test_clientDisconnect = do Server.mkRpcHandler @RPC2 $ echoHandler (Just disconnectCounter2) ] + -- Start server + let serverConfig = ServerConfig { + serverInsecure = Just $ InsecureConfig { + insecureHost = Just "127.0.0.1" + , insecurePort = 0 + } + , serverSecure = Nothing + } portSignal <- newEmptyMVar - void $ forkIO $ rawTestServer (putMVar portSignal) server + void $ forkIO $ forkServer def serverConfig server $ \runningServer -> do + putMVar portSignal =<< getServerPort runningServer + waitServer runningServer - -- Start server + -- Wait for the server to signal its port serverPort <- readMVar portSignal + + -- Start a client in a separate process let serverAddress = Client.ServerInsecure Client.Address { addressHost = "127.0.0.1" , addressPort = serverPort , addressAuthority = Nothing } - - -- Start a client in a separate process void $ forkProcess $ Client.withConnection def serverAddress $ \conn -> do -- Make 50 concurrent calls. 49 of them sending infinite messages. One @@ -156,16 +166,26 @@ test_serverDisconnect = withTemporaryFile $ \ipcFile -> do Server.mkRpcHandler @Trivial $ echoHandler Nothing ] - let -- Starts the server in a new process. Gives back an action that kills + let serverConfig = ServerConfig { + serverInsecure = Just $ InsecureConfig { + insecureHost = Just "127.0.0.1" + , insecurePort = 0 + } + , serverSecure = Nothing + } + + -- Starts the server in a new process. Gives back an action that kills -- the created server process. startServer :: IO (IO ()) startServer = do serverPid <- forkProcess $ - rawTestServer ipcWrite server + forkServer def serverConfig server $ \runningServer -> do + ipcWrite =<< getServerPort runningServer + waitServer runningServer return $ signalProcess sigKILL serverPid - -- Start server, get the port + -- Start server, get the initial port killServer <- startServer port1 <- ipcRead signalRestart <- newEmptyMVar diff --git a/test-grapesy/Test/Util/RawTestServer.hs b/test-grapesy/Test/Util/RawTestServer.hs index 77410c8..03362f2 100644 --- a/test-grapesy/Test/Util/RawTestServer.hs +++ b/test-grapesy/Test/Util/RawTestServer.hs @@ -1,8 +1,13 @@ -module Test.Util.RawTestServer where +module Test.Util.RawTestServer + ( -- * Raw test server + respondWith + + -- * Abstract response type + , Response(..) + , asciiHeader + , utf8Header + ) where -import Control.Concurrent -import Control.Concurrent.Async -import Control.Exception import Data.ByteString qualified as BS.Strict import Data.ByteString qualified as Strict (ByteString) import Data.ByteString.Builder qualified as BS.Builder @@ -10,12 +15,11 @@ import Data.ByteString.Char8 qualified as BS.Strict.Char8 import Data.ByteString.UTF8 qualified as BS.Strict.UTF8 import Data.String (fromString) import Network.HTTP2.Server qualified as HTTP2 -import Network.Run.TCP qualified as NetworkRun -import Network.Socket import Network.GRPC.Client qualified as Client -import Network.HTTP.Types qualified as HTTP import Network.GRPC.Common +import Network.GRPC.Server.Run +import Network.HTTP.Types qualified as HTTP {------------------------------------------------------------------------------- Raw test server @@ -23,47 +27,27 @@ import Network.GRPC.Common This allows us to simulate broken /servers/. -------------------------------------------------------------------------------} --- | Low-level test server --- --- We bypass the entire grapesy machinery for constructing the server, for added --- flexibility. This allows us to mock broken deployments or run the server in --- another thread that we throw asynchronous exceptions to, for example. --- --- The grapesy client can auto reconnect when the server is not (yet) up and --- running, but to keep things simple, we just signal when the server is ready. --- This also allows us to avoid binding to a specific port in the tests (which --- might already be in use on the machine running the tests, leading to spurious --- test failures). -rawTestServer :: (PortNumber -> IO ()) -> HTTP2.Server -> IO () -rawTestServer signalPort server = do - addr <- NetworkRun.resolve Stream (Just "127.0.0.1") "0" [AI_PASSIVE] - bracket (NetworkRun.openTCPServerSocket addr) close $ \listenSock -> do - addr' <- getSocketName listenSock - portOut <- case addr' of - SockAddrInet port _host -> return port - SockAddrInet6 port _ _host _ -> return port - SockAddrUnix{} -> error "rawTestServer: unexpected unix socket" - signalPort portOut - NetworkRun.runTCPServerWithSocket listenSock $ \clientSock -> - bracket (HTTP2.allocSimpleConfig clientSock 4096) - HTTP2.freeSimpleConfig $ \config -> - HTTP2.run HTTP2.defaultServerConfig config server - -- | Run the server and apply the continuation to an 'Client.Address' holding -- the running server's host and port. withTestServer :: HTTP2.Server -> (Client.Address -> IO a) -> IO a withTestServer server k = do - serverPort <- newEmptyMVar - withAsync (rawTestServer (putMVar serverPort) server) $ - \_serverThread -> do - port <- readMVar serverPort - let addr :: Client.Address - addr = Client.Address { - addressHost = "127.0.0.1" - , addressPort = port - , addressAuthority = Nothing - } - k addr + let serverConfig = + ServerConfig { + serverInsecure = Just $ InsecureConfig { + insecureHost = Just "127.0.0.1" + , insecurePort = 0 + } + , serverSecure = Nothing + } + forkServer def serverConfig server $ \runningServer -> do + port <- getServerPort runningServer + let addr :: Client.Address + addr = Client.Address { + addressHost = "127.0.0.1" + , addressPort = port + , addressAuthority = Nothing + } + k addr -- | Server that responds with the given 'Response', independent of the request respondWith :: Response -> (Client.Address -> IO a) -> IO a