{-|
Module      : Test.API.Notifications
Description : Tests for the notification mechanism (central exchange, dispatcher, websockets)
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# OPTIONS_GHC -Wno-orphans  #-}

{-# LANGUAGE ScopedTypeVariables #-}

    
module Test.API.Notifications (
    tests
  ) where

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (withAsync)
import Control.Concurrent.STM.TChan
import Control.Exception.Safe qualified as Exc
import Control.Monad (void)
import Control.Monad.STM (atomically)
import Data.Aeson qualified as Aeson
import Data.ByteString qualified as BS
import Data.Maybe (isJust)
import Gargantext.Core.Notifications.CentralExchange qualified as CE
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
import Gargantext.Core.Notifications.Dispatcher qualified as D
import Gargantext.Core.Notifications.Dispatcher.Types qualified as DT
import Gargantext.Core.Config.Types (NotificationsConfig(..))
import Network.WebSockets qualified as WS
import Prelude
import Test.API.Setup (withTestDBAndNotifications)
import Test.Hspec
import Test.Instances ()


tests :: NotificationsConfig -> D.Dispatcher -> Spec
tests nc dispatcher = sequential $ aroundAll (withTestDBAndNotifications dispatcher) $ do
  describe "Dispatcher, Central Exchange, WebSockets" $ do
    it "simple WS notification works" $ \((testEnv, port), _) -> do
      let topic = DT.UpdateTree 0
      tchan <- newTChanIO :: IO (TChan (Maybe DT.Notification))
      -- setup a websocket connection
      let wsConnect =
            withWSConnection ("127.0.0.1", port, "/ws") $ \conn -> do
              -- We wait a bit before the server settles
              threadDelay (100 * millisecond)
              WS.sendTextData conn $ Aeson.encode (DT.WSSubscribe topic)
              d <- WS.receiveData conn
              let dec = Aeson.decode d :: Maybe DT.Notification
              atomically $ writeTChan tchan dec
            
      -- wait a bit to settle
      threadDelay (100 * millisecond)

      withAsync wsConnect $ \_a -> do
        -- wait a bit to connect
        threadDelay (500 * millisecond)
  
        CE.notify nc $ CET.UpdateTreeFirstLevel 0
  
        md <- atomically $ readTChan tchan
  
        md `shouldSatisfy` isJust
        let (Just (DT.Notification topic' message')) = md
        topic' `shouldBe` topic
        message' `shouldBe` DT.MEmpty
  

millisecond :: Int
millisecond = 1000


-- | 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 =
  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
    Exc.catches (void $ WS.receiveDataMessage conn)
      [ Exc.Handler $ \(err :: WS.ConnectionException) ->
          case err of
            WS.CloseRequest _ _ -> putStrLn "[withWSConnection] closeRequest caught"
            _ -> Exc.throw err
      
      -- re-throw any other exceptions
      , Exc.Handler $ \(err :: Exc.SomeException) -> Exc.throw err ]