]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/Database/Action/Delete.hs
[DEPS] stack upgrade
[gargantext.git] / 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.Settings
25 import Gargantext.Core.Types.Individu (User(..))
26 import Gargantext.Database.Action.Flow.Utils (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