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

-- TODO-SECURITY: Critical

-- TODO-ACCESS: CanGetNode
-- TODO-EVENTS: No events as this is a read only query.
Node API
-------------------------------------------------------------------
-- TODO-ACCESS: access by admin only.
--              At first let's just have an isAdmin check.
--              Later: check userId CanDeleteNodes Nothing
-- TODO-EVENTS: DeletedNodes [NodeId]
--              {"tag": "DeletedNodes", "nodes": [Int*]}

-}

{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeOperators        #-}

module Gargantext.API.Node
  where

import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser (..), auth_node_id, auth_user_id)
import Gargantext.API.Admin.Auth (withNamedAccess, withNamedPolicyT, withPolicy, withPolicy)
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Auth.PolicyCheck ( nodeReadChecks, nodeWriteChecks, moveChecks, AccessPolicyManager, publishChecks )
import Gargantext.API.Errors.Types (BackendInternalError)
import Gargantext.API.Metrics
import Gargantext.API.Ngrams.Types (TabType(..))
import Gargantext.API.Node.DocumentsFromWriteNodes qualified as DFWN
import Gargantext.API.Node.DocumentUpload qualified as DocumentUpload
import Gargantext.API.Node.File ( fileApi, fileAsyncApi )
import Gargantext.API.Node.FrameCalcUpload qualified as FrameCalcUpload
import Gargantext.API.Node.New ( postNode, postNodeAsyncAPI )
import Gargantext.API.Node.Share qualified as Share
import Gargantext.API.Node.Types
import Gargantext.API.Node.Update qualified as Update
import Gargantext.API.Prelude ( GargM, GargServer, IsGargServer )
import Gargantext.API.Routes.Named.File qualified as Named
import Gargantext.API.Routes.Named.Node qualified as Named
import Gargantext.API.Routes.Named.Private qualified as Named
import Gargantext.API.Routes.Named.Publish qualified as Named
import Gargantext.API.Routes.Named.Share qualified as Named
import Gargantext.API.Routes.Named.Tree qualified as Named
import Gargantext.API.Search qualified as Search
import Gargantext.API.Server.Named.Ngrams (apiNgramsTableCorpus)
import Gargantext.API.Server.Named.Remote qualified as Named
import Gargantext.API.Server.Named.Remote qualified as Remote
import Gargantext.API.Table ( tableApi, getPair )
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Viz.Phylo.API (phyloAPI)
import Gargantext.Database.Action.Delete qualified as Action (deleteNode)
import Gargantext.Database.Action.Flow.Pairing (pairing)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataAny, HyperdataCorpus, HyperdataAnnuaire)
import Gargantext.Database.Admin.Types.Hyperdata.Prelude ( HyperdataC )
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (DBCmdExtra, JSONB)
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Children (getChildren)
import Gargantext.Database.Query.Table.NodeContext (nodeContextsCategory, nodeContextsScore)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Query.Table.NodeNode
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Query.Table.Node.Update qualified as U (update, Update(..), publish)
import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
import Gargantext.Database.Query.Tree (tree, tree_flat, TreeMode(..))
import Gargantext.Prelude
import Servant
import Servant.Server.Generic (AsServerT)


-- | Delete Nodes
-- Be careful: really delete nodes
-- Access by admin only
nodesAPI :: IsGargServer err env m => [NodeId] -> Named.NodesAPI (AsServerT m)
nodesAPI nodes = Named.NodesAPI { deleteNodeEp = deleteNodes nodes }

------------------------------------------------------------------------
-- | TODO-ACCESS: access by admin only.
-- At first let's just have an isAdmin check.
-- Later: CanAccessAnyNode or (CanGetAnyNode, CanPutAnyNode)
-- To manage the Users roots
-- TODO-EVENTS:
--   PutNode ?
-- TODO needs design discussion.
roots :: IsGargServer err env m => Named.Roots (AsServerT m)
roots = Named.Roots
  { getRootsEp = getNodesWithParentId Nothing
  , putRootsEp = pure (panicTrace "not implemented yet") -- TODO use patch map to update what we need
  }

-------------------------------------------------------------------
-- | Node API Types management
-- TODO-ACCESS : access by users
-- No ownership check is needed if we strictly follow the capability model.
--
-- CanGetNode (Node, Children, TableApi, TableNgramsApiGet, PairingApi, ChartApi,
--             SearchAPI)
-- CanRenameNode (or part of CanEditNode?)
-- CanCreateChildren (PostNodeApi)
-- CanEditNode / CanPutNode TODO not implemented yet
-- CanDeleteNode
-- CanPatch (TableNgramsApi)
-- CanFavorite
-- CanMoveToTrash

nodeNodeAPI :: forall proxy a env err m. (JSONB a, ToJSON a, IsGargServer env err m)
            => proxy a
            -> AuthenticatedUser
            -> CorpusId
            -> NodeId
            -> Named.NodeNodeAPI a (AsServerT m)
nodeNodeAPI p uId cId nId =
  withNamedAccess uId (PathNodeNode cId nId) nodeNodeAPI'
  where
    nodeNodeAPI' :: Named.NodeNodeAPI a (AsServerT m)
    nodeNodeAPI' = Named.NodeNodeAPI $ getNodeWith nId p

------------------------------------------------------------------------
------------------------------------------------------------------------
type CatApi =  Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
            :> ReqBody '[JSON] NodesToCategory
            :> Put     '[JSON] [Int]

catApi :: CorpusId -> GargServer CatApi
catApi cId cs' = do
  ret <- nodeContextsCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
  lId <- defaultList cId
  _ <- updateChart cId (Just lId) Docs Nothing
  pure ret

------------------------------------------------------------------------
type ScoreApi =  Summary " To Score NodeNodes"
            :> ReqBody '[JSON] NodesToScore
            :> Put     '[JSON] [Int]

scoreApi :: CorpusId -> GargServer ScoreApi
scoreApi = putScore
  where
    putScore :: CorpusId -> NodesToScore -> DBCmdExtra err [Int]
    putScore cId cs' = nodeContextsScore $ map (\n -> (cId, n, nts_score cs')) (nts_nodesId cs')

------------------------------------------------------------------------
-- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
-- Pairing utilities to move elsewhere
pairs :: IsGargServer err env m => CorpusId -> Named.Pairs (AsServerT m)
pairs cId = Named.Pairs $ do
  ns <- getNodeNode cId
  pure $ map _nn_node2_id ns

pairWith :: IsGargServer err env m => CorpusId -> Named.PairWith (AsServerT m)
pairWith cId = Named.PairWith $ \ aId lId -> do
  r <- pairing cId aId lId
  pairCorpusWithAnnuaire (SourceId cId) (TargetId aId)
  pure r


treeAPI :: IsGargServer env BackendInternalError m
        => AuthenticatedUser
        -> NodeId
        -> AccessPolicyManager
        -> Named.NodeTreeAPI (AsServerT m)
treeAPI authenticatedUser nodeId mgr =
  withNamedPolicyT authenticatedUser (nodeReadChecks nodeId) (Named.NodeTreeAPI
    { nodeTreeEp   = tree (_auth_user_id authenticatedUser) TreeAdvanced nodeId
    , firstLevelEp = tree (_auth_user_id authenticatedUser) TreeFirstLevel nodeId
    }) mgr

treeFlatAPI :: IsGargServer env err m
            => AuthenticatedUser
            -> RootId
            -> Named.TreeFlatAPI (AsServerT m)
treeFlatAPI authenticatedUser rootId =
  withNamedAccess authenticatedUser (PathNode rootId) $
    Named.TreeFlatAPI { getNodesEp = tree_flat (_auth_user_id authenticatedUser) rootId }

------------------------------------------------------------------------
-- | TODO Check if the name is less than 255 char
rename :: HasNodeError err => UserId -> NodeId -> RenameNode -> DBCmdExtra err [Int]
rename loggedInUserId nId (RenameNode name') = U.update loggedInUserId (U.Rename nId name')

putNode :: forall err a. (HyperdataC a)
        => NodeId
        -> a
        -> DBCmdExtra err Int
putNode n h = fromIntegral <$> updateHyperdata n h

moveNode :: HasNodeError err
         => UserId
         -> NodeId
         -> ParentId
         -> DBCmdExtra err [Int]
moveNode loggedInUserId n p = update loggedInUserId (Move n p)
-------------------------------------------------------------

annuaireNodeAPI :: AuthenticatedUser
                -> Named.AnnuaireAPIEndpoint (AsServerT (GargM Env BackendInternalError))
annuaireNodeAPI authenticatedUser = Named.AnnuaireAPIEndpoint $ \targetNode ->
  withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
  where
    concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataAnnuaire) authenticatedUser

corpusNodeAPI :: AuthenticatedUser
              -> Named.CorpusAPIEndpoint (AsServerT (GargM Env BackendInternalError))
corpusNodeAPI authenticatedUser = Named.CorpusAPIEndpoint $ \targetNode ->
  withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
  where
    concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataCorpus) authenticatedUser

------------------------------------------------------------------------
nodeAPI :: AuthenticatedUser
        -> Named.NodeAPIEndpoint (AsServerT (GargM Env BackendInternalError))
nodeAPI authenticatedUser = Named.NodeAPIEndpoint
  { nodeEndpointAPI = \targetNode ->
      withNamedAccess authenticatedUser (PathNode targetNode) (concreteAPI targetNode)
  , nodeRemoteImportAPI = Named.remoteImportAPI authenticatedUser
  }

  where
    concreteAPI = genericNodeAPI' (Proxy :: Proxy HyperdataAny) authenticatedUser

-- | The /actual/ (generic) node API, instantiated depending on the concrete type of node.
genericNodeAPI' :: forall a proxy. ( HyperdataC a )
                => proxy a
                -> AuthenticatedUser
                -> NodeId
                -> Named.NodeAPI a (AsServerT (GargM Env BackendInternalError))
genericNodeAPI' _ authenticatedUser targetNode =  Named.NodeAPI
  { nodeNodeAPI        = withNamedPolicyT authenticatedUser (nodeReadChecks targetNode) $
                           Named.NodeNodeAPI $ getNodeWith targetNode (Proxy :: Proxy a)
  , renameAPI          = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
                           Named.RenameAPI   $ rename loggedInUserId targetNode
  , postNodeAPI        = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
                           Named.PostNodeAPI $ postNode authenticatedUser targetNode
  , postNodeAsyncAPI   = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
                           postNodeAsyncAPI authenticatedUser targetNode
  , frameCalcUploadAPI = FrameCalcUpload.api authenticatedUser targetNode
  , putEp              = putNode targetNode
  , updateAPI          = withNamedPolicyT authenticatedUser (nodeWriteChecks targetNode) $
                           Update.api targetNode
  , deleteEp           = withPolicy authenticatedUser (nodeWriteChecks targetNode) $
                           Action.deleteNode userRootId targetNode
  , childrenAPI        = Named.ChildrenAPI $ getChildren targetNode (Proxy :: Proxy a)
  , tableAPI           = tableApi targetNode
  , tableNgramsAPI     = apiNgramsTableCorpus targetNode
  , catAPI             = Named.CatAPI $ catApi targetNode
  , scoreAPI           = Named.ScoreAPI $ scoreApi targetNode
  , searchAPI          = Search.api targetNode
  , shareAPI           = Named.ShareNode $ Share.api userRootId targetNode
  , unshareEp          = Share.unShare targetNode
  , publishAPI         = withNamedPolicyT authenticatedUser (publishChecks targetNode) $
                           Named.PublishAPI $ \Named.PublishRequest{pubrq_policy} -> U.publish loggedInUserId targetNode pubrq_policy
  ---- Pairing utilities
  , pairWithEp         = pairWith targetNode
  , pairsEp            = pairs targetNode
  , pairingEp          = Named.PairingAPI $ getPair targetNode
  ---- VIZ
  , scatterAPI         = scatterApi targetNode
  , chartAPI           = chartApi targetNode
  , pieAPI             = pieApi targetNode
  , treeAPI            = treeApi targetNode
  , phyloAPI           = phyloAPI targetNode
  , moveAPI            = Named.MoveAPI $ \parentId ->
                           withPolicy authenticatedUser (moveChecks (SourceId targetNode) (TargetId parentId)) $
                             moveNode loggedInUserId targetNode parentId
  , fileAPI            = Named.FileAPI { fileDownloadEp = fileApi targetNode }
  , fileAsyncAPI       = fileAsyncApi authenticatedUser targetNode
  , dfwnAPI            = DFWN.api authenticatedUser targetNode
  , documentUploadAPI  = DocumentUpload.api targetNode
  , remoteExportAPI    = Remote.remoteExportAPI targetNode authenticatedUser
  }
  where
    userRootId     = RootId $ authenticatedUser ^. auth_node_id
    loggedInUserId = authenticatedUser ^. auth_user_id