Delete.hs 2.5 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
{-|
Module      : Gargantext.Database.Action.Delete
Description : 
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

TODO: right managements of nodes children of node Team
-- TODO add proper Right Management Type

TODO: NodeError

-}

module Gargantext.Database.Action.Delete
  where

20 21 22 23
import Control.Lens     (view, (^.))
import Data.Text
import Servant

24 25
import Gargantext.Core
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 32
import Gargantext.Database.Prelude (Cmd', HasConfig, HasConnectionPool)
import Gargantext.Database.Query.Table.Node (getNodeWith)
33 34 35
import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
import Gargantext.Database.Schema.Node
import Gargantext.Prelude
Alexandre Delanoë's avatar
Alexandre Delanoë committed
36
import qualified Gargantext.Database.GargDB as GargDB
37
import qualified Gargantext.Database.Query.Table.Node as N (getNode, deleteNode)
38

39
------------------------------------------------------------------------
40 41 42
-- TODO
-- Delete Corpus children accoring its types
-- Delete NodeList (NodeStory + cbor file)
43
deleteNode :: (HasMail env, HasConfig env, HasConnectionPool env, HasNodeError err)
44 45
           => User
           -> NodeId
46
           -> Cmd' env err Int
47 48
deleteNode u nodeId = do
  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 55
        then N.deleteNode    nodeId
        else delFolderTeam u nodeId
56
    nt | nt == toDBid NodeFile -> do
57 58
      node <- getNodeWith nodeId (Proxy :: Proxy HyperdataFile)
      let (HyperdataFile { _hff_path = path }) = node ^. node_hyperdata
59
      GargDB.rmFile $ unpack path
60 61 62 63 64 65 66 67
      N.deleteNode nodeId
    _                             -> N.deleteNode nodeId
   
  -- if hasNodeType node' NodeUser
  --    then panic "Not allowed to delete NodeUser (yet)"
  --    else if hasNodeType node' NodeTeam
  --            then do
  --               uId   <- getUserId u
68
  --               if _node_user_id node' == uId
69 70 71
  --                  then N.deleteNode    nodeId
  --                  else delFolderTeam u nodeId
  --            else N.deleteNode nodeId