Stability : experimental
Portability : POSIX
-Main REST API of Gargantext (both Server and Client sides)
+Main (RESTful) API of the instance Gargantext.
-TODO App type, the main monad in which the bot code is written with.
+The Garg-API is typed to derive the documentation, the mock and tests.
+
+This API is indeed typed in order to be able to derive both the server
+and the client sides.
+
+The Garg-API-Monad enables:
+ - Security (WIP)
+ - Features (WIP)
+ - Database connection (long term)
+ - In Memory stack management (short term)
+ - Logs (WIP)
+
+Thanks to Yann Esposito for our discussions at the start and to Nicolas
+Pouillard (who mainly made it).
-Provide config, state, logs and IO
- type App m a = ( MonadState AppState m
- , MonadReader Conf m
- , MonadLog (WithSeverity Doc) m
- , MonadIO m) => m a
-Thanks @yannEsposito for this.
-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Gargantext.API
where
---------------------------------------------------------------------
-
-import System.IO (FilePath)
-
-import GHC.Generics (D1, Meta (..), Rep)
-import GHC.TypeLits (AppendSymbol, Symbol)
-
-import Control.Lens
-import Control.Exception (finally)
-import Control.Monad.Except (withExceptT, ExceptT)
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Reader (ReaderT, runReaderT)
-import Data.Aeson.Encode.Pretty (encodePretty)
-import qualified Data.ByteString.Lazy.Char8 as BL8
-import Data.Swagger
-import Data.Text (Text)
-import qualified Data.Text.IO as T
---import qualified Data.Set as Set
-import Data.Validity
-
-import Network.Wai
-import Network.Wai.Handler.Warp hiding (defaultSettings)
-
-import Servant
-import Servant.HTML.Blaze (HTML)
-import Servant.Mock (mock)
---import Servant.Job.Server (WithCallbacks)
-import Servant.Static.TH.Internal.Server (fileTreeToServer)
-import Servant.Static.TH.Internal.FileTree (fileTypeToFileTree, FileType(FileTypeFile))
-import Servant.Swagger
-import Servant.Swagger.UI
--- import Servant.API.Stream
-import Text.Blaze.Html (Html)
-
---import Gargantext.API.Swagger
-import Gargantext.Prelude
-import Gargantext.Core.Types (HasInvalidError(..))
-import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
-
-import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
-import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo)
-import Gargantext.API.Types
-import Gargantext.API.Node
-import Gargantext.Database.Schema.Node (HasNodeError(..), NodeError)
---import Gargantext.Database.Node.Contact (HyperdataContact)
-import Gargantext.Database.Types.Node
-import Gargantext.Database.Utils (HasConnection)
-import Gargantext.Database.Tree (HasTreeError(..), TreeError)
-import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
-import Gargantext.API.Count ( CountAPI, count, Query)
-import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
-import Gargantext.Database.Facet
-import Gargantext.Viz.Graph.API
-
---import Gargantext.API.Orchestrator
---import Gargantext.API.Orchestrator.Types
-
----------------------------------------------------------------------
-
-import GHC.Base (Applicative)
--- import Control.Lens
-
+import Control.Exception (finally)
+import Control.Lens
+import Control.Monad.Except (withExceptT)
+import Control.Monad.Reader (runReaderT)
+import Data.Aeson.Encode.Pretty (encodePretty)
import Data.List (lookup)
+import Data.Swagger
+import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
-
---import Network.Wai (Request, requestHeaders, responseLBS)
+import Data.Validity
+import Data.Version (showVersion)
+import GHC.Base (Applicative)
+import GHC.Generics (D1, Meta (..), Rep, Generic)
+import GHC.TypeLits (AppendSymbol, Symbol)
+import Gargantext.API.Admin.Auth (AuthContext, auth)
+import Gargantext.API.Admin.FrontEnd (frontEndServer)
+import Gargantext.API.Admin.Settings
+import Gargantext.API.Ngrams (HasRepoSaver(..), saveRepo)
+import Gargantext.API.Prelude
+import Gargantext.API.Routes
+import Gargantext.Prelude
+import Network.HTTP.Types hiding (Query)
+import Network.Wai
import Network.Wai (Request, requestHeaders)
---import qualified Network.Wai.Handler.Warp as Warp
+import Network.Wai.Handler.Warp hiding (defaultSettings)
import Network.Wai.Middleware.Cors
-
import Network.Wai.Middleware.RequestLogger
--- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
+import Servant
+import Servant.Auth.Server (AuthResult(..))
+import Servant.Auth.Swagger ()
+import Servant.Swagger
+import Servant.Swagger.UI
+import System.IO (FilePath)
+import qualified Data.ByteString.Lazy.Char8 as BL8
+import qualified Data.Text.IO as T
+import qualified Paths_gargantext as PG -- cabal magic build module
+import qualified Gargantext.API.Public as Public
-import Network.HTTP.Types hiding (Query)
+data Mode = Dev | Mock | Prod
+ deriving (Show, Read, Generic)
-import Gargantext.API.Settings
+-- | startGargantext takes as parameters port number and Ini file.
+startGargantext :: Mode -> PortNumber -> FilePath -> IO ()
+startGargantext mode port file = do
+ env <- newEnv port file
+ portRouteInfo port
+ app <- makeApp env
+ mid <- makeDevMiddleware mode
+ run port (mid app) `finally` stopGargantext env
-data GargError
- = GargNodeError NodeError
- | GargTreeError TreeError
- | GargInvalidError Validation
- deriving (Show)
+portRouteInfo :: PortNumber -> IO ()
+portRouteInfo port = do
+ T.putStrLn " ----Main Routes----- "
+ T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
+ T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
-makePrisms ''GargError
+-- TODO clean this Monad condition (more generic) ?
+stopGargantext :: HasRepoSaver env => env -> IO ()
+stopGargantext env = do
+ T.putStrLn "----- Stopping gargantext -----"
+ runReaderT saveRepo env
-instance HasNodeError GargError where
- _NodeError = _GargNodeError
+-- | Output generated @swagger.json@ file for the @'TodoAPI'@.
+swaggerWriteJSON :: IO ()
+swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
-instance HasInvalidError GargError where
- _InvalidError = _GargInvalidError
+-- | Swagger Specifications
+swaggerDoc :: Swagger
+swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
+ & info.title .~ "Gargantext"
+ & info.version .~ (cs $ showVersion PG.version)
+ -- & info.base_url ?~ (URL "http://gargantext.org/")
+ & info.description ?~ "REST API specifications"
+ -- & tags .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
+ & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
+ ["Gargantext" & description ?~ "Main operations"]
+ & info.license ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
+ where
+ urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
-instance HasTreeError GargError where
- _TreeError = _GargTreeError
+{-
+startGargantextMock :: PortNumber -> IO ()
+startGargantextMock port = do
+ portRouteInfo port
+ application <- makeMockApp . MockEnv $ FireWall False
+ run port application
+-}
-showAsServantErr :: Show a => a -> ServantErr
-showAsServantErr a = err500 { errBody = BL8.pack $ show a }
+----------------------------------------------------------------------
fireWall :: Applicative f => Request -> FireWall -> f Bool
fireWall req fw = do
let origin = lookup "Origin" (requestHeaders req)
let host = lookup "Host" (requestHeaders req)
- let hostOk = Just (encodeUtf8 "localhost:3000")
- let originOk = Just (encodeUtf8 "http://localhost:8008")
-
- if origin == originOk
- && host == hostOk
+ if origin == Just (encodeUtf8 "http://localhost:8008")
+ && host == Just (encodeUtf8 "localhost:3000")
|| (not $ unFireWall fw)
-
+
then pure True
else pure False
-
+{-
-- makeMockApp :: Env -> IO (Warp.Settings, Application)
makeMockApp :: MockEnv -> IO Application
makeMockApp env = do
--pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
+-}
-
-makeDevMiddleware :: IO Middleware
-makeDevMiddleware = do
+makeDevMiddleware :: Mode -> IO Middleware
+makeDevMiddleware mode = do
-- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
--logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
-- True -> app req resp
-- False -> resp ( responseLBS status401 []
-- "Invalid Origin or Host header")
---
+--
let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
-- { corsOrigins = Just ([env^.settings.allowedOrigin], False)
{ corsOrigins = Nothing -- == /*
--let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
-- $ Warp.defaultSettings
-
+
--pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
- pure $ logStdoutDev . corsMiddleware
+ case mode of
+ Prod -> pure $ logStdout . corsMiddleware
+ _ -> pure $ logStdoutDev . corsMiddleware
---------------------------------------------------------------------
-- | API Global
-
--- | API for serving @swagger.json@
-type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
-
--- | API for serving main operational routes of @gargantext.org@
-
-
-type GargAPI = "api" :> Summary "API " :> GargAPIVersion
--- | TODO :<|> Summary "Latest API" :> GargAPI'
-
-
-type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
-
-type GargAPI' =
- -- Auth endpoint
- "auth" :> Summary "AUTH API"
- :> ReqBody '[JSON] AuthRequest
- :> Post '[JSON] AuthResponse
-
- -- Roots endpoint
- :<|> "user" :> Summary "First user endpoint"
- :> Roots
-
- -- Node endpoint
- :<|> "node" :> Summary "Node endpoint"
- :> Capture "id" NodeId :> NodeAPI HyperdataAny
-
- -- Corpus endpoint
- :<|> "corpus":> Summary "Corpus endpoint"
- :> Capture "id" CorpusId :> NodeAPI HyperdataCorpus
-
- -- Annuaire endpoint
- :<|> "annuaire":> Summary "Annuaire endpoint"
- :> Capture "id" AnnuaireId :> NodeAPI HyperdataAnnuaire
-
- -- Corpus endpoint
- :<|> "nodes" :> Summary "Nodes endpoint"
- :> ReqBody '[JSON] [NodeId] :> NodesAPI
-
- -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
- -- Corpus endpoint
- :<|> "count" :> Summary "Count endpoint"
- :> ReqBody '[JSON] Query :> CountAPI
-
- -- Corpus endpoint
- :<|> "search":> Summary "Search endpoint"
- :> ReqBody '[JSON] SearchQuery
- :> QueryParam "offset" Int
- :> QueryParam "limit" Int
- :> QueryParam "order" OrderBy
- :> SearchAPI
-
- -- TODO move to NodeAPI?
- :<|> "graph" :> Summary "Graph endpoint"
- :> Capture "id" NodeId :> GraphAPI
-
- -- TODO move to NodeAPI?
- -- Tree endpoint
- :<|> "tree" :> Summary "Tree endpoint"
- :> Capture "id" NodeId :> TreeAPI
-
-
- -- :<|> "scraper" :> WithCallbacks ScraperAPI
-
--- /mv/<id>/<id>
--- /merge/<id>/<id>
--- /rename/<id>
- -- :<|> "static"
- -- :<|> "list" :> Capture "id" Int :> NodeAPI
- -- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
- -- :<|> "auth" :> Capture "id" Int :> NodeAPI
----------------------------------------------------------------------
-type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
-
-type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
-
---------------------------------------------------------------------
-- | Server declarations
-
-server :: forall env. (HasConnection env, HasRepo env, HasSettings env)
- => env -> IO (Server API)
+server :: forall env. EnvC env => env -> IO (Server API)
server env = do
-- orchestrator <- scrapyOrchestrator env
- pure $ swaggerFront
- :<|> hoistServer (Proxy :: Proxy GargAPI) transform serverGargAPI
- :<|> serverStatic
+ pure $ schemaUiServer swaggerDoc
+ :<|> hoistServerWithContext
+ (Proxy :: Proxy GargAPI)
+ (Proxy :: Proxy AuthContext)
+ transform
+ serverGargAPI
+ :<|> frontEndServer
where
- transform :: forall a. ReaderT env (ExceptT GargError IO) a -> Handler a
+ transform :: forall a. GargServerM env GargError a -> Handler a
transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
-serverGargAPI :: GargServer GargAPI
+showAsServantErr :: GargError -> ServerError
+showAsServantErr (GargServerError err) = err
+showAsServantErr a = err500 { errBody = BL8.pack $ show a }
+
+---------------------------
+
+serverGargAPI :: GargServerT env err (GargServerM env err) GargAPI
serverGargAPI -- orchestrator
= auth
- :<|> roots
- :<|> nodeAPI (Proxy :: Proxy HyperdataAny) fakeUserId
- :<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) fakeUserId
- :<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) fakeUserId
- :<|> nodesAPI
- :<|> count -- TODO: undefined
- :<|> search
- :<|> graphAPI -- TODO: mock
- :<|> treeAPI
+ :<|> gargVersion
+ :<|> serverPrivateGargAPI
+ :<|> Public.api
+
-- :<|> orchestrator
where
- fakeUserId = 1 -- TODO
-
-serverStatic :: Server (Get '[HTML] Html)
-serverStatic = $(do
- let path = "purescript-gargantext/dist/index.html"
- Just s <- liftIO (fileTypeToFileTree (FileTypeFile path))
- fileTreeToServer s
- )
----------------------------------------------------------------------
-swaggerFront :: Server SwaggerFrontAPI
-swaggerFront = schemaUiServer swaggerDoc
- :<|> frontEndServer
+ gargVersion :: GargServer GargVersion
+ gargVersion = pure (cs $ showVersion PG.version)
-gargMock :: Server GargAPI
-gargMock = mock apiGarg Proxy
+ serverPrivateGargAPI :: GargServerT env err (GargServerM env err) GargPrivateAPI
+ serverPrivateGargAPI (Authenticated auser) = serverPrivateGargAPI' auser
+ serverPrivateGargAPI _ = throwAll' (_ServerError # err401)
+-- Here throwAll' requires a concrete type for the monad.
----------------------------------------------------------------------
-makeApp :: (HasConnection env, HasRepo env, HasSettings env)
- => env -> IO Application
-makeApp = fmap (serve api) . server
-appMock :: Application
-appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
+-- TODO-SECURITY admin only: withAdmin
+-- Question: How do we mark admins?
+{-
+serverGargAdminAPI :: GargServer GargAdminAPI
+serverGargAdminAPI = roots
+ :<|> nodesAPI
+-}
+---------------------------------------------------------------------
+--gargMock :: Server GargAPI
+--gargMock = mock apiGarg Proxy
+---------------------------------------------------------------------
+makeApp :: EnvC env => env -> IO Application
+makeApp env = serveWithContext api cfg <$> server env
+ where
+ cfg :: Servant.Context AuthContext
+ cfg = env ^. settings . jwtSettings
+ :. env ^. settings . cookieSettings
+ -- :. authCheck env
+ :. EmptyContext
+
+--appMock :: Application
+--appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
---------------------------------------------------------------------
api :: Proxy API
api = Proxy
apiGarg :: Proxy GargAPI
apiGarg = Proxy
---------------------------------------------------------------------
-
schemaUiServer :: (Server api ~ Handler Swagger)
=> Swagger -> Server (SwaggerSchemaUI' dir api)
schemaUiServer = swaggerSchemaUIServer
-
+---------------------------------------------------------------------
-- Type Family for the Documentation
type family TypeName (x :: *) :: Symbol where
TypeName Int = "Int"
type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
--- | Swagger Specifications
-swaggerDoc :: Swagger
-swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
- & info.title .~ "Gargantext"
- & info.version .~ "4.0.2" -- TODO same version as Gargantext
- -- & info.base_url ?~ (URL "http://gargantext.org/")
- & info.description ?~ "REST API specifications"
- -- & tags .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
- & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
- ["Gargantext" & description ?~ "Main operations"]
- & info.license ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
- where
- urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
-
--- | Output generated @swagger.json@ file for the @'TodoAPI'@.
-swaggerWriteJSON :: IO ()
-swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
-
-portRouteInfo :: PortNumber -> IO ()
-portRouteInfo port = do
- T.putStrLn " ----Main Routes----- "
- T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
- T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
-
-stopGargantext :: HasRepoSaver env => env -> IO ()
-stopGargantext env = do
- T.putStrLn "----- Stopping gargantext -----"
- runReaderT saveRepo env
-
--- | startGargantext takes as parameters port number and Ini file.
-startGargantext :: PortNumber -> FilePath -> IO ()
-startGargantext port file = do
- env <- newEnv port file
- portRouteInfo port
- app <- makeApp env
- mid <- makeDevMiddleware
- run port (mid app) `finally` stopGargantext env
-
-startGargantextMock :: PortNumber -> IO ()
-startGargantextMock port = do
- portRouteInfo port
- application <- makeMockApp . MockEnv $ FireWall False
- run port application
-