]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API.hs
[CLEAN] useless extensions
[gargantext.git] / src / Gargantext / API.hs
1 {-|
2 Module : Gargantext.API
3 Description : Server API
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 Provide config, state, logs and IO
14 type App m a = ( MonadState AppState m
15 , MonadReader Conf m
16 , MonadLog (WithSeverity Doc) m
17 , MonadIO m) => m a
18 Thanks @yannEsposito for this.
19 -}
20
21 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
22
23 {-# LANGUAGE DataKinds #-}
24 {-# LANGUAGE DeriveGeneric #-}
25 {-# LANGUAGE FlexibleInstances #-}
26 {-# LANGUAGE OverloadedStrings #-}
27 {-# LANGUAGE TemplateHaskell #-}
28 {-# LANGUAGE TypeOperators #-}
29 {-# LANGUAGE KindSignatures #-}
30 {-# LANGUAGE TypeFamilies #-}
31 {-# LANGUAGE UndecidableInstances #-}
32
33 ---------------------------------------------------------------------
34 module Gargantext.API
35 where
36 ---------------------------------------------------------------------
37 import Gargantext.Prelude
38
39 import System.IO (FilePath, print)
40
41 import GHC.Generics (D1, Meta (..), Rep)
42 import GHC.TypeLits (AppendSymbol, Symbol)
43
44 import Control.Lens
45 import Data.Aeson.Encode.Pretty (encodePretty)
46 import qualified Data.ByteString.Lazy.Char8 as BL8
47 import Data.Swagger
48 import Data.Text (Text, pack)
49 --import qualified Data.Set as Set
50
51 import Database.PostgreSQL.Simple (Connection, connect)
52
53 import Network.Wai
54 import Network.Wai.Handler.Warp
55
56 import Servant
57 import Servant.Mock (mock)
58 import Servant.Swagger
59 import Servant.Swagger.UI
60 -- import Servant.API.Stream
61
62 --import Gargantext.API.Swagger
63 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
64
65 import Gargantext.API.Node ( Roots , roots
66 , NodeAPI , nodeAPI
67 , NodesAPI , nodesAPI
68 )
69 import Gargantext.API.Count ( CountAPI, count, Query)
70 import Gargantext.Database.Utils (databaseParameters)
71
72 ---------------------------------------------------------------------
73
74 import GHC.Base (Applicative)
75 -- import Control.Lens
76
77 import Data.List (lookup)
78 import Data.Text.Encoding (encodeUtf8)
79
80 --import Network.Wai (Request, requestHeaders, responseLBS)
81 import Network.Wai (Request, requestHeaders)
82 --import qualified Network.Wai.Handler.Warp as Warp
83 import Network.Wai.Middleware.Cors
84
85 import Network.Wai.Middleware.RequestLogger
86 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
87
88 import Network.HTTP.Types hiding (Query)
89
90
91 -- import Gargantext.API.Settings
92
93 data FireWall = FireWall { unFireWall :: Bool }
94
95 fireWall :: Applicative f => Request -> FireWall -> f Bool
96 fireWall req fw = do
97 let origin = lookup "Origin" (requestHeaders req)
98 let host = lookup "Host" (requestHeaders req)
99
100 let hostOk = Just (encodeUtf8 "localhost:3000")
101 let originOk = Just (encodeUtf8 "http://localhost:8008")
102
103 if origin == originOk
104 && host == hostOk
105 || (not $ unFireWall fw)
106
107 then pure True
108 else pure False
109
110
111 -- makeApp :: Env -> IO (Warp.Settings, Application)
112 makeApp :: FireWall -> IO Application
113 makeApp fw = do
114 let serverApp = appMock
115
116 -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
117 --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
118 let checkOriginAndHost app req resp = do
119 blocking <- fireWall req fw
120 case blocking of
121 True -> app req resp
122 False -> resp ( responseLBS status401 []
123 "Invalid Origin or Host header")
124
125 let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
126 -- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
127 { corsOrigins = Nothing -- == /*
128 , corsMethods = [ methodGet , methodPost , methodPut
129 , methodDelete, methodOptions, methodHead]
130 , corsRequestHeaders = ["authorization", "content-type"]
131 , corsExposedHeaders = Nothing
132 , corsMaxAge = Just ( 60*60*24 ) -- one day
133 , corsVaryOrigin = False
134 , corsRequireOrigin = False
135 , corsIgnoreFailures = False
136 }
137
138 --let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
139 -- $ Warp.defaultSettings
140
141 --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
142 pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
143
144
145 ---------------------------------------------------------------------
146 type PortNumber = Int
147 ---------------------------------------------------------------------
148 -- | API Global
149
150 -- | API for serving @swagger.json@
151 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
152
153 -- | API for serving main operational routes of @gargantext.org@
154 type GargAPI = "user" :> Summary "First user endpoint"
155 :> Roots
156
157 :<|> "node" :> Summary "Node endpoint"
158 :> Capture "id" Int :> NodeAPI
159
160 :<|> "corpus":> Summary "Corpus endpoint"
161 :> Capture "id" Int :> NodeAPI
162
163 :<|> "nodes" :> Summary "Nodes endpoint"
164 :> ReqBody '[JSON] [Int] :> NodesAPI
165
166 -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
167 :<|> "count" :> Summary "Count endpoint"
168 :> ReqBody '[JSON] Query :> CountAPI
169
170 -- /mv/<id>/<id>
171 -- /merge/<id>/<id>
172 -- /rename/<id>
173 -- :<|> "static"
174 -- :<|> "list" :> Capture "id" Int :> NodeAPI
175 -- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
176 -- :<|> "auth" :> Capture "id" Int :> NodeAPI
177 ---------------------------------------------------------------------
178 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
179
180 type API = SwaggerFrontAPI :<|> GargAPI
181
182 ---------------------------------------------------------------------
183 -- | Server declaration
184 server :: Connection -> Server API
185 server conn = swaggerFront
186 :<|> roots conn
187 :<|> nodeAPI conn
188 :<|> nodeAPI conn
189 :<|> nodesAPI conn
190 :<|> count
191
192 ---------------------------------------------------------------------
193 swaggerFront :: Server SwaggerFrontAPI
194 swaggerFront = schemaUiServer swaggerDoc
195 :<|> frontEndServer
196
197 gargMock :: Server GargAPI
198 gargMock = mock apiGarg Proxy
199
200 ---------------------------------------------------------------------
201 app :: Connection -> Application
202 app = serve api . server
203
204 appMock :: Application
205 appMock = serve api (swaggerFront :<|> gargMock)
206
207 ---------------------------------------------------------------------
208 api :: Proxy API
209 api = Proxy
210
211 apiGarg :: Proxy GargAPI
212 apiGarg = Proxy
213 ---------------------------------------------------------------------
214
215 schemaUiServer :: (Server api ~ Handler Swagger)
216 => Swagger -> Server (SwaggerSchemaUI' dir api)
217 schemaUiServer = swaggerSchemaUIServer
218
219
220 -- Type Familiy for the Documentation
221 type family TypeName (x :: *) :: Symbol where
222 TypeName Int = "Int"
223 TypeName Text = "Text"
224 TypeName x = GenericTypeName x (Rep x ())
225
226 type family GenericTypeName t (r :: *) :: Symbol where
227 GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
228
229 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
230
231
232 -- | Swagger Specifications
233 swaggerDoc :: Swagger
234 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
235 & info.title .~ "Gargantext"
236 & info.version .~ "0.1.0"
237 -- & info.base_url ?~ (URL "http://gargantext.org/")
238 & info.description ?~ "REST API specifications"
239 -- & tags .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
240 & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
241 ["Garg" & description ?~ "Main operations"]
242 & info.license ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
243 where
244 urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
245
246 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
247 swaggerWriteJSON :: IO ()
248 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
249
250 portRouteInfo :: PortNumber -> IO ()
251 portRouteInfo port = do
252 print (pack " ----Main Routes----- ")
253 print ("http://localhost:" <> show port <> "/index.html")
254 print ("http://localhost:" <> show port <> "/swagger-ui")
255
256 -- | startGargantext takes as parameters port number and Ini file.
257 startGargantext :: PortNumber -> FilePath -> IO ()
258 startGargantext port file = do
259
260 param <- databaseParameters file
261 conn <- connect param
262
263 portRouteInfo port
264 run port (app conn)
265
266 startGargantextMock :: PortNumber -> IO ()
267 startGargantextMock port = do
268 portRouteInfo port
269
270 application <- makeApp (FireWall False)
271
272 run port application
273