]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API.hs
[FIX] refactor nodeApi.
[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
25 {-# LANGUAGE NoImplicitPrelude #-}
26 {-# LANGUAGE DataKinds #-}
27 {-# LANGUAGE DeriveGeneric #-}
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 import Gargantext.Prelude
41
42 import System.IO (FilePath)
43
44 import GHC.Generics (D1, Meta (..), Rep)
45 import GHC.TypeLits (AppendSymbol, Symbol)
46
47 import Control.Lens
48 import Data.Aeson (Value)
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.Mock (mock)
61 --import Servant.Job.Server (WithCallbacks)
62 import Servant.Swagger
63 import Servant.Swagger.UI
64 -- import Servant.API.Stream
65
66 --import Gargantext.API.Swagger
67 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
68
69 import Gargantext.API.Node ( Roots , roots
70 , NodeAPI , nodeAPI
71 , NodesAPI , nodesAPI
72 , GraphAPI , graphAPI
73 , TreeAPI , treeAPI
74 , HyperdataCorpus
75 )
76 import Gargantext.Database.Types.Node ()
77 import Gargantext.API.Count ( CountAPI, count, Query)
78 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
79 --import Gargantext.API.Orchestrator
80 --import Gargantext.API.Orchestrator.Types
81
82 ---------------------------------------------------------------------
83
84 import GHC.Base (Applicative)
85 -- import Control.Lens
86
87 import Data.List (lookup)
88 import Data.Text.Encoding (encodeUtf8)
89
90 --import Network.Wai (Request, requestHeaders, responseLBS)
91 import Network.Wai (Request, requestHeaders)
92 --import qualified Network.Wai.Handler.Warp as Warp
93 import Network.Wai.Middleware.Cors
94
95 import Network.Wai.Middleware.RequestLogger
96 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
97
98 import Network.HTTP.Types hiding (Query)
99
100
101 import Gargantext.API.Settings
102
103 fireWall :: Applicative f => Request -> FireWall -> f Bool
104 fireWall req fw = do
105 let origin = lookup "Origin" (requestHeaders req)
106 let host = lookup "Host" (requestHeaders req)
107
108 let hostOk = Just (encodeUtf8 "localhost:3000")
109 let originOk = Just (encodeUtf8 "http://localhost:8008")
110
111 if origin == originOk
112 && host == hostOk
113 || (not $ unFireWall fw)
114
115 then pure True
116 else pure False
117
118
119 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
120 makeMockApp :: MockEnv -> IO Application
121 makeMockApp env = do
122 let serverApp = appMock
123
124 -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
125 --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
126 let checkOriginAndHost app req resp = do
127 blocking <- fireWall req (env ^. menv_firewall)
128 case blocking of
129 True -> app req resp
130 False -> resp ( responseLBS status401 []
131 "Invalid Origin or Host header")
132
133 let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
134 -- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
135 { corsOrigins = Nothing -- == /*
136 , corsMethods = [ methodGet , methodPost , methodPut
137 , methodDelete, methodOptions, methodHead]
138 , corsRequestHeaders = ["authorization", "content-type"]
139 , corsExposedHeaders = Nothing
140 , corsMaxAge = Just ( 60*60*24 ) -- one day
141 , corsVaryOrigin = False
142 , corsRequireOrigin = False
143 , corsIgnoreFailures = False
144 }
145
146 --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
147 -- $ Warp.defaultSettings
148
149 --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
150 pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
151
152
153 --
154 makeDevApp :: Env -> IO Application
155 makeDevApp env = do
156 serverApp <- makeApp env
157
158 -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
159 --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
160 -- let checkOriginAndHost app req resp = do
161 -- blocking <- fireWall req (env ^. menv_firewall)
162 -- case blocking of
163 -- True -> app req resp
164 -- False -> resp ( responseLBS status401 []
165 -- "Invalid Origin or Host header")
166 --
167 let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
168 -- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
169 { corsOrigins = Nothing -- == /*
170 , corsMethods = [ methodGet , methodPost , methodPut
171 , methodDelete, methodOptions, methodHead]
172 , corsRequestHeaders = ["authorization", "content-type"]
173 , corsExposedHeaders = Nothing
174 , corsMaxAge = Just ( 60*60*24 ) -- one day
175 , corsVaryOrigin = False
176 , corsRequireOrigin = False
177 , corsIgnoreFailures = False
178 }
179
180 --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
181 -- $ Warp.defaultSettings
182
183 --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
184 pure $ logStdoutDev $ corsMiddleware $ serverApp
185
186 --
187
188 ---------------------------------------------------------------------
189 -- | API Global
190
191 -- | API for serving @swagger.json@
192 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
193
194 -- | API for serving main operational routes of @gargantext.org@
195
196
197 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
198 -- | TODO :<|> Summary "Latest API" :> GargAPI'
199
200
201 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
202
203 type GargAPI' =
204
205 -- Roots endpoint
206 "user" :> Summary "First user endpoint"
207 :> Roots
208
209 -- Node endpoint
210 :<|> "node" :> Summary "Node endpoint"
211 :> Capture "id" Int :> NodeAPI Value
212
213 -- Corpus endpoint
214 :<|> "corpus":> Summary "Corpus endpoint"
215 :> Capture "id" Int :> NodeAPI HyperdataCorpus
216
217 -- Corpus endpoint
218 :<|> "nodes" :> Summary "Nodes endpoint"
219 :> ReqBody '[JSON] [Int] :> NodesAPI
220
221 -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
222 -- Corpus endpoint
223 :<|> "count" :> Summary "Count endpoint"
224 :> ReqBody '[JSON] Query :> CountAPI
225
226 -- Corpus endpoint
227 :<|> "search":> Summary "Search endpoint"
228 :> ReqBody '[JSON] SearchQuery :> SearchAPI
229
230 :<|> "graph" :> Summary "Graph endpoint"
231 :> Capture "id" Int :> GraphAPI
232
233 -- Tree endpoint
234 :<|> "tree" :> Summary "Tree endpoint"
235 :> Capture "id" Int :> TreeAPI
236
237
238 -- :<|> "scraper" :> WithCallbacks ScraperAPI
239
240 -- /mv/<id>/<id>
241 -- /merge/<id>/<id>
242 -- /rename/<id>
243 -- :<|> "static"
244 -- :<|> "list" :> Capture "id" Int :> NodeAPI
245 -- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
246 -- :<|> "auth" :> Capture "id" Int :> NodeAPI
247 ---------------------------------------------------------------------
248 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
249
250 type API = SwaggerFrontAPI :<|> GargAPI
251
252 ---------------------------------------------------------------------
253 -- | Server declaration
254 server :: Env -> IO (Server API)
255 server env = do
256 -- orchestrator <- scrapyOrchestrator env
257 pure $ swaggerFront
258 :<|> roots conn
259 :<|> nodeAPI conn (Proxy :: Proxy Value)
260 :<|> nodeAPI conn (Proxy :: Proxy HyperdataCorpus)
261 :<|> nodesAPI conn
262 :<|> count -- TODO: undefined
263 :<|> search conn
264 :<|> graphAPI conn -- TODO: mock
265 :<|> treeAPI conn
266 -- :<|> orchestrator
267 where
268 conn = env ^. env_conn
269
270 ---------------------------------------------------------------------
271 swaggerFront :: Server SwaggerFrontAPI
272 swaggerFront = schemaUiServer swaggerDoc
273 :<|> frontEndServer
274
275 gargMock :: Server GargAPI
276 gargMock = mock apiGarg Proxy
277
278 ---------------------------------------------------------------------
279 makeApp :: Env -> IO Application
280 makeApp = fmap (serve api) . server
281
282 appMock :: Application
283 appMock = serve api (swaggerFront :<|> gargMock)
284
285 ---------------------------------------------------------------------
286 api :: Proxy API
287 api = Proxy
288
289 apiGarg :: Proxy GargAPI
290 apiGarg = Proxy
291 ---------------------------------------------------------------------
292
293 schemaUiServer :: (Server api ~ Handler Swagger)
294 => Swagger -> Server (SwaggerSchemaUI' dir api)
295 schemaUiServer = swaggerSchemaUIServer
296
297
298 -- Type Family for the Documentation
299 type family TypeName (x :: *) :: Symbol where
300 TypeName Int = "Int"
301 TypeName Text = "Text"
302 TypeName x = GenericTypeName x (Rep x ())
303
304 type family GenericTypeName t (r :: *) :: Symbol where
305 GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
306
307 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
308
309
310 -- | Swagger Specifications
311 swaggerDoc :: Swagger
312 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
313 & info.title .~ "Gargantext"
314 & info.version .~ "0.1.0"
315 -- & info.base_url ?~ (URL "http://gargantext.org/")
316 & info.description ?~ "REST API specifications"
317 -- & tags .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
318 & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
319 ["Gargantext" & description ?~ "Main operations"]
320 & info.license ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
321 where
322 urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
323
324 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
325 swaggerWriteJSON :: IO ()
326 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
327
328 portRouteInfo :: PortNumber -> IO ()
329 portRouteInfo port = do
330 T.putStrLn " ----Main Routes----- "
331 T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
332 T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
333
334 -- | startGargantext takes as parameters port number and Ini file.
335 startGargantext :: PortNumber -> FilePath -> IO ()
336 startGargantext port file = do
337 env <- newEnv port file
338 portRouteInfo port
339 app <- makeDevApp env
340 run port app
341
342 startGargantextMock :: PortNumber -> IO ()
343 startGargantextMock port = do
344 portRouteInfo port
345 application <- makeMockApp . MockEnv $ FireWall False
346 run port application
347