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
10 Main REST API of Gargantext (both Server and Client sides)
12 TODO App type, the main monad in which the bot code is written with.
14 Provide config, state, logs and IO
15 type App m a = ( MonadState AppState m
17 , MonadLog (WithSeverity Doc) m
19 Thanks @yannEsposito for this.
22 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
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 #-}
36 ---------------------------------------------------------------------
39 ---------------------------------------------------------------------
41 import System.IO (FilePath)
43 import GHC.Generics (D1, Meta (..), Rep)
44 import GHC.TypeLits (AppendSymbol, Symbol)
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
52 import Data.Text (Text)
53 import qualified Data.Text.IO as T
54 --import qualified Data.Set as Set
57 import Network.Wai.Handler.Warp hiding (defaultSettings)
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)
70 --import Gargantext.API.Swagger
71 import Gargantext.Prelude
72 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
74 import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
75 import Gargantext.API.Node ( GargServer
85 --import Gargantext.Database.Node.Contact (HyperdataContact)
86 import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
87 import Gargantext.API.Count ( CountAPI, count, Query)
88 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
89 import Gargantext.Database.Facet
91 --import Gargantext.API.Orchestrator
92 --import Gargantext.API.Orchestrator.Types
94 ---------------------------------------------------------------------
96 import GHC.Base (Applicative)
97 -- import Control.Lens
99 import Data.List (lookup)
100 import Data.Text.Encoding (encodeUtf8)
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
107 import Network.Wai.Middleware.RequestLogger
108 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
110 import Network.HTTP.Types hiding (Query)
113 import Gargantext.API.Settings
115 fireWall :: Applicative f => Request -> FireWall -> f Bool
117 let origin = lookup "Origin" (requestHeaders req)
118 let host = lookup "Host" (requestHeaders req)
120 let hostOk = Just (encodeUtf8 "localhost:3000")
121 let originOk = Just (encodeUtf8 "http://localhost:8008")
123 if origin == originOk
125 || (not $ unFireWall fw)
131 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
132 makeMockApp :: MockEnv -> IO Application
134 let serverApp = appMock
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)
142 False -> resp ( responseLBS status401 []
143 "Invalid Origin or Host header")
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
158 --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
159 -- $ Warp.defaultSettings
161 --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
162 pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
166 makeDevApp :: Env -> IO Application
168 serverApp <- makeApp env
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)
175 -- True -> app req resp
176 -- False -> resp ( responseLBS status401 []
177 -- "Invalid Origin or Host header")
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
192 --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
193 -- $ Warp.defaultSettings
195 --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
196 pure $ logStdoutDev $ corsMiddleware $ serverApp
198 ---------------------------------------------------------------------
201 -- | API for serving @swagger.json@
202 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
204 -- | API for serving main operational routes of @gargantext.org@
207 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
208 -- | TODO :<|> Summary "Latest API" :> GargAPI'
211 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
215 "auth" :> Summary "AUTH API"
216 :> ReqBody '[JSON] AuthRequest
217 :> Post '[JSON] AuthResponse
220 :<|> "user" :> Summary "First user endpoint"
224 :<|> "node" :> Summary "Node endpoint"
225 :> Capture "id" NodeId :> NodeAPI HyperdataAny
228 :<|> "corpus":> Summary "Corpus endpoint"
229 :> Capture "id" CorpusId :> NodeAPI HyperdataCorpus
232 :<|> "annuaire":> Summary "Annuaire endpoint"
233 :> Capture "id" AnnuaireId :> NodeAPI HyperdataAnnuaire
236 :<|> "nodes" :> Summary "Nodes endpoint"
237 :> ReqBody '[JSON] [NodeId] :> NodesAPI
239 -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
241 :<|> "count" :> Summary "Count endpoint"
242 :> ReqBody '[JSON] Query :> CountAPI
245 :<|> "search":> Summary "Search endpoint"
246 :> ReqBody '[JSON] SearchQuery
247 :> QueryParam "offset" Int
248 :> QueryParam "limit" Int
249 :> QueryParam "order" OrderBy
252 :<|> "graph" :> Summary "Graph endpoint"
253 :> Capture "id" NodeId :> GraphAPI
256 :<|> "tree" :> Summary "Tree endpoint"
257 :> Capture "id" NodeId :> TreeAPI
260 -- :<|> "scraper" :> WithCallbacks ScraperAPI
266 -- :<|> "list" :> Capture "id" Int :> NodeAPI
267 -- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
268 -- :<|> "auth" :> Capture "id" Int :> NodeAPI
269 ---------------------------------------------------------------------
270 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
272 type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
274 ---------------------------------------------------------------------
275 -- | Server declarations
277 server :: Env -> IO (Server API)
279 -- orchestrator <- scrapyOrchestrator env
281 :<|> hoistServer (Proxy :: Proxy GargAPI) (`runReaderT` env) serverGargAPI
284 serverGargAPI :: GargServer GargAPI
285 serverGargAPI -- orchestrator
288 :<|> nodeAPI (Proxy :: Proxy HyperdataAny) fakeUserId
289 :<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) fakeUserId
290 :<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) fakeUserId
292 :<|> count -- TODO: undefined
294 :<|> graphAPI -- TODO: mock
298 fakeUserId = 1 -- TODO
300 serverIndex :: Server (Get '[HTML] Html)
301 serverIndex = $(do (Just s) <- liftIO (fileTypeToFileTree (FileTypeFile "purescript-gargantext/dist/index.html"))
304 ---------------------------------------------------------------------
305 swaggerFront :: Server SwaggerFrontAPI
306 swaggerFront = schemaUiServer swaggerDoc
309 gargMock :: Server GargAPI
310 gargMock = mock apiGarg Proxy
312 ---------------------------------------------------------------------
313 makeApp :: Env -> IO Application
314 makeApp = fmap (serve api) . server
316 appMock :: Application
317 appMock = serve api (swaggerFront :<|> gargMock :<|> serverIndex)
319 ---------------------------------------------------------------------
323 apiGarg :: Proxy GargAPI
325 ---------------------------------------------------------------------
327 schemaUiServer :: (Server api ~ Handler Swagger)
328 => Swagger -> Server (SwaggerSchemaUI' dir api)
329 schemaUiServer = swaggerSchemaUIServer
332 -- Type Family for the Documentation
333 type family TypeName (x :: *) :: Symbol where
335 TypeName Text = "Text"
336 TypeName x = GenericTypeName x (Rep x ())
338 type family GenericTypeName t (r :: *) :: Symbol where
339 GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
341 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
344 -- | Swagger Specifications
345 swaggerDoc :: Swagger
346 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
347 & info.title .~ "Gargantext"
348 & info.version .~ "4.0.2" -- TODO same version as Gargantext
349 -- & info.base_url ?~ (URL "http://gargantext.org/")
350 & info.description ?~ "REST API specifications"
351 -- & tags .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
352 & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
353 ["Gargantext" & description ?~ "Main operations"]
354 & info.license ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
356 urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
358 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
359 swaggerWriteJSON :: IO ()
360 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
362 portRouteInfo :: PortNumber -> IO ()
363 portRouteInfo port = do
364 T.putStrLn " ----Main Routes----- "
365 T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
366 T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
368 -- | startGargantext takes as parameters port number and Ini file.
369 startGargantext :: PortNumber -> FilePath -> IO ()
370 startGargantext port file = do
371 env <- newEnv port file
373 app <- makeDevApp env
376 startGargantextMock :: PortNumber -> IO ()
377 startGargantextMock port = do
379 application <- makeMockApp . MockEnv $ FireWall False