{-|
Module      : Gargantext.Core.AsyncUpdates.Dispatcher.Types
Description : Dispatcher (handles websocket connections, accepts message from central exchange)
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/341

Docs:
https://dev.sub.gargantext.org/#/share/Notes/187918
    
-}

{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-imports #-}
    
module Gargantext.Core.AsyncUpdates.Dispatcher.Types where

import Codec.Binary.UTF8.String qualified as CBUTF8
import Control.Concurrent.Async qualified as Async
import Control.Lens (Getter, view)
import Data.Aeson ((.:), (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Types (prependFailure, typeMismatch)
import Data.ByteString.Char8 qualified as C
import Data.ByteString.Lazy qualified as BSL
import Data.List (nubBy)
import DeferredFolds.UnfoldlM qualified as UnfoldlM
import Data.UUID.V4 as UUID
import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(_auth_user_id))
import Gargantext.API.Admin.Orchestrator.Types (JobLog)
import Gargantext.API.Admin.Types (jwtSettings, Settings, jwtSettings)
import Gargantext.API.Prelude (IsGargServer)
import Gargantext.Core.AsyncUpdates.CentralExchange.Types qualified as CETypes
import Gargantext.Core.AsyncUpdates.Constants as AUConstants
import Gargantext.Core.Types (NodeId, UserId)
import Gargantext.Prelude
import GHC.Conc (TVar, newTVarIO, readTVar, writeTVar)
import Nanomsg
import Network.WebSockets qualified as WS
import Prelude qualified
import Protolude.Base (Show(showsPrec))
import Servant
-- import Servant.API.NamedRoutes ((:-))
import Servant.API.WebSocket qualified as WS
import Servant.Auth.Server (verifyJWT)
import Servant.Job.Core (Safety(Safe))
import Servant.Job.Types (JobID, JobStatus(_job_id))
import Servant.Server.Generic (AsServer, AsServerT)
import StmContainers.Set as SSet



-- | A topic is sent, when a client wants to subscribe to specific
-- | types of notifications
data Topic =
  -- | Update given Servant Job (we currently send a request every
  -- | second to get job status).
   UpdateJobProgress (JobID 'Safe)
  -- | Given parent node id, trigger update of the node and its
  --   children (e.g. list is automatically created in a corpus)
  | UpdateTree NodeId
  deriving (Eq, Ord)
instance Prelude.Show Topic where
  show (UpdateJobProgress jId) = "UpdateJobProgress " <> (CBUTF8.decode $ BSL.unpack $ Aeson.encode jId)
  show (UpdateTree nodeId) = "UpdateTree " <> show nodeId
instance Hashable Topic where
  hashWithSalt salt (UpdateJobProgress jId) = hashWithSalt salt ("update-job-progress" :: Text, Aeson.encode jId)
  hashWithSalt salt (UpdateTree nodeId) = hashWithSalt salt ("update-tree" :: Text, nodeId)
instance FromJSON Topic where
  parseJSON = Aeson.withObject "Topic" $ \o -> do
    type_ <- o .: "type"
    case type_ of
      "update_job_progress" -> do
        jId <- o .: "j_id"
        pure $ UpdateJobProgress jId
      "update_tree" -> do
        node_id <- o .: "node_id"
        pure $ UpdateTree node_id
      s -> prependFailure "parsing type failed, " (typeMismatch "type" s)
instance ToJSON Topic where
  toJSON (UpdateJobProgress jId) = Aeson.object [
      "type" .= toJSON ("update_job_progress" :: Text)
    , "j_id" .= toJSON jId
    ]
  toJSON (UpdateTree node_id) = Aeson.object [
      "type" .= toJSON ("update_tree" :: Text)
    , "node_id" .= toJSON node_id
    ]

-- | A message to  be sent inside a Notification
data Message =
    MJobProgress (JobStatus 'Safe JobLog)
  | MEmpty
-- | For tests
instance Eq Message where
  (==) (MJobProgress js1) (MJobProgress js2) = _job_id js1 == _job_id js2
  (==) MEmpty MEmpty = True
  (==) _ _ = False
instance Prelude.Show Message where
  show (MJobProgress jobStatus) = "MJobProgress " <> (CBUTF8.decode $ BSL.unpack $ Aeson.encode jobStatus)
  show MEmpty = "MEmpty"
instance ToJSON Message where
  toJSON (MJobProgress jobStatus) = Aeson.object [
      "type" .= toJSON ("MJobProgress" :: Text)
    , "job_status" .= toJSON jobStatus
    ]
  toJSON MEmpty = Aeson.object [
      "type" .= toJSON ("MEmpty" :: Text)  
    ]
instance FromJSON Message where
  parseJSON = Aeson.withObject "Message" $ \o -> do
    type_ <- o .: "type"
    case type_ of
      "MJobProgress" -> do
        job_status <- o .: "job_status"
        pure $ MJobProgress job_status
      "MEmpty" -> pure MEmpty
      s -> prependFailure "parsing type failed, " (typeMismatch "type" s)

    
data ConnectedUser =
    CUUser UserId
  | CUPublic
  deriving (Eq, Show)
instance Hashable ConnectedUser where
  hashWithSalt salt (CUUser userId) = hashWithSalt salt ("cuuser" :: Text, userId)
  hashWithSalt salt CUPublic = hashWithSalt salt ("cupublic" :: Text)
  
newtype WSKeyConnection = WSKeyConnection (ByteString, WS.Connection)
instance Hashable WSKeyConnection where
  hashWithSalt salt (WSKeyConnection (key, _conn)) = hashWithSalt salt key
instance Eq WSKeyConnection where
  (==) (WSKeyConnection (key1, _conn1)) (WSKeyConnection (key2, _conn2)) = key1 == key2
instance Show WSKeyConnection where
  showsPrec d (WSKeyConnection (key, _conn)) = showsPrec d $ "WSKeyConnection " <> key
showWSKeyConnection :: WSKeyConnection -> Text
showWSKeyConnection ws = "WSKeyConnection " <> show (wsKey ws)
wsKey :: WSKeyConnection -> ByteString
wsKey (WSKeyConnection (key, _conn)) = key
wsConn :: WSKeyConnection -> WS.Connection
wsConn (WSKeyConnection (_key, conn)) = conn
    
data Subscription =
  Subscription {
      s_connected_user    :: ConnectedUser
    , s_ws_key_connection :: WSKeyConnection
    , s_topic             :: Topic }
    deriving (Eq, Show)
instance Hashable Subscription where
  hashWithSalt salt (Subscription { .. }) =
    hashWithSalt salt ( s_connected_user, s_ws_key_connection, s_topic )
subKey :: Subscription -> ByteString
subKey sub = wsKey $ s_ws_key_connection sub


type Token = Text

    
{-
We accept requests for subscription/unsubscription via websocket.

We could instead handle 1 websocket connection per every topic
subscription (e.g. parse headers in WS.PendingConnection. However, WS
by default can handle 65k concurrent connections. With multiple users
having multiple components open, we could exhaust that limit quickly.

Hence, we architect this to have 1 websocket connection per web
browser.
-}
data WSRequest =
    WSSubscribe Topic
  | WSUnsubscribe Topic
  | WSAuthorize Token
  | WSDeauthorize
  deriving (Eq, Show)
instance FromJSON WSRequest where
  parseJSON = Aeson.withObject "WSRequest" $ \o -> do
    request <- o .: "request"
    case request of
      "subscribe" -> do
        topic <- o .: "topic"
        pure $ WSSubscribe topic
      "unsubscribe" -> do
        topic <- o .: "topic"
        pure $ WSUnsubscribe topic
      "authorize" -> do
         token <- o .: "token"
         pure $ WSAuthorize token
      "deauthorize" -> pure $ WSDeauthorize
      s -> prependFailure "parsing request type failed, " (typeMismatch "request" s)
-- | For tests mainly
instance ToJSON WSRequest where
  toJSON (WSSubscribe topic) = Aeson.object [ "request" .= ( "subscribe":: Text )
                                            , "topic" .= topic ]
  toJSON (WSUnsubscribe topic) = Aeson.object [ "request" .= ( "unsubscribe" :: Text )
                                              , "topic" .= topic ]
  toJSON (WSAuthorize token) = Aeson.object [ "request" .= ( "authorize" :: Text )
                                            , "token" .= token ]
  toJSON WSDeauthorize = Aeson.object [ "request" .= ( "deauthorize" :: Text ) ]
    
data Dispatcher =
 Dispatcher { d_subscriptions :: SSet.Set Subscription
            -- , d_ws_server     :: WSAPI AsServer
            , d_ce_listener   :: ThreadId
            }


class HasDispatcher env where
  hasDispatcher :: Getter env Dispatcher


-- | A notification is sent to clients who subscribed to specific topics
data Notification =
   Notification Topic Message
  deriving (Show)

instance ToJSON Notification where
  toJSON (Notification topic message) = Aeson.object [
      "notification" .= toJSON (Aeson.object [
         "topic" .= toJSON topic
       , "message" .= toJSON message
       ])
    ]
    
