Portability : POSIX
Main REST API of Gargantext (both Server and Client sides)
+Thanks @yannEsposito for our discussions at the beginning of this project :).
-TODO App type, the main monad in which the bot code is written with.
-
-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 TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Gargantext.API
where
---------------------------------------------------------------------
-import Gargantext.Prelude
import System.IO (FilePath)
import GHC.TypeLits (AppendSymbol, Symbol)
import Control.Lens
-import Data.Aeson (Value)
+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.Mock (mock)
+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.API.FrontEnd (FrontEndAPI, frontEndServer)
-import Gargantext.API.Node ( Roots , roots
- , NodeAPI , nodeAPI
- , NodesAPI , nodesAPI
- , GraphAPI , graphAPI
- , TreeAPI , treeAPI
- , HyperdataCorpus
- )
-import Gargantext.Database.Types.Node ()
+--import Gargantext.Database.Node.Contact (HyperdataContact)
+import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
import Gargantext.API.Count ( CountAPI, count, Query)
-import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
+import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
+import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgramsApi, apiNgramsTableDoc)
+import Gargantext.API.Node
+import Gargantext.API.Search (SearchPairsAPI, searchPairs)
+import Gargantext.API.Types
+import qualified Gargantext.API.Corpus.New as New
+import Gargantext.Core.Types (HasInvalidError(..))
+import Gargantext.Database.Schema.Node (HasNodeError(..), NodeError)
+import Gargantext.Database.Tree (HasTreeError(..), TreeError)
+import Gargantext.Database.Types.Node
+import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
+import Gargantext.Database.Utils (HasConnection)
+import Gargantext.Prelude
+import Gargantext.Viz.Graph.API
+
--import Gargantext.API.Orchestrator
--import Gargantext.API.Orchestrator.Types
import Gargantext.API.Settings
+data GargError
+ = GargNodeError NodeError
+ | GargTreeError TreeError
+ | GargInvalidError Validation
+ deriving (Show)
+
+makePrisms ''GargError
+
+instance HasNodeError GargError where
+ _NodeError = _GargNodeError
+
+instance HasInvalidError GargError where
+ _InvalidError = _GargInvalidError
+
+instance HasTreeError GargError where
+ _TreeError = _GargTreeError
+
+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)
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
+-}
---
-makeDevApp :: Env -> IO Application
-makeDevApp env = do
- serverApp <- makeApp env
+makeDevMiddleware :: IO Middleware
+makeDevMiddleware = do
-- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
--logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
--let warpS = Warp.setPort (8008 :: Int) -- (env^.settings.appPort)
-- $ Warp.defaultSettings
- --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
- pure $ logStdoutDev $ corsMiddleware $ serverApp
-
---
+ --pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
+ pure $ logStdoutDev . corsMiddleware
---------------------------------------------------------------------
-- | API Global
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"
+ :<|> "user" :> Summary "First user endpoint"
:> Roots
-- Node endpoint
:<|> "node" :> Summary "Node endpoint"
- :> Capture "id" Int :> NodeAPI Value
+ :> Capture "id" NodeId :> NodeAPI HyperdataAny
-- Corpus endpoint
:<|> "corpus":> Summary "Corpus endpoint"
- :> Capture "id" Int :> NodeAPI HyperdataCorpus
+ :> Capture "id" CorpusId :> NodeAPI HyperdataCorpus
+
+ -- Annuaire endpoint
+ :<|> "annuaire":> Summary "Annuaire endpoint"
+ :> Capture "id" AnnuaireId :> NodeAPI HyperdataAnnuaire
+
+ -- Document endpoint
+ :<|> "document":> Summary "Document endpoint"
+ :> Capture "id" DocId :> "ngrams" :> TableNgramsApi
+
-- Corpus endpoint
:<|> "nodes" :> Summary "Nodes endpoint"
- :> ReqBody '[JSON] [Int] :> NodesAPI
+ :> 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 :> SearchAPI
-
+ -- Corpus endpoint --> TODO rename s/search/filter/g
+ :<|> "search":> Capture "corpus" NodeId :> SearchPairsAPI
+
+ -- TODO move to NodeAPI?
:<|> "graph" :> Summary "Graph endpoint"
- :> Capture "id" Int :> GraphAPI
-
+ :> Capture "id" NodeId :> GraphAPI
+
+ -- TODO move to NodeAPI?
-- Tree endpoint
:<|> "tree" :> Summary "Tree endpoint"
- :> Capture "id" Int :> TreeAPI
+ :> Capture "id" NodeId :> TreeAPI
+
+ :<|> "new" :> New.Api
-- :<|> "scraper" :> WithCallbacks ScraperAPI
-- /mv/<id>/<id>
-- /merge/<id>/<id>
-- /rename/<id>
- -- :<|> "static"
+ -- :<|> "static"
-- :<|> "list" :> Capture "id" Int :> NodeAPI
-- :<|> "ngrams" :> Capture "id" Int :> NodeAPI
-- :<|> "auth" :> Capture "id" Int :> NodeAPI
---------------------------------------------------------------------
-type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
+type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
-type API = SwaggerFrontAPI :<|> GargAPI
+type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
---------------------------------------------------------------------
--- | Server declaration
-server :: Env -> IO (Server API)
+-- | Server declarations
+
+server :: forall env. (HasConnection env, HasRepo env, HasSettings env)
+ => env -> IO (Server API)
server env = do
-- orchestrator <- scrapyOrchestrator env
- pure $ swaggerFront
- :<|> roots conn
- :<|> nodeAPI conn (Proxy :: Proxy Value)
- :<|> nodeAPI conn (Proxy :: Proxy HyperdataCorpus)
- :<|> nodesAPI conn
+ pure $ swaggerFront
+ :<|> hoistServer (Proxy :: Proxy GargAPI) transform serverGargAPI
+ :<|> serverStatic
+ where
+ transform :: forall a. ReaderT env (ExceptT GargError IO) a -> Handler a
+ transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
+
+serverGargAPI :: GargServer GargAPI
+serverGargAPI -- orchestrator
+ = auth
+ :<|> roots
+ :<|> nodeAPI (Proxy :: Proxy HyperdataAny) fakeUserId
+ :<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) fakeUserId
+ :<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) fakeUserId
+ :<|> apiNgramsTableDoc
+ :<|> nodesAPI
:<|> count -- TODO: undefined
- :<|> search conn
- :<|> graphAPI conn -- TODO: mock
- :<|> treeAPI conn
+ :<|> searchPairs -- TODO: move elsewhere
+ :<|> graphAPI -- TODO: mock
+ :<|> treeAPI
+ :<|> New.api
+ :<|> New.info fakeUserId
-- :<|> orchestrator
where
- conn = env ^. env_conn
+ fakeUserId = 2 -- TODO, byDefault user1 (if users automatically generated with inserUsersDemo)
+
+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
-gargMock :: Server GargAPI
-gargMock = mock apiGarg Proxy
+--gargMock :: Server GargAPI
+--gargMock = mock apiGarg Proxy
---------------------------------------------------------------------
-makeApp :: Env -> IO Application
+makeApp :: (HasConnection env, HasRepo env, HasSettings env)
+ => env -> IO Application
makeApp = fmap (serve api) . server
-appMock :: Application
-appMock = serve api (swaggerFront :<|> gargMock)
+--appMock :: Application
+--appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
---------------------------------------------------------------------
api :: Proxy API
swaggerDoc :: Swagger
swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
& info.title .~ "Gargantext"
- & info.version .~ "0.1.0"
+ & 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]
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 <- makeDevApp env
- run port app
+ 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
+-}
+
+
+