{-| Module : Gargantext.API.Node Description : Server API Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -- TODO-ACCESS: CanGetNode -- TODO-EVENTS: No events as this is a read only query. Node API ------------------------------------------------------------------- -- TODO-ACCESS: access by admin only. -- At first let's just have an isAdmin check. -- Later: check userId CanDeleteNodes Nothing -- TODO-EVENTS: DeletedNodes [NodeId] -- {"tag": "DeletedNodes", "nodes": [Int*]} -} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} module Gargantext.API.Table where import Data.Text qualified as T import Gargantext.API.HashedResponse (HashedResponse(..), constructHashedResponse) import Gargantext.API.Ngrams.Types (TabType(..)) import Gargantext.API.Prelude (IsGargServer) import Gargantext.API.Routes.Named.Table qualified as Named import Gargantext.API.Table.Types (FacetTableResult, TableQuery(..)) import Gargantext.Core.Text.Corpus.Query (RawQuery, parseQuery, getRawQuery) import Gargantext.Core.Types (TableResult(..)) import Gargantext.Core.Types.Query (Offset, Limit) import Gargantext.Database.Action.Learn (FavOrTrash(..), moreLike) import Gargantext.Database.Action.Search (searchCountInCorpus, searchInCorpus) import Gargantext.Database.Admin.Types.Node (ContactId, CorpusId, NodeId) import Gargantext.Database.Prelude (IsDBCmdExtra, IsDBCmd, DBCmd) import Gargantext.Database.Query.Facet (FacetDoc , runViewDocuments, runCountDocuments, OrderBy(..), runViewAuthorsDoc) import Gargantext.Database.Query.Table.Node.Error (HasNodeError) import Gargantext.Prelude import Gargantext.System.Logging import Servant.Server.Generic (AsServerT) tableApi :: IsGargServer env err m => NodeId -> Named.TableAPI (AsServerT m) tableApi id' = Named.TableAPI { getTableEp = getTableApi id' , postTableEp = postTableApi id' , hashTableEp = getTableHashApi id' } getTableApi :: (IsDBCmdExtra env err m, HasNodeError err, MonadLogger m) => NodeId -> Maybe TabType -> Maybe Limit -> Maybe Offset -> Maybe OrderBy -> Maybe RawQuery -> Maybe Text -> m (HashedResponse FacetTableResult) getTableApi cId tabType mLimit mOffset mOrderBy mQuery mYear = case mQuery of Nothing -> get_table Just "" -> get_table Just q -> case tabType of Just Docs -> do $(logLocM) DEBUG $ "New search with query " <> getRawQuery q constructHashedResponse <$> searchInCorpus' cId False q mOffset mLimit mOrderBy Just Trash -> constructHashedResponse <$> searchInCorpus' cId True q mOffset mLimit mOrderBy _ -> get_table where get_table = do $(logLocM) DEBUG $ "getTable cId = " <> T.pack (show cId) t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear pure $ constructHashedResponse t postTableApi :: (IsDBCmdExtra env err m, MonadLogger m, HasNodeError err) => NodeId -> TableQuery -> m FacetTableResult postTableApi cId tq = case tq of TableQuery o l order ft "" -> do $(logLocM) DEBUG $ "New search with no query" getTable cId (Just ft) (Just o) (Just l) (Just order) Nothing Nothing TableQuery o l order ft q -> case ft of Docs -> do $(logLocM) DEBUG $ "New search with query " <> getRawQuery q searchInCorpus' cId False q (Just o) (Just l) (Just order) Trash -> searchInCorpus' cId True q (Just o) (Just l) (Just order) x -> panicTrace $ "not implemented in tableApi " <> (show x) getTableHashApi :: (IsDBCmdExtra env err m, HasNodeError err, MonadLogger m) => NodeId -> Maybe TabType -> m Text getTableHashApi cId tabType = do HashedResponse { hash = h } <- getTableApi cId tabType Nothing Nothing Nothing Nothing Nothing pure h searchInCorpus' :: (IsDBCmd env err m, MonadLogger m) => CorpusId -> Bool -> RawQuery -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> m FacetTableResult searchInCorpus' cId t q o l order = do case parseQuery q of -- FIXME(adn) The error handling needs to be monomorphic over GargErr. Left noParseErr -> do $(logLocM) ERROR $ "Invalid input query " <> (getRawQuery q) <> " , error = " <> (T.pack noParseErr) pure $ TableResult 0 [] Right boolQuery -> do docs <- searchInCorpus cId t boolQuery o l order countAllDocs <- searchCountInCorpus cId t (Just boolQuery) pure $ TableResult { tr_docs = docs , tr_count = countAllDocs } getTable :: HasNodeError err => NodeId -> Maybe TabType -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Maybe RawQuery -> Maybe Text -> DBCmd err FacetTableResult getTable cId ft o l order raw_query year = do docs <- getTable' cId ft o l order query year docsCount <- runCountDocuments cId (ft == Just Trash) query year pure $ TableResult { tr_docs = docs, tr_count = docsCount } where query = getRawQuery <$> raw_query getTable' :: HasNodeError err => NodeId -> Maybe TabType -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Maybe Text -> Maybe Text -> DBCmd err [FacetDoc] getTable' cId ft o l order query year = case ft of (Just Docs) -> runViewDocuments cId False o l order query year (Just Trash) -> runViewDocuments cId True o l order query year (Just MoreFav) -> moreLike cId o l order IsFav (Just MoreTrash) -> moreLike cId o l order IsTrash x -> panicTrace $ "not implemented in getTable: " <> (show x) getPair :: ContactId -> Maybe TabType -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> DBCmd err [FacetDoc] getPair cId ft o l order = case ft of (Just Docs) -> runViewAuthorsDoc cId False o l order (Just Trash) -> runViewAuthorsDoc cId True o l order _ -> panicTrace $ "not implemented: get Pairing" <> (show ft)