@@ -27,7 +27,8 @@ import Control.Concurrent.Async
2727import Control.Concurrent
2828import Control.Exception
2929import qualified Data.ByteString.Lazy.Char8 as BL8 ( hPutStrLn )
30- import Network.Socket
30+ import Network.Simple.TCP hiding (send )
31+ import Network.Socket (socketToHandle )
3132import System.IO
3233import Data.String.Conversions
3334import Test.Hspec
@@ -122,14 +123,19 @@ mockServerTalk CommandConfigurationDone = do
122123testPort :: Int
123124testPort = 8001
124125
126+ -- | Sample host shared amongst client and server
127+ --
128+ testHost :: String
129+ testHost = " localhost"
130+ 125131-- | Runs server in a thread, 'withAsync' ensures cleanup.
126132--
127133withServer :: IO () -> IO ()
128134withServer test = withAsync server (const test)
129135 where
130136 server = runDAPServer config mockServerTalk
131137 config = ServerConfig
132- { host = " localhost "
138+ { host = testHost
133139 , port = testPort
134140 , serverCapabilities = defaultCapabilities
135141 , debugLogging = False
@@ -138,26 +144,17 @@ withServer test = withAsync server (const test)
138144-- | Spawns a new mock client that connects to the mock server.
139145--
140146withNewClient :: (Handle -> IO () ) -> IO ()
141- withNewClient continue = withSocketsDo $ do
142- [info] <- getAddrInfo (Just addrInfo) Nothing (Just (show testPort))
143- socket <- openSocket info
144- connect socket (addrAddress info) `catch` exceptionHandler
145- handle <- socketToHandle socket ReadWriteMode
146- hSetNewlineMode handle NewlineMode { inputNL = CRLF , outputNL = CRLF }
147- continue handle `finally` hClose handle
148- where
149- exceptionHandler :: SomeException -> IO ()
150- exceptionHandler _ = do
151- threadDelay 100
152- putStrLn " Retrying connection..."
153- withNewClient continue
154- 155- addrInfo :: AddrInfo
156- addrInfo
157- = defaultHints
158- { addrSocketType = Stream
159- , addrFamily = AF_INET
160- }
147+ withNewClient continue = flip catch exceptionHandler $
148+ connect testHost (show testPort) $ \ (socket, _) -> do
149+ handle <- socketToHandle socket ReadWriteMode
150+ hSetNewlineMode handle NewlineMode { inputNL = CRLF , outputNL = CRLF }
151+ continue handle `finally` hClose handle
152+ where
153+ exceptionHandler :: SomeException -> IO ()
154+ exceptionHandler _ = do
155+ threadDelay 100
156+ putStrLn " Retrying connection..."
157+ withNewClient continue
161158
162159-- | Helper to send JSON payloads to the server
163160--
0 commit comments