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