From 427a32fc573f792be6d2aaf79c043e80ce3bdf53 Mon Sep 17 00:00:00 2001 From: Diogo Biazus Date: Thu, 27 May 2021 18:17:41 -0400 Subject: [PATCH] Fix test configuration --- test/ServerSpec.hs | 173 +++++++++++++++++++++++---------------------- 1 file changed, 87 insertions(+), 86 deletions(-) diff --git a/test/ServerSpec.hs b/test/ServerSpec.hs index 5b2fa04..542d504 100644 --- a/test/ServerSpec.hs +++ b/test/ServerSpec.hs @@ -1,52 +1,51 @@ module ServerSpec (spec) where -import Protolude - -import Test.Hspec -import PostgresWebsockets -import PostgresWebsockets.Config - import Control.Lens import Data.Aeson.Lens - +import Network.Socket (withSocketsDo) import qualified Network.WebSockets as WS -import Network.Socket (withSocketsDo) +import PostgresWebsockets +import PostgresWebsockets.Config +import Protolude +import Test.Hspec testServerConfig :: AppConfig -testServerConfig = AppConfig - { configDatabase = "postgres://postgres:roottoor@localhost:5432/postgres_ws_test" - , configPath = Nothing - , configHost = "*" - , configPort = 8080 - , configListenChannel = "postgres-websockets-test-channel" - , configJwtSecret = "reallyreallyreallyreallyverysafe" - , configMetaChannel = Nothing - , configJwtSecretIsBase64 = False - , configPool = 10 - , configRetries = 5 - , configReconnectInterval = 0 - } +testServerConfig = + AppConfig + { configDatabase = "postgres://postgres:roottoor@localhost:5432/postgres_ws_test", + configPath = Nothing, + configHost = "*", + configPort = 8080, + configListenChannel = "postgres-websockets-test-channel", + configJwtSecret = "reallyreallyreallyreallyverysafe", + configMetaChannel = Nothing, + configJwtSecretIsBase64 = False, + configPool = 10, + configRetries = 5, + configReconnectInterval = Nothing + } startTestServer :: IO ThreadId startTestServer = do - threadId <- forkIO $ serve testServerConfig - threadDelay 500000 - pure threadId + threadId <- forkIO $ serve testServerConfig + threadDelay 500000 + pure threadId withServer :: IO () -> IO () withServer action = - bracket startTestServer - (\tid -> killThread tid >> threadDelay 500000) - (const action) + bracket + startTestServer + (\tid -> killThread tid >> threadDelay 500000) + (const action) sendWsData :: Text -> Text -> IO () sendWsData uri msg = - withSocketsDo $ - WS.runClient - "127.0.0.1" - (configPort testServerConfig) - (toS uri) - (`WS.sendTextData` msg) + withSocketsDo $ + WS.runClient + "127.0.0.1" + (configPort testServerConfig) + (toS uri) + (`WS.sendTextData` msg) testChannel :: Text testChannel = "/test/eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJtb2RlIjoicncifQ.auy9z4-pqoVEAay9oMi1FuG7ux_C_9RQCH8-wZgej18" @@ -59,62 +58,64 @@ testAndSecondaryChannel = "/eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJtb2RlIjoicnc waitForWsData :: Text -> IO (MVar ByteString) waitForWsData uri = do - msg <- newEmptyMVar - void $ forkIO $ - withSocketsDo $ - WS.runClient - "127.0.0.1" - (configPort testServerConfig) - (toS uri) - (\c -> do - m <- WS.receiveData c - putMVar msg m - ) - threadDelay 10000 - pure msg + msg <- newEmptyMVar + void $ + forkIO $ + withSocketsDo $ + WS.runClient + "127.0.0.1" + (configPort testServerConfig) + (toS uri) + ( \c -> do + m <- WS.receiveData c + putMVar msg m + ) + threadDelay 10000 + pure msg waitForMultipleWsData :: Int -> Text -> IO (MVar [ByteString]) waitForMultipleWsData messageCount uri = do - msg <- newEmptyMVar - void $ forkIO $ - withSocketsDo $ - WS.runClient - "127.0.0.1" - (configPort testServerConfig) - (toS uri) - (\c -> do - m <- replicateM messageCount (WS.receiveData c) - putMVar msg m - ) - threadDelay 1000 - pure msg + msg <- newEmptyMVar + void $ + forkIO $ + withSocketsDo $ + WS.runClient + "127.0.0.1" + (configPort testServerConfig) + (toS uri) + ( \c -> do + m <- replicateM messageCount (WS.receiveData c) + putMVar msg m + ) + threadDelay 1000 + pure msg spec :: Spec spec = around_ withServer $ - describe "serve" $ do - it "should be able to send messages to test server" $ - sendWsData testChannel "test data" - it "should be able to receive messages from test server" $ do - msg <- waitForWsData testChannel - sendWsData testChannel "test data" - msgJson <- takeMVar msg - (msgJson ^? key "payload" . _String) `shouldBe` Just "test data" - it "should be able to send messages to multiple channels in one shot" $ do - msg <- waitForWsData testChannel - secondaryMsg <- waitForWsData secondaryChannel - sendWsData testAndSecondaryChannel "test data" - msgJson <- takeMVar msg - secondaryMsgJson <- takeMVar secondaryMsg - - (msgJson ^? key "payload" . _String) `shouldBe` Just "test data" - (msgJson ^? key "channel" . _String) `shouldBe` Just "test" - (secondaryMsgJson ^? key "payload" . _String) `shouldBe` Just "test data" - (secondaryMsgJson ^? key "channel" . _String) `shouldBe` Just "secondary" - it "should be able to receive from multiple channels in one shot" $ do - msgs <- waitForMultipleWsData 2 testAndSecondaryChannel - sendWsData testAndSecondaryChannel "test data" - msgsJson <- takeMVar msgs - - forM_ - msgsJson - (\msgJson -> (msgJson ^? key "payload" . _String) `shouldBe` Just "test data") + describe "serve" $ do + it "should be able to send messages to test server" $ + sendWsData testChannel "test data" + it "should be able to receive messages from test server" $ do + msg <- waitForWsData testChannel + sendWsData testChannel "test data" + msgJson <- takeMVar msg + (msgJson ^? key "payload" . _String) `shouldBe` Just "test data" + it "should be able to send messages to multiple channels in one shot" $ do + msg <- waitForWsData testChannel + secondaryMsg <- waitForWsData secondaryChannel + sendWsData testAndSecondaryChannel "test data" + msgJson <- takeMVar msg + secondaryMsgJson <- takeMVar secondaryMsg + + (msgJson ^? key "payload" . _String) `shouldBe` Just "test data" + (msgJson ^? key "channel" . _String) `shouldBe` Just "test" + (secondaryMsgJson ^? key "payload" . _String) `shouldBe` Just "test data" + (secondaryMsgJson ^? key "channel" . _String) `shouldBe` Just "secondary" + it "should be able to receive from multiple channels in one shot" $ do + msgs <- waitForMultipleWsData 2 testAndSecondaryChannel + sendWsData testAndSecondaryChannel "test data" + msgsJson <- takeMVar msgs + + forM_ + msgsJson + (\msgJson -> (msgJson ^? key "payload" . _String) `shouldBe` Just "test data")