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