Skip to content

Commit 427a32f

Browse files
diogobdiogob
committed
Fix test configuration
1 parent 1975915 commit 427a32f

File tree

1 file changed

+87
-86
lines changed

1 file changed

+87
-86
lines changed

‎test/ServerSpec.hs

Lines changed: 87 additions & 86 deletions
Original file line numberDiff line numberDiff line change
@@ -1,52 +1,51 @@
11
module ServerSpec (spec) where
22

3-
import Protolude
4-
5-
import Test.Hspec
6-
import PostgresWebsockets
7-
import PostgresWebsockets.Config
8-
93
import Control.Lens
104
import Data.Aeson.Lens
11-
5+
import Network.Socket (withSocketsDo)
126
import qualified Network.WebSockets as WS
13-
import Network.Socket (withSocketsDo)
7+
import PostgresWebsockets
8+
import PostgresWebsockets.Config
9+
import Protolude
10+
import Test.Hspec
1411

1512
testServerConfig :: AppConfig
16-
testServerConfig = AppConfig
17-
{ configDatabase = "postgres://postgres:roottoor@localhost:5432/postgres_ws_test"
18-
, configPath = Nothing
19-
, configHost = "*"
20-
, configPort = 8080
21-
, configListenChannel = "postgres-websockets-test-channel"
22-
, configJwtSecret = "reallyreallyreallyreallyverysafe"
23-
, configMetaChannel = Nothing
24-
, configJwtSecretIsBase64 = False
25-
, configPool = 10
26-
, configRetries = 5
27-
, configReconnectInterval = 0
28-
}
13+
testServerConfig =
14+
AppConfig
15+
{ configDatabase = "postgres://postgres:roottoor@localhost:5432/postgres_ws_test",
16+
configPath = Nothing,
17+
configHost = "*",
18+
configPort = 8080,
19+
configListenChannel = "postgres-websockets-test-channel",
20+
configJwtSecret = "reallyreallyreallyreallyverysafe",
21+
configMetaChannel = Nothing,
22+
configJwtSecretIsBase64 = False,
23+
configPool = 10,
24+
configRetries = 5,
25+
configReconnectInterval = Nothing
26+
}
2927

3028
startTestServer :: IO ThreadId
3129
startTestServer = do
32-
threadId <- forkIO $ serve testServerConfig
33-
threadDelay 500000
34-
pure threadId
30+
threadId <- forkIO $ serve testServerConfig
31+
threadDelay 500000
32+
pure threadId
3533

3634
withServer :: IO () -> IO ()
3735
withServer action =
38-
bracket startTestServer
39-
(\tid -> killThread tid >> threadDelay 500000)
40-
(const action)
36+
bracket
37+
startTestServer
38+
(\tid -> killThread tid >> threadDelay 500000)
39+
(const action)
4140

4241
sendWsData :: Text -> Text -> IO ()
4342
sendWsData uri msg =
44-
withSocketsDo $
45-
WS.runClient
46-
"127.0.0.1"
47-
(configPort testServerConfig)
48-
(toS uri)
49-
(`WS.sendTextData` msg)
43+
withSocketsDo $
44+
WS.runClient
45+
"127.0.0.1"
46+
(configPort testServerConfig)
47+
(toS uri)
48+
(`WS.sendTextData` msg)
5049

5150
testChannel :: Text
5251
testChannel = "/test/eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJtb2RlIjoicncifQ.auy9z4-pqoVEAay9oMi1FuG7ux_C_9RQCH8-wZgej18"
@@ -59,62 +58,64 @@ testAndSecondaryChannel = "/eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJtb2RlIjoicnc
5958

6059
waitForWsData :: Text -> IO (MVar ByteString)
6160
waitForWsData uri = do
62-
msg <- newEmptyMVar
63-
void $ forkIO $
64-
withSocketsDo $
65-
WS.runClient
66-
"127.0.0.1"
67-
(configPort testServerConfig)
68-
(toS uri)
69-
(\c -> do
70-
m <- WS.receiveData c
71-
putMVar msg m
72-
)
73-
threadDelay 10000
74-
pure msg
61+
msg <- newEmptyMVar
62+
void $
63+
forkIO $
64+
withSocketsDo $
65+
WS.runClient
66+
"127.0.0.1"
67+
(configPort testServerConfig)
68+
(toS uri)
69+
( \c -> do
70+
m <- WS.receiveData c
71+
putMVar msg m
72+
)
73+
threadDelay 10000
74+
pure msg
7575

7676
waitForMultipleWsData :: Int -> Text -> IO (MVar [ByteString])
7777
waitForMultipleWsData messageCount uri = do
78-
msg <- newEmptyMVar
79-
void $ forkIO $
80-
withSocketsDo $
81-
WS.runClient
82-
"127.0.0.1"
83-
(configPort testServerConfig)
84-
(toS uri)
85-
(\c -> do
86-
m <- replicateM messageCount (WS.receiveData c)
87-
putMVar msg m
88-
)
89-
threadDelay 1000
90-
pure msg
78+
msg <- newEmptyMVar
79+
void $
80+
forkIO $
81+
withSocketsDo $
82+
WS.runClient
83+
"127.0.0.1"
84+
(configPort testServerConfig)
85+
(toS uri)
86+
( \c -> do
87+
m <- replicateM messageCount (WS.receiveData c)
88+
putMVar msg m
89+
)
90+
threadDelay 1000
91+
pure msg
9192

9293
spec :: Spec
9394
spec = around_ withServer $
94-
describe "serve" $ do
95-
it "should be able to send messages to test server" $
96-
sendWsData testChannel "test data"
97-
it "should be able to receive messages from test server" $ do
98-
msg <- waitForWsData testChannel
99-
sendWsData testChannel "test data"
100-
msgJson <- takeMVar msg
101-
(msgJson ^? key "payload" . _String) `shouldBe` Just "test data"
102-
it "should be able to send messages to multiple channels in one shot" $ do
103-
msg <- waitForWsData testChannel
104-
secondaryMsg <- waitForWsData secondaryChannel
105-
sendWsData testAndSecondaryChannel "test data"
106-
msgJson <- takeMVar msg
107-
secondaryMsgJson <- takeMVar secondaryMsg
108-
109-
(msgJson ^? key "payload" . _String) `shouldBe` Just "test data"
110-
(msgJson ^? key "channel" . _String) `shouldBe` Just "test"
111-
(secondaryMsgJson ^? key "payload" . _String) `shouldBe` Just "test data"
112-
(secondaryMsgJson ^? key "channel" . _String) `shouldBe` Just "secondary"
113-
it "should be able to receive from multiple channels in one shot" $ do
114-
msgs <- waitForMultipleWsData 2 testAndSecondaryChannel
115-
sendWsData testAndSecondaryChannel "test data"
116-
msgsJson <- takeMVar msgs
117-
118-
forM_
119-
msgsJson
120-
(\msgJson -> (msgJson ^? key "payload" . _String) `shouldBe` Just "test data")
95+
describe "serve" $ do
96+
it "should be able to send messages to test server" $
97+
sendWsData testChannel "test data"
98+
it "should be able to receive messages from test server" $ do
99+
msg <- waitForWsData testChannel
100+
sendWsData testChannel "test data"
101+
msgJson <- takeMVar msg
102+
(msgJson ^? key "payload" . _String) `shouldBe` Just "test data"
103+
it "should be able to send messages to multiple channels in one shot" $ do
104+
msg <- waitForWsData testChannel
105+
secondaryMsg <- waitForWsData secondaryChannel
106+
sendWsData testAndSecondaryChannel "test data"
107+
msgJson <- takeMVar msg
108+
secondaryMsgJson <- takeMVar secondaryMsg
109+
110+
(msgJson ^? key "payload" . _String) `shouldBe` Just "test data"
111+
(msgJson ^? key "channel" . _String) `shouldBe` Just "test"
112+
(secondaryMsgJson ^? key "payload" . _String) `shouldBe` Just "test data"
113+
(secondaryMsgJson ^? key "channel" . _String) `shouldBe` Just "secondary"
114+
it "should be able to receive from multiple channels in one shot" $ do
115+
msgs <- waitForMultipleWsData 2 testAndSecondaryChannel
116+
sendWsData testAndSecondaryChannel "test data"
117+
msgsJson <- takeMVar msgs
118+
119+
forM_
120+
msgsJson
121+
(\msgJson -> (msgJson ^? key "payload" . _String) `shouldBe` Just "test data")

0 commit comments

Comments
 (0)