Update.hs 5.62 KB
{-# LANGUAGE LambdaCase #-}
{-|
Module      : Gargantext.Database.Node.Update
Description : Update Node in Database (Postgres)
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

module Gargantext.Database.Query.Table.Node.Update (
    Update(..)
  , update
  , publish
  )
  where

import Database.PostgreSQL.Simple ( Only(Only) )
import Data.Text qualified as DT
import Gargantext.Core (fromDBid)
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CE
import Gargantext.Core.Types (Name)
import Gargantext.Database.Admin.Config ()
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (DBCmd, DBCmdExtra, runPGSQuery)
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Table.Node (getParentId, getNode, getUserRootPublicNode)
import Gargantext.Database.Query.Table.NodeNode (isNodeReadOnly, SourceId (..), TargetId(..), publishNode, unpublishNode)
import Gargantext.Database.Schema.Node
import Gargantext.Prelude

-- import Data.ByteString
--rename :: NodeId -> Text -> IO ByteString
--rename nodeId name = formatPGSQuery "UPDATE nodes SET name=? where id=?" (name,nodeId)
------------------------------------------------------------------------

data Update = Rename NodeId Name
            | Move   NodeId ParentId

-- | Update a Node
-- TODO : Field as parameter
-- TODO jsonb values, consider this: 
-- https://stackoverflow.com/questions/26703476/how-to-perform-update-operations-on-columns-of-type-jsonb-in-postgres-9-4

unOnly :: Only a -> a
unOnly (Only a) = a

-- | Prefer this, because it notifies parents of the node change
update :: HasNodeError err => UserId -> Update -> DBCmdExtra err [Int]
update _loggedInUserId (Rename nId newName) = do
  ret <- rename_db_update nId newName
  mpId <- getParentId nId
  case mpId of
    Nothing -> pure ()
    Just pId -> CE.ce_notify $ CE.UpdateTreeFirstLevel pId
  return ret
update loggedInUserId (Move sourceId targetId) = do
  mbParentId <- getParentId sourceId

  -- if the source and the target are the same, this is identity.
  case sourceId == targetId of
    True  -> pure [ _NodeId sourceId ]
    False -> do
      isSourceRO <- isNodeReadOnly sourceId
      isTargetRO <- isNodeReadOnly targetId

      -- Check if the source and the target are read only (i.e. published) and
      -- act accordingly.
      ids <- case (isSourceRO, isTargetRO) of
        (False, False)
          -> -- both are not read-only, normal move
             move_db_update sourceId targetId
        (False, True)
          -> do void $ publish_node (SourceId sourceId) (TargetId targetId) NPP_publish_no_edits_allowed
                move_db_update sourceId targetId
        (True, False)
          -> -- the source is read only. If we are the owner we allow unpublishing.
             -- FIXME(adn) is this check enough?
             do sourceNode <- getNode sourceId
                case _node_user_id sourceNode == loggedInUserId of
                  True -> do
                    userPublicFolderNode <- getUserRootPublicNode loggedInUserId
                    unpublishNode (SourceId $ sourceId) (TargetId $ _node_id userPublicFolderNode)
                    move_db_update sourceId targetId
                  False -> nodeError (NodeIsReadOnly targetId "logged user is not allowed to move/unpublish a read-only node")
        (True, True)
          -> -- this case is not allowed.
            nodeError (NodeIsReadOnly targetId "Both the source and the target are read-only.")

      for_ mbParentId $ CE.ce_notify . CE.UpdateTreeFirstLevel
      CE.ce_notify $ CE.UpdateTreeFirstLevel targetId

      pure ids

publish :: HasNodeError err => UserId -> NodeId -> NodePublishPolicy -> DBCmdExtra err Int
publish loggedInUserId sourceId policy = do
  targetId <- _node_id <$> getUserRootPublicNode loggedInUserId
  publish_node (SourceId sourceId) (TargetId targetId) policy

publish_node :: HasNodeError err => SourceId -> TargetId -> NodePublishPolicy -> DBCmdExtra err Int
publish_node (SourceId sourceId) (TargetId targetId) policy = do
  sourceNode <- getNode sourceId
  targetNode <- getNode targetId

  -- the target is read only
  -- First of all, we need to understand if the target node
  -- is a public folder, as we don't allow (at the moment)
  -- publishing into sub (public) directories.
  case fromDBid $ _node_typename targetNode of
   NodeFolderPublic
     -> do
     check_publish_source_type_allowed (SourceId sourceId) (TargetId targetId) (fromDBid $ _node_typename sourceNode)
     -- See issue #400, by default we publish in a \"strict\"
     -- way by disallowing further edits on the original node,
     -- including edits from the owner itself!
     publishNode policy (SourceId sourceId) (TargetId targetId)
     pure (_NodeId $ sourceId)
   _ -> nodeError (NodeIsReadOnly targetId "Target is read only, but not a public folder.")


-- Issue #400, for now we support only publishing corpus nodes
check_publish_source_type_allowed :: HasNodeError err => SourceId -> TargetId -> NodeType -> DBCmdExtra err ()
check_publish_source_type_allowed (SourceId nId) (TargetId tId) = \case
  NodeCorpus   -> pure ()
  NodeCorpusV3 -> pure ()
  _            -> nodeError (MoveError nId tId "At the moment only corpus nodes can be published.")

-- TODO-ACCESS
rename_db_update :: NodeId -> Name -> DBCmd err [Int]
rename_db_update nId name = map unOnly <$> runPGSQuery "UPDATE nodes SET name=? where id=? returning id" (DT.take 255 name, nId)

move_db_update :: NodeId -> NodeId -> DBCmd err [Int]
move_db_update nId pId = map unOnly <$> runPGSQuery "UPDATE nodes SET parent_id= ? where id=? returning id" (pId, nId)