src/Gargantext/Database/Action/Delete.hs

   1 {-|
   2 Module      : Gargantext.Database.Action.Delete
   3 Description :
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 TODO: right managements of nodes children of node Team
  11 -- TODO add proper Right Management Type
  12
  13 TODO: NodeError
  14
  15 -}
  16
  17 module Gargantext.Database.Action.Delete
  18   where
  19
  20 import Control.Lens     (view, (^.))
  21 import Data.Text
  22 import Servant
  23
  24 import Gargantext.API.Admin.Types
  25 import Gargantext.Core.Types.Individu (User(..))
  26 import Gargantext.Database.Action.User (getUserId)
  27 import Gargantext.Database.Action.Share (delFolderTeam)
  28 import Gargantext.Database.Admin.Config (nodeTypeId)
  29 import Gargantext.Database.Admin.Types.Hyperdata.File
  30 import Gargantext.Database.Admin.Types.Node -- (NodeType(..))
  31 import Gargantext.Database.Prelude (Cmd', HasConfig, HasConnectionPool)
  32 import qualified Gargantext.Database.Query.Table.Node as N (getNode, deleteNode)
  33 import Gargantext.Database.Query.Table.Node (getNodeWith)
  34 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
  35 import Gargantext.Database.Schema.Node
  36 import Gargantext.Prelude
  37 import qualified Gargantext.Prelude.Utils as GPU
  38
  39 ------------------------------------------------------------------------
  40
  41 deleteNode :: (HasConfig env, HasConnectionPool env, HasNodeError err, HasSettings env)
  42            => User
  43            -> NodeId
  44            -> Cmd' env err Int
  45 deleteNode u nodeId = do
  46   node' <- N.getNode nodeId
  47   case (view node_typename node') of
  48     nt | nt == nodeTypeId NodeUser -> panic "Not allowed to delete NodeUser (yet)"
  49     nt | nt == nodeTypeId NodeTeam -> do
  50       uId   <- getUserId u
  51       if _node_userId node' == uId
  52         then N.deleteNode    nodeId
  53         else delFolderTeam u nodeId
  54     nt | nt == nodeTypeId NodeFile -> do
  55       node <- getNodeWith nodeId (Proxy :: Proxy HyperdataFile)
  56       let (HyperdataFile { _hff_path = path }) = node ^. node_hyperdata
  57       GPU.removeFile $ unpack path
  58       N.deleteNode nodeId
  59     _                             -> N.deleteNode nodeId
  60
  61   -- if hasNodeType node' NodeUser
  62   --    then panic "Not allowed to delete NodeUser (yet)"
  63   --    else if hasNodeType node' NodeTeam
  64   --            then do
  65   --               uId   <- getUserId u
  66   --               if _node_userId node' == uId
  67   --                  then N.deleteNode    nodeId
  68   --                  else delFolderTeam u nodeId
  69   --            else N.deleteNode nodeId