Skip to content

haskell-gargantext
haskell-gargantext
Commit 5ec3c2af authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

Merge branch 'testing' into stable

parents df4e87cf e6a28179
Expand all Hide whitespace changes
Inline Side-by-side
Showing with 3207 additions and 3017 deletions
CHANGELOG.md
View file @ 5ec3c2af
## Version 0.0.7.1.6.5
* [BACK][FIX] TSV/CSV hot fix
## Version 0.0.7.1.6.4
* [FRONT][FIX][[Corpus] Import docs from selected list is broken (#679)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/679)
* [BACK][FIX][[Node terms] institutes missing with HAL request (#330)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/330)
## Version 0.0.7.1.6.3
* [BACK][FIX][CSV; TSV in all codebase (#348)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/348)
* [FRONT][FIX][CSV TSV in all codebase (#676)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/676)
* [FRONT][FIX][TSV export for ngrams table]
## Version 0.0.7.1.6.2
* [FRONT][FIX][Pb with term selection in phylomemy (#673)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/673)
## Version 0.0.7.1.6.1
* [FRONT][FIX][Display Phylomemy parameters (#580)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/580)
* [BACK][FIX][Consider integrating Servant named routes (#271)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/271)
## Version 0.0.7.1.6
* [BACK][REFACT][Consider integrating Servant named routes (#271)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/271)
* [FRONT][FIX] Double Option in form
## Version 0.0.7.1.5.5
* [BACK][FIX][`nodeErrorToFrontendError` contains an `undefined` (#346)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/346)
* [FRONT][FIX][[Tree perfs] When the tree is opening: reduce API calls or replace with lighter calls (#670)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/670)
## Version 0.0.7.1.5.4
* [BACK][FIX][[Docs TSV export/import] Check and maintain consistency between export and import formats (#345)](https://gitlab.iscpif.fr/gargantext/haskell-gargantext/issues/345)
## Version 0.0.7.1.5.3
* [FRONT][FIX][[Tree focus] Temporary HOTFIX: comment the forced focus (forest open nodes) for performances reason (#669)](https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/669)
......
bench-data/phylo/bpa-config.json
View file @ 5ec3c2af
{
"corpusPath" : "Gargantext_DocsList-nodeId-185487.csv",
"listPath" : "Gargantext_NgramsList-185488.csv",
"corpusPath" : "Gargantext_DocsList-nodeId-185487.tsv",
"listPath" : "Gargantext_NgramsList-185488.tsv",
"outputPath" : "data",
"corpusParser" : {
"tag" : "Csv",
"_csv_limit" : 1500000
"tag" : "Tsv",
"_tsv_limit" : 1500000
},
"listParser" : "V3",
"phyloName" : "bpa",
......
bin/gargantext-cli/CleanCsvCorpus.hs
View file @ 5ec3c2af
......@@ -19,15 +19,15 @@ import Data.Set qualified as S
import Data.Text (pack)
import Data.Vector (Vector)
import Data.Vector qualified as V
import Gargantext.Core.Text.Corpus.Parsers.CSV qualified as CSV
import Gargantext.Core.Text.Corpus.Parsers.TSV qualified as TSV
import Gargantext.Core.Text.Search
import Gargantext.Prelude
------------------------------------------------------------------------
type Query = [S.Term]
filterDocs :: [DocId] -> Vector CSV.CsvGargV3 -> Vector CSV.CsvGargV3
filterDocs docIds = V.filter (\doc -> S.member (CSV.d_docId doc) $ S.fromList docIds )
filterDocs :: [DocId] -> Vector TSV.TsvGargV3 -> Vector TSV.TsvGargV3
filterDocs docIds = V.filter (\doc -> S.member (TSV.d_docId doc) $ S.fromList docIds )
main :: IO ()
......@@ -37,19 +37,19 @@ main = do
--let q = ["water", "scarcity", "morocco", "shortage","flood"]
let q = ["gratuit", "gratuité", "culture", "culturel"]
eDocs <- CSV.readCSVFile rPath
eDocs <- TSV.readTSVFile rPath
case eDocs of
Right (h, csvDocs) -> do
putStrLn ("Number of documents before:" <> show (V.length csvDocs) :: Text)
putStrLn ("Mean size of docs:" <> show ( CSV.docsSize csvDocs) :: Text)
Right (h, tsvDocs) -> do
putStrLn ("Number of documents before:" <> show (V.length tsvDocs) :: Text)
putStrLn ("Mean size of docs:" <> show ( TSV.docsSize tsvDocs) :: Text)
let docs = CSV.toDocs csvDocs
let docs = TSV.toDocs tsvDocs
let engine = S.insertDocs docs initialDocSearchEngine
let docIds = S.query engine (map pack q)
let docs' = CSV.fromDocs $ filterDocs docIds (V.fromList docs)
let docs' = TSV.fromDocs $ filterDocs docIds (V.fromList docs)
putStrLn ("Number of documents after:" <> show (V.length docs') :: Text)
putStrLn ("Mean size of docs:" <> show (CSV.docsSize docs') :: Text)
putStrLn ("Mean size of docs:" <> show (TSV.docsSize docs') :: Text)
CSV.writeFile wPath (h, docs')
TSV.writeFile wPath (h, docs')
Left e -> panicTrace $ "Error: " <> e
bin/gargantext-cli/Main.hs
View file @ 5ec3c2af
......@@ -26,8 +26,8 @@ import Data.Text.Lazy.Encoding qualified as TLE
import Data.Tuple.Extra (both)
import Data.Vector qualified as DV
import Gargantext.Core.Text.Context (TermList)
import Gargantext.Core.Text.Corpus.Parsers.CSV (readCSVFile, csv_title, csv_abstract, csv_publication_year, fromMIntOrDec, defaultYear)
import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
import Gargantext.Core.Text.Corpus.Parsers.TSV (readTSVFile, tsv_title, tsv_abstract, tsv_publication_year, fromMIntOrDec, defaultYear)
import Gargantext.Core.Text.List.Formats.TSV (tsvMapTermList)
import Gargantext.Core.Text.Metrics.Count (coocOnContexts, Coocs)
import Gargantext.Core.Text.Terms.WithList ( Patterns, buildPatterns, extractTermsWithList )
import Gargantext.Prelude
......@@ -72,16 +72,16 @@ main = do
[corpusFile, termListFile, outputFile] <- getArgs
--corpus :: IO (DM.IntMap [[Text]])
eCorpusFile <- readCSVFile corpusFile
eCorpusFile <- readTSVFile corpusFile
case eCorpusFile of
Right cf -> do
let corpus = DM.fromListWith (<>)
. DV.toList
. DV.map (\n -> (fromMIntOrDec defaultYear $ csv_publication_year n, [(csv_title n) <> " " <> (csv_abstract n)]))
. DV.map (\n -> (fromMIntOrDec defaultYear $ tsv_publication_year n, [(tsv_title n) <> " " <> (tsv_abstract n)]))
. snd $ cf
-- termListMap :: [Text]
termList <- csvMapTermList termListFile
termList <- tsvMapTermList termListFile
putText $ show $ length termList
......
bin/gargantext-import/Main.hs
View file @ 5ec3c2af
......@@ -41,7 +41,7 @@ main = do
let
--tt = (Unsupervised EN 6 0 Nothing)
tt = (Multi EN)
format = CsvGargV3 -- CsvHal --WOS
format = TsvGargV3 -- TsvHal --WOS
limit' = case (readMaybe limit :: Maybe Limit) of
Nothing -> panicTrace $ "Cannot read limit: " <> (Text.pack limit)
Just l -> l
......@@ -49,8 +49,8 @@ main = do
mkCorpusUser = MkCorpusUserNormalCorpusName (UserName $ cs user) (cs name :: Text)
corpus = flowCorpusFile mkCorpusUser limit' tt format Plain corpusPath Nothing DevJobHandle
corpusCsvHal :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
corpusCsvHal = flowCorpusFile mkCorpusUser limit' tt CsvHal Plain corpusPath Nothing DevJobHandle
corpusTsvHal :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
corpusTsvHal = flowCorpusFile mkCorpusUser limit' tt TsvHal Plain corpusPath Nothing DevJobHandle
annuaire :: forall m. (FlowCmdM DevEnv BackendInternalError m, MonadJobStatus m, JobHandle m ~ DevJobHandle) => m CorpusId
annuaire = flowAnnuaire (MkCorpusUserNormalCorpusName (UserName $ cs user) "Annuaire") (Multi EN) corpusPath DevJobHandle
......@@ -71,8 +71,8 @@ main = do
then runCmdGargDev env corpus
else pure 0 --(cs "false")
_ <- if fun == "corpusCsvHal"
then runCmdGargDev env corpusCsvHal
_ <- if fun == "corpusTsvHal"
then runCmdGargDev env corpusTsvHal
else pure 0 --(cs "false")
_ <- if fun == "annuaire"
......
bin/gargantext-invitations/Main.hs
View file @ 5ec3c2af
......@@ -24,7 +24,8 @@ import Gargantext.Database.Prelude (CmdRandom)
import Gargantext.Prelude
import Gargantext.Prelude.Config (readConfig)
import Prelude (read)
import qualified Gargantext.API.Node.Share as Share
import Gargantext.API.Node.Share.Types qualified as Share
import Gargantext.API.Node.Share qualified as Share
main :: IO ()
main = do
......
bin/gargantext-phylo-profile/Main.hs
View file @ 5ec3c2af
......@@ -26,7 +26,7 @@ phyloConfig outdir = PhyloConfig {
corpusPath = "corpus.csv"
, listPath = "list.csv"
, outputPath = outdir
, corpusParser = Csv {_csv_limit = 150000}
, corpusParser = Tsv {_tsv_limit = 150000}
, listParser = V4
, phyloName = "phylo_profile_test"
, phyloScale = 2
......
bin/gargantext-phylo/Main.hs
View file @ 5ec3c2af
......@@ -31,9 +31,9 @@ import Gargantext.API.Ngrams.Prelude (toTermList)
import Gargantext.API.Ngrams.Types
import Gargantext.Core.Text.Context (TermList)
import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..), parseFile)
import Gargantext.Core.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year, csv_publication_month, csv_publication_day, csv'_source, csv'_title, csv'_abstract, csv'_publication_year, csv'_publication_month, csv'_publication_day, csv'_weight)
import Gargantext.Core.Text.Corpus.Parsers.CSV qualified as Csv
import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
import Gargantext.Core.Text.Corpus.Parsers.TSV (tsv_title, tsv_abstract, tsv_publication_year, tsv_publication_month, tsv_publication_day, tsv'_source, tsv'_title, tsv'_abstract, tsv'_publication_year, tsv'_publication_month, tsv'_publication_day, tsv'_weight)
import Gargantext.Core.Text.Corpus.Parsers.TSV qualified as Tsv
import Gargantext.Core.Text.List.Formats.TSV (tsvMapTermList)
import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList)
import Gargantext.Core.Types.Main (ListType(..))
......
bin/gargantext-phylo/Phylo/Common.hs
View file @ 5ec3c2af
......@@ -15,9 +15,9 @@ import Gargantext.API.Ngrams.Prelude (toTermList)
import Gargantext.API.Ngrams.Types
import Gargantext.Core.Text.Context (TermList)
import Gargantext.Core.Text.Corpus.Parsers (FileFormat(..), FileType(..), parseFile)
import Gargantext.Core.Text.Corpus.Parsers.CSV (csv_title, csv_abstract, csv_publication_year, csv_publication_month, csv_publication_day, csv'_source, csv'_title, csv'_abstract, csv'_publication_year, csv'_publication_month, csv'_publication_day, csv'_weight)
import Gargantext.Core.Text.Corpus.Parsers.CSV qualified as Csv
import Gargantext.Core.Text.List.Formats.CSV (csvMapTermList)
import Gargantext.Core.Text.Corpus.Parsers.TSV (tsv_title, tsv_abstract, tsv_publication_year, tsv_publication_month, tsv_publication_day, tsv'_source, tsv'_title, tsv'_abstract, tsv'_publication_year, tsv'_publication_month, tsv'_publication_day, tsv'_weight)
import Gargantext.Core.Text.Corpus.Parsers.TSV qualified as Tsv
import Gargantext.Core.Text.List.Formats.TSV (tsvMapTermList)
import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, extractTermsWithList)
import Gargantext.Core.Types.Main (ListType(..))
......@@ -76,29 +76,29 @@ wosToDocs limit patterns time path = do
<$> fromRight [] <$> parseFile WOS Plain (path <> file) ) files
-- To transform a Csv file into a list of Document
csvToDocs :: CorpusParser -> Patterns -> TimeUnit -> FilePath -> IO [Document]
csvToDocs parser patterns time path =
-- To transform a Tsv file into a list of Document
tsvToDocs :: CorpusParser -> Patterns -> TimeUnit -> FilePath -> IO [Document]
tsvToDocs parser patterns time path =
case parser of
Wos _ -> Prelude.error "csvToDocs: unimplemented"
Csv limit -> Vector.toList
Wos _ -> Prelude.error "tsvToDocs: unimplemented"
Tsv limit -> Vector.toList
<$> Vector.take limit
<$> Vector.map (\row -> Document (toPhyloDate (Csv.fromMIntOrDec Csv.defaultYear $ csv_publication_year row) (fromMaybe Csv.defaultMonth $ csv_publication_month row) (fromMaybe Csv.defaultDay $ csv_publication_day row) time)
(toPhyloDate' (Csv.fromMIntOrDec Csv.defaultYear $ csv_publication_year row) (fromMaybe Csv.defaultMonth $ csv_publication_month row) (fromMaybe Csv.defaultDay $ csv_publication_day row) time)
(termsInText patterns $ (csv_title row) <> " " <> (csv_abstract row))
<$> Vector.map (\row -> Document (toPhyloDate (Tsv.fromMIntOrDec Tsv.defaultYear $ tsv_publication_year row) (fromMaybe Tsv.defaultMonth $ tsv_publication_month row) (fromMaybe Tsv.defaultDay $ tsv_publication_day row) time)
(toPhyloDate' (Tsv.fromMIntOrDec Tsv.defaultYear $ tsv_publication_year row) (fromMaybe Tsv.defaultMonth $ tsv_publication_month row) (fromMaybe Tsv.defaultDay $ tsv_publication_day row) time)
(termsInText patterns $ (tsv_title row) <> " " <> (tsv_abstract row))
Nothing
[]
time
) <$> snd <$> either (\err -> panicTrace $ "CSV error" <> (show err)) identity <$> Csv.readCSVFile path
Csv' limit -> Vector.toList
) <$> snd <$> either (\err -> panicTrace $ "TSV error" <> (show err)) identity <$> Tsv.readTSVFile path
Tsv' limit -> Vector.toList
<$> Vector.take limit
<$> Vector.map (\row -> Document (toPhyloDate (csv'_publication_year row) (csv'_publication_month row) (csv'_publication_day row) time)
(toPhyloDate' (csv'_publication_year row) (csv'_publication_month row) (csv'_publication_day row) time)
(termsInText patterns $ (csv'_title row) <> " " <> (csv'_abstract row))
(Just $ csv'_weight row)
(map (T.strip . pack) $ splitOn ";" (unpack $ (csv'_source row)))
<$> Vector.map (\row -> Document (toPhyloDate (tsv'_publication_year row) (tsv'_publication_month row) (tsv'_publication_day row) time)
(toPhyloDate' (tsv'_publication_year row) (tsv'_publication_month row) (tsv'_publication_day row) time)
(termsInText patterns $ (tsv'_title row) <> " " <> (tsv'_abstract row))
(Just $ tsv'_weight row)
(map (T.strip . pack) $ splitOn ";" (unpack $ (tsv'_source row)))
time
) <$> snd <$> Csv.readWeightedCsv path
) <$> snd <$> Tsv.readWeightedTsv path
-- To parse a file into a list of Document
......@@ -107,8 +107,8 @@ fileToDocsAdvanced parser path time lst = do
let patterns = buildPatterns lst
case parser of
Wos limit -> wosToDocs limit patterns time path
Csv _ -> csvToDocs parser patterns time path
Csv' _ -> csvToDocs parser patterns time path
Tsv _ -> tsvToDocs parser patterns time path
Tsv' _ -> tsvToDocs parser patterns time path
fileToDocsDefault :: CorpusParser -> FilePath -> [TimeUnit] -> TermList -> IO [Document]
fileToDocsDefault parser path timeUnits lst =
......@@ -140,7 +140,7 @@ readListV4 path = do
fileToList :: ListParser -> FilePath -> IO TermList
fileToList parser path =
case parser of
V3 -> csvMapTermList path
V3 -> tsvMapTermList path
V4 -> fromJust
<$> toTermList MapTerm NgramsTerms
<$> readListV4 path
......
bin/metrics/histo/users.sql
View file @ 5ec3c2af
\COPY (select count(*), date_trunc('month', a.date_joined) from auth_user a group by 2) TO '/tmp/users.csv' (FORMAT csv);
\COPY (select count(*), date_trunc('month', a.date_joined) from auth_user a group by 2 ORDER BY 2) TO '/tmp/users.csv' (FORMAT csv);
......
bin/update-project-dependencies
View file @ 5ec3c2af
......@@ -18,8 +18,8 @@ fi
# with the `sha256sum` result calculated on the `cabal.project` and
# `cabal.project.freeze`. This ensures the files stay deterministic so that CI
# cache can kick in.
expected_cabal_project_hash="0d3f7f5beed88c1afe95e0df8a91080440ba59049f3610bf2343132635038d22"
expected_cabal_project_freeze_hash="9b2cac3a02e9b129bd80253fc407782bf10c7ed62ed21be41c720d30ed17ef53"
expected_cabal_project_hash="3d88bb97cd394b645692343591ae3230d5393ee07b4e805251fffb9aed4a52dd"
expected_cabal_project_freeze_hash="09930a2fa36e4325d46e5d069595d300c6017472f405f8ac67158377816d132a"
cabal --store-dir=$STORE_DIR v2-build --dry-run
cabal2stack --system-ghc --allow-newer --resolver lts-21.17 --resolver-file devops/stack/lts-21.17.yaml -o stack.yaml
......
cabal.project
View file @ 5ec3c2af
......@@ -51,8 +51,8 @@ source-repository-package
source-repository-package
type: git
location: https://github.com/alpmestan/servant-job.git
tag: b4182487cfe479777c11ca19f3c0d47840b376f6
location: https://github.com/adinapoli/servant-job.git
tag: 74a3296dfe1f0c4a3ade91336dcc689330e84156
source-repository-package
type: git
......@@ -93,7 +93,7 @@ source-repository-package
source-repository-package
type: git
location: https://gitlab.iscpif.fr/gargantext/crawlers/hal.git
tag: b99b9e568c8bdc73af2b8016ed03ba5ee83c2030
tag: 3a7d039e07c8564e8ff84ef88480924d18aa5018
source-repository-package
type: git
......
cabal.project.freeze
View file @ 5ec3c2af
......@@ -499,7 +499,7 @@ constraints: any.Cabal ==3.8.1.0,
any.servant-multipart ==0.12.1,
any.servant-multipart-api ==0.12.1,
any.servant-server ==0.20,
any.servant-swagger ==1.1.11,
any.servant-swagger ==1.2,
any.servant-swagger-ui ==0.3.5.5.0.0,
any.servant-swagger-ui-core ==0.3.5,
any.servant-xml-conduit ==0.1.0.4,
......
gargantext.cabal
View file @ 5ec3c2af
......@@ -5,7 +5,7 @@ cabal-version: 3.4
-- see: https://github.com/sol/hpack
name: gargantext
version: 0.0.7.1.5.3
version: 0.0.7.1.6.5
synopsis: Search, map, share
description: Please see README.md
category: Data
......@@ -38,13 +38,13 @@ data-files:
test-data/phylo/bpa_phylo_test.json
test-data/phylo/cleopatre.golden.json
test-data/phylo/nadal.golden.json
test-data/phylo/nadal_docslist.golden.csv
test-data/phylo/nadal_ngramslist.golden.csv
test-data/phylo/nadal_docslist.golden.tsv
test-data/phylo/nadal_ngramslist.golden.tsv
test-data/phylo/issue-290-small.golden.json
test-data/phylo/open_science.json
test-data/phylo/small-phylo.golden.json
test-data/phylo/small_phylo_docslist.csv
test-data/phylo/small_phylo_ngramslist.csv
test-data/phylo/small_phylo_docslist.tsv
test-data/phylo/small_phylo_ngramslist.tsv
test-data/phylo/187481.json
test-data/phylo/phylo2dot2json.golden.json
test-data/stemming/lancaster.txt
......@@ -113,6 +113,7 @@ library
Gargantext.API.Admin.Settings.CORS
Gargantext.API.Admin.Types
Gargantext.API.Auth.PolicyCheck
Gargantext.API.Count.Types
Gargantext.API.Dev
Gargantext.API.Errors
Gargantext.API.Errors.Class
......@@ -132,18 +133,23 @@ library
Gargantext.API.Node.Corpus.Types
Gargantext.API.Node.Corpus.Update
Gargantext.API.Node.File
Gargantext.API.Node.File.Types
Gargantext.API.Node.Share
Gargantext.API.Node.Share.Types
Gargantext.API.Node.ShareURL
Gargantext.API.Node.Types
Gargantext.API.Node.Update
Gargantext.API.Node.Update.Types
Gargantext.API.Prelude
Gargantext.API.Routes
Gargantext.API.Routes.Named
Gargantext.API.Routes.Named.Annuaire
Gargantext.API.Routes.Named.Contact
Gargantext.API.Routes.Named.Context
Gargantext.API.Routes.Named.Corpus
Gargantext.API.Routes.Named.Count
Gargantext.API.Routes.Named.Document
Gargantext.API.Routes.Named.EKG
Gargantext.API.Routes.Named.File
Gargantext.API.Routes.Named.FrameCalc
Gargantext.API.Routes.Named.List
......@@ -157,6 +163,8 @@ library
Gargantext.API.Routes.Named.Tree
Gargantext.API.Routes.Named.Viz
Gargantext.API.Routes.Types
Gargantext.API.Types
Gargantext.API.Viz.Types
Gargantext.Core
Gargantext.Core.Mail.Types
Gargantext.Core.Methods.Similarities
......@@ -173,13 +181,13 @@ library
Gargantext.Core.Text.Corpus.API.OpenAlex
Gargantext.Core.Text.Corpus.API.Pubmed
Gargantext.Core.Text.Corpus.Parsers
Gargantext.Core.Text.Corpus.Parsers.CSV
Gargantext.Core.Text.Corpus.Parsers.TSV
Gargantext.Core.Text.Corpus.Parsers.Date
Gargantext.Core.Text.Corpus.Parsers.Date.Parsec
Gargantext.Core.Text.Corpus.Query
Gargantext.Core.Text.List
Gargantext.Core.Text.List.Group.WithStem
Gargantext.Core.Text.List.Formats.CSV
Gargantext.Core.Text.List.Formats.TSV
Gargantext.Core.Text.Metrics
Gargantext.Core.Text.Metrics.CharByChar
Gargantext.Core.Text.Metrics.Count
......@@ -288,6 +296,7 @@ library
Gargantext.API.Metrics
Gargantext.API.Ngrams.NgramsTree
Gargantext.API.Node.Contact
Gargantext.API.Node.Contact.Types
Gargantext.API.Node.Corpus.Annuaire
Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export.Types
......@@ -299,17 +308,27 @@ library
Gargantext.API.Node.Phylo.Export
Gargantext.API.Node.Phylo.Export.Types
Gargantext.API.Node.DocumentUpload
Gargantext.API.Node.DocumentUpload.Types
Gargantext.API.Node.DocumentsFromWriteNodes
Gargantext.API.Node.DocumentsFromWriteNodes.Types
Gargantext.API.Node.FrameCalcUpload
Gargantext.API.Node.FrameCalcUpload.Types
Gargantext.API.Node.Get
Gargantext.API.Node.New
Gargantext.API.Public
Gargantext.API.Node.New.Types
Gargantext.API.Public.Types
Gargantext.API.Search
Gargantext.API.Server
Gargantext.API.Search.Types
Gargantext.API.Server.Named
Gargantext.API.Server.Named.EKG
Gargantext.API.Server.Named.Ngrams
Gargantext.API.Server.Named.Private
Gargantext.API.Server.Named.Public
Gargantext.API.Server.Named.Viz
Gargantext.API.Swagger
Gargantext.API.Table
Gargantext.API.Table.Types
Gargantext.API.ThrowAll
Gargantext.API.Types
Gargantext.Core.Ext.IMT
Gargantext.Core.Ext.IMTUser
Gargantext.Core.Flow.Ngrams
......@@ -622,8 +641,9 @@ library
, servant-job >= 0.2.0.0
, servant-multipart ^>= 0.12.1
, servant-server >= 0.18.3 && < 0.20
, servant-swagger ^>= 1.1.10
, servant-swagger >= 1.2
, servant-swagger-ui ^>= 0.3.5.3.5.0
, servant-swagger-ui-core >= 0.3.5
, servant-xml-conduit >= 0.1.0.4
, simple-reflect ^>= 0.3.3
, singletons ^>= 2.7
......
src/Gargantext/API.hs
View file @ 5ec3c2af
......@@ -46,10 +46,11 @@ import Gargantext.API.Admin.EnvTypes (Env, Mode(..))
import Gargantext.API.Admin.Settings (newEnv)
import Gargantext.API.Admin.Settings.CORS
import Gargantext.API.Admin.Types (FireWall(..), PortNumber, cookieSettings, jwtSettings, settings, corsSettings)
import Gargantext.API.EKG
import Gargantext.API.Routes.Named.EKG
import Gargantext.API.Middleware (logStdoutDevSanitised)
import Gargantext.API.Routes
import Gargantext.API.Server (server)
import Gargantext.API.Routes.Named (API)
import Gargantext.API.Server.Named (server)
import Gargantext.API.Server.Named.EKG
import Gargantext.Database.Prelude qualified as DB
import Gargantext.Prelude hiding (putStrLn)
import Gargantext.System.Logging
......@@ -166,11 +167,12 @@ makeGargMiddleware crsSettings mode = do
makeApp :: Env -> IO Application
makeApp env = do
serv <- server env
(ekgStore, ekgMid) <- newEkgStore api
ekgDir <- (</> "ekg-assets") <$> getDataDir
pure $ ekgMid $ serveWithContext apiWithEkg cfg
(ekgServer ekgDir ekgStore :<|> serv)
(WithEkg { ekgAPI = ekgServer ekgDir ekgStore
, wrappedAPI = server env
})
where
cfg :: Servant.Context AuthContext
cfg = env ^. settings . jwtSettings
......@@ -178,12 +180,15 @@ makeApp env = do
:. EmptyContext
---------------------------------------------------------------------
api :: Proxy API
api :: Proxy (NamedRoutes API)
api = Proxy
apiWithEkg :: Proxy (EkgAPI :<|> API)
apiWithEkg = Proxy
apiGarg :: Proxy GargAPI
apiGarg = Proxy
---------------------------------------------------------------------
data WithEkg api mode = WithEkg
{ ekgAPI :: mode :- NamedRoutes EkgAPI
, wrappedAPI :: mode :- NamedRoutes api
} deriving Generic
apiWithEkg :: Proxy (NamedRoutes (WithEkg API))
apiWithEkg = Proxy
src/Gargantext/API/Admin/Auth.hs
View file @ 5ec3c2af
......@@ -27,41 +27,42 @@ And you have the main viz
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
module Gargantext.API.Admin.Auth
( auth
, withPolicy
, withPolicyT
, withNamedPolicyT
, forgotPassword
, forgotPasswordAsync
, withAccess
, ForgotPasswordAPI
, withNamedAccess
, ForgotPasswordAsyncParams
, ForgotPasswordAsyncAPI
)
where
import Control.Lens (view, (#))
import Data.Aeson
import Data.Swagger (ToSchema(..))
import Data.Text qualified as Text
import Data.Text.Lazy.Encoding qualified as LE
import Data.UUID (UUID, fromText, toText)
import Data.UUID.V4 (nextRandom)
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Admin.Types
import Gargantext.API.Auth.PolicyCheck
import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, GargServer, _ServerError, GargM)
import Gargantext.API.Errors
import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC, _ServerError, GargM, IsGargServer)
import Gargantext.Core.Mail (MailModel(..), mail)
import Gargantext.Core.Mail.Types (mailSettings)
import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Action.User.New (guessUserName)
import Gargantext.Database.Admin.Types.Node (NodeId(..))
import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
import Gargantext.Database.Admin.Types.Node (UserId)
import Gargantext.Database.Prelude (Cmd', CmdCommon, DbCmd')
import Gargantext.Database.Query.Table.User
import Gargantext.Database.Query.Tree (isDescendantOf, isIn)
import Gargantext.Database.Query.Tree.Root (getRoot)
......@@ -71,8 +72,10 @@ import Gargantext.Prelude.Crypto.Auth qualified as Auth
import Gargantext.Prelude.Crypto.Pass.User (gargPass)
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant
import Servant.API.Generic ()
import Servant.Auth.Server
import Gargantext.API.Errors
import Servant.Server.Generic
import qualified Gargantext.API.Routes.Named as Named
---------------------------------------------------
......@@ -163,10 +166,23 @@ withAccess p _ ur id = hoistServer p f
f :: forall a. m a -> m a
f = withAccessM ur id
withNamedAccess :: forall env err m routes.
( IsGargServer env err m
, HasServer (NamedRoutes routes) '[]
)
=> AuthenticatedUser
-> PathId
-> routes (AsServerT m)
-> routes (AsServerT m)
withNamedAccess ur pathId = hoistServer (Proxy @(NamedRoutes routes)) f
where
f :: forall a. m a -> m a
f = withAccessM ur pathId
-- | Given the 'AuthenticatedUser', a policy check and a function that returns an @a@,
-- it runs the underlying policy check to ensure that the resource is returned only to
-- who is entitled to see it.
withPolicy :: GargServerC env BackendInternalError m
withPolicy :: IsGargServer env BackendInternalError m
=> AuthenticatedUser
-> BoolExpr AccessCheck
-> m a
......@@ -179,8 +195,21 @@ withPolicy ur checks m mgr = case mgr of
Allow -> m
Deny err -> throwError $ InternalServerError $ err
-- FIXME(adn) the types are wrong.
withNamedPolicyT :: forall env m routes.
( IsGargServer env BackendInternalError m
, HasServer (NamedRoutes routes) '[]
)
=> AuthenticatedUser
-> BoolExpr AccessCheck
-> routes (AsServerT m)
-> AccessPolicyManager
-> routes (AsServerT m)
withNamedPolicyT ur checks m mgr =
hoistServer (Proxy @(NamedRoutes routes)) (\n -> withPolicy ur checks n mgr) m
withPolicyT :: forall env m api. (
GargServerC env BackendInternalError m
IsGargServer env BackendInternalError m
, HasServer api '[]
)
=> Proxy api
......@@ -202,26 +231,12 @@ User can invite User in Team as NodeNode only if Team in his parents.
All users can access to the Team folder as if they were owner.
-}
newtype ForgotPasswordAsyncParams =
ForgotPasswordAsyncParams { email :: Text }
deriving (Generic, Show)
instance FromJSON ForgotPasswordAsyncParams where
parseJSON = genericParseJSON defaultOptions
instance ToJSON ForgotPasswordAsyncParams where
toJSON = genericToJSON defaultOptions
instance ToSchema ForgotPasswordAsyncParams
type ForgotPasswordAPI = Summary "Forgot password POST API"
:> ReqBody '[JSON] ForgotPasswordRequest
:> Post '[JSON] ForgotPasswordResponse
:<|> Summary "Forgot password GET API"
:> QueryParam "uuid" Text
:> Get '[JSON] ForgotPasswordGet
forgotPassword :: GargServer ForgotPasswordAPI
forgotPassword :: IsGargServer env err m => Named.ForgotPasswordAPI (AsServerT m)
-- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
forgotPassword = forgotPasswordPost :<|> forgotPasswordGet
forgotPassword = Named.ForgotPasswordAPI
{ forgotPasswordPostEp = forgotPasswordPost
, forgotPasswordGetEp = forgotPasswordGet
}
forgotPasswordPost :: (CmdCommon env)
=> ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
......@@ -310,11 +325,8 @@ generateForgotPasswordUUID = do
-- NOTE THe async endpoint is better for the "forget password"
-- request, because the delay in email sending etc won't reveal to
-- malicious users emails of our users in the db
type ForgotPasswordAsyncAPI = Summary "Forgot password asnc"
:> AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog
forgotPasswordAsync :: ServerT ForgotPasswordAsyncAPI (GargM Env BackendInternalError)
forgotPasswordAsync =
forgotPasswordAsync :: Named.ForgotPasswordAsyncAPI (AsServerT (GargM Env BackendInternalError))
forgotPasswordAsync = Named.ForgotPasswordAsyncAPI $ AsyncJobs $
serveJobsAPI ForgotPasswordJob $ \jHandle p -> forgotPasswordAsync' p jHandle
forgotPasswordAsync' :: (FlowCmdM env err m, MonadJobStatus m)
......
src/Gargantext/API/Admin/Auth/Types.hs
View file @ 5ec3c2af
......@@ -11,9 +11,36 @@ Portability : POSIX
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Admin.Auth.Types
where
import qualified Data.Aeson.TH as JSON
( -- * Types
AuthRequest(..)
, AuthResponse(..)
, Token
, TreeId
, CheckAuth(..)
, AuthenticatedUser(..)
, AuthContext
, AuthenticationError(..)
, PathId(..)
, Email
, Password
, ForgotPasswordRequest(..)
, ForgotPasswordResponse(..)
, ForgotPasswordAsyncParams(..)
, ForgotPasswordGet(..)
-- * Lenses
, auth_node_id
, auth_user_id
, authRes_token
, authRes_tree_id
, authRes_user_id
-- * Combinators
) where
import Crypto.JWT qualified as Jose
import Data.Aeson.TH qualified as JSON
import Data.Aeson.Types (genericParseJSON, defaultOptions, genericToJSON)
import Data.List (tail)
import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
import Gargantext.Core.Types.Individu (Username, GargPassword(..), arbitraryUsername, arbitraryPassword)
......@@ -23,7 +50,6 @@ import Gargantext.Prelude hiding (reverse)
import Servant.Auth.Server
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
import qualified Crypto.JWT as Jose
---------------------------------------------------
......@@ -106,6 +132,15 @@ data ForgotPasswordGet = ForgotPasswordGet {_fpGet_password :: Password}
instance ToSchema ForgotPasswordGet where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpGet_")
newtype ForgotPasswordAsyncParams =
ForgotPasswordAsyncParams { email :: Text }
deriving (Generic, Show)
instance FromJSON ForgotPasswordAsyncParams where
parseJSON = genericParseJSON defaultOptions
instance ToJSON ForgotPasswordAsyncParams where
toJSON = genericToJSON defaultOptions
instance ToSchema ForgotPasswordAsyncParams
--
-- Lenses
--
......
src/Gargantext/API/Admin/EnvTypes.hs
View file @ 5ec3c2af
......@@ -34,7 +34,7 @@ import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Types
import Gargantext.API.Errors.Types
import Gargantext.API.Job
import Gargantext.API.Prelude (GargM)
import Gargantext.API.Prelude (GargM, IsGargServer)
import Gargantext.Core.Mail.Types (HasMail, mailSettings)
import Gargantext.Core.NLP (NLPServerMap, HasNLPServer(..))
import Gargantext.Core.NodeStory
......@@ -91,7 +91,7 @@ data GargJob
= TableNgramsJob
| ForgotPasswordJob
| UpdateNgramsListJobJSON
| UpdateNgramsListJobCSV
| UpdateNgramsListJobTSV
| AddContactJob
| AddFileJob
| DocumentFromWriteNodeJob
......@@ -322,3 +322,6 @@ instance HasMail DevEnv where
instance HasNLPServer DevEnv where
nlpServer = dev_env_nlp
instance IsGargServer Env BackendInternalError (GargM Env BackendInternalError)
src/Gargantext/API/Admin/Orchestrator/Types.hs
View file @ 5ec3c2af
......@@ -136,5 +136,6 @@ type ScrapersEnv = JobEnv JobLog JobLog
type ScraperAPI = AsyncJobsAPI JobLog ScraperInput JobLog
------------------------------------------------------------------------
type AsyncJobs event ctI input output =
AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output
data AsyncJobs event ctI input output mode = AsyncJobs
{ asyncJobsAPI' :: mode :- AsyncJobsAPI' 'Unsafe 'Safe ctI '[JSON] Maybe event input output }
deriving Generic
src/Gargantext/API/Auth/PolicyCheck.hs
View file @ 5ec3c2af
......@@ -39,6 +39,7 @@ import Servant.Ekg
import Servant.Server.Internal.Delayed
import Servant.Server.Internal.DelayedIO
import qualified Servant.Swagger as Swagger
import Servant.Client.Core
-------------------------------------------------------------------------------
-- Types
......@@ -196,6 +197,12 @@ instance HasEndpoint sub => HasEndpoint (PolicyChecked sub) where
getEndpoint _ = getEndpoint (Proxy :: Proxy sub)
enumerateEndpoints _ = enumerateEndpoints (Proxy :: Proxy sub)
instance HasClient m sub => HasClient m (PolicyChecked sub) where
type Client m (PolicyChecked sub) = AccessPolicyManager -> Client m sub
clientWithRoute m _ req _mgr = clientWithRoute m (Proxy :: Proxy sub) req
hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl
-------------------------------------------------------------------------------
-- Utility functions
-------------------------------------------------------------------------------
......
src/Gargantext/API/Context.hs
View file @ 5ec3c2af
......@@ -23,28 +23,27 @@ import Prelude
import Data.Aeson (FromJSON, ToJSON)
import Servant
import Gargantext.API.Admin.Auth (withAccess)
import Gargantext.API.Admin.Auth (withNamedAccess)
import Gargantext.API.Admin.Auth.Types (PathId(..), AuthenticatedUser)
import Gargantext.API.Prelude
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (JSONB)
import Gargantext.Database.Query.Table.Context
import Servant.Server.Generic (AsServerT)
import Gargantext.API.Routes.Named.Context qualified as Named
-------------------------------------------------------------------
-- TODO use Context instead of Node
type ContextAPI a = Get '[JSON] (Node a)
------------------------------------------------------------------------
-- TODO NodeAPI -> ContextAPI
contextAPI :: forall proxy a.
( JSONB a
, FromJSON a
, ToJSON a
) => proxy a
-> AuthenticatedUser
-> ContextId
-> GargServer (ContextAPI a)
contextAPI p uId id' = withAccess (Proxy :: Proxy (ContextAPI a)) Proxy uId (PathNode $ contextId2NodeId id') contextAPI'
contextAPI :: ( IsGargServer env err m
, JSONB a
, FromJSON a
, ToJSON a )
=> Proxy a
-> AuthenticatedUser
-> ContextId
-> Named.ContextAPI a (AsServerT m)
contextAPI p uId id' =
withNamedAccess uId (PathNode $ contextId2NodeId id') contextAPI'
where
contextAPI' :: GargServer (ContextAPI a)
contextAPI' = getContextWith id' p
contextAPI' = Named.ContextAPI $ getContextWith id' p
src/Gargantext/API/Count.hs
View file @ 5ec3c2af
......@@ -17,143 +17,17 @@ Count API part of Gargantext.
{-# LANGUAGE DeriveAnyClass #-}
module Gargantext.API.Count (
CountAPI
, Scraper(..)
, QueryBool(..)
, Query(..)
, Message(..)
, Code
, Error
, Errors
, Counts(..)
, Count(..)
-- * functions
, count
, scrapers
countAPI
) where
import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
import Data.Text (pack)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.API.Count.Types
import Gargantext.API.Routes.Named.Count qualified as Named
import Gargantext.Prelude
import Servant (JSON, Post)
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary(..))
import Servant.Server.Generic (AsServerT)
-----------------------------------------------------------------------
-- TODO-ACCESS: CanCount
-- TODO-EVENTS: No events as this is a read only query.
type CountAPI = Post '[JSON] Counts
-----------------------------------------------------------------------
data Scraper = Pubmed | Hal | IsTex | Isidore
deriving (Eq, Show, Generic, Enum, Bounded)
scrapers :: [Scraper]
scrapers = [minBound..maxBound]
instance FromJSON Scraper
instance ToJSON Scraper
instance Arbitrary Scraper where
arbitrary = elements scrapers
instance ToSchema Scraper
-----------------------------------------------------------------------
data QueryBool = QueryBool Text
deriving (Eq, Show, Generic)
queries :: [QueryBool]
queries = [QueryBool (pack "(X OR X') AND (Y OR Y') NOT (Z OR Z')")]
--queries = [QueryBool (pack "(X + X') * (Y + Y') - (Z + Z')")]
instance Arbitrary QueryBool where
arbitrary = elements queries
instance FromJSON QueryBool
instance ToJSON QueryBool
instance ToSchema QueryBool
-----------------------------------------------------------------------
data Query = Query { query_query :: QueryBool
, query_name :: Maybe [Scraper]
}
deriving (Eq, Show, Generic)
instance FromJSON Query
instance ToJSON Query
instance Arbitrary Query where
arbitrary = elements [ Query q (Just n)
| q <- queries
, n <- take 10 $ permutations scrapers
]
instance ToSchema Query where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
-----------------------------------------------------------------------
type Code = Integer
type Error = Text
type Errors = [Error]
-----------------------------------------------------------------------
data Message = Message Code Errors
deriving (Eq, Show, Generic)
toMessage :: [(Code, Errors)] -> [Message]
toMessage = map (\(c,err) -> Message c err)
messages :: [Message]
messages = toMessage $ [ (400, ["Ill formed query "])
, (300, ["API connexion error "])
, (300, ["Internal Gargantext Error "])
] <> take 10 ( repeat (200, [""]))
instance Arbitrary Message where
arbitrary = elements messages
instance ToSchema Message
-----------------------------------------------------------------------
data Counts = Counts { results :: [Either Message Count]
} deriving (Eq, Show, Generic)
instance Arbitrary Counts where
arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
, Right (Count IsTex (Just 150))
, Right (Count Hal (Just 150))
]
]
instance ToSchema Counts
-----------------------------------------------------------------------
data Count = Count { count_name :: Scraper
, count_count :: Maybe Int
}
deriving (Eq, Show, Generic)
instance ToSchema Count where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
--instance Arbitrary Count where
-- arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
-----------------------------------------------------------------------
count :: Monad m => Query -> m Counts
count _ = undefined
--
-- JSON instances
--
instance FromJSON Message
instance ToJSON Message
$(deriveJSON (unPrefix "count_") ''Count)
instance FromJSON Counts
instance ToJSON Counts
countAPI :: Monad m => Query -> Named.CountAPI (AsServerT m)
countAPI _ = Named.CountAPI undefined
src/Gargantext/API/Count/Types.hs 0 → 100644
View file @ 5ec3c2af
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Count.Types (
Scraper(..)
, QueryBool(..)
, Query(..)
, Message(..)
, Code
, Error
, Errors
, Counts(..)
, Count(..)
-- * functions
, scrapers
) where
import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
import Data.Text (pack)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
import Gargantext.Prelude
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary(..))
-----------------------------------------------------------------------
data Scraper = Pubmed | Hal | IsTex | Isidore
deriving (Eq, Show, Generic, Enum, Bounded)
scrapers :: [Scraper]
scrapers = [minBound..maxBound]
instance FromJSON Scraper
instance ToJSON Scraper
instance Arbitrary Scraper where
arbitrary = elements scrapers
instance ToSchema Scraper
-----------------------------------------------------------------------
data QueryBool = QueryBool Text
deriving (Eq, Show, Generic)
queries :: [QueryBool]
queries = [QueryBool (pack "(X OR X') AND (Y OR Y') NOT (Z OR Z')")]
--queries = [QueryBool (pack "(X + X') * (Y + Y') - (Z + Z')")]
instance Arbitrary QueryBool where
arbitrary = elements queries
instance FromJSON QueryBool
instance ToJSON QueryBool
instance ToSchema QueryBool
-----------------------------------------------------------------------
data Query = Query { query_query :: QueryBool
, query_name :: Maybe [Scraper]
}
deriving (Eq, Show, Generic)
instance FromJSON Query
instance ToJSON Query
instance Arbitrary Query where
arbitrary = elements [ Query q (Just n)
| q <- queries
, n <- take 10 $ permutations scrapers
]
instance ToSchema Query where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
-----------------------------------------------------------------------
type Code = Integer
type Error = Text
type Errors = [Error]
-----------------------------------------------------------------------
data Message = Message Code Errors
deriving (Eq, Show, Generic)
toMessage :: [(Code, Errors)] -> [Message]
toMessage = map (\(c,err) -> Message c err)
messages :: [Message]
messages = toMessage $ [ (400, ["Ill formed query "])
, (300, ["API connexion error "])
, (300, ["Internal Gargantext Error "])
] <> take 10 ( repeat (200, [""]))
instance Arbitrary Message where
arbitrary = elements messages
instance ToSchema Message
-----------------------------------------------------------------------
data Counts = Counts { results :: [Either Message Count]
} deriving (Eq, Show, Generic)
instance Arbitrary Counts where
arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
, Right (Count IsTex (Just 150))
, Right (Count Hal (Just 150))
]
]
instance ToSchema Counts
-----------------------------------------------------------------------
data Count = Count { count_name :: Scraper
, count_count :: Maybe Int
}
deriving (Eq, Show, Generic)
instance ToSchema Count where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
--instance Arbitrary Count where
-- arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
--
-- JSON instances
--
instance FromJSON Message
instance ToJSON Message
$(deriveJSON (unPrefix "count_") ''Count)
instance FromJSON Counts
instance ToJSON Counts
src/Gargantext/API/Errors.hs
View file @ 5ec3c2af
......@@ -128,8 +128,6 @@ nodeErrorToFrontendError ne = case ne of
-> mkFrontendErrShow FE_node_root_not_found
NoCorpusFound
-> mkFrontendErrShow FE_node_corpus_not_found
NoUserFound _ur
-> undefined
NodeCreationFailed reason
-> case reason of
UserParentAlreadyExists pId uId
......@@ -175,7 +173,6 @@ showAsServantJSONErr :: BackendInternalError -> ServerError
showAsServantJSONErr (InternalNodeError err@(NoListFound {})) = err404 { errBody = JSON.encode err }
showAsServantJSONErr (InternalNodeError err@NoRootFound{}) = err404 { errBody = JSON.encode err }
showAsServantJSONErr (InternalNodeError err@NoCorpusFound) = err404 { errBody = JSON.encode err }
showAsServantJSONErr (InternalNodeError err@NoUserFound{}) = err404 { errBody = JSON.encode err }
showAsServantJSONErr (InternalNodeError err@(DoesNotExist {})) = err404 { errBody = JSON.encode err }
showAsServantJSONErr (InternalServerError err) = err
showAsServantJSONErr a = err500 { errBody = JSON.encode a }
src/Gargantext/API/GraphQL.hs
View file @ 5ec3c2af
......@@ -15,6 +15,8 @@ Portability : POSIX
{-# LANGUAGE KindSignatures #-} -- for use of Endpoint (name :: Symbol)
{-# LANGUAGE PartialTypeSignatures #-} -- to automatically use suggested type hole signatures during compilation
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
module Gargantext.API.GraphQL where
......@@ -46,16 +48,9 @@ import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Database.Prelude (CmdCommon)
import Gargantext.Prelude hiding (ByteString)
import Servant
( (:<|>) (..)
, (:>)
, Get
, JSON
, Post
, ReqBody
, ServerT
)
import Servant.Auth qualified as SA
import Servant.Auth.Server qualified as SAS
import Servant.Server.Generic
-- | Represents possible GraphQL queries.
......@@ -127,7 +122,7 @@ rootResolver authenticatedUser policyManager =
, user_infos = GQLUserInfo.resolveUserInfos authenticatedUser policyManager
, users = GQLUser.resolveUsers authenticatedUser policyManager
, tree = GQLTree.resolveTree authenticatedUser policyManager
, team = GQLTeam.resolveTeam
, team = GQLTeam.resolveTeam
, tree_branch = GQLTree.resolveBreadcrumb }
, mutationResolver = Mutation { update_user_info = GQLUserInfo.updateUserInfo
, update_user_pubmed_api_key = GQLUser.updateUserPubmedAPIKey
......@@ -151,34 +146,37 @@ app authenticatedUser policyManager = deriveApp (rootResolver authenticatedUser
-- servant.
-- | Servant route for the app we defined above.
type GQAPI = ReqBody '[JSON] GQLRequest :> Post '[JSON] GQLResponse
-- type Schema = "schema" :> Get '[PlainText] Text
-- | Servant route for the playground.
type Playground = Get '[HTML] ByteString
-- type API' (name :: Symbol) = name :> (GQAPI :<|> Schema :<|> Playground)
-- | Our API consists of `GQAPI` and `Playground`.
type API = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
:> "gql" :> (PolicyChecked GQAPI :<|> Playground)
newtype GQAPI mode = GQAPI
{ gqApi :: mode :- ReqBody '[JSON] GQLRequest :> Post '[JSON] GQLResponse
} deriving Generic
gqapi :: Proxy API
-- | Servant route for the playground.
newtype Playground mode = Playground
{ playground :: mode :- Get '[HTML] ByteString
} deriving Generic
newtype GraphQLAPI mode = GraphQLAPI
{ graphQLAPI :: mode :- SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser
:> "gql"
:> NamedRoutes GraphQLAPIEndpoints
} deriving Generic
data GraphQLAPIEndpoints mode = GraphQLAPIEndpoints
{ gqApiEp :: mode :- PolicyChecked (NamedRoutes GQAPI)
, playgroundEp :: mode :- NamedRoutes Playground
}
deriving Generic
gqapi :: Proxy (ToServantApi GraphQLAPI)
gqapi = Proxy
-- serveEndpoint ::
-- ( SubApp ServerApp e
-- , PubApp e
-- ) =>
-- [e -> IO ()] ->
-- App e IO ->
-- Server (API name)
-- serveEndpoint publish app' = (liftIO . httpPubApp publish app') :<|> withSchema app' :<|> pure httpPlayground
--
-- withSchema :: (Applicative f) => App e m -> f Text
-- withSchema = pure . LT.toStrict . decodeUtf8 . render
-- | Implementation of our API.
--api :: Server API
api
:: (Typeable env, CmdCommon env, HasJobEnv' env, HasSettings env)
=> ServerT API (GargM env BackendInternalError)
api (SAS.Authenticated auser) = (httpPubApp [] . app auser) :<|> pure httpPlayground
api _ = panicTrace "401 in graphql" -- SAS.throwAll (_ServerError # err401)
=> GraphQLAPI (AsServerT (GargM env BackendInternalError))
api = GraphQLAPI $ \case
(SAS.Authenticated auser)
-> GraphQLAPIEndpoints { gqApiEp = GQAPI . httpPubApp [] . app auser
, playgroundEp = Playground $ pure httpPlayground
}
_ -> panicTrace "401 in graphql" -- SAS.throwAll (_ServerError # err401)
src/Gargantext/API/Members.hs
View file @ 5ec3c2af
......@@ -10,23 +10,18 @@ Portability : POSIX
module Gargantext.API.Members where
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Errors.Types
import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Private qualified as Named
import Gargantext.Database.Action.Share (membersOf)
import Gargantext.Database.Admin.Types.Node (NodeType(NodeTeam))
import Gargantext.Database.Prelude (CmdCommon)
import Gargantext.Database.Query.Table.Node (getNodesIdWithType)
import Gargantext.Prelude
import Servant
import Servant.Server.Generic (AsServerT)
type MembersAPI = Get '[JSON] [Text]
members :: IsGargServer err env m => Named.MembersAPI (AsServerT m)
members = Named.MembersAPI getMembers
members :: ServerT MembersAPI (GargM Env BackendInternalError)
members = getMembers
getMembers :: (CmdCommon env) =>
GargM env BackendInternalError [Text]
getMembers :: IsGargServer err env m => m [Text]
getMembers = do
teamNodeIds <- getNodesIdWithType NodeTeam
m <- concatMapM membersOf teamNodeIds
......
src/Gargantext/API/Metrics.hs
View file @ 5ec3c2af
......@@ -25,7 +25,8 @@ import Data.Vector (Vector)
import Gargantext.API.HashedResponse
import Gargantext.API.Ngrams.NgramsTree
import Gargantext.API.Ngrams.Types
import Gargantext.API.Prelude (GargServer)
import Gargantext.API.Prelude (IsGargServer)
import Gargantext.API.Routes.Named.Metrics qualified as Named
import Gargantext.Core.NodeStory (HasNodeStory)
import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
import Gargantext.Core.Types (CorpusId, ListId, ListType(..))
......@@ -43,28 +44,15 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude hiding (hash)
import Servant
import Servant.Server.Generic (AsServerT)
-------------------------------------------------------------
-- | Scatter metrics API
type ScatterAPI = Summary "SepGen IncExc metrics"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Limit
:> Get '[JSON] (HashedResponse Metrics)
:<|> Summary "Scatter update"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Limit
:> Post '[JSON] ()
:<|> "hash" :> Summary "Scatter Hash"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> Get '[JSON] Text
scatterApi :: NodeId -> GargServer ScatterAPI
scatterApi id' = getScatter id'
:<|> updateScatter id'
:<|> getScatterHash id'
scatterApi :: IsGargServer err env m => NodeId -> Named.ScatterAPI (AsServerT m)
scatterApi id' = Named.ScatterAPI
{ sepGenEp = getScatter id'
, scatterUpdateEp = updateScatter id'
, scatterHashEp = getScatterHash id'
}
getScatter :: HasNodeStory env err m
=> CorpusId
......@@ -139,27 +127,12 @@ getScatterHash cId maybeListId tabType = do
-------------------------------------------------------------
-- | Chart metrics API
type ChartApi = Summary " Chart API"
:> QueryParam "from" UTCTime
:> QueryParam "to" UTCTime
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> Get '[JSON] (HashedResponse (ChartMetrics Histo))
:<|> Summary "Chart update"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParam "limit" Limit
:> Post '[JSON] ()
:<|> "hash" :> Summary "Chart Hash"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> Get '[JSON] Text
chartApi :: NodeId -> GargServer ChartApi
chartApi id' = getChart id'
:<|> updateChart id'
:<|> getChartHash id'
chartApi :: IsGargServer err env m => NodeId -> Named.ChartAPI (AsServerT m)
chartApi id' = Named.ChartAPI
{ getChartEp = getChart id'
, updateChartEp = updateChart id'
, chartHashEp = getChartHash id'
}
-- TODO add start / end
getChart :: HasNodeStory env err m
......@@ -243,10 +216,12 @@ type PieApi = Summary "Pie Chart"
:> QueryParamR "ngramsType" TabType
:> Get '[JSON] Text
pieApi :: NodeId -> GargServer PieApi
pieApi id' = getPie id'
:<|> updatePie id'
:<|> getPieHash id'
pieApi :: IsGargServer err env m => NodeId -> Named.PieAPI (AsServerT m)
pieApi id' = Named.PieAPI
{ getPieChartEp = getPie id'
, pieChartUpdateEp = updatePie id'
, pieHashEp = getPieHash id'
}
getPie :: HasNodeStory env err m
=> CorpusId
......@@ -313,29 +288,12 @@ getPieHash cId maybeListId tabType = do
-------------------------------------------------------------
-- | Tree metrics API
type TreeApi = Summary " Tree API"
:> QueryParam "from" UTCTime
:> QueryParam "to" UTCTime
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType
:> Get '[JSON] (HashedResponse (ChartMetrics (Vector NgramsTree)))
:<|> Summary "Tree Chart update"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType
:> Post '[JSON] ()
:<|> "hash" :>
Summary "Tree Hash"
:> QueryParam "list" ListId
:> QueryParamR "ngramsType" TabType
:> QueryParamR "listType" ListType
:> Get '[JSON] Text
treeApi :: NodeId -> GargServer TreeApi
treeApi id' = getTree id'
:<|> updateTree id'
:<|> getTreeHash id'
treeApi :: IsGargServer err env m => NodeId -> Named.TreeAPI (AsServerT m)
treeApi id' = Named.TreeAPI
{ treeChartEp = getTree id'
, treeChartUpdateEp = updateTree id'
, treeHashEp = getTreeHash id'
}
getTree :: HasNodeStory env err m
=> CorpusId
......
src/Gargantext/API/Ngrams.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Ngrams/List.hs
View file @ 5ec3c2af
......@@ -18,7 +18,7 @@ module Gargantext.API.Ngrams.List
where
import Data.ByteString.Lazy qualified as BSL
import Data.Csv qualified as Csv
import Data.Csv qualified as Tsv
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
import Data.Map.Strict (toList)
......@@ -28,14 +28,14 @@ import Data.Text (concat, pack, splitOn)
import Data.Vector (Vector)
import Data.Vector qualified as Vec
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types ( AsyncJobs, JobLog )
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Errors.Types (BackendInternalError)
import Gargantext.API.Ngrams (setListNgrams)
import Gargantext.API.Ngrams.List.Types
import Gargantext.API.Ngrams.Prelude (getNgramsList)
import Gargantext.API.Ngrams.Types
import Gargantext.API.Prelude (GargServer, GargM, serverError, HasServerError)
import Gargantext.API.Types (HTML)
import Gargantext.API.Prelude (GargM, serverError, HasServerError)
import Gargantext.API.Routes.Named.List qualified as Named
import Gargantext.Core.NodeStory.Types ( HasNodeStory )
import Gargantext.Core.Text.Ngrams (Ngrams, NgramsType(NgramsTerms))
import Gargantext.Core.Types.Main (ListType(..))
......@@ -47,41 +47,25 @@ import Gargantext.Database.Schema.Node (_node_parent_id)
import Gargantext.Database.Types (Indexed(..))
import Gargantext.Prelude hiding (concat, toList)
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Gargantext.Utils.Servant qualified as GUS
import Prelude qualified
import Protolude qualified as P
import Servant
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
type GETAPI = Summary "Get List"
:> "lists"
:> Capture "listId" ListId
:> ( "json"
:> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
:<|> "json.zip"
:> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
:<|> "csv"
:> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap) )
getApi :: GargServer GETAPI
getApi listId = getJson listId
:<|> getJsonZip listId
:<|> getCsv listId
getAPI :: Named.GETAPI (AsServerT (GargM Env BackendInternalError))
getAPI = Named.GETAPI $ \listId -> Named.ListEndpoints
{ listJSONEp = getJson listId
, listJSONZipEp = getJsonZip listId
, listTSVEp = getTsv listId
}
--
-- JSON API
--
----------------------
type JSONAPI = Summary "Update List"
:> "lists"
:> Capture "listId" ListId
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog
jsonApi :: ServerT JSONAPI (GargM Env BackendInternalError)
jsonApi = jsonPostAsync
jsonAPI :: Named.JSONAPI (AsServerT (GargM Env BackendInternalError))
jsonAPI = jsonPostAsync
------------------------------------------------------------------------
getJson :: HasNodeStory env err m
......@@ -107,23 +91,23 @@ getJsonZip lId = do
]
) nlz
getCsv :: HasNodeStory env err m
getTsv :: HasNodeStory env err m
=> ListId
-> m (Headers '[Header "Content-Disposition" Text] NgramsTableMap)
getCsv lId = do
getTsv lId = do
lst <- getNgramsList lId
pure $ case Map.lookup NgramsTerms lst of
Nothing -> noHeader Map.empty
Just (Versioned { _v_data }) ->
addHeader (concat [ "attachment; filename=GarganText_NgramsList-"
, pack $ show (_NodeId lId)
, ".csv"
, ".tsv"
]
) _v_data
------------------------------------------------------------------------
jsonPostAsync :: ServerT JSONAPI (GargM Env BackendInternalError)
jsonPostAsync lId =
jsonPostAsync :: Named.JSONAPI (AsServerT (GargM Env BackendInternalError))
jsonPostAsync = Named.JSONAPI $ \lId -> AsyncJobs $
serveJobsAPI UpdateNgramsListJobJSON $ \jHandle f ->
postAsyncJSON lId (_wjf_data f) jHandle
......@@ -156,53 +140,43 @@ postAsyncJSON l ngramsList jobHandle = do
--
-- CSV API
-- TSV API
--
----------------------
type CSVAPI = Summary "Update List (legacy v3 CSV)"
:> "lists"
:> Capture "listId" ListId
:> "csv"
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog
csvApi :: ServerT CSVAPI (GargM Env BackendInternalError)
csvApi = csvPostAsync
tsvAPI :: Named.TSVAPI (AsServerT (GargM Env BackendInternalError))
tsvAPI = tsvPostAsync
------------------------------------------------------------------------
csvPostAsync :: ServerT CSVAPI (GargM Env BackendInternalError)
csvPostAsync lId =
serveJobsAPI UpdateNgramsListJobCSV $ \jHandle f -> do
case ngramsListFromCSVData (_wtf_data f) of
tsvPostAsync :: Named.TSVAPI (AsServerT (GargM Env BackendInternalError))
tsvPostAsync = Named.TSVAPI $ \lId -> AsyncJobs $
serveJobsAPI UpdateNgramsListJobTSV $ \jHandle f -> do
case ngramsListFromTSVData (_wtf_data f) of
Left err -> serverError $ err500 { errReasonPhrase = err }
Right ngramsList -> postAsyncJSON lId ngramsList jHandle
-- | Tries converting a text file into an 'NgramList', so that we can reuse the
-- existing JSON endpoint for the CSV upload.
ngramsListFromCSVData :: Text -> Either Prelude.String NgramsList
ngramsListFromCSVData csvData = case decodeCsv of
-- /NOTE/ The legacy CSV data only supports terms in imports and exports, so this is
-- existing JSON endpoint for the TSV upload.
ngramsListFromTSVData :: Text -> Either Prelude.String NgramsList
ngramsListFromTSVData tsvData = case decodeTsv of
-- /NOTE/ The legacy TSV data only supports terms in imports and exports, so this is
-- all we care about.
Left err -> Left $ "Invalid CSV found in ngramsListFromCSVData: " <> err
Left err -> Left $ "Invalid TSV found in ngramsListFromTSVData: " <> err
Right terms -> pure $ Map.fromList [ (NgramsTerms, Versioned 0 $ mconcat . Vec.toList $ terms) ]
where
binaryData = BSL.fromStrict $ P.encodeUtf8 csvData
binaryData = BSL.fromStrict $ P.encodeUtf8 tsvData
decodeCsv :: Either Prelude.String (Vector NgramsTableMap)
decodeCsv = Csv.decodeWithP csvToNgramsTableMap
(Csv.defaultDecodeOptions { Csv.decDelimiter = fromIntegral (P.ord '\t') })
Csv.HasHeader
decodeTsv :: Either Prelude.String (Vector NgramsTableMap)
decodeTsv = Tsv.decodeWithP tsvToNgramsTableMap
(Tsv.defaultDecodeOptions { Tsv.decDelimiter = fromIntegral (P.ord '\t') })
Tsv.HasHeader
binaryData
-- | Converts a plain CSV 'Record' into an NgramsTableMap
csvToNgramsTableMap :: Csv.Record -> Csv.Parser NgramsTableMap
csvToNgramsTableMap record = case Vec.toList record of
-- | Converts a plain TSV 'Record' into an NgramsTableMap
tsvToNgramsTableMap :: Tsv.Record -> Tsv.Parser NgramsTableMap
tsvToNgramsTableMap record = case Vec.toList record of
(map P.decodeUtf8 -> [status, label, forms])
-> pure $ conv status label forms
_ -> Prelude.fail "csvToNgramsTableMap failed"
_ -> Prelude.fail "tsvToNgramsTableMap failed"
where
conv :: Text -> Text -> Text -> NgramsTableMap
......@@ -225,12 +199,12 @@ csvToNgramsTableMap record = case Vec.toList record of
------------------------------------------------------------------------
-- | This is for debugging the CSV parser in the REPL
importCsvFile :: forall env err m. (HasNodeStory env err m, HasServerError err, MonadJobStatus m)
-- | This is for debugging the TSV parser in the REPL
importTsvFile :: forall env err m. (HasNodeStory env err m, HasServerError err, MonadJobStatus m)
=> ListId -> P.FilePath -> m ()
importCsvFile lId fp = do
importTsvFile lId fp = do
contents <- liftBase $ P.readFile fp
case ngramsListFromCSVData contents of
case ngramsListFromTSVData contents of
Left err -> serverError $ err500 { errReasonPhrase = err }
Right ngramsList -> postAsyncJSON lId ngramsList (noJobHandle @m Proxy)
......
src/Gargantext/API/Ngrams/Types.hs
View file @ 5ec3c2af
......@@ -24,7 +24,7 @@ import Control.Category ((>>>))
import Control.Lens (makePrisms, Iso', iso, from, (.=), (?=), (#), to, folded, {-withIndex, ifolded,-} view, use, (^?), (%~), (%=), at, _Just, Each(..), itraverse_, both, forOf_, (?~), over)
import Data.Aeson hiding ((.=))
import Data.Csv (defaultEncodeOptions, encodeByNameWith, header, namedRecord, EncodeOptions(..), NamedRecord, Quoting(QuoteNone))
import Data.Csv qualified as Csv
import Data.Csv qualified as Tsv
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.List qualified as List
import Data.Map.Strict qualified as Map
......@@ -47,9 +47,9 @@ import Gargantext.Database.Admin.Types.Node (ContextId)
import Gargantext.Database.Prelude (fromField', HasConnectionPool, HasConfig, CmdM')
import Gargantext.Prelude hiding (IsString, hash, from, replace, to)
import Gargantext.Prelude.Crypto.Hash (IsHashable(..))
import Gargantext.Utils.Servant (CSV, ZIP)
import Gargantext.Utils.Servant (TSV, ZIP)
import Gargantext.Utils.Zip (zipContentsPure)
import Servant ( FromHttpApiData(parseUrlPiece), ToHttpApiData(toUrlPiece), Required, Strict, QueryParam', MimeRender(.. ))
import Servant ( FromHttpApiData(parseUrlPiece), ToHttpApiData(toUrlPiece), Required, Strict, QueryParam', MimeRender(.. ), MimeUnrender(..))
import Servant.Job.Utils (jsonOptions)
import Test.QuickCheck (elements, frequency)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
......@@ -94,7 +94,7 @@ instance ToJSONKey TabType where
toJSONKey = genericToJSONKey defaultJSONKeyOptions
newtype MSet a = MSet (Map a ())
deriving stock (Eq, Ord, Show, Generic)
deriving stock (Eq, Ord, Show, Read, Generic)
deriving newtype (Arbitrary, Semigroup, Monoid)
deriving anyclass (ToExpr)
......@@ -128,7 +128,7 @@ instance (ToJSONKey a, ToSchema a) => ToSchema (MSet a) where
------------------------------------------------------------------------
newtype NgramsTerm = NgramsTerm { unNgramsTerm :: Text }
deriving (Ord, Eq, Show, Generic)
deriving (Ord, Eq, Show, Read, Generic)
deriving newtype (ToJSONKey, ToJSON, FromJSON, Semigroup, Arbitrary, Serialise, ToSchema, Hashable, NFData, FromField, ToField)
deriving anyclass (ToExpr)
instance IsHashable NgramsTerm where
......@@ -159,7 +159,7 @@ data NgramsRepoElement = NgramsRepoElement
, _nre_parent :: !(Maybe NgramsTerm)
, _nre_children :: !(MSet NgramsTerm)
}
deriving (Ord, Eq, Show, Generic)
deriving (Ord, Eq, Show, Read, Generic)
deriveJSON (unPrefix "_nre_") ''NgramsRepoElement
-- TODO
-- if ngrams & not size => size
......@@ -299,10 +299,10 @@ data NgramsSearchQuery = NgramsSearchQuery
type NgramsTableMap = Map NgramsTerm NgramsRepoElement
-- CSV:
-- TSV:
-- header: status\tlabel\tforms
-- item: map\taccountability\taccounting|&|accoutns|&|account
instance MimeRender CSV NgramsTableMap where
instance MimeRender TSV NgramsTableMap where
-- mimeRender _ _val = encode ([] :: [(Text, Text)])
mimeRender _ val = encodeByNameWith encOptions (header ["status", "label", "forms"]) $ fn <$> Map.toList val
where
......@@ -310,9 +310,9 @@ instance MimeRender CSV NgramsTableMap where
, encQuoting = QuoteNone }
fn :: (NgramsTerm, NgramsRepoElement) -> NamedRecord
fn (NgramsTerm term, NgramsRepoElement { _nre_list, _nre_children }) =
namedRecord [ "status" Csv..= toText _nre_list
, "label" Csv..= term
, "forms" Csv..= T.intercalate "|&|" (unNgramsTerm <$> mSetToList _nre_children)]
namedRecord [ "status" Tsv..= toText _nre_list
, "label" Tsv..= term
, "forms" Tsv..= T.intercalate "|&|" (unNgramsTerm <$> mSetToList _nre_children)]
toText :: ListType -> Text
toText CandidateTerm = "candidate"
toText MapTerm = "map"
......@@ -811,6 +811,9 @@ instance MimeRender ZIP NgramsListZIP where
mimeRender _ nlz@(NgramsListZIP { .. }) =
zipContentsPure (T.unpack $ nlzFileName nlz) (encode _nlz_nl)
instance MimeUnrender ZIP NgramsListZIP where
mimeUnrender _ _ = Left "mimeUnrender for NgramsListZIP not supported"
--
......
src/Gargantext/API/Node.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Node/Contact.hs
View file @ 5ec3c2af
......@@ -21,15 +21,15 @@ module Gargantext.API.Node.Contact
where
import Conduit ( yield )
import Data.Aeson
import Data.Swagger ( ToSchema )
import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser(AuthenticatedUser) )
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Node ( nodeNodeAPI, NodeNodeAPI )
import Gargantext.API.Node ( nodeNodeAPI )
import Gargantext.API.Node.Contact.Types
import Gargantext.API.Prelude (GargM, simuLogs)
import Gargantext.API.Routes.Named.Contact qualified as Named
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Terms (TermType(..))
import Gargantext.Core.Types.Individu (User(..))
......@@ -38,38 +38,21 @@ import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Hyperdata.Contact ( HyperdataContact, hyperdataContact )
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataAnnuaire(..) )
import Gargantext.Database.Admin.Types.Node ( CorpusId, NodeId )
import Gargantext.Prelude (($), Generic, Maybe(..), Text)
import Gargantext.Utils.Aeson qualified as GUA
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
import Gargantext.Prelude (($), Maybe(..))
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
import Gargantext.Database.Query.Tree.Root (MkCorpusUser(MkCorpusUserNormalCorpusIds))
------------------------------------------------------------------------
type API = "contact" :> Summary "Contact endpoint"
:> API_Async
:<|> Capture "contact_id" NodeId
:> NodeNodeAPI HyperdataContact
import Servant.Server.Generic (AsServerT)
api :: AuthenticatedUser -> CorpusId -> ServerT API (GargM Env BackendInternalError)
api authUser@(AuthenticatedUser userNodeId _userUserId) cid =
(api_async (RootId userNodeId) cid)
:<|> (nodeNodeAPI (Proxy :: Proxy HyperdataContact) authUser cid)
type API_Async = AsyncJobs JobLog '[JSON] AddContactParams JobLog
------------------------------------------------------------------------
data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
| AddContactParamsAdvanced { firstname :: !Text
, lastname :: !Text
-- TODO add others fields
}
deriving (Generic)
contactAPI :: AuthenticatedUser -> CorpusId -> Named.ContactAPI (AsServerT (GargM Env BackendInternalError))
contactAPI authUser@(AuthenticatedUser userNodeId _userUserId) cid = Named.ContactAPI
{ contactAsyncAPI = api_async (RootId userNodeId) cid
, getContactEp = nodeNodeAPI (Proxy :: Proxy HyperdataContact) authUser cid
}
----------------------------------------------------------------------
api_async :: User -> NodeId -> ServerT API_Async (GargM Env BackendInternalError)
api_async u nId =
api_async :: User -> NodeId -> Named.ContactAsyncAPI (AsServerT (GargM Env BackendInternalError))
api_async u nId = Named.ContactAsyncAPI $ AsyncJobs $
serveJobsAPI AddContactJob $ \jHandle p ->
addContact u nId p jHandle
......@@ -88,16 +71,3 @@ addContact u nId (AddContactParams fn ln) jobHandle = do
addContact _uId _nId _p jobHandle = do
simuLogs jobHandle 10
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON AddContactParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON AddContactParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema AddContactParams
instance Arbitrary AddContactParams where
arbitrary = elements [AddContactParams "Pierre" "Dupont"]
------------------------------------------------------------------------
src/Gargantext/API/Node/Contact/Types.hs 0 → 100644
View file @ 5ec3c2af
module Gargantext.API.Node.Contact.Types where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.Utils.Aeson qualified as GUA
import Test.QuickCheck
------------------------------------------------------------------------
data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
| AddContactParamsAdvanced { firstname :: !Text
, lastname :: !Text
-- TODO add others fields
}
deriving (Generic)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON AddContactParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON AddContactParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema AddContactParams
instance Arbitrary AddContactParams where
arbitrary = elements [AddContactParams "Pierre" "Dupont"]
------------------------------------------------------------------------
src/Gargantext/API/Node/Corpus/Annuaire.hs
View file @ 5ec3c2af
......@@ -17,7 +17,6 @@ module Gargantext.API.Node.Corpus.Annuaire
import Control.Lens hiding (elements)
import Data.Aeson
import Data.Swagger
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.Corpus.New.Types qualified as NewTypes
import Gargantext.Core (Lang(..))
import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
......@@ -51,16 +50,6 @@ instance ToJSON AnnuaireWithForm where
instance ToSchema AnnuaireWithForm where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_wf_")
------------------------------------------------------------------------
type AddWithForm = Summary "Add with FormUrlEncoded to annuaire endpoint"
:> "annuaire"
:> Capture "annuaire_id" AnnuaireId
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog
------------------------------------------------------------------------
addToAnnuaireWithForm :: (FlowCmdM env err m, MonadJobStatus m)
=> AnnuaireId
......
src/Gargantext/API/Node/Corpus/Export.hs
View file @ 5ec3c2af
......@@ -26,7 +26,7 @@ import Gargantext.API.Ngrams.Tools (filterListWithRoot, mapTermListRoot, getRepo
import Gargantext.API.Ngrams.Types ( NgramsTerm(unNgramsTerm) )
import Gargantext.API.Node.Corpus.Export.Types ( Corpus(..) )
import Gargantext.API.Node.Document.Export.Types qualified as DocumentExport
import Gargantext.API.Prelude (GargNoServer)
import Gargantext.API.Prelude (IsGargServer)
import Gargantext.Core.NodeStory.Types ( NodeListStory )
import Gargantext.Core.Text.Ngrams (NgramsType(..))
import Gargantext.Core.Types.Main ( ListType(MapTerm) )
......@@ -42,52 +42,52 @@ import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
import Gargantext.Database.Schema.Context (_context_id)
import Gargantext.Prelude hiding (hash)
import Gargantext.Prelude.Crypto.Hash (hash)
import Servant (Headers, Header, addHeader, Summary, (:>), JSON, Get, QueryParam)
--------------------------------------------------
type API = Summary "Corpus Export"
:> "export"
:> QueryParam "listId" ListId
:> QueryParam "ngramsType" NgramsType
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Corpus)
import Servant (Headers, Header, addHeader)
import Servant.Server.Generic (AsServerT)
import qualified Gargantext.API.Routes.Named.Corpus as Named
--------------------------------------------------
-- | Hashes are ordered by Set
getCorpus :: CorpusId
-> Maybe ListId
-> Maybe NgramsType
-> GargNoServer (Headers '[Header "Content-Disposition" Text] Corpus)
getCorpus cId lId nt' = do
getCorpus :: forall env err m. IsGargServer env err m
=> CorpusId
-> Named.CorpusExportAPI (AsServerT m)
getCorpus cId = Named.CorpusExportAPI $ \lId nt' -> get_corpus lId nt'
let
nt = fromMaybe NgramsTerms nt'
where
get_corpus :: IsGargServer env err m
=> Maybe ListId
-> Maybe NgramsType
-> m (Headers '[Header "Content-Disposition" Text] Corpus)
get_corpus lId nt' = do
let
nt = fromMaybe NgramsTerms nt'
listId <- case lId of
Nothing -> defaultList cId
Just l -> pure l
listId <- case lId of
Nothing -> defaultList cId
Just l -> pure l
-- FIXME(adn) Audit the usage of this, we are converting from a node
-- to a context id.
ns <- Map.fromList
<$> map (\n -> (nodeId2ContextId $ _context_id n, n))
<$> selectDocNodes cId
-- FIXME(adn) Audit the usage of this, we are converting from a node
-- to a context id.
ns <- Map.fromList
<$> map (\n -> (nodeId2ContextId $ _context_id n, n))
<$> selectDocNodes cId
repo <- getRepo [listId]
ngs <- getContextNgrams cId listId MapTerm nt repo
let -- uniqId is hash computed already for each document imported in database
r = Map.intersectionWith
(\a b -> DocumentExport.Document { _d_document = context2node a
, _d_ngrams = DocumentExport.Ngrams (Set.toList b) (hash b)
, _d_hash = d_hash a b }
) ns (Map.map (Set.map unNgramsTerm) ngs)
where
d_hash :: Context HyperdataDocument -> Set Text -> Text
d_hash _a b = hash [ -- fromMaybe "" (_hd_uniqId $ _context_hyperdata a),
hash b
]
pure $ addHeader ("attachment; filename=GarganText_corpus-" <> pack (show cId) <> ".json")
$ Corpus { _c_corpus = Map.elems r
, _c_hash = hash $ List.map DocumentExport._d_hash $ Map.elems r }
repo <- getRepo [listId]
ngs <- getContextNgrams cId listId MapTerm nt repo
let -- uniqId is hash computed already for each document imported in database
r = Map.intersectionWith
(\a b -> DocumentExport.Document { _d_document = context2node a
, _d_ngrams = DocumentExport.Ngrams (Set.toList b) (hash b)
, _d_hash = d_hash a b }
) ns (Map.map (Set.map unNgramsTerm) ngs)
where
d_hash :: Context HyperdataDocument -> Set Text -> Text
d_hash _a b = hash [ -- fromMaybe "" (_hd_uniqId $ _context_hyperdata a),
hash b
]
pure $ addHeader ("attachment; filename=GarganText_corpus-" <> pack (show cId) <> ".json")
$ Corpus { _c_corpus = Map.elems r
, _c_hash = hash $ List.map DocumentExport._d_hash $ Map.elems r }
getContextNgrams :: HasNodeError err
=> CorpusId
......
src/Gargantext/API/Node/Corpus/New.hs
View file @ 5ec3c2af
......@@ -28,7 +28,6 @@ import Data.Swagger ( ToSchema(..) )
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import EPO.API.Client.Types qualified as EPO
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
import Gargantext.API.Node.Corpus.New.Types ( FileFormat(..), FileType(..) )
......@@ -61,7 +60,6 @@ import Gargantext.Prelude
import Gargantext.Prelude.Config (gc_max_docs_parsers)
import Gargantext.System.Logging ( logLocM, LogLevel(..) )
import Gargantext.Utils.Jobs.Monad (JobHandle, MonadJobStatus(..))
import Servant ( JSON, type (:>), FormUrlEncoded, Capture, Summary )
import Test.QuickCheck.Arbitrary (Arbitrary(..))
------------------------------------------------------------------------
......@@ -132,13 +130,6 @@ instance ToSchema ApiInfo
info :: ApiInfo
info = ApiInfo API.externalAPIs
------------------------------------------------------------------------
type AddWithQuery = Summary "Add with Query to corpus endpoint"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> "query"
:> AsyncJobs JobLog '[JSON] WithQuery JobLog
{-
type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
:> "corpus"
......@@ -228,14 +219,6 @@ addToCorpusWithQuery user cid (WithQuery { _wq_query = q
$(logLocM) ERROR (T.pack $ show err) -- log the full error
markFailed (Just err) jobHandle
type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog
addToCorpusWithForm :: ( FlowCmdM env err m
, MonadJobStatus m
, HasNodeStoryImmediateSaver env
......@@ -257,8 +240,8 @@ addToCorpusWithForm user cid nwf jobHandle = do
let limit = fromIntegral limit' :: Integer
let
parseC = case (nwf ^. wf_filetype) of
CSV -> Parser.parseFormatC Parser.CsvGargV3
CSV_HAL -> Parser.parseFormatC Parser.CsvHal
TSV -> Parser.parseFormatC Parser.TsvGargV3
TSV_HAL -> Parser.parseFormatC Parser.TsvHal
Iramuteq -> Parser.parseFormatC Parser.Iramuteq
Istex -> Parser.parseFormatC Parser.Istex
JSON -> Parser.parseFormatC Parser.JSON
......@@ -342,16 +325,6 @@ addToCorpusWithFile cid input filetype logStatus = do
}
-}
type AddWithFile = Summary "Add with FileUrlEncoded to corpus endpoint"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> "add"
:> "file"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
addToCorpusWithFile :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
=> User
-> CorpusId
......
src/Gargantext/API/Node/Corpus/New/Types.hs
View file @ 5ec3c2af
......@@ -8,8 +8,8 @@ import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
data FileType = CSV
| CSV_HAL
data FileType = TSV
| TSV_HAL
| Istex
| PresseRIS
| WOS
......@@ -17,14 +17,14 @@ data FileType = CSV
| JSON
deriving (Eq, Show, Generic)
instance ToSchema FileType
instance Arbitrary FileType where arbitrary = elements [CSV, PresseRIS]
instance Arbitrary FileType where arbitrary = elements [TSV, PresseRIS]
instance ToParamSchema FileType
instance FromJSON FileType
instance ToJSON FileType
instance FromHttpApiData FileType where
parseUrlPiece "CSV" = pure CSV
parseUrlPiece "CSV_HAL" = pure CSV_HAL
parseUrlPiece "TSV" = pure TSV
parseUrlPiece "TSV_HAL" = pure TSV_HAL
parseUrlPiece "Istex" = pure Istex
parseUrlPiece "PresseRis" = pure PresseRIS
parseUrlPiece "WOS" = pure WOS
......
src/Gargantext/API/Node/Document/Export.hs
View file @ 5ec3c2af
......@@ -13,13 +13,15 @@ module Gargantext.API.Node.Document.Export
import Control.Lens (view)
import Data.ByteString.Lazy.Char8 qualified as BSC
import Data.Csv (encodeDefaultOrderedByName)
import Data.Csv (encodeDefaultOrderedByNameWith, defaultEncodeOptions, encDelimiter, encQuoting, Quoting(..))
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Time.Clock.System (getSystemTime, systemSeconds)
import Data.Time.LocalTime (getCurrentTimeZone, TimeZone (timeZoneMinutes))
import Data.Version (showVersion)
import Gargantext.API.Node.Document.Export.Types
import Gargantext.API.Prelude (GargNoServer, GargServer)
import Gargantext.API.Prelude (GargNoServer, IsGargServer)
import Gargantext.API.Routes.Named.Document qualified as Named
import Gargantext.Core (toDBid)
import Gargantext.Database.Admin.Types.Node (DocId, NodeId, NodeType(..))
import Gargantext.Database.Query.Facet (runViewDocuments, Facet(..))
......@@ -28,16 +30,19 @@ import Gargantext.Database.Query.Table.Node.User ( getNodeUser )
import Gargantext.Database.Schema.Node (NodePoly(..), node_user_id)
import Gargantext.Prelude
import Paths_gargantext qualified as PG -- cabal magic build module
import Servant ( addHeader, (:<|>)((:<|>)), Header, Headers(getResponse) )
import Data.Time.LocalTime (getCurrentTimeZone, TimeZone (timeZoneMinutes))
import Servant ( addHeader, Header, Headers(getResponse) )
import Servant.Server.Generic (AsServerT)
api :: NodeId
-- ^ The ID of the target user
-> DocId
-> GargServer API
api userNodeId dId = getDocumentsJSON userNodeId dId
:<|> getDocumentsJSONZip userNodeId dId
:<|> getDocumentsCSV userNodeId dId
documentExportAPI :: IsGargServer env err m
=> NodeId
-- ^ The ID of the target user
-> DocId
-> Named.DocumentExportAPI (AsServerT m)
documentExportAPI userNodeId dId = Named.DocumentExportAPI $ Named.DocumentExportEndpoints
{ exportJSONEp = getDocumentsJSON userNodeId dId
, exportJSONZipEp = getDocumentsJSONZip userNodeId dId
, exportTSVEp = getDocumentsTSV userNodeId dId
}
--------------------------------------------------
-- | Hashes are ordered by Set
......@@ -93,16 +98,16 @@ getDocumentsJSONZip userNodeId pId = do
, dezFileName dexpz
, ".zip" ]) dexpz
getDocumentsCSV :: NodeId
getDocumentsTSV :: NodeId
-- ^ The Node ID of the target user
-> DocId
-> GargNoServer (Headers '[Header "Content-Disposition" T.Text] T.Text) -- [Document]
getDocumentsCSV userNodeId pId = do
getDocumentsTSV userNodeId pId = do
dJSON <- getDocumentsJSON userNodeId pId
let DocumentExport { _de_documents } = getResponse dJSON
let ret = TE.decodeUtf8 $ BSC.toStrict $ encodeDefaultOrderedByName _de_documents
let ret = TE.decodeUtf8 $ BSC.toStrict $ encodeDefaultOrderedByNameWith (defaultEncodeOptions {encDelimiter = fromIntegral $ ord '\t', encQuoting = QuoteAll }) _de_documents
pure $ addHeader (T.concat [ "attachment; filename=GarganText_DocsList-"
, T.pack $ show pId
, ".csv"])
, ".tsv"])
ret
src/Gargantext/API/Node/Document/Export/Types.hs
View file @ 5ec3c2af
......@@ -27,7 +27,7 @@ import Gargantext.Database.Schema.Node (NodePoly(..))
import Gargantext.Utils.Servant (ZIP)
import Gargantext.Utils.Zip (zipContentsPureWithLastModified)
import Protolude
import Servant ((:>), (:<|>), Get, Header, Headers(..), JSON, MimeRender(..), PlainText, Summary)
import Servant (MimeRender(..), MimeUnrender(..))
-- | Document Export
......@@ -101,15 +101,6 @@ instance ToParamSchema Document where
instance ToParamSchema Ngrams where
toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
--------------------------------------------------
type API = Summary "Document Export"
:> "export"
:> ( "json"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
:<|> "json.zip"
:> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
:<|> "csv"
:> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text) )
$(deriveJSON (unPrefix "_ng_") ''Ngrams)
$(deriveJSON (unPrefix "_d_") ''Document)
......@@ -127,3 +118,6 @@ dezFileName (DocumentExportZIP { .. }) = "GarganText_DocsList-" <> show _dez_doc
instance MimeRender ZIP DocumentExportZIP where
mimeRender _ dexpz@(DocumentExportZIP { .. }) =
zipContentsPureWithLastModified (T.unpack $ dezFileName dexpz) (encode _dez_dexp) _dez_last_modified
instance MimeUnrender ZIP DocumentExportZIP where
mimeUnrender _ _ = Left "mimeUnrender for DocumentExportZIP not supported"
src/Gargantext/API/Node/DocumentUpload.hs
View file @ 5ec3c2af
......@@ -17,18 +17,17 @@ Portability : POSIX
module Gargantext.API.Node.DocumentUpload where
import Control.Lens (view)
import Data.Aeson ( Options(..), genericParseJSON, defaultOptions, genericToJSON, SumEncoding(..) )
import Data.Swagger (ToSchema)
import Data.Text qualified as T
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Node.DocumentUpload.Types
import Gargantext.API.Prelude ( GargM )
import Gargantext.API.Routes.Named.Document qualified as Named
import Gargantext.Core (Lang(..))
import Gargantext.Core.NLP (nlpServerGet)
import Gargantext.Core.Text.Corpus.Parsers.Date (mDateSplit)
import Gargantext.Core.Text.Terms (TermType(..))
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Database.Action.Flow (addDocumentsToHyperCorpus)
import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
import Gargantext.Database.Admin.Types.Hyperdata.Corpus ( HyperdataCorpus )
......@@ -37,47 +36,11 @@ import Gargantext.Database.Admin.Types.Node ( DocId, NodeId, NodeType(NodeCorpus
import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant ( JSON, Summary, type (:>), HasServer(ServerT) )
import Servant.Server.Generic (AsServerT)
data DocumentUpload = DocumentUpload
{ _du_abstract :: T.Text
, _du_authors :: T.Text
, _du_sources :: T.Text
, _du_title :: T.Text
, _du_date :: T.Text
, _du_language :: T.Text
}
deriving (Generic)
$(makeLenses ''DocumentUpload)
instance ToSchema DocumentUpload
instance FromJSON DocumentUpload
where
parseJSON = genericParseJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
instance ToJSON DocumentUpload
where
toJSON = genericToJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
type API = Summary " Document upload"
:> "document"
:> "upload"
:> "async"
:> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
api :: NodeId -> ServerT API (GargM Env BackendInternalError)
api nId =
api :: NodeId -> Named.DocumentUploadAPI (AsServerT (GargM Env BackendInternalError))
api nId = Named.DocumentUploadAPI $ AsyncJobs $
serveJobsAPI UploadDocumentJob $ \jHandle q -> do
documentUploadAsync nId q jHandle
......
src/Gargantext/API/Node/DocumentUpload/Types.hs 0 → 100644
View file @ 5ec3c2af
{-# LANGUAGE TemplateHaskell #-}
module Gargantext.API.Node.DocumentUpload.Types where
import Data.Aeson ( Options(..), genericParseJSON, defaultOptions, genericToJSON, SumEncoding(..) )
import Data.Swagger (ToSchema)
import Data.Text qualified as T
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Prelude
data DocumentUpload = DocumentUpload
{ _du_abstract :: T.Text
, _du_authors :: T.Text
, _du_sources :: T.Text
, _du_title :: T.Text
, _du_date :: T.Text
, _du_language :: T.Text
}
deriving (Generic)
$(makeLenses ''DocumentUpload)
instance ToSchema DocumentUpload
instance FromJSON DocumentUpload
where
parseJSON = genericParseJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
instance ToJSON DocumentUpload
where
toJSON = genericToJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
View file @ 5ec3c2af
......@@ -17,22 +17,21 @@ module Gargantext.API.Node.DocumentsFromWriteNodes
where
import Conduit ( yieldMany )
import Data.Aeson ( genericParseJSON, defaultOptions, genericToJSON )
import Data.List qualified as List
import Data.Swagger ( ToSchema )
import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser, auth_node_id, auth_user_id )
import Gargantext.API.Admin.EnvTypes (Env, GargJob(..))
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Ngrams (commitStatePatch, Versioned(..))
import Gargantext.API.Node.DocumentsFromWriteNodes.Types
import Gargantext.API.Prelude (GargM)
import Gargantext.API.Routes.Named.Document qualified as Named
import Gargantext.Core (Lang(..))
import Gargantext.Core.NodeStory (HasNodeStoryImmediateSaver, HasNodeArchiveStoryImmediateSaver, currentVersion)
import Gargantext.Core.Text.Corpus.Parsers.Date (split')
import Gargantext.Core.Text.Corpus.Parsers.FrameWrite
import Gargantext.Core.Text.List.Social (FlowSocialListWith)
import Gargantext.Core.Text.Terms (TermType(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow (flowDataText, DataText(..))
......@@ -46,30 +45,13 @@ import Gargantext.Prelude
import Gargantext.System.Logging
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Gargantext.Utils.Jobs.Error
import Servant ( JSON, Summary, type (:>), HasServer(ServerT) )
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
type API = Summary " Documents from Write nodes."
:> AsyncJobs JobLog '[JSON] Params JobLog
------------------------------------------------------------------------
data Params = Params
{ id :: Int
, paragraphs :: Text
, lang :: Lang
, selection :: FlowSocialListWith
}
deriving (Generic, Show)
instance FromJSON Params where
parseJSON = genericParseJSON defaultOptions
instance ToJSON Params where
toJSON = genericToJSON defaultOptions
instance ToSchema Params
------------------------------------------------------------------------
api :: AuthenticatedUser
-- ^ The logged-in user
-> NodeId
-> ServerT API (GargM Env BackendInternalError)
api authenticatedUser nId =
-> Named.DocumentsFromWriteNodesAPI (AsServerT (GargM Env BackendInternalError))
api authenticatedUser nId = Named.DocumentsFromWriteNodesAPI $ AsyncJobs $
serveJobsAPI DocumentFromWriteNodeJob $ \jHandle p ->
documentsFromWriteNodes authenticatedUser nId p jHandle
......
src/Gargantext/API/Node/DocumentsFromWriteNodes/Types.hs 0 → 100644
View file @ 5ec3c2af
module Gargantext.API.Node.DocumentsFromWriteNodes.Types where
import Data.Aeson ( genericParseJSON, defaultOptions, genericToJSON )
import Data.Swagger ( ToSchema )
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.List.Social (FlowSocialListWith)
import Gargantext.Prelude
------------------------------------------------------------------------
data Params = Params
{ id :: Int
, paragraphs :: Text
, lang :: Lang
, selection :: FlowSocialListWith
}
deriving (Generic, Show)
instance FromJSON Params where
parseJSON = genericParseJSON defaultOptions
instance ToJSON Params where
toJSON = genericToJSON defaultOptions
instance ToSchema Params
------------------------------------------------------------------------
src/Gargantext/API/Node/File.hs
View file @ 5ec3c2af
......@@ -17,19 +17,17 @@ Portability : POSIX
module Gargantext.API.Node.File where
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.MIME.Types qualified as DMT
import Data.Swagger (ToSchema(..))
import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types ( AuthenticatedUser, auth_user_id )
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Node.File.Types
import Gargantext.API.Node.Types ( NewWithFile(NewWithFile) )
import Gargantext.API.Prelude ( GargM, GargServer )
import Gargantext.Core.Types (TODO)
import Gargantext.API.Prelude ( GargM )
import Gargantext.API.Routes.Named.File qualified as Named
import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
import Gargantext.Database.Action.Node (mkNodeWithParent)
import Gargantext.Database.Admin.Types.Hyperdata.File ( HyperdataFile(..) )
......@@ -40,40 +38,14 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_hyperdata)
import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Network.HTTP.Media qualified as M
import Servant
import Servant.Server.Generic (AsServerT)
data RESPONSE deriving Typeable
instance Accept RESPONSE where
contentType _ = "text" M.// "*"
instance MimeRender RESPONSE BSResponse where
mimeRender _ (BSResponse val) = BSL.fromStrict $ val
type FileApi = Summary "File download"
:> "download"
:> Get '[RESPONSE] (Headers '[Servant.Header "Content-Type" Text] BSResponse)
instance MimeUnrender RESPONSE BSResponse where
mimeUnrender _ lbs = Right $ BSResponse (BSL.toStrict lbs)
fileApi :: NodeId -> GargServer FileApi
fileApi :: (HasSettings env, FlowCmdM env err m)
=> NodeId
-> m (Headers '[Servant.Header "Content-Type" Text] BSResponse)
fileApi nId = fileDownload nId
newtype Contents = Contents BS.ByteString
instance GargDB.ReadFile Contents where
readFile' fp = do
c <- BS.readFile fp
pure $ Contents c
newtype BSResponse = BSResponse BS.ByteString
deriving (Generic)
instance ToSchema BSResponse where
declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
fileDownload :: (HasSettings env, FlowCmdM env err m)
=> NodeId
-> m (Headers '[Servant.Header "Content-Type" Text] BSResponse)
......@@ -102,17 +74,11 @@ fileDownload nId = do
-- let settings = embeddedSettings [("", "hello")]
-- Tagged $ staticApp settings
type FileAsyncApi = Summary "File Async Api"
:> "file"
:> "add"
:> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
fileAsyncApi :: AuthenticatedUser
-- ^ The logged-in user
-> NodeId
-> ServerT FileAsyncApi (GargM Env BackendInternalError)
fileAsyncApi authenticatedUser nId =
-> Named.FileAsyncAPI (AsServerT (GargM Env BackendInternalError))
fileAsyncApi authenticatedUser nId = Named.FileAsyncAPI $ AsyncJobs $
serveJobsAPI AddFileJob $ \jHandle i ->
addWithFile authenticatedUser nId i jHandle
......
src/Gargantext/API/Node/File/Types.hs 0 → 100644
View file @ 5ec3c2af
module Gargantext.API.Node.File.Types where
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.Swagger (ToSchema(..))
import Gargantext.Core.Types (TODO)
import Gargantext.Database.GargDB qualified as GargDB
import Gargantext.Prelude
import Network.HTTP.Media qualified as M
import Servant
data RESPONSE deriving Typeable
instance Accept RESPONSE where
contentType _ = "text" M.// "*"
instance MimeRender RESPONSE BSResponse where
mimeRender _ (BSResponse val) = BSL.fromStrict $ val
instance MimeUnrender RESPONSE BSResponse where
mimeUnrender _ lbs = Right $ BSResponse (BSL.toStrict lbs)
newtype Contents = Contents BS.ByteString
instance GargDB.ReadFile Contents where
readFile' fp = do
c <- BS.readFile fp
pure $ Contents c
newtype BSResponse = BSResponse BS.ByteString
deriving (Generic)
instance ToSchema BSResponse where
declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy TODO)
src/Gargantext/API/Node/FrameCalcUpload.hs
View file @ 5ec3c2af
......@@ -17,19 +17,18 @@ module Gargantext.API.Node.FrameCalcUpload where
import Data.ByteString.Lazy qualified as BSL
import Data.ByteString.UTF8 qualified as BSU8
import Data.Swagger ( ToSchema )
import Data.Text qualified as T
import Gargantext.API.Admin.Auth.Types ( auth_node_id, AuthenticatedUser )
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Node.Corpus.New (addToCorpusWithForm)
import Gargantext.API.Node.Corpus.New.Types (FileFormat(..), FileType(..))
import Gargantext.API.Node.FrameCalcUpload.Types
import Gargantext.API.Node.Types (NewWithForm(..))
import Gargantext.API.Prelude ( GargM )
import Gargantext.Core (Lang)
import Gargantext.API.Routes.Named.FrameCalc qualified as Named
import Gargantext.Core.NodeStory.Types ( HasNodeArchiveStoryImmediateSaver )
import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Database.Action.Flow.Types ( FlowCmdM )
import Gargantext.Database.Admin.Types.Hyperdata.Frame ( HyperdataFrame(..) )
......@@ -41,29 +40,11 @@ import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..), markFailureNoErr)
import Network.HTTP.Client (newManager, httpLbs, parseRequest, responseBody)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Servant ( type (:>), JSON, Summary, HasServer(ServerT) )
import Web.FormUrlEncoded (FromForm)
import Servant.Server.Generic (AsServerT)
data FrameCalcUpload = FrameCalcUpload {
_wf_lang :: !(Maybe Lang)
, _wf_selection :: !FlowSocialListWith
}
deriving (Generic)
instance FromForm FrameCalcUpload
instance FromJSON FrameCalcUpload
instance ToJSON FrameCalcUpload
instance ToSchema FrameCalcUpload
type API = Summary " FrameCalc upload"
:> "add"
:> "framecalc"
:> "async"
:> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
api :: AuthenticatedUser -> NodeId -> ServerT API (GargM Env BackendInternalError)
api authenticatedUser nId =
api :: AuthenticatedUser -> NodeId -> Named.FrameCalcAPI (AsServerT (GargM Env BackendInternalError))
api authenticatedUser nId = Named.FrameCalcAPI $ AsyncJobs $
serveJobsAPI UploadFrameCalcJob $ \jHandle p ->
frameCalcUploadAsync authenticatedUser nId p jHandle
......@@ -108,7 +89,7 @@ frameCalcUploadAsync authenticatedUser nId (FrameCalcUpload _wf_lang _wf_selecti
-- FIXME(adn) Audit this conversion.
addToCorpusWithForm (RootId userNodeId)
cId
(NewWithForm { _wf_filetype = CSV
(NewWithForm { _wf_filetype = TSV
, _wf_fileformat = Plain
, _wf_data = body
, _wf_lang
......
src/Gargantext/API/Node/FrameCalcUpload/Types.hs 0 → 100644
View file @ 5ec3c2af
module Gargantext.API.Node.FrameCalcUpload.Types where
import Data.Swagger ( ToSchema )
import Gargantext.Core (Lang)
import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
import Gargantext.Prelude
import Web.FormUrlEncoded (FromForm)
data FrameCalcUpload = FrameCalcUpload {
_wf_lang :: !(Maybe Lang)
, _wf_selection :: !FlowSocialListWith
}
deriving (Generic)
instance FromForm FrameCalcUpload
instance FromJSON FrameCalcUpload
instance ToJSON FrameCalcUpload
instance ToSchema FrameCalcUpload
src/Gargantext/API/Node/Get.hs
View file @ 5ec3c2af
......@@ -22,32 +22,16 @@ module Gargantext.API.Node.Get
import Data.Aeson
import Data.Swagger
import Gargantext.API.Prelude
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (JSONB)
import Gargantext.Prelude
import Servant
import Test.QuickCheck.Arbitrary
------------------------------------------------------------------------
type API a = Summary "Polymorphic Get Node Endpoint"
:> ReqBody '[JSON] GetNodeParams
:> Get '[JSON] (Node a)
------------------------------------------------------------------------
data GetNodeParams = GetNodeParams { node_id :: NodeId
, nodetype :: NodeType
}
deriving (Generic)
----------------------------------------------------------------------
api :: forall proxy a.
( JSONB a
, FromJSON a
, ToJSON a
) => proxy a -> UserId -> NodeId -> GargServer (API a)
api _p _uId _nId (GetNodeParams _nId' _nt) = undefined
------------------------------------------------------------------------
instance FromJSON GetNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
......
src/Gargantext/API/Node/New.hs
View file @ 5ec3c2af
......@@ -21,13 +21,13 @@ module Gargantext.API.Node.New
where
import Control.Lens hiding (elements, Empty)
import Data.Aeson
import Data.Swagger
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs (..))
import Gargantext.API.Errors.Types
import Gargantext.API.Node.New.Types
import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Node qualified as Named
import Gargantext.Database.Action.Flow.Types
import Gargantext.Database.Action.Node
import Gargantext.Database.Admin.Types.Node
......@@ -35,24 +35,7 @@ import Gargantext.Database.Prelude (Cmd)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Prelude
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
import Web.FormUrlEncoded (FromForm, ToForm)
------------------------------------------------------------------------
data PostNode = PostNode { pn_name :: Text
, pn_typename :: NodeType}
deriving (Generic)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON PostNode
instance ToJSON PostNode
instance ToSchema PostNode
instance FromForm PostNode
instance ToForm PostNode
instance Arbitrary PostNode where
arbitrary = elements [PostNode "Node test" NodeCorpus]
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
postNode :: HasNodeError err
......@@ -65,19 +48,13 @@ postNode authenticatedUser pId (PostNode nodeName nt) = do
let userId = authenticatedUser ^. auth_user_id
mkNodeWithParent nt (Just pId) userId nodeName
------------------------------------------------------------------------
type PostNodeAsync = Summary "Post Node"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
postNodeAsyncAPI
:: AuthenticatedUser
-- ^ The logged-in user
-> NodeId
-- ^ The target node
-> ServerT PostNodeAsync (GargM Env BackendInternalError)
postNodeAsyncAPI authenticatedUser nId =
-> Named.PostNodeAsyncAPI (AsServerT (GargM Env BackendInternalError))
postNodeAsyncAPI authenticatedUser nId = Named.PostNodeAsyncAPI $ AsyncJobs $
serveJobsAPI NewNodeJob $ \jHandle p -> postNodeAsync authenticatedUser nId p jHandle
------------------------------------------------------------------------
......
src/Gargantext/API/Node/New/Types.hs 0 → 100644
View file @ 5ec3c2af
module Gargantext.API.Node.New.Types (
PostNode(..)
) where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.Core.Types (NodeType (..))
import Test.QuickCheck
import Web.FormUrlEncoded
------------------------------------------------------------------------
data PostNode = PostNode { pn_name :: Text
, pn_typename :: NodeType}
deriving (Generic)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON PostNode
instance ToJSON PostNode
instance ToSchema PostNode
instance FromForm PostNode
instance ToForm PostNode
instance Arbitrary PostNode where
arbitrary = elements [PostNode "Node test" NodeCorpus]
src/Gargantext/API/Node/Phylo/Export.hs
View file @ 5ec3c2af
......@@ -13,20 +13,24 @@ module Gargantext.API.Node.Phylo.Export
import Data.Aeson
import Data.Text qualified as T
import Gargantext.API.Node.Phylo.Export.Types
import Gargantext.API.Prelude (GargNoServer, GargServer)
import Gargantext.API.Prelude (GargNoServer, IsGargServer)
import Gargantext.API.Routes.Named.Viz qualified as Named
import Gargantext.Core.Viz.Phylo.API.Tools
import Gargantext.Core.Viz.Phylo.Example (phyloCleopatre)
import Gargantext.Database.Admin.Types.Node (PhyloId, NodeId,)
import Gargantext.Prelude
import Servant
import Servant.Server.Generic (AsServerT)
api :: NodeId
api :: IsGargServer env err m
=> NodeId
-- ^ The ID of the target user
-> PhyloId
-> GargServer API
api userNodeId dId = getPhyloJson userNodeId dId
:<|> getPhyloDot userNodeId dId
-> Named.PhyloExportAPI (AsServerT m)
api userNodeId dId = Named.PhyloExportAPI $ Named.PhyloExportEndpoints
{ exportPhyloJSONEp = getPhyloJson userNodeId dId
, exportPhyloDotEp = getPhyloDot userNodeId dId
}
getPhyloJson :: NodeId
-- ^ The ID of the target user
......@@ -54,4 +58,4 @@ getPhyloDot _ pId = do
, "GarganText_Phylo-"
, T.pack (show pId)
, ".dot" ])
phyloDot
\ No newline at end of file
phyloDot
src/Gargantext/API/Node/Phylo/Export/Types.hs
View file @ 5ec3c2af
......@@ -13,7 +13,6 @@ Portability : POSIX
module Gargantext.API.Node.Phylo.Export.Types where
import Data.Aeson
import Data.Aeson.TH (deriveJSON)
-- import Data.Csv (DefaultOrdered(..), ToNamedRecord(..), (.=), header, namedRecord)
import Data.Swagger ( genericDeclareNamedSchema, ToParamSchema(..), ToSchema(..) )
......@@ -27,7 +26,7 @@ import Gargantext.Database.Admin.Types.Node (PhyloId)
-- import Gargantext.Utils.Servant (ZIP)
-- import Gargantext.Utils.Zip (zipContentsPure)
import Protolude
import Servant ((:>), (:<|>), Get, Header, Headers(..), JSON, Summary) --, PlainText, MimeRender(..)
--, PlainText, MimeRender(..)
-- | Phylo Export
......@@ -97,14 +96,6 @@ instance ToParamSchema Phylo where
toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
--------------------------------------------------
type API = Summary "Phylo Export"
:> "export"
:> ( "json"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Value)
:<|> "dot"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] Text)
)
-- type API = Summary "Phylo Export"
-- :> "export"
-- :> Get '[JSON,DOT] (Headers '[Servant.Header "Content-Disposition" Text] Value)
......
src/Gargantext/API/Node/Share.hs
View file @ 5ec3c2af
......@@ -15,11 +15,11 @@ Portability : POSIX
module Gargantext.API.Node.Share
where
import Data.Aeson
import Data.List qualified as List
import Data.Swagger
import Data.Text qualified as Text
import Gargantext.API.Node.Share.Types
import Gargantext.API.Prelude
import Gargantext.API.Routes.Named.Share qualified as Named
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Types.Individu (User(..), arbitraryUsername)
import Gargantext.Database.Action.Share (ShareNodeWith(..))
......@@ -31,26 +31,8 @@ import Gargantext.Database.Prelude (CmdRandom)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Tree (findNodesWithType)
import Gargantext.Prelude
import Gargantext.Utils.Aeson qualified as GUA
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
data ShareNodeParams = ShareTeamParams { username :: Text }
| SharePublicParams { node_id :: NodeId }
deriving (Generic)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON ShareNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON ShareNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema ShareNodeParams
instance Arbitrary ShareNodeParams where
arbitrary = elements [ ShareTeamParams "user1"
, SharePublicParams (UnsafeMkNodeId 1)
]
------------------------------------------------------------------------
-- TODO permission
-- TODO refactor userId which is used twice
......@@ -98,15 +80,5 @@ api _uId nId2 (SharePublicParams nId1) =
fromIntegral <$> DB.shareNodeWith (ShareNodeWith_Node NodeFolderPublic nId1) nId2
------------------------------------------------------------------------
type API = Summary " Share Node with username"
:> ReqBody '[JSON] ShareNodeParams
:> Post '[JSON] Int
------------------------------------------------------------------------
type Unpublish = Summary " Unpublish Node"
:> Capture "node_id" NodeId
:> Put '[JSON] Int
unPublish :: NodeId -> GargServer Unpublish
unPublish n = DB.unPublish n
unPublish :: IsGargServer env err m => NodeId -> Named.Unpublish (AsServerT m)
unPublish n = Named.Unpublish $ DB.unPublish n
src/Gargantext/API/Node/Share/Types.hs 0 → 100644
View file @ 5ec3c2af
module Gargantext.API.Node.Share.Types where
import Data.Aeson
import Data.Swagger
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude
import Gargantext.Utils.Aeson qualified as GUA
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary
data ShareNodeParams = ShareTeamParams { username :: Text }
| SharePublicParams { node_id :: NodeId }
deriving (Generic)
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON ShareNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON ShareNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema ShareNodeParams
instance Arbitrary ShareNodeParams where
arbitrary = elements [ ShareTeamParams "user1"
, SharePublicParams (UnsafeMkNodeId 1)
]
src/Gargantext/API/Node/ShareURL.hs
View file @ 5ec3c2af
......@@ -6,24 +6,20 @@ module Gargantext.API.Node.ShareURL where
import Data.Text
import Gargantext.Prelude
import Gargantext.API.Prelude
import Servant
import Gargantext.Core.Types (NodeType, NodeId, unNodeId)
import Gargantext.Database.Prelude (HasConfig (hasConfig), CmdCommon)
import Control.Lens.Getter (view)
import Gargantext.Prelude.Config (gc_url)
import Gargantext.API.Admin.EnvTypes (Env)
import Gargantext.API.Errors (BackendInternalError)
import Gargantext.API.Routes.Named.Share qualified as Named
import Servant.Server.Generic (AsServerT)
type API = Summary "Fetch URL for sharing a node"
:> QueryParam "type" NodeType
:> QueryParam "id" NodeId
:> Get '[JSON] Text
shareURL :: IsGargServer env err m => Named.ShareURL (AsServerT m)
shareURL = Named.ShareURL getUrl
api :: ServerT API (GargM Env BackendInternalError)
api = getUrl
getUrl :: (CmdCommon env) =>
Maybe NodeType -> Maybe NodeId -> GargM env BackendInternalError Text
getUrl :: (IsGargServer env err m, CmdCommon env)
=> Maybe NodeType
-> Maybe NodeId
-> m Text
getUrl nt id = do
-- TODO add check that the node is able to be shared (in a shared folder)
case nt of
......
src/Gargantext/API/Node/Types.hs
View file @ 5ec3c2af
......@@ -23,6 +23,8 @@ import Gargantext.API.Node.Corpus.Types
import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Corpus.Query qualified as API
import Gargantext.Core.Text.List.Social (FlowSocialListWith)
import Gargantext.Core.Types (NodeId)
import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import Gargantext.Database.GargDB qualified as GargDB
import Gargantext.Prelude
......@@ -113,3 +115,32 @@ instance Arbitrary WithQuery where
<*> arbitrary
<*> arbitrary
------------------------------------------------------------------------
data RenameNode = RenameNode { r_name :: Text }
deriving (Generic)
$(deriveJSON (unPrefix "r_" ) ''RenameNode )
instance ToSchema RenameNode
instance Arbitrary RenameNode where
arbitrary = elements [RenameNode "test"]
data NodesToScore = NodesToScore { nts_nodesId :: [NodeId]
, nts_score :: Int
}
deriving (Generic)
-- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON NodesToScore
instance ToJSON NodesToScore
instance ToSchema NodesToScore
data NodesToCategory = NodesToCategory { ntc_nodesId :: [NodeId]
, ntc_category :: Int
}
deriving (Generic)
-- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON NodesToCategory
instance ToJSON NodesToCategory
instance ToSchema NodesToCategory
src/Gargantext/API/Node/Update.hs
View file @ 5ec3c2af
......@@ -16,24 +16,21 @@ module Gargantext.API.Node.Update
where
import Control.Lens (view)
import Data.Aeson
import Data.Set qualified as Set
import Data.Swagger ( ToSchema )
import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Orchestrator.Types (AsyncJobs(..))
import Gargantext.API.Admin.Types (HasSettings)
import Gargantext.API.Errors.Types ( BackendInternalError )
import Gargantext.API.Metrics qualified as Metrics
import Gargantext.API.Ngrams.Types qualified as NgramsTypes
import Gargantext.API.Node.Update.Types
import Gargantext.API.Prelude (GargM, simuLogs)
import Gargantext.Core.Methods.Similarities (GraphMetric(..))
import Gargantext.API.Routes.Named.Node qualified as Named
import Gargantext.Core.NodeStory.Types (HasNodeStory)
import Gargantext.Core.Text.Ngrams (NgramsType(NgramsTerms))
import Gargantext.Core.Types.Main (ListType(..))
import Gargantext.Core.Viz.Graph.API (recomputeGraph)
import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
import Gargantext.Core.Viz.Graph.Types (Strength)
import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..), subConfigAPI2config)
import Gargantext.Core.Viz.Phylo (subConfigAPI2config)
import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
import Gargantext.Database.Action.Flow (reIndexWith)
import Gargantext.Database.Action.Flow.Pairing (pairing)
......@@ -45,53 +42,13 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Database.Schema.Node (node_parent_id)
import Gargantext.Prelude
import Gargantext.System.Logging ( MonadLogger )
import Gargantext.Utils.Aeson qualified as GUA
import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
import Gargantext.Utils.UTCTime (timeMeasured)
import Servant
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
import Servant.Server.Generic (AsServerT)
------------------------------------------------------------------------
type API = Summary " Update node according to NodeType params"
:> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
------------------------------------------------------------------------
data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
| UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric
, methodGraphClustering :: !PartitionMethod
, methodGraphBridgeness :: !BridgenessMethod
, methodGraphEdgesStrength :: !Strength
, methodGraphNodeType1 :: !NgramsType
, methodGraphNodeType2 :: !NgramsType
}
| UpdateNodeParamsTexts { methodTexts :: !Granularity }
| UpdateNodeParamsBoard { methodBoard :: !Charts }
| LinkNodeReq { nodeType :: !NodeType
, id :: !NodeId }
| UpdateNodePhylo { config :: !PhyloSubConfigAPI }
deriving (Generic)
----------------------------------------------------------------------
data Method = Basic | Advanced | WithModel
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data Granularity = NewNgrams | NewTexts | Both
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data Charts = Sources | Authors | Institutes | Ngrams | All
deriving (Generic, Eq, Ord, Enum, Bounded)
------------------------------------------------------------------------
api :: NodeId -> ServerT API (GargM Env BackendInternalError)
api nId =
api :: NodeId -> Named.UpdateAPI (AsServerT (GargM Env BackendInternalError))
api nId = Named.UpdateAPI $ AsyncJobs $
serveJobsAPI UpdateNodeJob $ \jHandle p ->
updateNode nId p jHandle
......@@ -206,39 +163,3 @@ updateDocs cId = do
-- printDebug "updateContextsScore" (cId, lId, u)
pure ()
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON UpdateNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON UpdateNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema UpdateNodeParams
instance Arbitrary UpdateNodeParams where
arbitrary = do
l <- UpdateNodeParamsList <$> arbitrary
g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
t <- UpdateNodeParamsTexts <$> arbitrary
b <- UpdateNodeParamsBoard <$> arbitrary
elements [l,g,t,b]
instance FromJSON Method
instance ToJSON Method
instance ToSchema Method
instance Arbitrary Method where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON Granularity
instance ToJSON Granularity
instance ToSchema Granularity
instance Arbitrary Granularity where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON Charts
instance ToJSON Charts
instance ToSchema Charts
instance Arbitrary Charts where
arbitrary = elements [ minBound .. maxBound ]
------------------------------------------------------------------------
src/Gargantext/API/Node/Update/Types.hs 0 → 100644
View file @ 5ec3c2af
module Gargantext.API.Node.Update.Types where
import Data.Aeson
import Data.Swagger ( ToSchema )
import Gargantext.Core.Methods.Similarities (GraphMetric(..))
import Gargantext.Core.Text.Ngrams (NgramsType)
import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..))
import Gargantext.Core.Viz.Graph.Types (Strength)
import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..))
import Gargantext.Database.Admin.Types.Node ( NodeId, NodeType )
import Gargantext.Prelude
import Gargantext.Utils.Aeson qualified as GUA
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary ( Arbitrary(arbitrary) )
------------------------------------------------------------------------
data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
| UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric
, methodGraphClustering :: !PartitionMethod
, methodGraphBridgeness :: !BridgenessMethod
, methodGraphEdgesStrength :: !Strength
, methodGraphNodeType1 :: !NgramsType
, methodGraphNodeType2 :: !NgramsType
}
| UpdateNodeParamsTexts { methodTexts :: !Granularity }
| UpdateNodeParamsBoard { methodBoard :: !Charts }
| LinkNodeReq { nodeType :: !NodeType
, id :: !NodeId }
| UpdateNodePhylo { config :: !PhyloSubConfigAPI }
deriving (Generic)
----------------------------------------------------------------------
data Method = Basic | Advanced | WithModel
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data Granularity = NewNgrams | NewTexts | Both
deriving (Generic, Eq, Ord, Enum, Bounded)
----------------------------------------------------------------------
data Charts = Sources | Authors | Institutes | Ngrams | All
deriving (Generic, Eq, Ord, Enum, Bounded)
------------------------------------------------------------------------
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON UpdateNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON UpdateNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema UpdateNodeParams
instance Arbitrary UpdateNodeParams where
arbitrary = do
l <- UpdateNodeParamsList <$> arbitrary
g <- UpdateNodeParamsGraph <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
t <- UpdateNodeParamsTexts <$> arbitrary
b <- UpdateNodeParamsBoard <$> arbitrary
elements [l,g,t,b]
instance FromJSON Method
instance ToJSON Method
instance ToSchema Method
instance Arbitrary Method where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON Granularity
instance ToJSON Granularity
instance ToSchema Granularity
instance Arbitrary Granularity where
arbitrary = elements [ minBound .. maxBound ]
instance FromJSON Charts
instance ToJSON Charts
instance ToSchema Charts
instance Arbitrary Charts where
arbitrary = elements [ minBound .. maxBound ]
------------------------------------------------------------------------
src/Gargantext/API/Prelude.hs
View file @ 5ec3c2af
......@@ -77,6 +77,9 @@ type GargServerT env err m api = GargServerC env err m => ServerT api m
type GargServer api = forall env err m. MonadLogger m => GargServerT env err m api
class (MonadLogger m, GargServerC env err m) => IsGargServer env err m
-- = forall env err m. (MonadLogger m, GargServerC env err m) => AsServerT m
-- This is the concrete monad. It needs to be used as little as possible.
type GargM env err = ReaderT env (ExceptT err IO)
-- This is the server type using GargM. It needs to be used as little as possible.
......
src/Gargantext/API/Public/Types.hs 0 → 100644
View file @ 5ec3c2af
module Gargantext.API.Public.Types (
PublicData(..)
, defaultPublicData
) where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.Utils.Aeson qualified as GUA
import Prelude
import Test.QuickCheck
data PublicData = PublicData
{ title :: Text
, abstract :: Text
, img :: Text
, url :: Text
, date :: Text
, database :: Text
, author :: Text
} | NoData { nodata:: Text}
deriving (Generic)
instance FromJSON PublicData where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON PublicData where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema PublicData
instance Arbitrary PublicData where
arbitrary = elements
$ replicate 6 defaultPublicData
defaultPublicData :: PublicData
defaultPublicData =
PublicData { title = "Title"
, abstract = foldl (<>) "" $ replicate 100 "abstract "
, img = "images/Gargantextuel-212x300.jpg"
, url = "https://.."
, date = "YY/MM/DD"
, database = "database"
, author = "Author" }
src/Gargantext/API/Routes.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Routes/Named.hs
View file @ 5ec3c2af
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named where
{-# LANGUAGE TypeApplications #-}
module Gargantext.API.Routes.Named (
-- * Routes types
API(..)
, NamedAPI(..)
, SwaggerAPI(..)
, BackEndAPI(..)
, MkBackEndAPI(..)
, GargAPIVersion(..)
, GargAPI'(..)
, AuthAPI(..)
, ForgotPasswordAPI(..)
, ForgotPasswordAsyncAPI(..)
, GargVersion(..)
) where
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Auth (ForgotPasswordAsyncParams)
import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Routes.Named.Public
import Gargantext.API.GraphQL
import Gargantext.API.Routes.Named.Private
import Gargantext.API.Routes.Named.Public
import Gargantext.API.Routes.Types
import Servant.API ((:>), (:-), JSON, ReqBody, Post, Get, QueryParam)
import Servant.API.Description (Summary)
import Servant.API.NamedRoutes
import Servant.Auth.Swagger ()
import Servant.Swagger.UI
type GargAPI = NamedRoutes (MkGargAPI (GargAPIVersion GargAPI'))
newtype API mode = API
{ apiWithCustomErrorScheme :: mode :- WithCustomErrorScheme (NamedRoutes NamedAPI)
} deriving Generic
data NamedAPI mode = NamedAPI
{ swaggerAPI :: mode :- SwaggerSchemaUI "swagger-ui" "swagger.json"
, backendAPI :: mode :- NamedRoutes BackEndAPI
, graphqlAPI :: mode :- NamedRoutes GraphQLAPI -- FIXME(adn) convert to named!
, frontendAPI :: mode :- FrontEndAPI
} deriving Generic
newtype SwaggerAPI mode = SwaggerAPI
{ swaggerSchemaEp :: mode :- SwaggerSchemaUI "swagger-ui" "swagger.json"
} deriving Generic
newtype BackEndAPI mode = BackEndAPI {
backendAPI' :: mode :- NamedRoutes (MkBackEndAPI (GargAPIVersion GargAPI'))
} deriving Generic
data MkGargAPI sub mode = MkGargAPI
{ mkGargAPI :: mode :- "api" :> Summary "API " :> NamedRoutes sub
newtype MkBackEndAPI sub mode = MkBackEndAPI
{ mkBackEndAPI :: mode :- "api" :> Summary "Backend API " :> NamedRoutes sub
} deriving Generic
data GargAPIVersion sub mode = GargAPIVersion
newtype GargAPIVersion sub mode = GargAPIVersion
{ gargAPIVersion :: mode :- "v1.0" :> Summary "Garg API Version " :> NamedRoutes sub
} deriving Generic
......@@ -38,7 +77,7 @@ data GargAPI' mode = GargAPI'
} deriving Generic
data AuthAPI mode = AuthAPI
newtype AuthAPI mode = AuthAPI
{ authEp :: mode :- "auth" :> Summary "AUTH API"
:> ReqBody '[JSON] AuthRequest
:> Post '[JSON] AuthResponse
......@@ -57,10 +96,10 @@ data ForgotPasswordAPI mode = ForgotPasswordAPI
data ForgotPasswordAsyncAPI mode = ForgotPasswordAsyncAPI
{ forgotPasswordAsyncEp :: mode :- Summary "Forgot password asnc"
:> AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] ForgotPasswordAsyncParams JobLog)
} deriving Generic
data GargVersion mode = GargVersion
{ gargVersionEp :: "version" :> Summary "Backend version" :> Get '[JSON] Text
{ gargVersionEp :: mode :- "version" :> Summary "Backend version" :> Get '[JSON] Text
} deriving Generic
src/Gargantext/API/Routes/Named/Annuaire.hs 0 → 100644
View file @ 5ec3c2af
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Annuaire (
-- * Routes types
AddAnnuaireWithForm(..)
) where
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.Corpus.Annuaire (AnnuaireWithForm)
import Gargantext.Database.Admin.Types.Node
import Servant
newtype AddAnnuaireWithForm mode = AddAnnuaireWithForm
{ addWithFormEp :: mode :- Summary "Add with FormUrlEncoded to annuaire endpoint"
:> "annuaire"
:> Capture "annuaire_id" AnnuaireId
:> "add"
:> "form"
:> "async"
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog)
} deriving Generic
src/Gargantext/API/Routes/Named/Contact.hs
View file @ 5ec3c2af
......@@ -10,9 +10,9 @@ module Gargantext.API.Routes.Named.Contact (
) where
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.Contact.Types (AddContactParams(..))
import Gargantext.API.Routes.Named.Node (NodeNodeAPI(..))
import Gargantext.Database.Admin.Types.Hyperdata.Contact
import Gargantext.Database.Admin.Types.Node
......@@ -26,13 +26,5 @@ data ContactAPI mode = ContactAPI
newtype ContactAsyncAPI mode = ContactAsyncAPI
{ addContactAsyncEp :: mode :- AsyncJobs JobLog '[JSON] AddContactParams JobLog
{ addContactAsyncEp :: mode :- NamedRoutes (AsyncJobs JobLog '[JSON] AddContactParams JobLog)
} deriving Generic
data AddContactParams = AddContactParams { firstname :: !Text, lastname :: !Text }
| AddContactParamsAdvanced { firstname :: !Text
, lastname :: !Text
-- TODO add others fields
}
deriving Generic
src/Gargantext/API/Routes/Named/Context.hs
View file @ 5ec3c2af
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.Context where
module Gargantext.API.Routes.Named.Context (
-- * Routes types
ContextAPI(..)
) where
import GHC.Generics
import Gargantext.Database.Admin.Types.Node
import Servant
data ContextAPI mode a = ContextAPI
data ContextAPI a mode = ContextAPI
{ getNodeEp :: mode :- Get '[JSON] (Node a)
} deriving Generic
src/Gargantext/API/Routes/Named/Corpus.hs
View file @ 5ec3c2af
......@@ -10,7 +10,6 @@ module Gargantext.API.Routes.Named.Corpus (
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.Corpus.Annuaire hiding (AddWithForm)
import Gargantext.API.Node.Corpus.Export.Types
import Gargantext.API.Node.Types
import Gargantext.Core.Text.Ngrams (NgramsType(..))
......@@ -27,20 +26,19 @@ newtype CorpusExportAPI mode = CorpusExportAPI
} deriving Generic
newtype AddWithForm mode = AddWithForm
{ addWithFormEp :: mode :- Summary "Add with FormUrlEncoded to annuaire endpoint"
:> "annuaire"
:> Capture "annuaire_id" AnnuaireId
{ addWithFormEp :: mode :- Summary "Add with FormUrlEncoded to corpus endpoint"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog)
} deriving Generic
newtype AddWithQuery mode = AddWithQuery
{ addWithQueryEp :: mode :- Summary "Add with Query to corpus endpoint"
:> "corpus"
:> Capture "corpus_id" CorpusId
:> "query"
:> AsyncJobs JobLog '[JSON] WithQuery JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] WithQuery JobLog)
} deriving Generic
src/Gargantext/API/Routes/Named/Count.hs
View file @ 5ec3c2af
......@@ -10,7 +10,7 @@ module Gargantext.API.Routes.Named.Count (
import GHC.Generics
import Servant
import Gargantext.API.Count as X hiding (CountAPI)
import Gargantext.API.Count.Types as X
newtype CountAPI mode = CountAPI
......
src/Gargantext/API/Routes/Named/Document.hs
View file @ 5ec3c2af
......@@ -6,49 +6,38 @@ module Gargantext.API.Routes.Named.Document (
DocumentsFromWriteNodesAPI(..)
, DocumentUploadAPI(..)
, DocumentExportAPI(..)
, DocumentExportEndpoints(..)
-- * API types
, Params(..)
, DocumentUpload(..)
-- * functions and lenses
, du_title
, du_sources
, du_language
, du_date
, du_authors
, du_abstract
) where
import Control.Lens
import Data.Aeson
import Data.Swagger hiding (fieldLabelModifier)
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.Document.Export.Types
import Gargantext.Core
import Gargantext.Core.Text.List.Social
import Gargantext.Core.Utils.Prefix
import Gargantext.API.Node.DocumentsFromWriteNodes.Types ( Params(..) )
import Gargantext.API.Node.DocumentUpload.Types ( DocumentUpload(..), )
import Gargantext.Utils.Servant (ZIP)
import Prelude
import Servant
newtype DocumentExportAPI mode = DocumentExportAPI
{ documentExportAPI ::
mode :- Summary "Document Export"
:> "export"
:> ( "json"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
:<|> "json.zip"
:> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
:<|> "csv"
:> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text) )
{ documentExportAPI :: mode :- Summary "Document Export" :> "export" :> NamedRoutes DocumentExportEndpoints
} deriving Generic
data DocumentExportEndpoints mode = DocumentExportEndpoints
{ exportJSONEp :: mode :- "json"
:> Get '[JSON] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExport)
, exportJSONZipEp :: mode :- "json.zip"
:> Get '[ZIP] (Headers '[Servant.Header "Content-Disposition" Text] DocumentExportZIP)
, exportTSVEp :: mode :- "tsv"
:> Get '[PlainText] (Headers '[Servant.Header "Content-Disposition" Text] Text)
} deriving Generic
newtype DocumentsFromWriteNodesAPI mode = DocumentsFromWriteNodesAPI
{ docFromWriteNodesEp :: mode :- Summary " Documents from Write nodes."
:> AsyncJobs JobLog '[JSON] Params JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] Params JobLog)
} deriving Generic
......@@ -57,61 +46,5 @@ newtype DocumentUploadAPI mode = DocumentUploadAPI
:> "document"
:> "upload"
:> "async"
:> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] DocumentUpload JobLog)
} deriving Generic
data Params = Params
{ id :: Int
, paragraphs :: Text
, lang :: Lang
, selection :: FlowSocialListWith
}
deriving (Generic, Show)
data DocumentUpload = DocumentUpload
{ _du_abstract :: Text
, _du_authors :: Text
, _du_sources :: Text
, _du_title :: Text
, _du_date :: Text
, _du_language :: Text
}
deriving Generic
--
-- instances
--
instance FromJSON Params where
parseJSON = genericParseJSON defaultOptions
instance ToJSON Params where
toJSON = genericToJSON defaultOptions
instance ToSchema Params
$(makeLenses ''DocumentUpload)
instance ToSchema DocumentUpload
instance FromJSON DocumentUpload
where
parseJSON = genericParseJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
instance ToJSON DocumentUpload
where
toJSON = genericToJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_du_"
, omitNothingFields = True
}
)
src/Gargantext/API/Routes/Named/EKG.hs 0 → 100644
View file @ 5ec3c2af
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.EKG (
-- * Routes types
EkgAPI(..)
) where
import Data.Text (Text)
import GHC.Generics
import Servant
import System.Metrics.Json qualified as J
-- Mimics https://github.com/tibbe/ekg/blob/master/System/Remote/Snap.hs#L98
newtype EkgAPI mode = EkgAPI
{ ekgAPI :: mode :- "ekg" :> ( "api" :> ( Get '[JSON] J.Sample :<|>
CaptureAll "segments" Text :> Get '[JSON] J.Value
) :<|> Raw )
} deriving Generic
src/Gargantext/API/Routes/Named/File.hs
View file @ 5ec3c2af
......@@ -9,9 +9,9 @@ module Gargantext.API.Routes.Named.File (
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Node.File
import Gargantext.API.Node.Types
import Servant
import Gargantext.API.Node.File.Types
data FileAPI mode = FileAPI
{ fileDownloadEp :: mode :- Summary "File download"
......@@ -24,6 +24,6 @@ data FileAsyncAPI mode = FileAsyncAPI
{ addFileAsyncEp :: mode :- Summary "File Async Api"
:> "file"
:> "add"
:> AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] NewWithFile JobLog)
} deriving Generic
src/Gargantext/API/Routes/Named/FrameCalc.hs
View file @ 5ec3c2af
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.FrameCalc where
module Gargantext.API.Routes.Named.FrameCalc (
-- * Routes types
FrameCalcAPI(..)
) where
import Servant
import GHC.Generics
import Gargantext.API.Node.FrameCalcUpload (FrameCalcUpload)
import Gargantext.API.Node.FrameCalcUpload.Types (FrameCalcUpload)
import Gargantext.API.Admin.Orchestrator.Types
data FrameCalcAPI mode = FrameCalcAPI
newtype FrameCalcAPI mode = FrameCalcAPI
{ frameCalcUploadEp :: mode :- Summary " FrameCalc upload"
:> "add"
:> "framecalc"
:> "async"
:> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog)
} deriving Generic
src/Gargantext/API/Routes/Named/List.hs
View file @ 5ec3c2af
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
module Gargantext.API.Routes.Named.List where
module Gargantext.API.Routes.Named.List (
-- * Routes types
GETAPI(..)
, ListEndpoints(..)
, JSONAPI(..)
, TSVAPI(..)
) where
import Data.Text (Text)
import GHC.Generics
......@@ -16,14 +22,16 @@ newtype GETAPI mode = GETAPI
{ getListEp :: mode :- Summary "Get List"
:> "lists"
:> Capture "listId" ListId
:> ( "json"
:> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
:<|> "json.zip"
:> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
:<|> "csv"
:> Get '[GUS.CSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap) )
:> NamedRoutes ListEndpoints
} deriving Generic
data ListEndpoints mode = ListEndpoints
{ listJSONEp :: mode :- "json"
:> Get '[JSON, HTML] (Headers '[Header "Content-Disposition" Text] NgramsList)
, listJSONZipEp :: mode :- "json.zip"
:> Get '[GUS.ZIP] (Headers '[Header "Content-Disposition" Text] NgramsListZIP)
, listTSVEp :: mode :- "tsv" :> Get '[GUS.TSV] (Headers '[Header "Content-Disposition" Text] NgramsTableMap)
} deriving Generic
newtype JSONAPI mode = JSONAPI
{ updateListJSONEp :: mode :- Summary "Update List"
......@@ -32,17 +40,17 @@ newtype JSONAPI mode = JSONAPI
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] WithJsonFile JobLog)
} deriving Generic
newtype CSVAPI mode = CSVAPI
{ updateListCSVEp :: mode :- Summary "Update List (legacy v3 CSV)"
newtype TSVAPI mode = TSVAPI
{ updateListTSVEp :: mode :- Summary "Update List (legacy v3 TSV)"
:> "lists"
:> Capture "listId" ListId
:> "csv"
:> "tsv"
:> "add"
:> "form"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] WithTextFile JobLog)
} deriving Generic
src/Gargantext/API/Routes/Named/Node.hs
View file @ 5ec3c2af
......@@ -7,7 +7,7 @@ module Gargantext.API.Routes.Named.Node (
, PostNodeAPI(..)
, ChildrenAPI(..)
, NodeNodeAPI(..)
, PostNodeAsync(..)
, PostNodeAsyncAPI(..)
, CatAPI(..)
, UpdateAPI(..)
, MoveAPI(..)
......@@ -16,6 +16,7 @@ module Gargantext.API.Routes.Named.Node (
, Pairs(..)
, Roots(..)
, NodesAPI(..)
, ScoreAPI(..)
-- * API types (might appear in the routes)
, Charts(..)
......@@ -27,9 +28,6 @@ module Gargantext.API.Routes.Named.Node (
, UpdateNodeParams(..)
) where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Auth.PolicyCheck ( PolicyChecked )
......@@ -42,20 +40,15 @@ import Gargantext.API.Routes.Named.Viz
import Gargantext.API.Routes.Named.Search
import Gargantext.API.Routes.Named.Share as Share
import Gargantext.API.Routes.Named.Table
import Gargantext.API.Routes.Named.Tree
import Gargantext.Core.Methods.Similarities
import Gargantext.Core.Text.Ngrams
import Gargantext.API.Node.Types ( RenameNode(..), NodesToScore(..), NodesToCategory(..) )
import Gargantext.API.Node.New.Types ( PostNode(..) )
import Gargantext.API.Node.Update.Types ( UpdateNodeParams(..), Charts(..), Granularity(..), Method(..) )
import Gargantext.Core.Types
import Gargantext.Core.Types.Query
import Gargantext.Core.Viz.Graph.Tools
import Gargantext.Core.Viz.Graph.Types hiding (Node)
import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..))
import Gargantext.Database.Admin.Types.Hyperdata.User ( HyperdataUser )
import Gargantext.Database.Query.Facet.Types ( FacetDoc, OrderBy(..) )
import Prelude
import Servant
import Test.QuickCheck
import Web.FormUrlEncoded (FromForm, ToForm)
-------------------------------------------------------------------
-- | Node API Types management
......@@ -72,11 +65,11 @@ import Web.FormUrlEncoded (FromForm, ToForm)
-- CanFavorite
-- CanMoveToTrash
data NodeAPI mode a = NodeAPI
data NodeAPI a mode = NodeAPI
{ nodeNodeAPI :: mode :- PolicyChecked (NamedRoutes (NodeNodeAPI a))
, renameAPI :: mode :- "rename" :> NamedRoutes RenameAPI
, postNodeAPI :: mode :- NamedRoutes PostNodeAPI -- TODO move to children POST
, postNodeAsync :: mode :- NamedRoutes PostNodeAsync
, postNodeAsyncAPI :: mode :- NamedRoutes PostNodeAsyncAPI
, frameCalcUploadAPI :: mode :- NamedRoutes FrameCalcAPI
, putEp :: mode :- ReqBody '[JSON] a :> Put '[JSON] Int
, updateAPI :: mode :- "update" :> NamedRoutes UpdateAPI
......@@ -88,15 +81,15 @@ data NodeAPI mode a = NodeAPI
, scoreAPI :: mode :- "score" :> NamedRoutes ScoreAPI
, searchAPI :: mode :- "search" :> NamedRoutes (SearchAPI SearchResult)
, shareAPI :: mode :- "share" :> NamedRoutes ShareNode
-- Pairing utilities
---- Pairing utilities
, pairWithEp :: mode :- "pairwith" :> NamedRoutes PairWith
, pairsEp :: mode :- "pairs" :> NamedRoutes Pairs
, pairingEp :: mode :- "pairing" :> NamedRoutes PairingAPI
-- VIZ
---- VIZ
, scatterAPI :: mode :- "metrics" :> NamedRoutes ScatterAPI
, charAPI :: mode :- "chart" :> NamedRoutes ChartAPI
, chartAPI :: mode :- "chart" :> NamedRoutes ChartAPI
, pieAPI :: mode :- "pie" :> NamedRoutes PieAPI
, treeAPI :: mode :- "tree" :> NamedRoutes NodeTreeAPI
, treeAPI :: mode :- "tree" :> NamedRoutes TreeAPI
, phyloAPI :: mode :- "phylo" :> NamedRoutes PhyloAPI
, moveAPI :: mode :- "move" :> NamedRoutes MoveAPI
, unpublishEp :: mode :- "unpublish" :> NamedRoutes Share.Unpublish
......@@ -124,11 +117,11 @@ newtype PostNodeAPI mode = PostNodeAPI
newtype ChildrenAPI a mode = ChildrenAPI
{ summaryChildrenEp :: Summary " Summary children"
:> QueryParam "type" NodeType
:> QueryParam "offset" Offset
:> QueryParam "limit" Limit
:> Get '[JSON] (NodeTableResult a)
{ summaryChildrenEp :: mode :- Summary " Summary children"
:> QueryParam "type" NodeType
:> QueryParam "offset" Offset
:> QueryParam "limit" Limit
:> Get '[JSON] (NodeTableResult a)
} deriving Generic
......@@ -137,10 +130,10 @@ newtype NodeNodeAPI a mode = NodeNodeAPI
} deriving Generic
newtype PostNodeAsync mode = PostNodeAsync
newtype PostNodeAsyncAPI mode = PostNodeAsyncAPI
{ postNodeAsyncEp :: mode :- Summary "Post Node"
:> "async"
:> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
:> NamedRoutes (AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog)
} deriving Generic
......@@ -153,7 +146,7 @@ newtype CatAPI mode = CatAPI
newtype UpdateAPI mode = UpdateAPI
{ updateNodeEp :: mode :- Summary " Update node according to NodeType params"
:> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
:> NamedRoutes (AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog)
} deriving Generic
......@@ -205,81 +198,3 @@ data Roots mode = Roots
newtype NodesAPI mode = NodesAPI
{ deleteNodeEp :: mode :- Delete '[JSON] Int
} deriving Generic
--
-- API types (might appears in the routes)
--
newtype RenameNode = RenameNode { r_name :: Text }
deriving Generic
data NodesToCategory = NodesToCategory
{ ntc_nodesId :: [NodeId]
, ntc_category :: Int
} deriving Generic
data PostNode = PostNode
{ pn_name :: Text
, pn_typename :: NodeType
} deriving Generic
data UpdateNodeParams = UpdateNodeParamsList { methodList :: !Method }
| UpdateNodeParamsGraph { methodGraphMetric :: !GraphMetric
, methodGraphClustering :: !PartitionMethod
, methodGraphBridgeness :: !BridgenessMethod
, methodGraphEdgesStrength :: !Strength
, methodGraphNodeType1 :: !NgramsType
, methodGraphNodeType2 :: !NgramsType
}
| UpdateNodeParamsTexts { methodTexts :: !Granularity }
| UpdateNodeParamsBoard { methodBoard :: !Charts }
| LinkNodeReq { nodeType :: !NodeType
, id :: !NodeId }
| UpdateNodePhylo { config :: !PhyloSubConfigAPI }
deriving Generic
data Method = Basic | Advanced | WithModel
deriving (Generic, Eq, Ord, Enum, Bounded)
data Granularity = NewNgrams | NewTexts | Both
deriving (Generic, Eq, Ord, Enum, Bounded)
data Charts = Sources | Authors | Institutes | Ngrams | All
deriving (Generic, Eq, Ord, Enum, Bounded)
data NodesToScore = NodesToScore { nts_nodesId :: [NodeId]
, nts_score :: Int
}
deriving (Generic)
--
-- Instances
--
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON PostNode
instance ToJSON PostNode
instance ToSchema PostNode
instance FromForm PostNode
instance ToForm PostNode
instance Arbitrary PostNode where
arbitrary = elements [PostNode "Node test" NodeCorpus]
-- TODO unPrefix "ntc_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON NodesToScore
instance ToJSON NodesToScore
instance ToSchema NodesToScore
src/Gargantext/API/Routes/Named/Private.hs
View file @ 5ec3c2af
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeFamilies #-}
module Gargantext.API.Routes.Named.Private (
-- * Routes types
GargPrivateAPI
GargPrivateAPI(..)
, MkProtectedAPI
, GargPrivateAPI'(..)
, GargAdminAPI(..)
, NodeEndpoint(..)
, NodeAPIEndpoint(..)
, MembersAPI(..)
, IsGenericNodeRoute(..)
) where
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Admin.Auth.Types
......@@ -20,7 +25,6 @@ import Gargantext.API.Routes.Named.Context
import Gargantext.API.Routes.Named.Corpus
import Gargantext.API.Routes.Named.Count
import Gargantext.API.Routes.Named.Document
import Gargantext.API.Routes.Named.Metrics
import Gargantext.API.Routes.Named.Node
import Gargantext.API.Routes.Named.List qualified as List
import Gargantext.API.Routes.Named.Share
......@@ -32,6 +36,8 @@ import Gargantext.Database.Admin.Types.Hyperdata.Corpus
import Gargantext.Database.Admin.Types.Node
import Servant.API
import Servant.Auth qualified as SA
import Data.Kind
import GHC.TypeLits
type MkProtectedAPI private = SA.Auth '[SA.JWT, SA.Cookie] AuthenticatedUser :> private
......@@ -44,13 +50,11 @@ newtype GargPrivateAPI mode = GargPrivateAPI
data GargPrivateAPI' mode = GargPrivateAPI'
{ gargAdminAPI :: mode :- NamedRoutes GargAdminAPI
, nodeEp :: mode :- NamedRoutes NodeEndpoint
, contextEp :: mode :- "context" :> Summary "Node endpoint"
, nodeEp :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataAny)
, contextEp :: mode :- "context" :> Summary "Context endpoint"
:> Capture "node_id" ContextId
:> NamedRoutes (ContextAPI HyperdataAny)
, corpusNodeAPI :: mode :- "corpus" :> Summary "Corpus endpoint"
:> Capture "corpus_id" CorpusId
:> NamedRoutes (NodeAPI HyperdataCorpus)
, corpusNodeAPI :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataCorpus)
, corpusNodeNodeAPI :: mode :- "corpus" :> Summary "Corpus endpoint"
:> Capture "node1_id" NodeId
:> "document"
......@@ -58,9 +62,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
:> NamedRoutes (NodeNodeAPI HyperdataAny)
, corpusExportAPI :: mode :- "corpus" :> Capture "node_id" CorpusId
:> NamedRoutes CorpusExportAPI
, annuaireEp :: mode :- "annuaire" :> Summary "Annuaire endpoint"
:> Capture "annuaire_id" AnnuaireId
:> NamedRoutes (NodeAPI HyperdataAnnuaire)
, annuaireEp :: mode :- NamedRoutes (NodeAPIEndpoint HyperdataAnnuaire)
, contactAPI :: mode :- "annuaire" :> Summary "Contact endpoint"
:> Capture "annuaire_id" NodeId
:> NamedRoutes ContactAPI
......@@ -70,6 +72,8 @@ data GargPrivateAPI' mode = GargPrivateAPI'
:> NamedRoutes TableNgramsAPI
, documentExportAPI :: mode :- "texts" :> Capture "node_id" DocId
:> NamedRoutes DocumentExportAPI
, phyloExportAPI :: mode :- "phylo" :> Capture "node_id" DocId
:> NamedRoutes PhyloExportAPI
, countAPI :: mode :- "count" :> Summary "Count endpoint"
:> ReqBody '[JSON] Query
:> NamedRoutes CountAPI
......@@ -78,7 +82,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
:> NamedRoutes GraphAPI
, treeAPI :: mode :- "tree" :> Summary "Tree endpoint"
:> Capture "tree_id" NodeId
:> PolicyChecked (NamedRoutes TreeAPI)
:> PolicyChecked (NamedRoutes NodeTreeAPI)
, treeFlatAPI :: mode :- "treeflat" :> Summary "Flat tree endpoint"
:> Capture "tree_id" NodeId
:> NamedRoutes TreeFlatAPI
......@@ -87,7 +91,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
, addWithQueryEp :: mode :- NamedRoutes AddWithQuery
, listGetAPI :: mode :- NamedRoutes List.GETAPI
, listJsonAPI :: mode :- NamedRoutes List.JSONAPI
, listCsvAPI :: mode :- NamedRoutes List.CSVAPI
, listTsvAPI :: mode :- NamedRoutes List.TSVAPI
, shareUrlEp :: mode :- "shareurl" :> NamedRoutes ShareURL
} deriving Generic
......@@ -99,15 +103,34 @@ data GargAdminAPI mode = GargAdminAPI
:> NamedRoutes NodesAPI
} deriving Generic
data NodeEndpoint mode = NodeEndpoint
{ nodeEndpointAPI :: mode :- "node" :> Summary "Node endpoint"
:> Capture "node_id" NodeId
:> NamedRoutes (NodeAPI HyperdataAny)
class IsGenericNodeRoute a where
type family TyToSubPath (a :: Type) :: Symbol
type family TyToCapture (a :: Type) :: Symbol
type family TyToSummary (a :: Type) :: Type
instance IsGenericNodeRoute HyperdataAny where
type instance TyToSubPath HyperdataAny = "node"
type instance TyToCapture HyperdataAny = "node_id"
type instance TyToSummary HyperdataAny = Summary "Node endpoint"
instance IsGenericNodeRoute HyperdataCorpus where
type instance TyToSubPath HyperdataCorpus = "corpus"
type instance TyToCapture HyperdataCorpus = "corpus_id"
type instance TyToSummary HyperdataCorpus = Summary "Corpus endpoint"
instance IsGenericNodeRoute HyperdataAnnuaire where
type instance TyToSubPath HyperdataAnnuaire = "annuaire"
type instance TyToCapture HyperdataAnnuaire = "annuaire_id"
type instance TyToSummary HyperdataAnnuaire = Summary "Annuaire endpoint"
newtype NodeAPIEndpoint a mode = NodeAPIEndpoint
{ nodeEndpointAPI :: mode :- TyToSubPath a
:> TyToSummary a
:> Capture (TyToCapture a) NodeId
:> NamedRoutes (NodeAPI a)
} deriving Generic
data MembersAPI mode = MembersAPI
newtype MembersAPI mode = MembersAPI
{ getMembersEp :: mode :- Get '[JSON] [Text]
}
} deriving Generic
src/Gargantext/API/Routes/Named/Public.hs
View file @ 5ec3c2af
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeOperators #-}
module Gargantext.API.Routes.Named.Public where
module Gargantext.API.Routes.Named.Public (
-- * Routes types
GargPublicAPI(..)
, HomeAPI(..)
, NodeAPI(..)
) where
import GHC.Generics
import Gargantext.API.Public qualified as Public
import Gargantext.API.Public.Types qualified as Public
import Gargantext.API.Routes.Named.File
import Gargantext.Database.Admin.Types.Node ( NodeId )
import Servant.API
data GargPublicAPI mode = GargPublicAPI
{ publicHomeAPI :: mode :- NamedRoutes HomeAPI
, publicNodeAPI :: mode :- NamedRoutes NodeAPI
} deriving Generic
data HomeAPI mode = HomeAPI
{ homeEp :: mode :- Summary "Public Home API" :> Get '[JSON] [Public.PublicData]
} deriving Generic
data NodeAPI mode = NodeAPI
{ nodeEp :: mode :- Summary "Public Node API" :> Capture "node" NodeId :> "file" :> NamedRoutes FileAPI
} deriving Generic
src/Gargantext/API/Routes/Named/Search.hs
View file @ 5ec3c2af
......@@ -12,23 +12,16 @@ module Gargantext.API.Routes.Named.Search (
) where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.Core.Text.Corpus.Query (RawQuery (..))
import Gargantext.API.Search.Types ( SearchQuery(..), SearchType(..), SearchResult(..), SearchResultTypes(..) )
import Gargantext.Core.Types.Query (Limit, Offset)
import Gargantext.Core.Types.Search
import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import Gargantext.Database.Query.Facet
import Prelude
import Servant
import Test.QuickCheck
-- TODO-ACCESS: CanSearch? or is it part of CanGetNode
-- TODO-EVENTS: No event, this is a read-only query.
data SearchAPI results mode = SearchAPI
newtype SearchAPI results mode = SearchAPI
{ searchEp :: mode :- Summary "Search endpoint"
:> ReqBody '[JSON] SearchQuery
:> QueryParam "offset" Offset
......@@ -36,79 +29,3 @@ data SearchAPI results mode = SearchAPI
:> QueryParam "order" OrderBy
:> Post '[JSON] results
} deriving Generic
data SearchType = SearchDoc | SearchContact | SearchDocWithNgrams
deriving Generic
data SearchQuery = SearchQuery
{ query :: !RawQuery
, expected :: !SearchType
} deriving Generic
newtype SearchResult =
SearchResult { result :: SearchResultTypes }
deriving Generic
data SearchResultTypes =
SearchResultDoc { docs :: ![Row] }
| SearchResultContact { contacts :: ![Row] }
| SearchNoResult { message :: !Text }
deriving Generic
--
-- instances
--
instance FromJSON SearchResult where
parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchResult where
toJSON = genericToJSON defaultOptions
instance ToSchema SearchResult
instance Arbitrary SearchResult where
arbitrary = SearchResult <$> arbitrary
instance FromJSON SearchResultTypes where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance ToJSON SearchResultTypes where
toJSON = genericToJSON (defaultOptions { sumEncoding = defaultTaggedObject })
instance Arbitrary SearchResultTypes where
arbitrary = do
srd <- SearchResultDoc <$> arbitrary
src <- SearchResultContact <$> arbitrary
srn <- pure $ SearchNoResult "No result because.."
elements [srd, src, srn]
instance ToSchema SearchResultTypes where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
instance FromJSON SearchQuery where
parseJSON = genericParseJSON defaultOptions
instance ToJSON SearchQuery where
toJSON = genericToJSON defaultOptions
instance ToSchema SearchQuery
instance Arbitrary SearchQuery where
arbitrary = elements [SearchQuery (RawQuery "electrodes") SearchDoc]
instance FromJSON SearchType where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON SearchType where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema SearchType
instance Arbitrary SearchType where
arbitrary = elements [SearchDoc, SearchContact]
src/Gargantext/API/Routes/Named/Share.hs
View file @ 5ec3c2af
......@@ -11,15 +11,13 @@ module Gargantext.API.Routes.Named.Share (
, ShareNodeParams(..)
) where
import Data.Aeson
import Data.Swagger
import Data.Text (Text)
import GHC.Generics
import Gargantext.API.Node.Share.Types ( ShareNodeParams (..) )
import Gargantext.Database.Admin.Types.Node
import Gargantext.Utils.Aeson qualified as GUA
import Prelude
import Servant
import Test.QuickCheck
newtype ShareURL mode = ShareURL
{ shareUrlEp :: mode :- Summary "Fetch URL for sharing a node"
......@@ -39,25 +37,3 @@ newtype ShareNode mode = ShareNode
newtype Unpublish mode = Unpublish
{ unpublishEp :: mode :- Summary " Unpublish Node" :> Capture "node_id" NodeId :> Put '[JSON] Int
} deriving Generic
--
-- API Types
--
data ShareNodeParams = ShareTeamParams { username :: Text }
| SharePublicParams { node_id :: NodeId }
deriving (Generic)
--
-- Instances
--
-- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.
instance FromJSON ShareNodeParams where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToJSON ShareNodeParams where
toJSON = genericToJSON (defaultOptions { sumEncoding = GUA.defaultTaggedObject })
instance ToSchema ShareNodeParams
instance Arbitrary ShareNodeParams where
arbitrary = elements [ ShareTeamParams "user1"
, SharePublicParams (UnsafeMkNodeId 1)
]
src/Gargantext/API/Routes/Named/Table.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Routes/Named/Viz.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Routes/Types.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Search.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Search/Types.hs 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Server/Named/EKG.hs 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Server/Named/Ngrams.hs 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Server/Named/Private.hs 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Server/Named/Viz.hs 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Swagger.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Table.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Table/Types.hs 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/ThrowAll.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Types.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/API/Viz/Types.hs 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Ext/IMT.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Ext/IMTUser.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Text/Convert.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Text/Corpus/Parsers.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Text/Search.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Text/Upload.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Viz/Graph/API.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Viz/Graph/Types.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Viz/Phylo.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Viz/Phylo/API.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Core/Viz/Phylo/PhyloMaker.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Utils/Jobs.hs
View file @ 5ec3c2af
This diff is collapsed.
src/Gargantext/Utils/Servant.hs
View file @ 5ec3c2af
This diff is collapsed.
stack.yaml
View file @ 5ec3c2af
This diff is collapsed.
test-data/phylo/187481.json
View file @ 5ec3c2af
This diff is collapsed.
test-data/phylo/GarganText_DocsList-nodeId-187481.csv deleted 100644 → 0
View file @ df4e87cf
This diff is collapsed.
test-data/phylo/GarganText_DocsList-nodeId-187481.tsv 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
test-data/phylo/cleopatre.golden.csv.json 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
test-data/phylo/cleopatre.golden.json
View file @ 5ec3c2af
This diff is collapsed.
test-data/phylo/issue-290-small.golden.json
View file @ 5ec3c2af
This diff is collapsed.
test-data/phylo/nadal.golden.json
View file @ 5ec3c2af
This diff is collapsed.
test-data/phylo/nadal_docslist.golden.csv deleted 100644 → 0
View file @ df4e87cf
This diff is collapsed.
test-data/phylo/nadal_docslist.golden.tsv 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
test-data/phylo/open_science.json
View file @ 5ec3c2af
This diff is collapsed.
test-data/phylo/small-phylo.golden.json
View file @ 5ec3c2af
This diff is collapsed.
test-data/phylo/small_phylo_docslist.csv deleted 100644 → 0
View file @ df4e87cf
This diff is collapsed.
test-data/phylo/small_phylo_docslist.tsv 0 → 100644
View file @ 5ec3c2af
This diff is collapsed.
test/Test/API/Authentication.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/API/Errors.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/API/Private.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/API/Routes.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/API/Setup.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/API/UpdateList.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/Graph/Distance.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/Offline/JSON.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/Offline/Phylo.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/Types.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/Utils.hs
View file @ 5ec3c2af
This diff is collapsed.
test/Test/Utils/Crypto.hs
View file @ 5ec3c2af
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment