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