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.Core
  25 import Gargantext.Core.Mail.Types (HasMail)
  26 import Gargantext.Core.Types.Individu (User(..))
  27 import Gargantext.Database.Action.Share (delFolderTeam)
  28 import Gargantext.Database.Action.User (getUserId)
  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 Gargantext.Database.Query.Table.Node (getNodeWith)
  33 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
  34 import Gargantext.Database.Schema.Node
  35 import Gargantext.Prelude
  36 import qualified Gargantext.Database.GargDB as GargDB
  37 import qualified Gargantext.Database.Query.Table.Node as N (getNode, deleteNode)
  38
  39 ------------------------------------------------------------------------
  40 -- TODO
  41 -- Delete Corpus children accoring its types
  42 -- Delete NodeList (NodeStory + cbor file)
  43 deleteNode :: (HasMail env, HasConfig env, HasConnectionPool env, HasNodeError err)
  44            => User
  45            -> NodeId
  46            -> Cmd' env err Int
  47 deleteNode u nodeId = do
  48   node' <- N.getNode nodeId
  49   case (view node_typename node') of
  50     nt | nt == toDBid NodeUser -> panic "[G.D.A.D.deleteNode] Not allowed to delete NodeUser (yet)"
  51     nt | nt == toDBid NodeTeam -> do
  52       uId   <- getUserId u
  53       if _node_user_id node' == uId
  54         then N.deleteNode    nodeId
  55         else delFolderTeam u nodeId
  56     nt | nt == toDBid NodeFile -> do
  57       node <- getNodeWith nodeId (Proxy :: Proxy HyperdataFile)
  58       let (HyperdataFile { _hff_path = path }) = node ^. node_hyperdata
  59       GargDB.rmFile $ unpack path
  60       N.deleteNode nodeId
  61     _                             -> N.deleteNode nodeId
  62
  63   -- if hasNodeType node' NodeUser
  64   --    then panic "Not allowed to delete NodeUser (yet)"
  65   --    else if hasNodeType node' NodeTeam
  66   --            then do
  67   --               uId   <- getUserId u
  68   --               if _node_user_id node' == uId
  69   --                  then N.deleteNode    nodeId
  70   --                  else delFolderTeam u nodeId
  71   --            else N.deleteNode nodeId