{-|
Module      : Gargantext.Database.Action.Share
Description :
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}


{-# LANGUAGE Arrows       #-}
{-# LANGUAGE ViewPatterns #-}

module Gargantext.Database.Action.Share
  where

import Control.Arrow (returnA)
import Control.Lens (view)
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CE
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database
import Gargantext.Database.Action.User (getUserId)
import Gargantext.Database.Admin.Config (hasNodeType, isInNodeTypes)
import Gargantext.Database.Admin.Types.Hyperdata.Any (HyperdataAny(..))
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Node (getNode, getNodesWith)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError, nodeErrorWith)
import Gargantext.Database.Query.Table.User
import Gargantext.Database.Query.Tree.Root (getRootId)
import Gargantext.Database.Schema.Node
import Gargantext.Prelude
import Gargantext.Utils.Tuple (uncurryMaybe)
import Opaleye hiding (not)
import Opaleye qualified as O

-- | TODO move in PhyloConfig of Gargantext
publicNodeTypes :: [NodeType]
publicNodeTypes = [NodeDashboard, NodeGraph, NodePhylo, NodeFile]

------------------------------------------------------------------------
data ShareNodeWith = ShareNodeWith_User !NodeType !User
                   | ShareNodeWith_Node !NodeType !NodeId

------------------------------------------------------------------------
deleteMemberShip :: HasNodeError err => [(SharedFolderId, TeamNodeId)] -> DBUpdate err [Int]
deleteMemberShip xs = mapM (\(s,t) -> deleteNodeNode s t) xs

------------------------------------------------------------------------

type SharedFolderId = NodeId
type TeamNodeId     = NodeId

-- List members of a Team
-- Result gives the username and its SharedFolderId that has to be eventually
-- used for the membership
membersOf :: HasNodeError err
          => TeamNodeId -> DBQuery err x [(Text, SharedFolderId)]
membersOf nId = do
  res <- mkOpaQuery $ membersOfQuery nId
  pure $ catMaybes (uncurryMaybe <$> res)


membersOfQuery :: TeamNodeId
               -> SelectArr () (MaybeFields (Field SqlText), MaybeFields (Field SqlInt4))
membersOfQuery (_NodeId -> teamId) = proc () -> do
  (nn, n, u) <- nodeNode_node_User -< ()
  restrict -< (nn ^. nn_node2_id) .== sqlInt4 teamId
  returnA -< ( user_username <$> u
             , view node_id <$> n )


nodeNode_node_User :: O.Select ( NodeNodeRead
                               , MaybeFields NodeRead
                               , MaybeFields UserRead )
nodeNode_node_User = proc () -> do
  nn <- queryNodeNodeTable -< ()
  n <- optionalRestrict queryNodeTable -<
    \n' -> (n' ^. node_id) .== (nn ^. nn_node1_id)
  u <- optionalRestrict queryUserTable -<
    \u' -> (view node_user_id <$> n) .=== justFields (user_id u')

  returnA -< (nn, n, u)

------------------------------------------------------------------------
-- To Share a Node Team with a user, use this function
-- basically used with the invitation to a team
shareNodeWith :: HasNodeError err
              => ShareNodeWith
              -> NodeId
              -- ^ The target node we would like to share, it has
              -- to be a 'NodeFolderShared'.
              -> DBUpdate err (Int, [CE.CEMessage])
              -- ^ Returns as the second argument the list of messages
              -- we need to submit to the central exchange.
shareNodeWith (ShareNodeWith_User NodeFolderShared u) n = do
  nodeToCheck <- getNode   n
  userIdCheck <- getUserId u
  if not (hasNodeType nodeToCheck NodeTeam)
    then nodeErrorWith "[G.D.A.S.shareNodeWith] Can share node Team only"
    else
      if (view node_user_id nodeToCheck == userIdCheck)
        then nodeErrorWith "[G.D.A.S.shareNodeWith] Can share to others only"
        else do
          folderSharedId  <- getFolderId u NodeFolderShared
          ret <- shareNode (SourceId folderSharedId) (TargetId n)
          let msgs = [CE.UpdateTreeFirstLevel folderSharedId, CE.UpdateTreeFirstLevel n]
          pure (ret, msgs)

shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId) n = do
  nodeToCheck <- getNode n
  if not (isInNodeTypes nodeToCheck publicNodeTypes)
    then nodeErrorWith $ "[G.D.A.S.shareNodeWith] Can share this nodesTypes only: "
                   <> (show publicNodeTypes)
    else do
      folderToCheck <- getNode nId
      if hasNodeType folderToCheck NodeFolderPublic
        then do
          ret <- shareNode (SourceId nId) (TargetId n)
          let msgs = [CE.UpdateTreeFirstLevel nId, CE.UpdateTreeFirstLevel n]
          pure (ret, msgs)
        else nodeErrorWith "[G.D.A.S.shareNodeWith] Can share NodeWith NodeFolderPublic only"

shareNodeWith _ _ = nodeErrorWith "[G.D.A.S.shareNodeWith] Not implemented for this NodeType"

------------------------------------------------------------------------
getFolderId :: HasNodeError err => User -> NodeType -> DBQuery err x NodeId
getFolderId u nt = do
  rootId <- getRootId u
  s <- getNodesWith rootId HyperdataAny (Just nt) Nothing Nothing
  case head s of
    Nothing -> nodeErrorWith "[G.D.A.S.getFolderId] No folder shared found"
    Just  f -> pure (_node_id f)

------------------------------------------------------------------------
type TeamId = NodeId

delFolderTeam :: HasNodeError err => User -> TeamId -> DBUpdate err Int
delFolderTeam u nId = do
  folderSharedId <- getFolderId u NodeFolderShared
  deleteNodeNode folderSharedId nId

unshare :: HasNodeError err
        => ParentId -> NodeId
        -> DBUpdate err Int
unshare p n = deleteNodeNode p n
