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