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