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(..))
  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) => env
 282        -> IO (Server API)
 283 server env = do
 284   -- orchestrator <- scrapyOrchestrator env
 285   pure $  swaggerFront
 286      :<|> hoistServer (Proxy :: Proxy GargAPI) (`runReaderT` env) serverGargAPI
 287      :<|> serverIndex
 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 serverIndex :: Server (Get '[HTML] Html)
 306 serverIndex = $(do (Just s) <- liftIO (fileTypeToFileTree (FileTypeFile "purescript-gargantext/dist/index.html"))
 307                    fileTreeToServer s)
 308
 309 ---------------------------------------------------------------------
 310 swaggerFront :: Server SwaggerFrontAPI
 311 swaggerFront = schemaUiServer swaggerDoc
 312            :<|> frontEndServer
 313
 314 gargMock :: Server GargAPI
 315 gargMock = mock apiGarg Proxy
 316
 317 ---------------------------------------------------------------------
 318 makeApp :: (HasConnection env, HasRepoVar env) => env -> IO Application
 319 makeApp = fmap (serve api) . server
 320
 321 appMock :: Application
 322 appMock = serve api (swaggerFront :<|> gargMock :<|> serverIndex)
 323
 324 ---------------------------------------------------------------------
 325 api :: Proxy API
 326 api  = Proxy
 327
 328 apiGarg :: Proxy GargAPI
 329 apiGarg  = Proxy
 330 ---------------------------------------------------------------------
 331
 332 schemaUiServer :: (Server api ~ Handler Swagger)
 333         => Swagger -> Server (SwaggerSchemaUI' dir api)
 334 schemaUiServer = swaggerSchemaUIServer
 335
 336
 337 -- Type Family for the Documentation
 338 type family TypeName (x :: *) :: Symbol where
 339     TypeName Int  = "Int"
 340     TypeName Text = "Text"
 341     TypeName x    = GenericTypeName x (Rep x ())
 342
 343 type family GenericTypeName t (r :: *) :: Symbol where
 344     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 345
 346 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 347
 348
 349 -- | Swagger Specifications
 350 swaggerDoc :: Swagger
 351 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 352   & info.title       .~ "Gargantext"
 353   & info.version     .~ "4.0.2" -- TODO same version as Gargantext
 354   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 355   & info.description ?~ "REST API specifications"
 356   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 357   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 358                  ["Gargantext" & description ?~ "Main operations"]
 359   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 360     where
 361         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 362
 363 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 364 swaggerWriteJSON :: IO ()
 365 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 366
 367 portRouteInfo :: PortNumber -> IO ()
 368 portRouteInfo port = do
 369   T.putStrLn "      ----Main Routes-----      "
 370   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 371   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 372
 373 stopGargantext :: HasRepoVar env => env -> IO ()
 374 stopGargantext env = do
 375   T.putStrLn "----- Stopping gargantext -----"
 376   cleanEnv env
 377
 378 -- | startGargantext takes as parameters port number and Ini file.
 379 startGargantext :: PortNumber -> FilePath -> IO ()
 380 startGargantext port file = do
 381   env <- newEnv port file
 382   portRouteInfo port
 383   app <- makeApp env
 384   mid <- makeDevMiddleware
 385   run port (mid app) `finally` stopGargantext env
 386
 387 startGargantextMock :: PortNumber -> IO ()
 388 startGargantextMock port = do
 389   portRouteInfo port
 390   application <- makeMockApp . MockEnv $ FireWall False
 391   run port application
 392