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 #-}
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 #-}
36 ---------------------------------------------------------------------
39 ---------------------------------------------------------------------
40 import Gargantext.Prelude
42 import System.IO (FilePath)
44 import GHC.Generics (D1, Meta (..), Rep)
45 import GHC.TypeLits (AppendSymbol, Symbol)
48 import Data.Aeson (Value)
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.Mock (mock)
61 --import Servant.Job.Server (WithCallbacks)
62 import Servant.Swagger
63 import Servant.Swagger.UI
64 -- import Servant.API.Stream
66 --import Gargantext.API.Swagger
67 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
69 import Gargantext.API.Node ( Roots , roots
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
82 ---------------------------------------------------------------------
84 import GHC.Base (Applicative)
85 -- import Control.Lens
87 import Data.List (lookup)
88 import Data.Text.Encoding (encodeUtf8)
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
95 import Network.Wai.Middleware.RequestLogger
96 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
98 import Network.HTTP.Types hiding (Query)
101 import Gargantext.API.Settings
103 fireWall :: Applicative f => Request -> FireWall -> f Bool
105 let origin = lookup "Origin" (requestHeaders req)
106 let host = lookup "Host" (requestHeaders req)
108 let hostOk = Just (encodeUtf8 "localhost:3000")
109 let originOk = Just (encodeUtf8 "http://localhost:8008")
111 if origin == originOk
113 || (not $ unFireWall fw)
119 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
120 makeMockApp :: MockEnv -> IO Application
122 let serverApp = appMock
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)
130 False -> resp ( responseLBS status401 []
131 "Invalid Origin or Host header")
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
146 --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
147 -- $ Warp.defaultSettings
149 --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
150 pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
154 makeDevApp :: Env -> IO Application
156 serverApp <- makeApp env
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)
163 -- True -> app req resp
164 -- False -> resp ( responseLBS status401 []
165 -- "Invalid Origin or Host header")
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
180 --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
181 -- $ Warp.defaultSettings
183 --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
184 pure $ logStdoutDev $ corsMiddleware $ serverApp
188 ---------------------------------------------------------------------
191 -- | API for serving @swagger.json@
192 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
194 -- | API for serving main operational routes of @gargantext.org@
197 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
198 -- | TODO :<|> Summary "Latest API" :> GargAPI'
201 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
206 "user" :> Summary "First user endpoint"
210 :<|> "node" :> Summary "Node endpoint"
211 :> Capture "id" Int :> NodeAPI Value
214 :<|> "corpus":> Summary "Corpus endpoint"
215 :> Capture "id" Int :> NodeAPI HyperdataCorpus
218 :<|> "nodes" :> Summary "Nodes endpoint"
219 :> ReqBody '[JSON] [Int] :> NodesAPI
221 -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
223 :<|> "count" :> Summary "Count endpoint"
224 :> ReqBody '[JSON] Query :> CountAPI
227 :<|> "search":> Summary "Search endpoint"
228 :> ReqBody '[JSON] SearchQuery :> SearchAPI
230 :<|> "graph" :> Summary "Graph endpoint"
231 :> Capture "id" Int :> GraphAPI
234 :<|> "tree" :> Summary "Tree endpoint"
235 :> Capture "id" Int :> TreeAPI
238 -- :<|> "scraper" :> WithCallbacks ScraperAPI
244 -- :<|> "list" :> Capture "id" Int :> NodeAPI
245 -- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
246 -- :<|> "auth" :> Capture "id" Int :> NodeAPI
247 ---------------------------------------------------------------------
248 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
250 type API = SwaggerFrontAPI :<|> GargAPI
252 ---------------------------------------------------------------------
253 -- | Server declaration
254 server :: Env -> IO (Server API)
256 -- orchestrator <- scrapyOrchestrator env
259 :<|> nodeAPI conn (Proxy :: Proxy Value)
260 :<|> nodeAPI conn (Proxy :: Proxy HyperdataCorpus)
262 :<|> count -- TODO: undefined
264 :<|> graphAPI conn -- TODO: mock
268 conn = env ^. env_conn
270 ---------------------------------------------------------------------
271 swaggerFront :: Server SwaggerFrontAPI
272 swaggerFront = schemaUiServer swaggerDoc
275 gargMock :: Server GargAPI
276 gargMock = mock apiGarg Proxy
278 ---------------------------------------------------------------------
279 makeApp :: Env -> IO Application
280 makeApp = fmap (serve api) . server
282 appMock :: Application
283 appMock = serve api (swaggerFront :<|> gargMock)
285 ---------------------------------------------------------------------
289 apiGarg :: Proxy GargAPI
291 ---------------------------------------------------------------------
293 schemaUiServer :: (Server api ~ Handler Swagger)
294 => Swagger -> Server (SwaggerSchemaUI' dir api)
295 schemaUiServer = swaggerSchemaUIServer
298 -- Type Family for the Documentation
299 type family TypeName (x :: *) :: Symbol where
301 TypeName Text = "Text"
302 TypeName x = GenericTypeName x (Rep x ())
304 type family GenericTypeName t (r :: *) :: Symbol where
305 GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
307 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
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 )
322 urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
324 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
325 swaggerWriteJSON :: IO ()
326 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
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"
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
339 app <- makeDevApp env
342 startGargantextMock :: PortNumber -> IO ()
343 startGargantextMock port = do
345 application <- makeMockApp . MockEnv $ FireWall False