]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API.hs
[Database] Cosmetics.
[gargantext.git] / src / Gargantext / API.hs
1 {-|
2 Module : Gargantext.API
3 Description : REST API declaration
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
8 Portability : POSIX
9
10 Main REST API of Gargantext (both Server and Client sides)
11
12 TODO App type, the main monad in which the bot code is written with.
13
14 Provide config, state, logs and IO
15 type App m a = ( MonadState AppState m
16 , MonadReader Conf m
17 , MonadLog (WithSeverity Doc) m
18 , MonadIO m) => m a
19 Thanks @yannEsposito for this.
20 -}
21
22 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
23
24 {-# LANGUAGE NoImplicitPrelude #-}
25 {-# LANGUAGE DataKinds #-}
26 {-# LANGUAGE DeriveGeneric #-}
27 {-# LANGUAGE FlexibleContexts #-}
28 {-# LANGUAGE FlexibleInstances #-}
29 {-# LANGUAGE OverloadedStrings #-}
30 {-# LANGUAGE TemplateHaskell #-}
31 {-# LANGUAGE TypeOperators #-}
32 {-# LANGUAGE KindSignatures #-}
33 {-# LANGUAGE TypeFamilies #-}
34 {-# LANGUAGE UndecidableInstances #-}
35
36 ---------------------------------------------------------------------
37 module Gargantext.API
38 where
39 ---------------------------------------------------------------------
40
41 import System.IO (FilePath)
42
43 import GHC.Generics (D1, Meta (..), Rep)
44 import GHC.TypeLits (AppendSymbol, Symbol)
45
46 import Control.Lens
47 import Control.Monad.IO.Class (liftIO)
48 import Control.Monad.Reader (runReaderT)
49 import Data.Aeson.Encode.Pretty (encodePretty)
50 import qualified Data.ByteString.Lazy.Char8 as BL8
51 import Data.Swagger
52 import Data.Text (Text)
53 import qualified Data.Text.IO as T
54 --import qualified Data.Set as Set
55
56 import Network.Wai
57 import Network.Wai.Handler.Warp hiding (defaultSettings)
58
59 import Servant
60 import Servant.HTML.Blaze (HTML)
61 import Servant.Mock (mock)
62 --import Servant.Job.Server (WithCallbacks)
63 import Servant.Static.TH.Internal.Server (fileTreeToServer)
64 import Servant.Static.TH.Internal.FileTree (fileTypeToFileTree, FileType(FileTypeFile))
65 import Servant.Swagger
66 import Servant.Swagger.UI
67 -- import Servant.API.Stream
68 import Text.Blaze.Html (Html)
69
70 --import Gargantext.API.Swagger
71 import Gargantext.Prelude
72 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
73
74 import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
75 import Gargantext.API.Node ( GargServer
76 , Roots , roots
77 , NodeAPI , nodeAPI
78 , NodesAPI , nodesAPI
79 , GraphAPI , graphAPI
80 , TreeAPI , treeAPI
81 , HyperdataAny
82 , HyperdataCorpus
83 , HyperdataAnnuaire
84 )
85 --import Gargantext.Database.Node.Contact (HyperdataContact)
86 import Gargantext.Database.Types.Node ()
87 import Gargantext.API.Count ( CountAPI, count, Query)
88 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
89 import Gargantext.Database.Facet
90
91 --import Gargantext.API.Orchestrator
92 --import Gargantext.API.Orchestrator.Types
93
94 ---------------------------------------------------------------------
95
96 import GHC.Base (Applicative)
97 -- import Control.Lens
98
99 import Data.List (lookup)
100 import Data.Text.Encoding (encodeUtf8)
101
102 --import Network.Wai (Request, requestHeaders, responseLBS)
103 import Network.Wai (Request, requestHeaders)
104 --import qualified Network.Wai.Handler.Warp as Warp
105 import Network.Wai.Middleware.Cors
106
107 import Network.Wai.Middleware.RequestLogger
108 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
109
110 import Network.HTTP.Types hiding (Query)
111
112
113 import Gargantext.API.Settings
114
115 fireWall :: Applicative f => Request -> FireWall -> f Bool
116 fireWall req fw = do
117 let origin = lookup "Origin" (requestHeaders req)
118 let host = lookup "Host" (requestHeaders req)
119
120 let hostOk = Just (encodeUtf8 "localhost:3000")
121 let originOk = Just (encodeUtf8 "http://localhost:8008")
122
123 if origin == originOk
124 && host == hostOk
125 || (not $ unFireWall fw)
126
127 then pure True
128 else pure False
129
130
131 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
132 makeMockApp :: MockEnv -> IO Application
133 makeMockApp env = do
134 let serverApp = appMock
135
136 -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
137 --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
138 let checkOriginAndHost app req resp = do
139 blocking <- fireWall req (env ^. menv_firewall)
140 case blocking of
141 True -> app req resp
142 False -> resp ( responseLBS status401 []
143 "Invalid Origin or Host header")
144
145 let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
146 -- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
147 { corsOrigins = Nothing -- == /*
148 , corsMethods = [ methodGet , methodPost , methodPut
149 , methodDelete, methodOptions, methodHead]
150 , corsRequestHeaders = ["authorization", "content-type"]
151 , corsExposedHeaders = Nothing
152 , corsMaxAge = Just ( 60*60*24 ) -- one day
153 , corsVaryOrigin = False
154 , corsRequireOrigin = False
155 , corsIgnoreFailures = False
156 }
157
158 --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
159 -- $ Warp.defaultSettings
160
161 --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
162 pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
163
164
165
166 makeDevApp :: Env -> IO Application
167 makeDevApp env = do
168 serverApp <- makeApp env
169
170 -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
171 --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
172 -- let checkOriginAndHost app req resp = do
173 -- blocking <- fireWall req (env ^. menv_firewall)
174 -- case blocking of
175 -- True -> app req resp
176 -- False -> resp ( responseLBS status401 []
177 -- "Invalid Origin or Host header")
178 --
179 let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
180 -- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
181 { corsOrigins = Nothing -- == /*
182 , corsMethods = [ methodGet , methodPost , methodPut
183 , methodDelete, methodOptions, methodHead]
184 , corsRequestHeaders = ["authorization", "content-type"]
185 , corsExposedHeaders = Nothing
186 , corsMaxAge = Just ( 60*60*24 ) -- one day
187 , corsVaryOrigin = False
188 , corsRequireOrigin = False
189 , corsIgnoreFailures = False
190 }
191
192 --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
193 -- $ Warp.defaultSettings
194
195 --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
196 pure $ logStdoutDev $ corsMiddleware $ serverApp
197
198 ---------------------------------------------------------------------
199 -- | API Global
200
201 -- | API for serving @swagger.json@
202 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
203
204 -- | API for serving main operational routes of @gargantext.org@
205
206
207 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
208 -- | TODO :<|> Summary "Latest API" :> GargAPI'
209
210
211 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
212
213 type GargAPI' =
214 -- Auth endpoint
215 "auth" :> Summary "AUTH API"
216 :> ReqBody '[JSON] AuthRequest
217 :> Post '[JSON] AuthResponse
218
219 -- Roots endpoint
220 :<|> "user" :> Summary "First user endpoint"
221 :> Roots
222
223 -- Node endpoint
224 :<|> "node" :> Summary "Node endpoint"
225 :> Capture "id" Int :> NodeAPI HyperdataAny
226
227 -- Corpus endpoint
228 :<|> "corpus":> Summary "Corpus endpoint"
229 :> Capture "id" Int :> NodeAPI HyperdataCorpus
230
231 -- Annuaire endpoint
232 :<|> "annuaire":> Summary "Annuaire endpoint"
233 :> Capture "id" Int :> NodeAPI HyperdataAnnuaire
234
235 -- Corpus endpoint
236 :<|> "nodes" :> Summary "Nodes endpoint"
237 :> ReqBody '[JSON] [Int] :> NodesAPI
238
239 -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
240 -- Corpus endpoint
241 :<|> "count" :> Summary "Count endpoint"
242 :> ReqBody '[JSON] Query :> CountAPI
243
244 -- Corpus endpoint
245 :<|> "search":> Summary "Search endpoint"
246 :> ReqBody '[JSON] SearchQuery
247 :> QueryParam "offset" Int
248 :> QueryParam "limit" Int
249 :> QueryParam "order" OrderBy
250 :> SearchAPI
251
252 :<|> "graph" :> Summary "Graph endpoint"
253 :> Capture "id" Int :> GraphAPI
254
255 -- Tree endpoint
256 :<|> "tree" :> Summary "Tree endpoint"
257 :> Capture "id" Int :> TreeAPI
258
259
260 -- :<|> "scraper" :> WithCallbacks ScraperAPI
261
262 -- /mv/<id>/<id>
263 -- /merge/<id>/<id>
264 -- /rename/<id>
265 -- :<|> "static"
266 -- :<|> "list" :> Capture "id" Int :> NodeAPI
267 -- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
268 -- :<|> "auth" :> Capture "id" Int :> NodeAPI
269 ---------------------------------------------------------------------
270 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
271
272 type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
273
274 ---------------------------------------------------------------------
275 -- | Server declarations
276
277 server :: Env -> IO (Server API)
278 server env = do
279 -- orchestrator <- scrapyOrchestrator env
280 pure $ swaggerFront
281 :<|> hoistServer (Proxy :: Proxy GargAPI) (`runReaderT` env) serverGargAPI
282 :<|> serverIndex
283
284 serverGargAPI :: GargServer GargAPI
285 serverGargAPI -- orchestrator
286 = auth
287 :<|> roots
288 :<|> nodeAPI (Proxy :: Proxy HyperdataAny)
289 :<|> nodeAPI (Proxy :: Proxy HyperdataCorpus)
290 :<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire)
291 :<|> nodesAPI
292 :<|> count -- TODO: undefined
293 :<|> search
294 :<|> graphAPI -- TODO: mock
295 :<|> treeAPI
296 -- :<|> orchestrator
297
298 serverIndex :: Server (Get '[HTML] Html)
299 serverIndex = $(do (Just s) <- liftIO (fileTypeToFileTree (FileTypeFile "purescript-gargantext/dist/index.html"))
300 fileTreeToServer s)
301
302 ---------------------------------------------------------------------
303 swaggerFront :: Server SwaggerFrontAPI
304 swaggerFront = schemaUiServer swaggerDoc
305 :<|> frontEndServer
306
307 gargMock :: Server GargAPI
308 gargMock = mock apiGarg Proxy
309
310 ---------------------------------------------------------------------
311 makeApp :: Env -> IO Application
312 makeApp = fmap (serve api) . server
313
314 appMock :: Application
315 appMock = serve api (swaggerFront :<|> gargMock :<|> serverIndex)
316
317 ---------------------------------------------------------------------
318 api :: Proxy API
319 api = Proxy
320
321 apiGarg :: Proxy GargAPI
322 apiGarg = Proxy
323 ---------------------------------------------------------------------
324
325 schemaUiServer :: (Server api ~ Handler Swagger)
326 => Swagger -> Server (SwaggerSchemaUI' dir api)
327 schemaUiServer = swaggerSchemaUIServer
328
329
330 -- Type Family for the Documentation
331 type family TypeName (x :: *) :: Symbol where
332 TypeName Int = "Int"
333 TypeName Text = "Text"
334 TypeName x = GenericTypeName x (Rep x ())
335
336 type family GenericTypeName t (r :: *) :: Symbol where
337 GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
338
339 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
340
341
342 -- | Swagger Specifications
343 swaggerDoc :: Swagger
344 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
345 & info.title .~ "Gargantext"
346 & info.version .~ "4.0.2" -- TODO same version as Gargantext
347 -- & info.base_url ?~ (URL "http://gargantext.org/")
348 & info.description ?~ "REST API specifications"
349 -- & tags .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
350 & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
351 ["Gargantext" & description ?~ "Main operations"]
352 & info.license ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
353 where
354 urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
355
356 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
357 swaggerWriteJSON :: IO ()
358 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
359
360 portRouteInfo :: PortNumber -> IO ()
361 portRouteInfo port = do
362 T.putStrLn " ----Main Routes----- "
363 T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
364 T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
365
366 -- | startGargantext takes as parameters port number and Ini file.
367 startGargantext :: PortNumber -> FilePath -> IO ()
368 startGargantext port file = do
369 env <- newEnv port file
370 portRouteInfo port
371 app <- makeDevApp env
372 run port app
373
374 startGargantextMock :: PortNumber -> IO ()
375 startGargantextMock port = do
376 portRouteInfo port
377 application <- makeMockApp . MockEnv $ FireWall False
378 run port application
379