postgres-websockets-0.11.2.4: test/ServerSpec.hs

module ServerSpec (spec) where

import APrelude
import Control.Lens
import Data.Aeson.Lens
import Network.Socket (withSocketsDo)
import qualified Network.WebSockets as WS
import PostgresWebsockets
import PostgresWebsockets.Config
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 = Nothing,
      configCertificateFile = Nothing,
      configKeyFile = Nothing
    }

startTestServer :: IO ThreadId
startTestServer = do
  threadId <- forkIO $ serve testServerConfig
  threadDelay 500000
  pure threadId

withServer :: IO () -> IO ()
withServer 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)
      (unpack uri)
      (`WS.sendTextData` msg)

testChannel :: Text
testChannel = "/test/eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJtb2RlIjoicncifQ.auy9z4-pqoVEAay9oMi1FuG7ux_C_9RQCH8-wZgej18"

secondaryChannel :: Text
secondaryChannel = "/secondary/eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJtb2RlIjoicncifQ.auy9z4-pqoVEAay9oMi1FuG7ux_C_9RQCH8-wZgej18"

testAndSecondaryChannel :: Text
testAndSecondaryChannel = "/eyJhbGciOiJIUzI1NiIsInR5cCI6IkpXVCJ9.eyJtb2RlIjoicnciLCJjaGFubmVscyI6WyJ0ZXN0Iiwic2Vjb25kYXJ5Il19.7tB2A9MhpY4tyqhfnHNy5FUYw4gwpKtL4UAHBXbNEz4"

waitForWsData :: Text -> IO (MVar ByteString)
waitForWsData uri = do
  msg <- newEmptyMVar
  void $
    forkIO $
      withSocketsDo $
        WS.runClient
          "127.0.0.1"
          (configPort testServerConfig)
          (unpack 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)
          (unpack 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")