{-# OPTIONS_GHC -Wno-orphans #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Utils.Notifications where import Control.Concurrent.Async (Async, withAsync) import Control.Exception.Safe qualified as Exc import Control.Monad (void) import Data.ByteString qualified as BS import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT import Network.WebSockets qualified as WS import Prelude import Test.Instances () instance Eq DT.Notification where -- simple (==) n1 n2 = show n1 == show n2 millisecond :: Int millisecond = 1000 withWSConnection :: (String, Int) -> WS.ClientApp () -> IO () withWSConnection (host, port) = withWSConnection' (host, port, "/ws") -- | Wrap the logic of asynchronous connection closing -- https://hackage.haskell.org/package/websockets-0.13.0.0/docs/Network-WebSockets-Connection.html#v:sendClose withWSConnection' :: (String, Int, String) -> WS.ClientApp () -> IO () withWSConnection' (host, port, path) cb = Exc.catches ( WS.runClient host port path $ \conn -> do cb conn -- shut down gracefully, otherwise a 'ConnectionException' is thrown WS.sendClose conn ("" :: BS.ByteString) -- wait for close response, should throw a 'CloseRequest' exception void $ WS.receiveDataMessage conn ) [ Exc.Handler $ \(err :: WS.ConnectionException) -> case err of WS.CloseRequest _ _ -> putStrLn $ "[withWSConnection] CloseRequest caught" -- WS.ConnectionClosed -> putStrLn $ "[withWSConnection] ConnectionClosed caught" _ -> do putStrLn $ "[withWSConnection] unexpected: " <> show err Exc.throw err -- re-throw any other exceptions , Exc.Handler $ \(err :: Exc.SomeException) -> Exc.throw err ] -- | Same as 'withWSConnection', but spawns an async thread withAsyncWSConnection :: (String, Int) -> WS.ClientApp () -> (Async () -> IO ()) -> IO () withAsyncWSConnection hp wsCb cb = withAsync (withWSConnection hp wsCb) cb