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 (RESTful) API of the instance Gargantext.
  11
  12 The Garg-API is typed to derive the documentation, the mock and tests.
  13
  14 This API is indeed typed in order to be able to derive both the server
  15 and the client sides.
  16
  17 The Garg-API-Monad enables:
  18   - Security (WIP)
  19   - Features (WIP)
  20   - Database connection (long term)
  21   - In Memory stack management (short term)
  22   - Logs (WIP)
  23
  24 Thanks to Yann Esposito for our discussions at the start and to Nicolas
  25 Pouillard (who mainly made it).
  26
  27 -}
  28
  29 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  30
  31 {-# LANGUAGE ConstraintKinds      #-}
  32 {-# LANGUAGE NoImplicitPrelude    #-}
  33 {-# LANGUAGE DataKinds            #-}
  34 {-# LANGUAGE DeriveGeneric        #-}
  35 {-# LANGUAGE FlexibleContexts     #-}
  36 {-# LANGUAGE FlexibleInstances    #-}
  37 {-# LANGUAGE OverloadedStrings    #-}
  38 {-# LANGUAGE TemplateHaskell      #-}
  39 {-# LANGUAGE TypeOperators        #-}
  40 {-# LANGUAGE KindSignatures       #-}
  41 {-# LANGUAGE RankNTypes           #-}
  42 {-# LANGUAGE ScopedTypeVariables  #-}
  43 {-# LANGUAGE TypeFamilies         #-}
  44 {-# LANGUAGE UndecidableInstances #-}
  45
  46 ---------------------------------------------------------------------
  47 module Gargantext.API
  48       where
  49 ---------------------------------------------------------------------
  50
  51 import           System.IO (FilePath)
  52
  53 import           GHC.Generics (D1, Meta (..), Rep)
  54 import           GHC.TypeLits (AppendSymbol, Symbol)
  55
  56 import           Control.Lens
  57 import           Control.Exception (finally)
  58 import           Control.Monad.Except (withExceptT, ExceptT)
  59 import           Control.Monad.IO.Class (liftIO)
  60 import           Control.Monad.Reader (ReaderT, runReaderT)
  61 import           Data.Aeson.Encode.Pretty (encodePretty)
  62 import qualified Data.ByteString.Lazy.Char8 as BL8
  63 import           Data.Swagger
  64 import           Data.Text (Text)
  65 import qualified Data.Text.IO as T
  66 --import qualified Data.Set as Set
  67 import           Data.Validity
  68
  69 import           Network.Wai
  70 import           Network.Wai.Handler.Warp hiding (defaultSettings)
  71
  72 import           Servant
  73 import           Servant.Auth as SA
  74 import           Servant.Auth.Server (AuthResult(..))
  75 import           Servant.Auth.Swagger ()
  76 --import           Servant.Mock (mock)
  77 --import           Servant.Job.Server (WithCallbacks)
  78 import           Servant.Job.Async
  79 import           Servant.Swagger
  80 import           Servant.Swagger.UI
  81 -- import Servant.API.Stream
  82
  83 --import Gargantext.API.Swagger
  84
  85 import Gargantext.Database.Node.Contact (HyperdataContact)
  86 import Gargantext.API.Auth (AuthRequest, AuthResponse, AuthenticatedUser(..), AuthContext, auth, withAccess, PathId(..))
  87 import Gargantext.API.Count  ( CountAPI, count, Query)
  88 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
  89 import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgramsApi, apiNgramsTableDoc)
  90 import Gargantext.API.Node
  91 import Gargantext.API.Search (SearchPairsAPI, searchPairs)
  92 import Gargantext.API.Types
  93 import qualified Gargantext.API.Annuaire as Annuaire
  94 import qualified Gargantext.API.Export as Export
  95 import qualified Gargantext.API.Corpus.New as New
  96 import Gargantext.Database.Types.Node
  97 import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
  98 import Gargantext.Database.Utils (HasConnection)
  99 import Gargantext.Prelude
 100 import Gargantext.Viz.Graph.API
 101
 102 --import Gargantext.API.Orchestrator
 103 import Gargantext.API.Orchestrator.Types
 104
 105 ---------------------------------------------------------------------
 106 import GHC.Base (Applicative)
 107 -- import Control.Lens
 108
 109 import Data.List (lookup)
 110 import Data.Text.Encoding (encodeUtf8)
 111
 112 --import Network.Wai (Request, requestHeaders, responseLBS)
 113 import Network.Wai (Request, requestHeaders)
 114 --import qualified Network.Wai.Handler.Warp as Warp
 115 import Network.Wai.Middleware.Cors
 116
 117 import Network.Wai.Middleware.RequestLogger
 118 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
 119
 120 import Network.HTTP.Types hiding (Query)
 121
 122 import Gargantext.API.Settings
 123
 124 showAsServantErr :: GargError -> ServerError
 125 showAsServantErr (GargServerError err) = err
 126 showAsServantErr a = err500 { errBody = BL8.pack $ show a }
 127
 128 fireWall :: Applicative f => Request -> FireWall -> f Bool
 129 fireWall req fw = do
 130     let origin = lookup "Origin" (requestHeaders req)
 131     let host   = lookup "Host"   (requestHeaders req)
 132
 133     let hostOk   = Just (encodeUtf8 "localhost:3000")
 134     let originOk = Just (encodeUtf8 "http://localhost:8008")
 135
 136     if  origin == originOk
 137        && host == hostOk
 138        || (not $ unFireWall fw)
 139
 140        then pure True
 141        else pure False
 142
 143 {-
 144 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
 145 makeMockApp :: MockEnv -> IO Application
 146 makeMockApp env = do
 147     let serverApp = appMock
 148
 149     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 150     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 151     let checkOriginAndHost app req resp = do
 152             blocking <- fireWall req (env ^. menv_firewall)
 153             case blocking  of
 154                 True  -> app req resp
 155                 False -> resp ( responseLBS status401 []
 156                               "Invalid Origin or Host header")
 157
 158     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 159 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 160             { corsOrigins        = Nothing --  == /*
 161             , corsMethods        = [ methodGet   , methodPost   , methodPut
 162                                    , methodDelete, methodOptions, methodHead]
 163             , corsRequestHeaders = ["authorization", "content-type"]
 164             , corsExposedHeaders = Nothing
 165             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 166             , corsVaryOrigin     = False
 167             , corsRequireOrigin  = False
 168             , corsIgnoreFailures = False
 169             }
 170
 171     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 172     --          $ Warp.defaultSettings
 173
 174     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 175     pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
 176 -}
 177
 178
 179 makeDevMiddleware :: IO Middleware
 180 makeDevMiddleware = do
 181
 182     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 183     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 184 --    let checkOriginAndHost app req resp = do
 185 --            blocking <- fireWall req (env ^. menv_firewall)
 186 --            case blocking  of
 187 --                True  -> app req resp
 188 --                False -> resp ( responseLBS status401 []
 189 --                              "Invalid Origin or Host header")
 190 --
 191     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 192 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 193             { corsOrigins        = Nothing --  == /*
 194             , corsMethods        = [ methodGet   , methodPost   , methodPut
 195                                    , methodDelete, methodOptions, methodHead]
 196             , corsRequestHeaders = ["authorization", "content-type"]
 197             , corsExposedHeaders = Nothing
 198             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 199             , corsVaryOrigin     = False
 200             , corsRequireOrigin  = False
 201             , corsIgnoreFailures = False
 202             }
 203
 204     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 205     --          $ Warp.defaultSettings
 206
 207     --pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
 208     pure $ logStdoutDev . corsMiddleware
 209
 210 ---------------------------------------------------------------------
 211 -- | API Global
 212
 213 -- | API for serving @swagger.json@
 214 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
 215
 216 -- | API for serving main operational routes of @gargantext.org@
 217
 218
 219 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 220 -- | TODO          :<|> Summary "Latest API" :> GargAPI'
 221
 222
 223 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
 224
 225 type GargAPI' =
 226            -- Auth endpoint
 227                 "auth"  :> Summary "AUTH API"
 228                         :> ReqBody '[JSON] AuthRequest
 229                         :> Post    '[JSON] AuthResponse
 230            -- TODO-ACCESS here we want to request a particular header for
 231            -- auth and capabilities.
 232           :<|> GargPrivateAPI
 233
 234 type GargPrivateAPI = SA.Auth '[SA.JWT] AuthenticatedUser :> GargPrivateAPI'
 235
 236 type GargAdminAPI
 237               -- Roots endpoint
 238              =  "user"  :> Summary "First user endpoint"
 239                         :> Roots
 240            :<|> "nodes" :> Summary "Nodes endpoint"
 241                         :> ReqBody '[JSON] [NodeId] :> NodesAPI
 242
 243 ----------------------------------------
 244 -- For Tests
 245 type FibAPI = Get '[JSON] Int
 246
 247 fibAPI ::  Int -> GargServer FibAPI
 248 fibAPI n = pure (fib n)
 249 ----------------------------------------
 250
 251
 252 type GargPrivateAPI' =
 253                 GargAdminAPI
 254
 255            -- Node endpoint
 256            :<|> "node"  :> Summary "Node endpoint"
 257                         :> Capture "node_id" NodeId
 258                         :> NodeAPI HyperdataAny
 259
 260            -- Corpus endpoint
 261            :<|> "corpus":> Summary "Corpus endpoint"
 262                         :> Capture "corpus_id" CorpusId
 263                         :> NodeAPI HyperdataCorpus
 264
 265            :<|> "corpus":> Summary "Corpus endpoint"
 266                         :> Capture "node1_id" NodeId
 267                         :> "document"
 268                         :> Capture "node2_id" NodeId
 269                         :> NodeNodeAPI HyperdataAny
 270
 271            :<|> "corpus" :> Capture "node_id" CorpusId
 272                          :> Export.API
 273
 274            -- Annuaire endpoint
 275            :<|> "annuaire":> Summary "Annuaire endpoint"
 276                           :> Capture "annuaire_id" AnnuaireId
 277                           :> NodeAPI HyperdataAnnuaire
 278
 279            :<|> "annuaire" :> Summary "Contact endpoint"
 280                            :> Capture "annuaire_id" NodeId
 281                            :> "contact" :> Capture "contact_id" NodeId
 282                            :> NodeNodeAPI HyperdataContact
 283
 284            -- Document endpoint
 285            :<|> "document":> Summary "Document endpoint"
 286                           :> Capture "doc_id" DocId
 287                           :> "ngrams" :> TableNgramsApi
 288
 289         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
 290             -- TODO-SECURITY
 291            :<|> "count" :> Summary "Count endpoint"
 292                         :> ReqBody '[JSON] Query :> CountAPI
 293
 294            -- Corpus endpoint --> TODO rename s/search/filter/g
 295            :<|> "search":> Capture "corpus" NodeId
 296                         :> SearchPairsAPI
 297
 298            -- TODO move to NodeAPI?
 299            :<|> "graph" :> Summary "Graph endpoint"
 300                         :> Capture "graph_id" NodeId
 301                         :> GraphAPI
 302
 303            -- TODO move to NodeAPI?
 304            -- Tree endpoint
 305            :<|> "tree" :> Summary "Tree endpoint"
 306                        :> Capture "tree_id" NodeId
 307                        :> TreeAPI
 308
 309            -- :<|> New.Upload
 310            :<|> New.AddWithForm
 311            :<|> New.AddWithQuery
 312
 313            :<|> Annuaire.AddWithForm
 314            -- :<|> New.AddWithFile
 315        --  :<|> "scraper" :> WithCallbacks ScraperAPI
 316        --  :<|> "new"  :> New.Api
 317            :<|> "fib" :> Summary "Fib test"
 318                       :> Capture "x" Int
 319                       :> FibAPI -- Get '[JSON] Int
 320
 321 -- /mv/<id>/<id>
 322 -- /merge/<id>/<id>
 323 -- /rename/<id>
 324        -- :<|> "static"
 325        -- :<|> "list"     :> Capture "node_id" Int  :> NodeAPI
 326        -- :<|> "ngrams"   :> Capture "node_id" Int  :> NodeAPI
 327        -- :<|> "auth"     :> Capture "node_id" Int  :> NodeAPI
 328 ---------------------------------------------------------------------
 329
 330 type API = SwaggerAPI
 331        :<|> GargAPI
 332        :<|> FrontEndAPI
 333
 334 -- This is the concrete monad. It needs to be used as little as possible,
 335 -- instead, prefer GargServer, GargServerT, GargServerC.
 336 type GargServerM env err = ReaderT env (ExceptT err IO)
 337
 338 type EnvC env =
 339   ( HasConnection env
 340   , HasRepo env
 341   , HasSettings env
 342   , HasJobEnv env ScraperStatus ScraperStatus
 343   )
 344
 345 ---------------------------------------------------------------------
 346 -- | Server declarations
 347
 348 server :: forall env. EnvC env => env -> IO (Server API)
 349 server env = do
 350   -- orchestrator <- scrapyOrchestrator env
 351   pure $  schemaUiServer swaggerDoc
 352      :<|> hoistServerWithContext (Proxy :: Proxy GargAPI) (Proxy :: Proxy AuthContext) transform serverGargAPI
 353      :<|> frontEndServer
 354   where
 355     transform :: forall a. GargServerM env GargError a -> Handler a
 356     transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
 357
 358 serverGargAPI :: GargServerT env err (GargServerM env err) GargAPI
 359 serverGargAPI -- orchestrator
 360        =  auth :<|> serverPrivateGargAPI
 361   --   :<|> orchestrator
 362
 363 serverPrivateGargAPI :: GargServerT env err (GargServerM env err) GargPrivateAPI
 364 serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
 365 serverPrivateGargAPI _                     = throwAll' (_ServerError # err401)
 366 -- Here throwAll' requires a concrete type for the monad.
 367
 368 -- TODO-SECURITY admin only: withAdmin
 369 -- Question: How do we mark admins?
 370 serverGargAdminAPI :: GargServer GargAdminAPI
 371 serverGargAdminAPI =  roots
 372                  :<|> nodesAPI
 373
 374
 375 serverPrivateGargAPI' :: AuthenticatedUser -> GargServer GargPrivateAPI'
 376 serverPrivateGargAPI' (AuthenticatedUser (NodeId uid))
 377        =  serverGargAdminAPI
 378      :<|> nodeAPI     (Proxy :: Proxy HyperdataAny)      uid
 379      :<|> nodeAPI     (Proxy :: Proxy HyperdataCorpus)   uid
 380      :<|> nodeNodeAPI (Proxy :: Proxy HyperdataAny)      uid
 381      :<|> Export.getCorpus   -- uid
 382      :<|> nodeAPI     (Proxy :: Proxy HyperdataAnnuaire) uid
 383      :<|> nodeNodeAPI (Proxy :: Proxy HyperdataContact)  uid
 384
 385      :<|> withAccess  (Proxy :: Proxy TableNgramsApi) Proxy uid
 386           <$> PathNode <*> apiNgramsTableDoc
 387
 388      :<|> count -- TODO: undefined
 389
 390      :<|> withAccess (Proxy :: Proxy SearchPairsAPI) Proxy uid
 391           <$> PathNode <*> searchPairs -- TODO: move elsewhere
 392
 393      :<|> withAccess (Proxy :: Proxy GraphAPI)       Proxy uid
 394           <$> PathNode <*> graphAPI uid -- TODO: mock
 395
 396      :<|> withAccess (Proxy :: Proxy TreeAPI)        Proxy uid
 397           <$> PathNode <*> treeAPI
 398      -- TODO access
 399      -- :<|> addUpload
 400      -- :<|> (\corpus -> addWithQuery corpus :<|> addWithFile corpus)
 401      :<|> addCorpusWithForm
 402      :<|> addCorpusWithQuery
 403
 404      :<|> addAnnuaireWithForm
 405      -- :<|> New.api  uid -- TODO-SECURITY
 406      -- :<|> New.info uid -- TODO-SECURITY
 407      :<|> fibAPI
 408
 409
 410 {-
 411 addUpload :: GargServer New.Upload
 412 addUpload cId = (serveJobsAPI $ JobFunction (\i log -> New.addToCorpusJobFunction cid i (liftIO . log)))
 413            :<|> (serveJobsAPI $ JobFunction (\i log -> New.addToCorpusWithForm    cid i (liftIO . log)))
 414 --}
 415
 416 addCorpusWithQuery :: GargServer New.AddWithQuery
 417 addCorpusWithQuery cid =
 418   serveJobsAPI $
 419     JobFunction (\i log -> New.addToCorpusJobFunction cid i (liftIO . log))
 420
 421 addWithFile :: GargServer New.AddWithFile
 422 addWithFile cid i f =
 423   serveJobsAPI $
 424     JobFunction (\_i log -> New.addToCorpusWithFile cid i f (liftIO . log))
 425
 426 addCorpusWithForm :: GargServer New.AddWithForm
 427 addCorpusWithForm cid =
 428   serveJobsAPI $
 429     JobFunction (\i log -> New.addToCorpusWithForm cid i (liftIO . log))
 430
 431 addAnnuaireWithForm :: GargServer Annuaire.AddWithForm
 432 addAnnuaireWithForm cid =
 433   serveJobsAPI $
 434     JobFunction (\i log -> Annuaire.addToAnnuaireWithForm cid i (liftIO . log))
 435
 436 {-
 437 serverStatic :: Server (Get '[HTML] Html)
 438 serverStatic = $(do
 439                   let path = "purescript-gargantext/dist/index.html"
 440                   Just s <- liftIO (fileTypeToFileTree (FileTypeFile path))
 441                   fileTreeToServer s
 442                 )
 443 -}
 444 ---------------------------------------------------------------------
 445 --gargMock :: Server GargAPI
 446 --gargMock = mock apiGarg Proxy
 447 ---------------------------------------------------------------------
 448 makeApp :: EnvC env => env -> IO Application
 449 makeApp env = serveWithContext api cfg <$> server env
 450   where
 451     cfg :: Servant.Context AuthContext
 452     cfg = env ^. settings . jwtSettings
 453        :. env ^. settings . cookieSettings
 454     -- :. authCheck env
 455        :. EmptyContext
 456
 457 --appMock :: Application
 458 --appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
 459 ---------------------------------------------------------------------
 460 api :: Proxy API
 461 api  = Proxy
 462
 463 apiGarg :: Proxy GargAPI
 464 apiGarg  = Proxy
 465 ---------------------------------------------------------------------
 466 schemaUiServer :: (Server api ~ Handler Swagger)
 467         => Swagger -> Server (SwaggerSchemaUI' dir api)
 468 schemaUiServer = swaggerSchemaUIServer
 469
 470 -- Type Family for the Documentation
 471 type family TypeName (x :: *) :: Symbol where
 472     TypeName Int  = "Int"
 473     TypeName Text = "Text"
 474     TypeName x    = GenericTypeName x (Rep x ())
 475
 476 type family GenericTypeName t (r :: *) :: Symbol where
 477     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 478
 479 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 480
 481
 482 -- | Swagger Specifications
 483 swaggerDoc :: Swagger
 484 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 485   & info.title       .~ "Gargantext"
 486   & info.version     .~ "4.0.2" -- TODO same version as Gargantext
 487   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 488   & info.description ?~ "REST API specifications"
 489   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 490   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 491                  ["Gargantext" & description ?~ "Main operations"]
 492   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 493     where
 494         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 495
 496 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 497 swaggerWriteJSON :: IO ()
 498 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 499
 500 portRouteInfo :: PortNumber -> IO ()
 501 portRouteInfo port = do
 502   T.putStrLn "      ----Main Routes-----      "
 503   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 504   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 505
 506 stopGargantext :: HasRepoSaver env => env -> IO ()
 507 stopGargantext env = do
 508   T.putStrLn "----- Stopping gargantext -----"
 509   runReaderT saveRepo env
 510
 511 -- | startGargantext takes as parameters port number and Ini file.
 512 startGargantext :: PortNumber -> FilePath -> IO ()
 513 startGargantext port file = do
 514   env <- newEnv port file
 515   portRouteInfo port
 516   app <- makeApp env
 517   mid <- makeDevMiddleware
 518   run port (mid app) `finally` stopGargantext env
 519
 520 {-
 521 startGargantextMock :: PortNumber -> IO ()
 522 startGargantextMock port = do
 523   portRouteInfo port
 524   application <- makeMockApp . MockEnv $ FireWall False
 525   run port application
 526 -}
 527
 528
 529