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 TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
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 (runReaderT)
+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.Mock (mock)
--import Servant.Job.Server (WithCallbacks)
import Servant.Static.TH.Internal.Server (fileTreeToServer)
import Servant.Static.TH.Internal.FileTree (fileTypeToFileTree, FileType(FileTypeFile))
import Text.Blaze.Html (Html)
--import Gargantext.API.Swagger
-import Gargantext.Prelude
-import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
-import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
-import Gargantext.API.Node ( GargServer
- , Roots , roots
- , NodeAPI , nodeAPI
- , NodesAPI , nodesAPI
- , GraphAPI , graphAPI
- , TreeAPI , treeAPI
- , HyperdataAny
- , HyperdataCorpus
- , HyperdataAnnuaire
- )
--import Gargantext.Database.Node.Contact (HyperdataContact)
-import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
+import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
import Gargantext.API.Count ( CountAPI, count, Query)
-import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
-import Gargantext.Database.Facet
+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
:<|> "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] [NodeId] :> NodesAPI
:<|> "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
+ -- Corpus endpoint --> TODO rename s/search/filter/g
+ :<|> "search":> Capture "corpus" NodeId :> SearchPairsAPI
-- TODO move to NodeAPI?
:<|> "graph" :> Summary "Graph endpoint"
:<|> "tree" :> Summary "Tree endpoint"
:> Capture "id" NodeId :> TreeAPI
+ :<|> "new" :> New.Api
+
-- :<|> "scraper" :> WithCallbacks ScraperAPI
---------------------------------------------------------------------
-- | Server declarations
-server :: Env -> IO (Server API)
+server :: forall env. (HasConnection env, HasRepo env, HasSettings env)
+ => env -> IO (Server API)
server env = do
-- orchestrator <- scrapyOrchestrator env
pure $ swaggerFront
- :<|> hoistServer (Proxy :: Proxy GargAPI) (`runReaderT` env) serverGargAPI
- :<|> serverIndex
+ :<|> 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
:<|> nodeAPI (Proxy :: Proxy HyperdataAny) fakeUserId
:<|> nodeAPI (Proxy :: Proxy HyperdataCorpus) fakeUserId
:<|> nodeAPI (Proxy :: Proxy HyperdataAnnuaire) fakeUserId
+ :<|> apiNgramsTableDoc
:<|> nodesAPI
:<|> count -- TODO: undefined
- :<|> search
+ :<|> searchPairs -- TODO: move elsewhere
:<|> graphAPI -- TODO: mock
:<|> treeAPI
+ :<|> New.api
+ :<|> New.info fakeUserId
-- :<|> orchestrator
where
- fakeUserId = 1 -- TODO
+ fakeUserId = 2 -- TODO, byDefault user1 (if users automatically generated with inserUsersDemo)
-serverIndex :: Server (Get '[HTML] Html)
-serverIndex = $(do (Just s) <- liftIO (fileTypeToFileTree (FileTypeFile "purescript-gargantext/dist/index.html"))
- fileTreeToServer s)
+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 :<|> serverIndex)
+--appMock :: Application
+--appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
---------------------------------------------------------------------
api :: Proxy API
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
+-}
+
+
+