git.iko.soy/project-m36
on fd05d50 help sign in
project-m36/test/Server/WebSocket.hs
103 lines 4.3 kB history raw
1-- test the websocket server
2import Test.HUnit
3import qualified Network.WebSockets as WS
4import ProjectM36.Server.WebSocket
5import ProjectM36.Server.Config
6import ProjectM36.Server
7import ProjectM36.Client
8import Network.Socket
9import Control.Exception
10import Control.Concurrent
11import System.Exit
12import Data.Typeable
13import Data.Text hiding (map)
14import Data.Aeson
15import ProjectM36.Base
16import qualified Data.Map as M
17import qualified Data.ByteString.Lazy as BS
18import ProjectM36.Relation
19import Network.Transport.TCP (decodeEndPointAddress)
21--start the websocket server
22-- run some tutoriald against it
24launchTestServer :: IO (PortNumber, DatabaseName)
25launchTestServer = do
26 addressMVar <- newEmptyMVar
27 let config = defaultServerConfig { databaseName = testDatabaseName,
28 bindPort = 0 }
29 testDatabaseName = "test"
30 -- start normal server
31 _ <- forkIO (launchServer config (Just addressMVar) >> pure ())
32 serverAddress <- takeMVar addressMVar
33 let wsServerHost = "127.0.0.1"
34 wsServerPort = 8889
35 Just (dbHost, dbPort, _) = decodeEndPointAddress serverAddress
36 -- start websocket server proxy -- runServer doesn't support returning an arbitrary socket
37 _ <- forkIO (WS.runServer wsServerHost wsServerPort (websocketProxyServer (read dbPort) dbHost))
38 --wait for socket to be listening
39 waitForListenSocket 5 (fromIntegral wsServerPort)
40 pure (fromIntegral wsServerPort, testDatabaseName)
42data TestException = WaitForSocketListenException
43 deriving (Show, Typeable)
45instance Exception TestException
47waitForListenSocket :: Int -> PortNumber -> IO ()
48waitForListenSocket secondsToTry port =
49 if secondsToTry <= 0 then
50 throw WaitForSocketListenException
51 else do
52 hostaddr <- inet_addr "127.0.0.1"
53 sock <- socket AF_INET Stream defaultProtocol
54 let handler :: IOException -> IO ()
55 handler _ = do
56 threadDelay 1000000
57 waitForListenSocket (secondsToTry - 1) port
58 catch (connect sock (SockAddrInet port hostaddr)) handler
60main :: IO ()
61main = do
62 (port, dbname) <- launchTestServer
63 tcounts <- runTestTT (testList port dbname)
64 if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
66testList :: PortNumber -> DatabaseName -> Test
67testList port dbName = TestList $ map (\f -> f port dbName) [testBasicConnection,
68 testTutorialD]
70basicConnection :: PortNumber -> WS.ClientApp () -> IO ()
71basicConnection port = WS.runClient "127.0.0.1" (fromIntegral port) "/"
73basicConnectionWithDatabase :: PortNumber -> DatabaseName -> WS.ClientApp () -> IO ()
74basicConnectionWithDatabase port dbname block = basicConnection port (\conn -> do
75 WS.sendTextData conn ("connectdb:" `append` pack dbname)
76 block conn)
78testBasicConnection :: PortNumber -> DatabaseName -> Test
79testBasicConnection port _ = TestCase $ basicConnection port (\conn -> WS.sendClose conn ("test close"::Text))
81testTutorialD :: PortNumber -> DatabaseName -> Test
82testTutorialD port dbname = TestCase $ basicConnectionWithDatabase port dbname testtutd
83 where
84 discardPromptInfo conn = do
85 response <- WS.receiveData conn :: IO BS.ByteString
86 let decoded = decode response :: Maybe (M.Map Text (M.Map Text Text))
87 case decoded of
88 Just _ -> pure ()
89 Nothing -> assertFailure ("failed to decode prompt info: " ++ show response)
91 testtutd conn = do
92 discardPromptInfo conn
93 WS.sendTextData conn ("executetutd:" `append` ":showexpr true")
94 discardPromptInfo conn
95 discardPromptInfo conn
97 --receive relation response
98 response <- WS.receiveData conn :: IO BS.ByteString
99 let decoded = decode response :: Maybe (M.Map Text Relation)
101 case decoded of
102 Just val -> assertEqual "round-trip true relation" (M.lookup "displayrelation" val) (Just relationTrue) >> WS.sendClose conn ("test close"::Text)
103 Nothing -> assertFailure ("failed to decode relation from: " ++ show response)