{-# LANGUAGE OverloadedStrings #-} module Network.WebSockets.SkewsSpec ( spec ) where import Control.Applicative (empty, (<|>)) import Control.Concurrent (threadDelay) import Control.Concurrent.Async (async, replicateConcurrently, replicateConcurrently_, wait) import Data.ByteString.Char8 () import Data.Foldable (toList) import Data.Traversable (for) import Deque () import System.Envy (FromEnv, decodeEnv, env, fromEnv) import Test.Hspec import Text.Read (readMaybe) import qualified Network.WebSockets as WS import qualified Network.WebSockets.Skews as Skews -- import Debug.Trace newtype PortNumber = PortNumber Int deriving (Eq, Show) instance FromEnv PortNumber where fromEnv = do mpn <- (readMaybe <$> env "SKEWS_TEST_PORT") <|> pure (Just 8614) PortNumber <$> maybe empty pure mpn spec :: Spec spec = context "After running Skews.start and starting a client" $ do Right (PortNumber pn) <- runIO decodeEnv let host = "127.0.0.1" server <- runIO $ Skews.start $ Skews.Args host pn let runClient = WS.runClient host pn "/" before_ (Skews.reinit server) $ do it "after enqueResponses and setDefaultResponse, responds with the given responses and records request" $ do let requests = ["client1", "client2", "client3", "client4", "client5"] -- Close code 1000: normal closure: https://tools.ietf.org/html/rfc6455#section-7.4 lastRequest = WS.ControlMessage $ WS.Close 1000 "bye by client" responses = ["response1", "response2", "response3"] defaultResponse = "default response" Skews.setDefaultResponse server defaultResponse mapM_ (Skews.enqueResponse server) responses actuallyResponded <- runClient $ \conn -> do ress <- for requests $ \request -> do WS.sendBinaryData conn request WS.receiveData conn Skews.forgetDefaultResponse server WS.send conn lastRequest {- FIXME: -- timeout function doesn't kill `WS.receive conn`. -- So I can't test the exact behaviour of forgetDefaultResponse resLast <- timeout 1 $ WS.receive conn return (ress, resLast) -} return ress toList <$> Skews.recentlyReceived server `shouldReturn` requests actuallyResponded `shouldBe` responses ++ [defaultResponse, defaultResponse] it "sendToClients delivers the given message to all connected clients" $ do let msg = "message" clientCount = 10 clientAction = runClient $ \conn -> do threadDelay $ 100 * 1000 WS.receiveData conn actuallyReceived <- async $ replicateConcurrently clientCount clientAction threadDelay $ 50 * 1000 Skews.sendToClients server msg wait actuallyReceived `shouldReturn` replicate clientCount msg it "can record requests sent concurrently" $ do let msg = "client message" clientCount = 10 clientAction = runClient (`WS.sendBinaryData` msg) replicateConcurrently_ clientCount clientAction threadDelay $ 50 * 1000 toList <$> Skews.recentlyReceived server `shouldReturn` replicate clientCount msg