]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Node.hs
[Merge]
[gargantext.git] / src / Gargantext / API / Node.hs
1 {-|
2 Module : Gargantext.API.Node
3 Description : Server API
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-SECURITY: Critical
11
12 -- TODO-ACCESS: CanGetNode
13 -- TODO-EVENTS: No events as this is a read only query.
14 Node API
15 -------------------------------------------------------------------
16 -- TODO-ACCESS: access by admin only.
17 -- At first let's just have an isAdmin check.
18 -- Later: check userId CanDeleteNodes Nothing
19 -- TODO-EVENTS: DeletedNodes [NodeId]
20 -- {"tag": "DeletedNodes", "nodes": [Int*]}
21
22 -}
23
24 {-# OPTIONS_GHC -fno-warn-orphans #-}
25
26 {-# LANGUAGE ScopedTypeVariables #-}
27 {-# LANGUAGE TemplateHaskell #-}
28 {-# LANGUAGE TypeOperators #-}
29
30 module Gargantext.API.Node
31 where
32
33 import Data.Aeson (FromJSON, ToJSON)
34 import Data.Aeson.TH (deriveJSON)
35 import Data.Maybe
36 import Data.Swagger
37 import Data.Text (Text())
38 import GHC.Generics (Generic)
39 import Servant
40 import Test.QuickCheck (elements)
41 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
42
43 import Gargantext.API.Admin.Auth (withAccess, PathId(..))
44 import Gargantext.API.Metrics
45 import Gargantext.API.Ngrams (TabType(..), TableNgramsApi, apiNgramsTableCorpus)
46 import Gargantext.API.Node.File
47 import Gargantext.API.Node.New
48 import Gargantext.API.Prelude
49 import Gargantext.API.Table
50 import Gargantext.Core.Types (NodeTableResult)
51 import Gargantext.Core.Types.Individu (User(..))
52 import Gargantext.Core.Types.Main (Tree, NodeTree)
53 import Gargantext.Core.Utils.Prefix (unPrefix)
54 import Gargantext.Database.Action.Flow.Pairing (pairing)
55 import Gargantext.Database.Admin.Types.Hyperdata
56 import Gargantext.Database.Admin.Types.Node
57 import Gargantext.Database.Prelude -- (Cmd, CmdM)
58 import Gargantext.Database.Query.Facet (FacetDoc, OrderBy(..))
59 import Gargantext.Database.Query.Table.Node
60 import Gargantext.Database.Query.Table.Node.Children (getChildren)
61 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
62 import Gargantext.Database.Query.Table.Node.Update (Update(..), update)
63 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
64 import Gargantext.Database.Query.Table.NodeNode
65 import Gargantext.Database.Query.Tree (tree, TreeMode(..))
66 import Gargantext.Prelude
67 import Gargantext.Core.Viz.Phylo.API (PhyloAPI, phyloAPI)
68 import qualified Gargantext.API.Node.Share as Share
69 import qualified Gargantext.API.Node.Update as Update
70 import qualified Gargantext.API.Search as Search
71 import qualified Gargantext.Database.Action.Delete as Action (deleteNode)
72 import qualified Gargantext.Database.Query.Table.Node.Update as U (update, Update(..))
73
74 {-
75 import qualified Gargantext.Core.Text.List.Learn as Learn
76 import qualified Data.Vector as Vec
77 --}
78
79 -- | Admin NodesAPI
80 -- TODO
81 type NodesAPI = Delete '[JSON] Int
82
83 -- | Delete Nodes
84 -- Be careful: really delete nodes
85 -- Access by admin only
86 nodesAPI :: [NodeId] -> GargServer NodesAPI
87 nodesAPI = deleteNodes
88
89 ------------------------------------------------------------------------
90 -- | TODO-ACCESS: access by admin only.
91 -- At first let's just have an isAdmin check.
92 -- Later: CanAccessAnyNode or (CanGetAnyNode, CanPutAnyNode)
93 -- To manage the Users roots
94 -- TODO-EVENTS:
95 -- PutNode ?
96 -- TODO needs design discussion.
97 type Roots = Get '[JSON] [Node HyperdataUser]
98 :<|> Put '[JSON] Int -- TODO
99
100 -- | TODO: access by admin only
101 roots :: GargServer Roots
102 roots = getNodesWithParentId Nothing
103 :<|> pure (panic "not implemented yet") -- TODO use patch map to update what we need
104
105 -------------------------------------------------------------------
106 -- | Node API Types management
107 -- TODO-ACCESS : access by users
108 -- No ownership check is needed if we strictly follow the capability model.
109 --
110 -- CanGetNode (Node, Children, TableApi, TableNgramsApiGet, PairingApi, ChartApi,
111 -- SearchAPI)
112 -- CanRenameNode (or part of CanEditNode?)
113 -- CanCreateChildren (PostNodeApi)
114 -- CanEditNode / CanPutNode TODO not implemented yet
115 -- CanDeleteNode
116 -- CanPatch (TableNgramsApi)
117 -- CanFavorite
118 -- CanMoveToTrash
119
120 type NodeAPI a = Get '[JSON] (Node a)
121 :<|> "rename" :> RenameApi
122 :<|> PostNodeApi -- TODO move to children POST
123 :<|> PostNodeAsync
124 :<|> ReqBody '[JSON] a :> Put '[JSON] Int
125 :<|> "update" :> Update.API
126 :<|> Delete '[JSON] Int
127 :<|> "children" :> ChildrenApi a
128
129 -- TODO gather it
130 :<|> "table" :> TableApi
131 :<|> "ngrams" :> TableNgramsApi
132
133 :<|> "category" :> CatApi
134 :<|> "search" :> (Search.API Search.SearchResult)
135 :<|> "share" :> Share.API
136
137 -- Pairing utilities
138 :<|> "pairwith" :> PairWith
139 :<|> "pairs" :> Pairs
140 :<|> "pairing" :> PairingApi
141
142 -- VIZ
143 :<|> "metrics" :> ScatterAPI
144 :<|> "chart" :> ChartApi
145 :<|> "pie" :> PieApi
146 :<|> "tree" :> TreeApi
147 :<|> "phylo" :> PhyloAPI
148 -- :<|> "add" :> NodeAddAPI
149 :<|> "move" :> MoveAPI
150 :<|> "unpublish" :> Share.Unpublish
151
152 :<|> "file" :> FileApi
153 :<|> "async" :> FileAsyncApi
154
155 -- TODO-ACCESS: check userId CanRenameNode nodeId
156 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
157 type RenameApi = Summary " Rename Node"
158 :> ReqBody '[JSON] RenameNode
159 :> Put '[JSON] [Int]
160
161 type PostNodeApi = Summary " PostNode Node with ParentId as {id}"
162 :> ReqBody '[JSON] PostNode
163 :> Post '[JSON] [NodeId]
164
165 type ChildrenApi a = Summary " Summary children"
166 :> QueryParam "type" NodeType
167 :> QueryParam "offset" Int
168 :> QueryParam "limit" Int
169 -- :> Get '[JSON] [Node a]
170 :> Get '[JSON] (NodeTableResult a)
171
172 ------------------------------------------------------------------------
173 type NodeNodeAPI a = Get '[JSON] (Node a)
174
175 nodeNodeAPI :: forall proxy a. (JSONB a, ToJSON a)
176 => proxy a
177 -> UserId
178 -> CorpusId
179 -> NodeId
180 -> GargServer (NodeNodeAPI a)
181 nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uId (PathNodeNode cId nId) nodeNodeAPI'
182 where
183 nodeNodeAPI' :: GargServer (NodeNodeAPI a)
184 nodeNodeAPI' = getNodeWith nId p
185
186 ------------------------------------------------------------------------
187 -- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
188 nodeAPI :: forall proxy a.
189 ( JSONB a
190 , FromJSON a
191 , ToJSON a
192 ) => proxy a
193 -> UserId
194 -> NodeId
195 -> GargServer (NodeAPI a)
196 nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode id') nodeAPI'
197 where
198 nodeAPI' :: GargServer (NodeAPI a)
199 nodeAPI' = getNodeWith id' p
200 :<|> rename id'
201 :<|> postNode uId id'
202 :<|> postNodeAsyncAPI uId id'
203 :<|> putNode id'
204 :<|> Update.api uId id'
205 :<|> Action.deleteNode (RootId $ NodeId uId) id'
206 :<|> getChildren id' p
207
208 -- TODO gather it
209 :<|> tableApi id'
210 :<|> apiNgramsTableCorpus id'
211
212 :<|> catApi id'
213 :<|> Search.api id'
214 :<|> Share.api id'
215 -- Pairing Tools
216 :<|> pairWith id'
217 :<|> pairs id'
218 :<|> getPair id'
219
220 -- VIZ
221 :<|> scatterApi id'
222 :<|> chartApi id'
223 :<|> pieApi id'
224 :<|> treeApi id'
225 :<|> phyloAPI id' uId
226 :<|> moveNode (RootId $ NodeId uId) id'
227 -- :<|> nodeAddAPI id'
228 -- :<|> postUpload id'
229 :<|> Share.unPublish id'
230
231 :<|> fileApi uId id'
232 :<|> fileAsyncApi uId id'
233
234
235 ------------------------------------------------------------------------
236 data RenameNode = RenameNode { r_name :: Text }
237 deriving (Generic)
238
239 ------------------------------------------------------------------------
240 ------------------------------------------------------------------------
241 type CatApi = Summary " To Categorize NodeNodes: 0 for delete, 1/null neutral, 2 favorite"
242 :> ReqBody '[JSON] NodesToCategory
243 :> Put '[JSON] [Int]
244
245 data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
246 , ntc_category :: Int
247 }
248 deriving (Generic)
249
250 -- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
251 instance FromJSON NodesToCategory
252 instance ToJSON NodesToCategory
253 instance ToSchema NodesToCategory
254
255 catApi :: CorpusId -> GargServer CatApi
256 catApi = putCat
257 where
258 putCat :: CorpusId -> NodesToCategory -> Cmd err [Int]
259 putCat cId cs' = nodeNodesCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
260
261 ------------------------------------------------------------------------
262 -- TODO adapt FacetDoc -> ListDoc (and add type of document as column)
263 -- Pairing utilities to move elsewhere
264 type PairingApi = Summary " Pairing API"
265 :> QueryParam "view" TabType
266 -- TODO change TabType -> DocType (CorpusId for pairing)
267 :> QueryParam "offset" Int
268 :> QueryParam "limit" Int
269 :> QueryParam "order" OrderBy
270 :> Get '[JSON] [FacetDoc]
271
272 ----------
273 type Pairs = Summary "List of Pairs"
274 :> Get '[JSON] [AnnuaireId]
275 pairs :: CorpusId -> GargServer Pairs
276 pairs cId = do
277 ns <- getNodeNode cId
278 pure $ map _nn_node2_id ns
279
280 type PairWith = Summary "Pair a Corpus with an Annuaire"
281 :> "annuaire" :> Capture "annuaire_id" AnnuaireId
282 :> QueryParam "list_id" ListId
283 :> Post '[JSON] Int
284
285 pairWith :: CorpusId -> GargServer PairWith
286 pairWith cId aId lId = do
287 r <- pairing cId aId lId
288 _ <- insertNodeNode [ NodeNode cId aId Nothing Nothing]
289 pure r
290
291
292 ------------------------------------------------------------------------
293 type TreeAPI = QueryParams "type" NodeType :> Get '[JSON] (Tree NodeTree)
294
295 treeAPI :: NodeId -> GargServer TreeAPI
296 treeAPI = tree Advanced
297
298 ------------------------------------------------------------------------
299 -- | TODO Check if the name is less than 255 char
300 rename :: NodeId -> RenameNode -> Cmd err [Int]
301 rename nId (RenameNode name') = U.update (U.Rename nId name')
302
303 putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
304 => NodeId
305 -> a
306 -> Cmd err Int
307 putNode n h = fromIntegral <$> updateHyperdata n h
308
309 -------------------------------------------------------------
310 type MoveAPI = Summary "Move Node endpoint"
311 :> Capture "parent_id" ParentId
312 :> Put '[JSON] [Int]
313
314 moveNode :: User
315 -> NodeId
316 -> ParentId
317 -> Cmd err [Int]
318 moveNode _u n p = update (Move n p)
319 -------------------------------------------------------------
320
321
322 $(deriveJSON (unPrefix "r_" ) ''RenameNode )
323 instance ToSchema RenameNode
324 instance Arbitrary RenameNode where
325 arbitrary = elements [RenameNode "test"]
326
327
328 -------------------------------------------------------------