2 Module : Gargantext.API.Routes
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
14 {-# LANGUAGE ConstraintKinds #-}
15 {-# LANGUAGE TypeOperators #-}
16 {-# LANGUAGE KindSignatures #-}
17 {-# LANGUAGE ScopedTypeVariables #-}
18 {-# LANGUAGE TypeFamilies #-}
20 ---------------------------------------------------------------------
21 module Gargantext.API.Routes
23 ---------------------------------------------------------------------
25 -- import qualified Gargantext.API.Search as Search
26 import Control.Concurrent (threadDelay)
27 import Control.Lens (view)
28 import Data.Text (Text)
30 import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), PathId(..))
31 import Gargantext.API.Admin.Auth (withAccess)
32 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
33 import Gargantext.API.Count (CountAPI, count, Query)
34 import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableDoc)
35 import Gargantext.API.Node
36 import Gargantext.API.Prelude
37 import Gargantext.Core.Types.Individu (User(..))
38 import Gargantext.Core.Viz.Graph.API
39 import Gargantext.Database.Prelude (HasConfig(..))
40 import Gargantext.Database.Admin.Types.Hyperdata
41 import Gargantext.Database.Admin.Types.Node
42 import Gargantext.Prelude
43 import Gargantext.Prelude.Config (gc_max_docs_scrapers)
45 import Servant.Auth as SA
46 import Servant.Auth.Swagger ()
47 import Servant.Job.Async
48 import Servant.Swagger.UI
49 import qualified Gargantext.API.Ngrams.List as List
50 import qualified Gargantext.API.Node.Contact as Contact
51 import qualified Gargantext.API.Node.Corpus.Annuaire as Annuaire
52 import qualified Gargantext.API.Node.Corpus.Export as Export
53 import qualified Gargantext.API.Node.Corpus.Export.Types as Export
54 import qualified Gargantext.API.Node.Corpus.New as New
55 import qualified Gargantext.API.Public as Public
57 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
58 -- | TODO :<|> Summary "Latest API" :> GargAPI'
60 type GargAPIVersion = "v1.0"
61 :> Summary "Garg API Version "
64 type GargVersion = "version"
65 :> Summary "Backend version"
70 "auth" :> Summary "AUTH API"
71 :> ReqBody '[JSON] AuthRequest
72 :> Post '[JSON] AuthResponse
74 -- TODO-ACCESS here we want to request a particular header for
75 -- auth and capabilities.
77 :<|> "public" :> Public.API
80 type GargPrivateAPI = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
85 = "user" :> Summary "First user endpoint"
87 :<|> "nodes" :> Summary "Nodes endpoint"
88 :> ReqBody '[JSON] [NodeId] :> NodesAPI
90 type GargPrivateAPI' =
94 :<|> "node" :> Summary "Node endpoint"
95 :> Capture "node_id" NodeId
96 :> NodeAPI HyperdataAny
99 :<|> "corpus" :> Summary "Corpus endpoint"
100 :> Capture "corpus_id" CorpusId
101 :> NodeAPI HyperdataCorpus
103 :<|> "corpus" :> Summary "Corpus endpoint"
104 :> Capture "node1_id" NodeId
106 :> Capture "node2_id" NodeId
107 :> NodeNodeAPI HyperdataAny
109 :<|> "corpus" :> Capture "node_id" CorpusId
114 :<|> "contact" :> Summary "Contact endpoint"
115 :> Capture "contact_id" ContactId
116 :> NodeAPI HyperdataContact
119 :<|> "annuaire" :> Summary "Annuaire endpoint"
120 :> Capture "annuaire_id" AnnuaireId
121 :> NodeAPI HyperdataAnnuaire
123 :<|> "annuaire" :> Summary "Contact endpoint"
124 :> Capture "annuaire_id" NodeId
127 :<|> "document" :> Summary "Document endpoint"
128 :> Capture "doc_id" DocId
132 -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
134 :<|> "count" :> Summary "Count endpoint"
135 :> ReqBody '[JSON] Query
138 -- Corpus endpoint --> TODO rename s/search/filter/g
139 -- :<|> "search" :> Capture "corpus" NodeId
140 -- :> (Search.API Search.SearchResult)
142 -- TODO move to NodeAPI?
143 :<|> "graph" :> Summary "Graph endpoint"
144 :> Capture "graph_id" NodeId
147 -- TODO move to NodeAPI?
149 :<|> "tree" :> Summary "Tree endpoint"
150 :> Capture "tree_id" NodeId
155 -- :<|> New.AddWithFile
156 :<|> New.AddWithQuery
158 -- :<|> "annuaire" :> Annuaire.AddWithForm
159 -- :<|> New.AddWithFile
160 -- :<|> "scraper" :> WithCallbacks ScraperAPI
161 -- :<|> "new" :> New.Api
163 :<|> "lists" :> Summary "List export API"
164 :> Capture "listId" ListId
167 :<|> "wait" :> Summary "Wait test"
169 :> WaitAPI -- Get '[JSON] Int
175 -- :<|> "list" :> Capture "node_id" Int :> NodeAPI
176 -- :<|> "ngrams" :> Capture "node_id" Int :> NodeAPI
177 -- :<|> "auth" :> Capture "node_id" Int :> NodeAPI
178 ---------------------------------------------------------------------
180 type API = SwaggerAPI
184 -- | API for serving @swagger.json@
185 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
187 -- | API for serving main operational routes of @gargantext.org@
193 -- :<|> "list" :> Capture "node_id" Int :> NodeAPI
194 -- :<|> "ngrams" :> Capture "node_id" Int :> NodeAPI
195 -- :<|> "auth" :> Capture "node_id" Int :> NodeAPI
196 ---------------------------------------------------------------------
198 ---------------------------------------------------------------------
199 -- | Server declarations
201 -- TODO-SECURITY admin only: withAdmin
202 -- Question: How do we mark admins?
203 serverGargAdminAPI :: GargServer GargAdminAPI
204 serverGargAdminAPI = roots
208 serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI'
209 serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
211 :<|> nodeAPI (Proxy :: Proxy HyperdataAny) uid
212 :<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) uid
213 :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny) uid
214 :<|> Export.getCorpus -- uid
215 -- :<|> nodeAPI (Proxy :: Proxy HyperdataContact) uid
216 :<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) uid
219 :<|> withAccess (Proxy :: Proxy TableNgramsApi) Proxy uid
220 <$> PathNode <*> apiNgramsTableDoc
222 :<|> count -- TODO: undefined
224 -- :<|> withAccess (Proxy :: Proxy (Search.API Search.SearchResult)) Proxy uid
225 -- <$> PathNode <*> Search.api -- TODO: move elsewhere
227 :<|> withAccess (Proxy :: Proxy GraphAPI) Proxy uid
228 <$> PathNode <*> graphAPI uid -- TODO: mock
230 :<|> withAccess (Proxy :: Proxy TreeAPI) Proxy uid
231 <$> PathNode <*> treeAPI
233 :<|> addCorpusWithForm (RootId (NodeId uid))
234 -- :<|> addCorpusWithFile (RootId (NodeId uid))
235 :<|> addCorpusWithQuery (RootId (NodeId uid))
237 -- :<|> addAnnuaireWithForm
238 -- :<|> New.api uid -- TODO-SECURITY
239 -- :<|> New.info uid -- TODO-SECURITY
244 ----------------------------------------------------------------------
246 type WaitAPI = Get '[JSON] Text
248 waitAPI :: Int -> GargServer WaitAPI
251 m = (10 :: Int) ^ (6 :: Int)
252 _ <- liftBase $ threadDelay ( m * n)
253 pure $ "Waited: " <> (cs $ show n)
254 ----------------------------------------
256 addCorpusWithQuery :: User -> GargServer New.AddWithQuery
257 addCorpusWithQuery user cid =
259 JobFunction (\q log' -> do
260 limit <- view $ hasConfig . gc_max_docs_scrapers
261 New.addToCorpusWithQuery user cid q (Just limit) (liftBase . log')
263 printDebug "addToCorpusWithQuery" x
269 addWithFile :: GargServer New.AddWithFile
270 addWithFile cid i f =
272 JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftBase . log))
275 addCorpusWithForm :: User -> GargServer New.AddWithForm
276 addCorpusWithForm user cid =
278 JobFunction (\i log' ->
281 printDebug "addToCorpusWithForm" x
283 in New.addToCorpusWithForm user cid i log'')
285 addCorpusWithFile :: User -> GargServer New.AddWithFile
286 addCorpusWithFile user cid =
288 JobFunction (\i log' ->
291 printDebug "addToCorpusWithFile" x
293 in New.addToCorpusWithFile user cid i log'')
295 addAnnuaireWithForm :: GargServer Annuaire.AddWithForm
296 addAnnuaireWithForm cid =
298 JobFunction (\i log' -> Annuaire.addToAnnuaireWithForm cid i (liftBase . log'))