git.iko.soy/project-m36
on master help sign in
restore server tests and patch websocket server test
commiteb42ebcda50e1ac4573b6011541a44f9718e4892 authorAgentM <agentm@themactionfaction.com> dateWed 25 Jan 2017, 00:32 (10 years ago) parentdb9742f
3 files changed+20−17
compare with master
unifiedsplit
project-m36.cabal+1−1 test/Server/Main.hs+7−7 test/Server/WebSocket.hs+12−9
project-m36.cabal+1−1
@@ -411,7 +411,7 @@ Test-Suite test-websocket-server
411411 Default-Language: Haskell2010
412412 type: exitcode-stdio-1.0
413413 main-is: test/Server/WebSocket.hs
414− Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, uuid-aeson, project-m36 == 0.1, random, MonadRandom
414+ Build-Depends: base, HUnit, Cabal, containers, hashable, unordered-containers, mtl, vector, vector-binary-instances, time, hashable-time, bytestring, uuid, stm, deepseq, deepseq-generics, binary, parallel, cassava, attoparsec, gnuplot, directory, temporary, haskeline, megaparsec, text, base64-bytestring, data-interval, filepath, transformers, stm-containers, list-t, websockets, optparse-applicative, network, aeson, uuid-aeson, project-m36 == 0.1, random, MonadRandom, network-transport-tcp
415415 Other-Modules: TutorialD.Interpreter.Export.Base, TutorialD.Interpreter.Export.CSV, TutorialD.Interpreter.Import.BasicExamples, TutorialD.Interpreter.Import.CSV, TutorialD.Interpreter.InformationOperator, TutorialD.Interpreter.RODatabaseContextOperator, TutorialD.Interpreter.TransactionGraphOperator, ProjectM36.Client.Json, ProjectM36.Server.RemoteCallTypes.Json, ProjectM36.Server.WebSocket, TutorialD.Interpreter, TutorialD.Interpreter.Base, TutorialD.Interpreter.DatabaseContextExpr, TutorialD.Interpreter.Import.Base, TutorialD.Interpreter.Import.TutorialD, TutorialD.Interpreter.RelationalExpr, TutorialD.Interpreter.Types, TutorialD.Interpreter.DatabaseContextIOOperator, TutorialD.Interpreter.TransGraphRelationalOperator
416416 Default-Extensions: OverloadedStrings
417417 GHC-Options: -Wall
test/Server/Main.hs+7−7
@@ -22,7 +22,7 @@ import Control.Exception
2222import Control.Monad.IO.Class
2323
2424testList :: SessionId -> Connection -> MVar () -> Test
25−testList sessionId conn notificationTestMVar = TestList $ serverTests
25+testList sessionId conn notificationTestMVar = TestList $ serverTests ++ sessionTests
2626 where
2727 sessionTests = map (\t -> t sessionId conn) [
2828 testRelationalExpr,
@@ -60,8 +60,10 @@ testDatabaseName = "test"
6060
6161testConnection :: EndPointAddress -> MVar () -> IO (Either ConnectionError (SessionId, Connection))
6262testConnection serverAddress mvar = do
63− let connInfo = RemoteProcessConnectionInfo testDatabaseName (NodeId serverAddress) (testNotificationCallback mvar)
64− putStrLn ("Connecting to " ++ show serverAddress)
63+ let Just (host, service, _) = decodeEndPointAddress serverAddress
64+ serverAddress' = encodeEndPointAddress host service 1
65+ let connInfo = RemoteProcessConnectionInfo testDatabaseName (NodeId serverAddress') (testNotificationCallback mvar)
66+ --putStrLn ("testConnection: " ++ show serverAddress)
6567 eConn <- connectProjectM36 connInfo
6668 case eConn of
6769 Left err -> pure $ Left err
@@ -82,7 +84,7 @@ launchTestServer ti = do
8284 addressMVar <- newEmptyMVar
8385 tid <- forkIO $ launchServer config (Just addressMVar) >> pure ()
8486 endPointAddress <- takeMVar addressMVar
85− liftIO $ putStrLn ("launched server on " ++ show endPointAddress)
87+ --liftIO $ putStrLn ("launched server on " ++ show endPointAddress)
8688 pure (endPointAddress, tid)
8789
8890testRelationalExpr :: SessionId -> Connection -> Test
@@ -196,9 +198,7 @@ testRequestTimeout :: Test
196198testRequestTimeout = TestCase $ do
197199 (serverAddress, serverTid) <- launchTestServer 1000
198200 unusedMVar <- newEmptyMVar
199− let Just (host, service, _) = decodeEndPointAddress serverAddress
200− serverAddress' = encodeEndPointAddress host service 1
201− eTestConn <- testConnection serverAddress' unusedMVar
201+ eTestConn <- testConnection serverAddress unusedMVar
202202 --eTestConn <- testConnection (encodeEndPointAddress "127.0.0.1" "10000" 1) unusedMVar
203203 case eTestConn of
204204 Left err -> putStrLn ("failed to connect: " ++ show err) >> exitFailure
test/Server/WebSocket.hs+12−9
@@ -17,25 +17,28 @@ import ProjectM36.Base
1717import qualified Data.Map as M
1818import qualified Data.ByteString.Lazy as BS
1919import ProjectM36.Relation
20+import Network.Transport.TCP (decodeEndPointAddress)
2021
2122--start the websocket server
2223-- run some tutoriald against it
2324
2425launchTestServer :: IO (PortNumber, DatabaseName)
2526launchTestServer = do
26− portMVar <- newEmptyMVar
27− let config = defaultServerConfig { databaseName = testDatabaseName }
27+ addressMVar <- newEmptyMVar
28+ let config = defaultServerConfig { databaseName = testDatabaseName,
29+ bindPort = 0 }
2830 testDatabaseName = "test"
2931 -- start normal server
30− _ <- forkIO (launchServer config (Just portMVar) >> pure ())
31− serverPort <- takeMVar portMVar
32− let serverHost = "127.0.0.1"
33− let testPort = 8889
32+ _ <- forkIO (launchServer config (Just addressMVar) >> pure ())
33+ serverAddress <- takeMVar addressMVar
34+ let wsServerHost = "127.0.0.1"
35+ wsServerPort = 8889
36+ Just (dbHost, dbPort, _) = decodeEndPointAddress serverAddress
3437 -- start websocket server proxy -- runServer doesn't support returning an arbitrary socket
35− _ <- forkIO (WS.runServer serverHost testPort (websocketProxyServer serverPort serverHost))
38+ _ <- forkIO (WS.runServer wsServerHost wsServerPort (websocketProxyServer (read dbPort) dbHost))
3639 --wait for socket to be listening
37− waitForListenSocket 5 (fromIntegral testPort)
38− pure (fromIntegral testPort, testDatabaseName)
40+ waitForListenSocket 5 (fromIntegral wsServerPort)
41+ pure (fromIntegral wsServerPort, testDatabaseName)
3942
4043data TestException = WaitForSocketListenException
4144 deriving (Show, Typeable)