Commit dfb65fb8 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[MERGE] fix conflicts

parents f262753d 9360652c
...@@ -33,6 +33,7 @@ data-files: ...@@ -33,6 +33,7 @@ data-files:
ekg-assets/chart_line_add.png ekg-assets/chart_line_add.png
ekg-assets/cross.png ekg-assets/cross.png
test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
test-data/ngrams/GarganText_DocsList-nodeId-177.json
test-data/ngrams/simple.json test-data/ngrams/simple.json
test-data/ngrams/simple.tsv test-data/ngrams/simple.tsv
test-data/phylo/bpa_phylo_test.json test-data/phylo/bpa_phylo_test.json
...@@ -130,6 +131,7 @@ library ...@@ -130,6 +131,7 @@ library
Gargantext.API.Ngrams.Types Gargantext.API.Ngrams.Types
Gargantext.API.Node Gargantext.API.Node
Gargantext.API.Node.Corpus.New Gargantext.API.Node.Corpus.New
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.Types Gargantext.API.Node.Corpus.Types
Gargantext.API.Node.Corpus.Update Gargantext.API.Node.Corpus.Update
Gargantext.API.Node.File Gargantext.API.Node.File
...@@ -193,13 +195,14 @@ library ...@@ -193,13 +195,14 @@ library
Gargantext.Core.Text.Corpus.API.OpenAlex Gargantext.Core.Text.Corpus.API.OpenAlex
Gargantext.Core.Text.Corpus.API.Pubmed Gargantext.Core.Text.Corpus.API.Pubmed
Gargantext.Core.Text.Corpus.Parsers Gargantext.Core.Text.Corpus.Parsers
Gargantext.Core.Text.Corpus.Parsers.TSV
Gargantext.Core.Text.Corpus.Parsers.Date Gargantext.Core.Text.Corpus.Parsers.Date
Gargantext.Core.Text.Corpus.Parsers.Date.Parsec Gargantext.Core.Text.Corpus.Parsers.Date.Parsec
Gargantext.Core.Text.Corpus.Parsers.TSV
Gargantext.Core.Text.Corpus.Query Gargantext.Core.Text.Corpus.Query
Gargantext.Core.Text.List Gargantext.Core.Text.List
Gargantext.Core.Text.List.Group.WithStem
Gargantext.Core.Text.List.Formats.TSV Gargantext.Core.Text.List.Formats.TSV
Gargantext.Core.Text.List.Group.WithStem
Gargantext.Core.Text.List.Social
Gargantext.Core.Text.Metrics Gargantext.Core.Text.Metrics
Gargantext.Core.Text.Metrics.CharByChar Gargantext.Core.Text.Metrics.CharByChar
Gargantext.Core.Text.Metrics.Count Gargantext.Core.Text.Metrics.Count
...@@ -315,7 +318,6 @@ library ...@@ -315,7 +318,6 @@ library
Gargantext.API.Node.Corpus.Export Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export.Types Gargantext.API.Node.Corpus.Export.Types
Gargantext.API.Node.Corpus.New.File Gargantext.API.Node.Corpus.New.File
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.Searx Gargantext.API.Node.Corpus.Searx
Gargantext.API.Node.Document.Export Gargantext.API.Node.Document.Export
Gargantext.API.Node.Document.Export.Types Gargantext.API.Node.Document.Export.Types
...@@ -383,7 +385,6 @@ library ...@@ -383,7 +385,6 @@ library
Gargantext.Core.Text.List.Group.WithScores Gargantext.Core.Text.List.Group.WithScores
Gargantext.Core.Text.List.Learn Gargantext.Core.Text.List.Learn
Gargantext.Core.Text.List.Merge Gargantext.Core.Text.List.Merge
Gargantext.Core.Text.List.Social
Gargantext.Core.Text.List.Social.Find Gargantext.Core.Text.List.Social.Find
Gargantext.Core.Text.List.Social.Patch Gargantext.Core.Text.List.Social.Patch
Gargantext.Core.Text.List.Social.Prelude Gargantext.Core.Text.List.Social.Prelude
...@@ -932,9 +933,12 @@ test-suite garg-test-tasty ...@@ -932,9 +933,12 @@ test-suite garg-test-tasty
other-modules: other-modules:
CLI.Phylo.Common CLI.Phylo.Common
Paths_gargantext Paths_gargantext
Test.Core.AsyncUpdates
Test.API.Private.Share
Test.API.Authentication
Test.API.Routes Test.API.Routes
Test.API.Setup Test.API.Setup
Test.Core.AsyncUpdates Test.API.UpdateList
Test.Core.Similarity Test.Core.Similarity
Test.Core.Text Test.Core.Text
Test.Core.Text.Corpus.Query Test.Core.Text.Corpus.Query
......
...@@ -8,6 +8,7 @@ module Gargantext.API.Errors ( ...@@ -8,6 +8,7 @@ module Gargantext.API.Errors (
-- * Types -- * Types
, GargErrorScheme(..) , GargErrorScheme(..)
, renderGargErrorScheme
-- * Conversion functions -- * Conversion functions
, backendErrorToFrontendError , backendErrorToFrontendError
...@@ -48,6 +49,11 @@ data GargErrorScheme ...@@ -48,6 +49,11 @@ data GargErrorScheme
-- https://spec.graphql.org/June2018/#sec-Errors -- https://spec.graphql.org/June2018/#sec-Errors
deriving (Show, Eq) deriving (Show, Eq)
renderGargErrorScheme :: GargErrorScheme -> T.Text
renderGargErrorScheme = \case
GES_old -> "old"
GES_new -> "new"
-- | Transforms a backend internal error into something that the frontend -- | Transforms a backend internal error into something that the frontend
-- can consume. This is the only representation we offer to the outside world, -- can consume. This is the only representation we offer to the outside world,
-- as we later encode this into a 'ServerError' in the main server handler. -- as we later encode this into a 'ServerError' in the main server handler.
...@@ -105,12 +111,11 @@ frontendErrorToServerError fe@(FrontendError diag ty _) = ...@@ -105,12 +111,11 @@ frontendErrorToServerError fe@(FrontendError diag ty _) =
} }
internalServerErrorToFrontendError :: ServerError -> FrontendError internalServerErrorToFrontendError :: ServerError -> FrontendError
internalServerErrorToFrontendError = \case internalServerErrorToFrontendError ServerError{..}
ServerError{..} | errHTTPCode == 405
| errHTTPCode == 405 = mkFrontendErr' (T.pack errReasonPhrase) $ FE_not_allowed (TL.toStrict $ TE.decodeUtf8 $ errBody)
-> mkFrontendErr' (T.pack errReasonPhrase) $ FE_not_allowed (TL.toStrict $ TE.decodeUtf8 $ errBody) | otherwise
| otherwise = mkFrontendErr' (T.pack errReasonPhrase) $ FE_internal_server_error (TL.toStrict $ TE.decodeUtf8 $ errBody)
-> mkFrontendErr' (T.pack errReasonPhrase) $ FE_internal_server_error (TL.toStrict $ TE.decodeUtf8 $ errBody)
jobErrorToFrontendError :: JobError -> FrontendError jobErrorToFrontendError :: JobError -> FrontendError
jobErrorToFrontendError = \case jobErrorToFrontendError = \case
......
...@@ -86,7 +86,7 @@ data GargPrivateAPI' mode = GargPrivateAPI' ...@@ -86,7 +86,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
:> Capture "tree_id" NodeId :> Capture "tree_id" NodeId
:> NamedRoutes TreeFlatAPI :> NamedRoutes TreeFlatAPI
, membersAPI :: mode :- "members" :> Summary "Team node members" :> NamedRoutes MembersAPI , membersAPI :: mode :- "members" :> Summary "Team node members" :> NamedRoutes MembersAPI
, addWithFormEp :: mode :- NamedRoutes AddWithForm , addWithFormAPI :: mode :- NamedRoutes AddWithForm
, addWithQueryEp :: mode :- NamedRoutes AddWithQuery , addWithQueryEp :: mode :- NamedRoutes AddWithQuery
, listGetAPI :: mode :- NamedRoutes List.GETAPI , listGetAPI :: mode :- NamedRoutes List.GETAPI
, listJsonAPI :: mode :- NamedRoutes List.JSONAPI , listJsonAPI :: mode :- NamedRoutes List.JSONAPI
......
...@@ -5,6 +5,7 @@ module Gargantext.API.Routes.Types where ...@@ -5,6 +5,7 @@ module Gargantext.API.Routes.Types where
import Control.Lens import Control.Lens
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.CaseInsensitive qualified as CI
import Data.List qualified as L import Data.List qualified as L
import Data.Proxy import Data.Proxy
import Data.Set qualified as Set import Data.Set qualified as Set
...@@ -12,16 +13,21 @@ import Gargantext.API.Errors ...@@ -12,16 +13,21 @@ import Gargantext.API.Errors
import Network.Wai hiding (responseHeaders) import Network.Wai hiding (responseHeaders)
import Prelude import Prelude
import Servant.API.Routes import Servant.API.Routes
import Servant.API.Routes.Internal.Response (unResponses)
import Servant.API.Routes.Route
import Servant.Client hiding (responseHeaders) import Servant.Client hiding (responseHeaders)
import Servant.Client.Core.Request (addHeader)
import Servant.Ekg import Servant.Ekg
import Servant.Server import Servant.Server
import Servant.Server.Internal.Delayed import Servant.Server.Internal.Delayed
import Servant.Server.Internal.DelayedIO import Servant.Server.Internal.DelayedIO
import Servant.API.Routes.Route import Network.HTTP.Types (HeaderName)
import Servant.API.Routes.Internal.Response (unResponses)
data WithCustomErrorScheme a data WithCustomErrorScheme a
xGargErrorScheme :: HeaderName
xGargErrorScheme = CI.mk "X-Garg-Error-Scheme"
instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx where instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx where
type ServerT (WithCustomErrorScheme subApi) m = GargErrorScheme -> ServerT subApi m type ServerT (WithCustomErrorScheme subApi) m = GargErrorScheme -> ServerT subApi m
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy subApi) pc nt . s hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy subApi) pc nt . s
...@@ -30,7 +36,7 @@ instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx ...@@ -30,7 +36,7 @@ instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx
getErrorScheme :: DelayedIO GargErrorScheme getErrorScheme :: DelayedIO GargErrorScheme
getErrorScheme = withRequest $ \rq -> do getErrorScheme = withRequest $ \rq -> do
let hdrs = requestHeaders rq let hdrs = requestHeaders rq
in case L.lookup "X-Garg-Error-Scheme" hdrs of in case L.lookup xGargErrorScheme hdrs of
Nothing -> pure GES_old Nothing -> pure GES_old
Just "new" -> pure GES_new Just "new" -> pure GES_new
Just _ -> pure GES_old Just _ -> pure GES_old
...@@ -41,7 +47,9 @@ instance HasEndpoint sub => HasEndpoint (WithCustomErrorScheme sub) where ...@@ -41,7 +47,9 @@ instance HasEndpoint sub => HasEndpoint (WithCustomErrorScheme sub) where
instance HasClient m sub => HasClient m (WithCustomErrorScheme sub) where instance HasClient m sub => HasClient m (WithCustomErrorScheme sub) where
type Client m (WithCustomErrorScheme sub) = GargErrorScheme -> Client m sub type Client m (WithCustomErrorScheme sub) = GargErrorScheme -> Client m sub
clientWithRoute m _ req _mgr = clientWithRoute m (Proxy :: Proxy sub) req clientWithRoute m _ req0 _mgr =
let req = addHeader xGargErrorScheme (renderGargErrorScheme $ GES_new) req0
in clientWithRoute m (Proxy :: Proxy sub) req
hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy sub) nt . cl
...@@ -49,5 +57,5 @@ instance (HasRoutes subApi) => HasRoutes (WithCustomErrorScheme subApi) where ...@@ -49,5 +57,5 @@ instance (HasRoutes subApi) => HasRoutes (WithCustomErrorScheme subApi) where
getRoutes = getRoutes =
let apiRoutes = getRoutes @subApi let apiRoutes = getRoutes @subApi
errHeader = mkHeaderRep @"X-Garg-Error-Scheme" @ByteString errHeader = mkHeaderRep @"X-Garg-Error-Scheme" @ByteString
addHeader rt = rt & routeResponse . unResponses . traversed . responseHeaders %~ Set.insert errHeader addHeader' rt = rt & routeResponse . unResponses . traversed . responseHeaders %~ Set.insert errHeader
in addHeader <$> apiRoutes in addHeader' <$> apiRoutes
...@@ -58,7 +58,7 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId) ...@@ -58,7 +58,7 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
, treeAPI = Tree.treeAPI authenticatedUser , treeAPI = Tree.treeAPI authenticatedUser
, treeFlatAPI = Tree.treeFlatAPI authenticatedUser , treeFlatAPI = Tree.treeFlatAPI authenticatedUser
, membersAPI = members , membersAPI = members
, addWithFormEp = addCorpusWithForm (RootId userNodeId) , addWithFormAPI = addCorpusWithForm (RootId userNodeId)
, addWithQueryEp = addCorpusWithQuery (RootId userNodeId) , addWithQueryEp = addCorpusWithQuery (RootId userNodeId)
, listGetAPI = List.getAPI , listGetAPI = List.getAPI
, listJsonAPI = List.jsonAPI , listJsonAPI = List.jsonAPI
......
...@@ -83,6 +83,7 @@ instance ToSchema FlowSocialListWith where ...@@ -83,6 +83,7 @@ instance ToSchema FlowSocialListWith where
instance FromHttpApiData FlowSocialListWith instance FromHttpApiData FlowSocialListWith
where where
parseUrlPiece "My lists first" = pure $ FlowSocialListWithPriority { fslw_priority = MySelfFirst } parseUrlPiece "My lists first" = pure $ FlowSocialListWithPriority { fslw_priority = MySelfFirst }
parseUrlPiece "MySelfFirst" = pure $ FlowSocialListWithPriority { fslw_priority = MySelfFirst }
parseUrlPiece "Others lists first" = pure $ FlowSocialListWithPriority { fslw_priority = OthersFirst } parseUrlPiece "Others lists first" = pure $ FlowSocialListWithPriority { fslw_priority = OthersFirst }
parseUrlPiece "NoList" = pure $ NoList True parseUrlPiece "NoList" = pure $ NoList True
parseUrlPiece x = panicTrace $ "[G.C.T.L.Social] TODO FromHttpApiData FlowSocialListWith error: " <> (show x) parseUrlPiece x = panicTrace $ "[G.C.T.L.Social] TODO FromHttpApiData FlowSocialListWith error: " <> (show x)
......
...@@ -127,7 +127,8 @@ getOccByNgramsOnlyFast cId lId nt = do ...@@ -127,7 +127,8 @@ getOccByNgramsOnlyFast cId lId nt = do
WITH cnnv AS WITH cnnv AS
( SELECT DISTINCT context_node_ngrams.context_id, ( SELECT DISTINCT context_node_ngrams.context_id,
context_node_ngrams.ngrams_id, context_node_ngrams.ngrams_id,
nodes_contexts.node_id nodes_contexts.node_id,
nodes_contexts.category
FROM nodes_contexts FROM nodes_contexts
JOIN context_node_ngrams ON context_node_ngrams.context_id = nodes_contexts.context_id JOIN context_node_ngrams ON context_node_ngrams.context_id = nodes_contexts.context_id
), ),
...@@ -135,7 +136,7 @@ getOccByNgramsOnlyFast cId lId nt = do ...@@ -135,7 +136,7 @@ getOccByNgramsOnlyFast cId lId nt = do
(SELECT context_id, ngrams_id, terms (SELECT context_id, ngrams_id, terms
FROM cnnv FROM cnnv
JOIN ngrams ON cnnv.ngrams_id = ngrams.id JOIN ngrams ON cnnv.ngrams_id = ngrams.id
WHERE node_id = ? WHERE node_id = ? AND cnnv.category > 0
), ),
ncids_agg AS ncids_agg AS
(SELECT ngrams_id, terms, array_agg(DISTINCT context_id) AS agg (SELECT ngrams_id, terms, array_agg(DISTINCT context_id) AS agg
......
{
"documents": [
{
"document": {
"id": 7796,
"hash_id": null,
"typename": 4,
"user_id": 2,
"parent_id": null,
"name": "Beyond the C: Retargetable Decompilation using Neural Machine Translation",
"date": "2021-12-31T23:00:00Z",
"hyperdata": {
"abstract": " The problem of reversing the compilation process, decompilation, is an important tool in reverse engineering of computer software. Recently, researchers have proposed using techniques from neural machine translation to automate the process in decompilation. Although such techniques hold the promise of targeting a wider range of source and assembly languages, to date they have primarily targeted C code. In this paper we argue that existing neural decompilers have achieved higher accuracy at the cost of requiring language-specific domain knowledge such as tokenizers and parsers to build an abstract syntax tree (AST) for the source language, which increases the overhead of supporting new languages. We explore a different tradeoff that, to the extent possible, treats the assembly and source languages as plain text, and show that this allows us to build a decompiler that is easily retargetable to new languages. We evaluate our prototype decompiler, Beyond The C (BTC), on Go, Fortran, OCaml, and C, and examine the impact of parameters such as tokenization and training data selection on the quality of decompilation, finding that it achieves comparable decompilation results to prior work in neural decompilation with significantly less domain knowledge. We will release our training data, trained decompilation models, and code to help encourage future research into language-agnostic decompilation. ",
"authors": "Iman Hosseini, Brendan Dolan-Gavitt",
"bdd": "Arxiv",
"doi": "10.14722/bar.2022.23009",
"institutes": ", ",
"language_iso2": "EN",
"publication_date": "2022-12-17T20:45:59Z",
"publication_year": 2022,
"source": "",
"title": "Beyond the C: Retargetable Decompilation using Neural Machine Translation",
"url": "http://arxiv.org/pdf/2212.08950v1"
}
},
"ngrams": {
"ngrams": [],
"hash": ""
},
"hash": ""
},
{
"document": {
"id": 7797,
"hash_id": null,
"typename": 4,
"user_id": 2,
"parent_id": null,
"name": "TREXIO: A File Format and Library for Quantum Chemistry",
"date": "2022-12-31T23:00:00Z",
"hyperdata": {
"abstract": " TREXIO is an open-source file format and library developed for the storage and manipulation of data produced by quantum chemistry calculations. It is designed with the goal of providing a reliable and efficient method of storing and exchanging wave function parameters and matrix elements, making it an important tool for researchers in the field of quantum chemistry. In this work, we present an overview of the TREXIO file format and library. The library consists of a front-end implemented in the C programming language and two different back-ends: a text back-end and a binary back-end utilizing the HDF5 library which enables fast read and write operations. It is compatible with a variety of platforms and has interfaces for the Fortran, Python, and OCaml programming languages. In addition, a suite of tools has been developed to facilitate the use of the TREXIO format and library, including converters for popular quantum chemistry codes and utilities for validating and manipulating data stored in TREXIO files. The simplicity, versatility, and ease of use of TREXIO make it a valuable resource for researchers working with quantum chemistry data. ",
"authors": "Evgeny Posenitskiy, Vijay Gopal Chilkuri, Abdallah Ammar, Michał Hapka, Katarzyna Pernal, Ravindra Shinde, Edgar Josué Landinez Borda, Claudia Filippi, Kosuke Nakano, Otto Kohulák, Sandro Sorella, Pablo de Oliveira Castro, William Jalby, Pablo López Rıós, Ali Alavi, Anthony Scemama",
"bdd": "Arxiv",
"doi": "10.1063/5.0148161",
"institutes": ", , , , , , , , , , , , , , , ",
"language_iso2": "EN",
"publication_date": "2023-02-28T17:44:54Z",
"publication_year": 2023,
"source": "",
"title": "TREXIO: A File Format and Library for Quantum Chemistry",
"url": "http://arxiv.org/pdf/2302.14793v2"
}
},
"ngrams": {
"ngrams": [],
"hash": ""
},
"hash": ""
}
]
}
...@@ -43,7 +43,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -43,7 +43,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "returns the old error by default" $ \((_testEnv, port), app) -> do it "returns the old error by default" $ \((_testEnv, port), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
res <- protected token "GET" (mkUrl port "/node/99") "" res <- protected token "GET" (mkUrl port "/node/99") ""
case res of case res of
SResponse{..} SResponse{..}
...@@ -54,7 +54,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -54,7 +54,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
res <- protectedNewError token "GET" (mkUrl port "/node/99") "" res <- protectedNewError token "GET" (mkUrl port "/node/99") ""
case res of case res of
SResponse{..} SResponse{..}
......
...@@ -28,7 +28,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -28,7 +28,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
createAliceAndBob testEnv createAliceAndBob testEnv
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
let query = [r| { "query": "{ user_infos(user_id: 2) { ui_id, ui_email } }" } |] let query = [r| { "query": "{ user_infos(user_id: 2) { ui_id, ui_email } }" } |]
let expected = [json| {"data":{"user_infos":[{"ui_id":2,"ui_email":"alice@gargan.text"}]}} |] let expected = [json| {"data":{"user_infos":[{"ui_id":2,"ui_email":"alice@gargan.text"}]}} |]
protected token "POST" "/gql" query `shouldRespondWithFragment` expected protected token "POST" "/gql" query `shouldRespondWithFragment` expected
...@@ -36,7 +36,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -36,7 +36,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
describe "nodes" $ do describe "nodes" $ do
it "returns node_type" $ \((_testEnv, port), app) -> do it "returns node_type" $ \((_testEnv, port), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
let query = [r| { "query": "{ nodes(node_id: 2) { node_type } }" } |] let query = [r| { "query": "{ nodes(node_id: 2) { node_type } }" } |]
let expected = [json| {"data":{"nodes":[{"node_type":"NodeFolderPrivate"}]}} |] let expected = [json| {"data":{"nodes":[{"node_type":"NodeFolderPrivate"}]}} |]
protected token "POST" "/gql" query `shouldRespondWithFragment` expected protected token "POST" "/gql" query `shouldRespondWithFragment` expected
...@@ -44,21 +44,21 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -44,21 +44,21 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
describe "check error format" $ do describe "check error format" $ do
it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |] let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |]
let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |] let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
protectedNewError token "POST" "/gql" query `shouldRespondWithFragment` expected protectedNewError token "POST" "/gql" query `shouldRespondWithFragment` expected
it "returns the old error (though this is deprecated)" $ \((_testEnv, port), app) -> do it "returns the old error (though this is deprecated)" $ \((_testEnv, port), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |] let query = [r| { "query": "{ languages(id:5) { lt_lang } }" } |]
let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |] let expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
protected token "POST" "/gql" query `shouldRespondWithFragment` expected protected token "POST" "/gql" query `shouldRespondWithFragment` expected
it "check new errors with 'type'" $ \((_testEnv, port), app) -> do it "check new errors with 'type'" $ \((_testEnv, port), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "gargantua" (GargPassword "secret_key") $ \token -> do withValidLogin port "gargantua" (GargPassword "secret_key") $ \_clientEnv token -> do
let query = [r| { "query": "mutation { delete_team_membership(shared_folder_id:1, team_node_id:1, token:\"abc\") }" } |] let query = [r| { "query": "mutation { delete_team_membership(shared_folder_id:1, team_node_id:1, token:\"abc\") }" } |]
let expected = [json| {"errors":[{"extensions":{"data":{"msg":"This user is not team owner","user_id":1},"diagnostic":"User not authorized. ","type":"EC_403__user_not_authorized"},"message":"User not authorized. "}]} |] let expected = [json| {"errors":[{"extensions":{"data":{"msg":"This user is not team owner","user_id":1},"diagnostic":"User not authorized. ","type":"EC_403__user_not_authorized"},"message":"User not authorized. "}]} |]
shouldRespondWithFragmentCustomStatus 403 shouldRespondWithFragmentCustomStatus 403
......
...@@ -33,7 +33,7 @@ privateTests = ...@@ -33,7 +33,7 @@ privateTests =
describe "Private API" $ do describe "Private API" $ do
baseUrl <- runIO $ parseBaseUrl "http://localhost" baseUrl <- runIO $ parseBaseUrl "http://localhost"
manager <- runIO $ newManager defaultManagerSettings manager <- runIO $ newManager defaultManagerSettings
let clientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port }) let unauthenticatedClientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })
describe "GET /api/v1.0/user" $ do describe "GET /api/v1.0/user" $ do
...@@ -45,17 +45,17 @@ privateTests = ...@@ -45,17 +45,17 @@ privateTests =
let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM)) let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
admin_user_api_get = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser]) admin_user_api_get = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser])
result <- runClientM admin_user_api_get (clientEnv port) result <- runClientM admin_user_api_get (unauthenticatedClientEnv port)
length result `shouldBe` 0 length result `shouldBe` 0
-- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking. -- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
it "allows 'alice' to see the results" $ \((_testEnv, port), _) -> do it "allows 'alice' to see the results" $ \((_testEnv, port), _) -> do
withValidLogin port "alice" (GargPassword "alice") $ \_token -> do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv _token -> do
let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM)) let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
admin_user_api_get = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser]) admin_user_api_get = (getRootsEp . rootsEp $ gargAdminClient :: ClientM [Node HyperdataUser])
_nodes <- runClientM admin_user_api_get (clientEnv port) _nodes <- runClientM admin_user_api_get clientEnv
pendingWith "currently useless" pendingWith "currently useless"
describe "GET /api/v1.0/node" $ do describe "GET /api/v1.0/node" $ do
...@@ -66,13 +66,13 @@ privateTests = ...@@ -66,13 +66,13 @@ privateTests =
it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
protected token "GET" (mkUrl port "/node/8") "" protected token "GET" (mkUrl port "/node/8") ""
`shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |] `shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |]
it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` 403 protected token "GET" (mkUrl port "/node/1") "" `shouldRespondWith` 403
describe "GET /api/v1.0/tree" $ do describe "GET /api/v1.0/tree" $ do
...@@ -82,13 +82,13 @@ privateTests = ...@@ -82,13 +82,13 @@ privateTests =
it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do it "allows 'alice' to see her own node info" $ \((_testEnv, port), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
protected token "GET" (mkUrl port "/tree/8") "" protected token "GET" (mkUrl port "/tree/8") ""
`shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |] `shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]
it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do it "forbids 'alice' to see others node private info" $ \((_testEnv, port), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
protected token "GET" (mkUrl port "/tree/1") "" `shouldRespondWith` 403 protected token "GET" (mkUrl port "/tree/1") "" `shouldRespondWith` 403
......
...@@ -16,7 +16,6 @@ import Gargantext.API.Routes.Named.Share ...@@ -16,7 +16,6 @@ import Gargantext.API.Routes.Named.Share
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Prelude import Gargantext.Prelude
import Network.HTTP.Client hiding (responseBody)
import Prelude (fail) import Prelude (fail)
import Servant.Auth.Client qualified as SC import Servant.Auth.Client qualified as SC
import Servant.Client import Servant.Client
...@@ -49,14 +48,10 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -49,14 +48,10 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
-- Let's create the Alice user. -- Let's create the Alice user.
createAliceAndBob testEnv createAliceAndBob testEnv
baseUrl <- runIO $ parseBaseUrl "http://localhost"
manager <- runIO $ newManager defaultManagerSettings
let clientEnv port = mkClientEnv manager (baseUrl { baseUrlPort = port })
it "should fail if no node type is specified" $ \((_testEnv, serverPort), app) -> do it "should fail if no node type is specified" $ \((_testEnv, serverPort), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin serverPort "alice" (GargPassword "alice") $ \token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
url <- liftIO $ runClientM (shareURL (toServantToken token) Nothing Nothing) (clientEnv serverPort) url <- liftIO $ runClientM (shareURL (toServantToken token) Nothing Nothing) clientEnv
case url of case url of
Left (FailureResponse _req res) Left (FailureResponse _req res)
-> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node Type" . T.pack) -> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node Type" . T.pack)
...@@ -64,8 +59,8 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -64,8 +59,8 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "should fail if no node ID is specified" $ \((_testEnv, serverPort), app) -> do it "should fail if no node ID is specified" $ \((_testEnv, serverPort), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin serverPort "alice" (GargPassword "alice") $ \token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) Nothing) (clientEnv serverPort) url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) Nothing) clientEnv
case url of case url of
Left (FailureResponse _req res) Left (FailureResponse _req res)
-> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node ID" . T.pack) -> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node ID" . T.pack)
...@@ -73,9 +68,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -73,9 +68,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "should return a valid URL" $ \((testEnv, serverPort), app) -> do it "should return a valid URL" $ \((testEnv, serverPort), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin serverPort "alice" (GargPassword "alice") $ \token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
cId <- liftIO $ newCorpusForUser testEnv "alice" cId <- liftIO $ newCorpusForUser testEnv "alice"
url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) (Just cId)) (clientEnv serverPort) url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) (Just cId)) clientEnv
case url of case url of
Left err Left err
-> fail (show err) -> fail (show err)
...@@ -84,9 +79,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -84,9 +79,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "should include the port if needed (like localhost)" $ \((testEnv, serverPort), app) -> do it "should include the port if needed (like localhost)" $ \((testEnv, serverPort), app) -> do
withApplication app $ do withApplication app $ do
withValidLogin serverPort "alice" (GargPassword "alice") $ \token -> do withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
cId <- liftIO $ newCorpusForUser testEnv "alice" cId <- liftIO $ newCorpusForUser testEnv "alice"
url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) (Just cId)) (clientEnv serverPort) url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) (Just cId)) clientEnv
case url of case url of
Left err Left err
-> fail (show err) -> fail (show err)
......
...@@ -4,8 +4,10 @@ module Test.API.Setup where ...@@ -4,8 +4,10 @@ module Test.API.Setup where
import Control.Concurrent.Async qualified as Async import Control.Concurrent.Async qualified as Async
import Control.Concurrent.MVar import Control.Concurrent.MVar
import Control.Exception
import Control.Lens import Control.Lens
import Control.Monad.Reader import Control.Monad.Reader
import Data.ByteString.Lazy.Char8 qualified as C8L
import Data.Cache qualified as InMemory import Data.Cache qualified as InMemory
import Data.Streaming.Network (bindPortTCP) import Data.Streaming.Network (bindPortTCP)
import Gargantext.API (makeApp) import Gargantext.API (makeApp)
...@@ -38,7 +40,9 @@ import Gargantext.Utils.Jobs.Monad qualified as Jobs ...@@ -38,7 +40,9 @@ import Gargantext.Utils.Jobs.Monad qualified as Jobs
import Gargantext.Utils.Jobs.Queue qualified as Jobs import Gargantext.Utils.Jobs.Queue qualified as Jobs
import Gargantext.Utils.Jobs.Settings qualified as Jobs import Gargantext.Utils.Jobs.Settings qualified as Jobs
import Network.HTTP.Client.TLS (newTlsManager) import Network.HTTP.Client.TLS (newTlsManager)
import Network.Wai (Application) import Network.HTTP.Types
import Network.Wai (Application, responseLBS)
import Network.Wai qualified as Wai
import Network.Wai.Handler.Warp (runSettingsSocket) import Network.Wai.Handler.Warp (runSettingsSocket)
import Network.Wai.Handler.Warp qualified as Warp import Network.Wai.Handler.Warp qualified as Warp
import Network.Wai.Handler.Warp.Internal import Network.Wai.Handler.Warp.Internal
...@@ -127,7 +131,8 @@ withTestDBAndPort action = ...@@ -127,7 +131,8 @@ withTestDBAndPort action =
app <- withLoggerHoisted Mock $ \ioLogger -> do app <- withLoggerHoisted Mock $ \ioLogger -> do
env <- newTestEnv testEnv ioLogger 8080 env <- newTestEnv testEnv ioLogger 8080
makeApp env makeApp env
Warp.testWithApplication (pure app) $ \port -> action ((testEnv, port), app) let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions }
Warp.testWithApplicationSettings stgs (pure app) $ \port -> action ((testEnv, port), app)
-- | Starts the backend server /and/ the microservices proxy, the former at -- | Starts the backend server /and/ the microservices proxy, the former at
-- a random port, the latter at a predictable port. -- a random port, the latter at a predictable port.
...@@ -169,6 +174,11 @@ createAliceAndBob testEnv = do ...@@ -169,6 +174,11 @@ createAliceAndBob testEnv = do
void $ new_user nur1 void $ new_user nur1
void $ new_user nur2 void $ new_user nur2
-- show the full exceptions during testing, rather than shallowing them under a generic
-- "Something went wrong".
showDebugExceptions :: SomeException -> Wai.Response
showDebugExceptions e =
responseLBS status500 [(hContentType, "text/plain; charset=utf-8")] (C8L.pack $ show e)
-- | A version of 'withApplication' that allows supplying a user-specified port -- | A version of 'withApplication' that allows supplying a user-specified port
-- so that we are sure that our garg apps will run on the same port as specified -- so that we are sure that our garg apps will run on the same port as specified
...@@ -182,6 +192,7 @@ testWithApplicationOnPort mkApp userPort action = do ...@@ -182,6 +192,7 @@ testWithApplicationOnPort mkApp userPort action = do
{ settingsBeforeMainLoop = { settingsBeforeMainLoop =
notify started () >> settingsBeforeMainLoop Warp.defaultSettings notify started () >> settingsBeforeMainLoop Warp.defaultSettings
, settingsPort = userPort , settingsPort = userPort
, settingsOnExceptionResponse = showDebugExceptions
} }
sock <- bindPortTCP userPort "127.0.0.1" sock <- bindPortTCP userPort "127.0.0.1"
result <- result <-
......
...@@ -14,6 +14,7 @@ module Test.API.UpdateList ( ...@@ -14,6 +14,7 @@ module Test.API.UpdateList (
import Control.Lens (mapped, over) import Control.Lens (mapped, over)
import Control.Monad.Fail (fail) import Control.Monad.Fail (fail)
import Data.Aeson qualified as JSON
import Data.Aeson.QQ import Data.Aeson.QQ
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
import Data.Map.Strict.Patch qualified as PM import Data.Map.Strict.Patch qualified as PM
...@@ -23,9 +24,18 @@ import Data.Text qualified as T ...@@ -23,9 +24,18 @@ import Data.Text qualified as T
import Data.Text.IO qualified as TIO import Data.Text.IO qualified as TIO
import Fmt import Fmt
import Gargantext.API.Admin.Auth.Types (Token) import Gargantext.API.Admin.Auth.Types (Token)
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Errors
import Gargantext.API.Ngrams qualified as APINgrams import Gargantext.API.Ngrams qualified as APINgrams
import Gargantext.API.Ngrams.List ( ngramsListFromTSVData ) import Gargantext.API.Ngrams.List ( ngramsListFromTSVData )
import Gargantext.API.Ngrams.Types ( MSet(..), NgramsPatch(..), NgramsRepoElement(..), NgramsTablePatch(..), NgramsTerm(..), Versioned(..), mSetToList, toNgramsPatch, ne_children, ne_ngrams, vc_data, _NgramsTable ) import Gargantext.API.Ngrams.Types ( MSet(..), NgramsPatch(..), NgramsRepoElement(..), NgramsTablePatch(..), NgramsTerm(..), Versioned(..), mSetToList, toNgramsPatch, ne_children, ne_ngrams, vc_data, _NgramsTable )
import Gargantext.API.Node.Corpus.New.Types qualified as FType
import Gargantext.API.Node.Types
import Gargantext.API.Routes.Named
import Gargantext.API.Routes.Named.Corpus
import Gargantext.API.Routes.Named.Private
import Gargantext.Core qualified as Lang
import Gargantext.Core.Text.List.Social
import Gargantext.Core.Text.Ngrams import Gargantext.Core.Text.Ngrams
import Gargantext.Core.Types ( CorpusId, ListId, ListType(..), NodeId, _NodeId ) import Gargantext.Core.Types ( CorpusId, ListId, ListType(..), NodeId, _NodeId )
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
...@@ -36,8 +46,10 @@ import Gargantext.Database.Query.Tree.Root ...@@ -36,8 +46,10 @@ import Gargantext.Database.Query.Tree.Root
import Gargantext.Prelude hiding (get) import Gargantext.Prelude hiding (get)
import Network.Wai.Handler.Warp qualified as Wai import Network.Wai.Handler.Warp qualified as Wai
import Paths_gargantext (getDataFileName) import Paths_gargantext (getDataFileName)
import Servant.Client (runClientM) import Servant
import Test.API.Routes (mkUrl, table_ngrams_get_api, table_ngrams_put_api) import Servant.Client
import Servant.Job.Async
import Test.API.Routes (mkUrl, table_ngrams_get_api, table_ngrams_put_api, toServantToken, clientRoutes)
import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob) import Test.API.Setup (withTestDBAndPort, setupEnvironment, createAliceAndBob)
import Test.Database.Types import Test.Database.Types
import Test.Hspec import Test.Hspec
...@@ -45,7 +57,7 @@ import Test.Hspec.Wai (shouldRespondWith) ...@@ -45,7 +57,7 @@ import Test.Hspec.Wai (shouldRespondWith)
import Test.Hspec.Wai.Internal (withApplication, WaiSession) import Test.Hspec.Wai.Internal (withApplication, WaiSession)
import Test.Hspec.Wai.JSON (json) import Test.Hspec.Wai.JSON (json)
import Test.Types (JobPollHandle(..)) import Test.Types (JobPollHandle(..))
import Test.Utils (authenticatedServantClient, getJSON, pollUntilFinished, postJSONUrlEncoded, protectedJSON, withValidLogin) import Test.Utils (getJSON, pollUntilFinished, postJSONUrlEncoded, protectedJSON, withValidLogin)
import Web.FormUrlEncoded import Web.FormUrlEncoded
...@@ -102,7 +114,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -102,7 +114,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "allows uploading a JSON ngrams file" $ \((testEnv, port), app) -> do it "allows uploading a JSON ngrams file" $ \((testEnv, port), app) -> do
cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
listId <- uploadJSONList port token cId listId <- uploadJSONList port token cId
-- Now check that we can retrieve the ngrams -- Now check that we can retrieve the ngrams
...@@ -124,14 +136,12 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -124,14 +136,12 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "does not create duplicates when uploading JSON (#313)" $ \((testEnv, port), app) -> do it "does not create duplicates when uploading JSON (#313)" $ \((testEnv, port), app) -> do
cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
-- this term is imported from the .json file -- this term is imported from the .json file
let importedTerm = NgramsTerm "abelian group" let importedTerm = NgramsTerm "abelian group"
-- this is the new term, under which importedTerm will be grouped -- this is the new term, under which importedTerm will be grouped
let newTerm = NgramsTerm "new abelian group" let newTerm = NgramsTerm "new abelian group"
clientEnv <- liftIO $ authenticatedServantClient port token
listId <- uploadJSONList port token cId listId <- uploadJSONList port token cId
let checkNgrams expected = do let checkNgrams expected = do
...@@ -198,7 +208,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -198,7 +208,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "allows uploading a CSV ngrams file" $ \((testEnv, port), app) -> do it "allows uploading a CSV ngrams file" $ \((testEnv, port), app) -> do
cId <- newCorpusForUser testEnv "alice" cId <- newCorpusForUser testEnv "alice"
withApplication app $ do withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|] ([listId] :: [NodeId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeList","pn_name":"Testing"}|]
-- Upload the CSV doc -- Upload the CSV doc
simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.tsv") simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.tsv")
...@@ -236,3 +246,55 @@ tests = sequential $ aroundAll withTestDBAndPort $ do ...@@ -236,3 +246,55 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
] ]
} |] } |]
describe "POST /api/v1.0/corpus/:id/add/form/async (JSON)" $ do
it "allows uploading a JSON docs file" $ \((testEnv, port), app) -> do
cId <- newCorpusForUser testEnv "alice"
withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
-- Import the docsList with only two documents, both containing a \"fortran\" term.
([corpusId] :: [CorpusId]) <- protectedJSON token "POST" (mkUrl port ("/node/" <> build cId)) [aesonQQ|{"pn_typename":"NodeCorpus","pn_name":"Testing"}|]
simpleDocs <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/GarganText_DocsList-nodeId-177.json")
let newWithForm = mkNewWithForm simpleDocs "GarganText_DocsList-nodeId-177.json"
(j :: JobPollHandle) <- checkEither $ fmap toJobPollHandle <$> liftIO (runClientM (add_file_async token corpusId newWithForm) clientEnv)
let mkPollUrl jh = "/corpus/" <> fromString (show $ _NodeId corpusId) <> "/add/form/async/" +|_jph_id jh|+ "/poll?limit=1"
j' <- pollUntilFinished token port mkPollUrl j
liftIO (_jph_status j' `shouldBe` "IsFinished")
toJobPollHandle :: JobStatus 'Safe JobLog -> JobPollHandle
toJobPollHandle = either (\x -> panicTrace $ "toJobPollHandle:" <> T.pack x) identity . JSON.eitherDecode . JSON.encode
checkEither :: (Show a, Monad m) => m (Either a b) -> m b
checkEither = fmap (either (\x -> panicTrace $ "checkEither:" <> T.pack (show x)) identity)
mkNewWithForm :: T.Text -> T.Text -> NewWithForm
mkNewWithForm content name = NewWithForm
{ _wf_filetype = FType.JSON
, _wf_fileformat = FType.Plain
, _wf_data = content
, _wf_lang = Just Lang.EN
, _wf_name = name
, _wf_selection = FlowSocialListWithPriority MySelfFirst
}
add_file_async :: Token
-> CorpusId
-> NewWithForm
-> ClientM (JobStatus 'Safe JobLog)
add_file_async (toServantToken -> token) corpusId nwf =
clientRoutes & apiWithCustomErrorScheme
& ($ GES_new)
& backendAPI
& backendAPI'
& mkBackEndAPI
& gargAPIVersion
& gargPrivateAPI
& mkPrivateAPI
& ($ token)
& addWithFormAPI
& addWithFormEp
& ($ corpusId)
& asyncJobsAPI'
& (\(_ :<|> submitForm :<|> _) -> submitForm (JobInput nwf Nothing))
...@@ -11,7 +11,6 @@ import Data.Aeson qualified as JSON ...@@ -11,7 +11,6 @@ import Data.Aeson qualified as JSON
import Data.Aeson.KeyMap qualified as KM import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Char8 qualified as B import Data.ByteString.Char8 qualified as B
import Data.ByteString.Lazy qualified as L import Data.ByteString.Lazy qualified as L
import Data.CaseInsensitive qualified as CI
import Data.Map.Strict qualified as Map import Data.Map.Strict qualified as Map
import Data.Text qualified as T import Data.Text qualified as T
import Data.Text.Encoding qualified as TE import Data.Text.Encoding qualified as TE
...@@ -19,6 +18,7 @@ import Data.Text.Lazy qualified as TL ...@@ -19,6 +18,7 @@ import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TLE import Data.Text.Lazy.Encoding qualified as TLE
import Data.TreeDiff import Data.TreeDiff
import Fmt (Builder) import Fmt (Builder)
import Gargantext.API.Routes.Types (xGargErrorScheme)
import Gargantext.API.Admin.Auth.Types (AuthRequest(..), Token, authRes_token) import Gargantext.API.Admin.Auth.Types (AuthRequest(..), Token, authRes_token)
import Gargantext.Core.Types.Individu (Username, GargPassword) import Gargantext.Core.Types.Individu (Username, GargPassword)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -111,19 +111,6 @@ containsJSON expected = MatchBody matcher ...@@ -111,19 +111,6 @@ containsJSON expected = MatchBody matcher
isSubsetOf x y = x == y isSubsetOf x y = x == y
authenticatedServantClient :: Int -> T.Text -> IO ClientEnv
authenticatedServantClient port token = do
baseUrl <- parseBaseUrl "http://0.0.0.0"
manager <- newManager defaultManagerSettings
let requestAddToken url req =
defaultMakeClientRequest url $ addHeader hAuthorization ("Bearer " <> token)
$ addHeader hContentType (T.pack "application/json") req
pure $ (mkClientEnv manager (baseUrl { baseUrlPort = port })) { makeClientRequest = requestAddToken }
-- | Issue a request with a valid 'Authorization: Bearer' inside. -- | Issue a request with a valid 'Authorization: Bearer' inside.
protected :: HasCallStack protected :: HasCallStack
=> Token => Token
...@@ -171,7 +158,7 @@ protectedWith extraHeaders tkn mth url payload = ...@@ -171,7 +158,7 @@ protectedWith extraHeaders tkn mth url payload =
protectedNewError :: HasCallStack => Token -> Method -> ByteString -> L.ByteString -> WaiSession () SResponse protectedNewError :: HasCallStack => Token -> Method -> ByteString -> L.ByteString -> WaiSession () SResponse
protectedNewError tkn mth url = protectedWith newErrorFormat tkn mth url protectedNewError tkn mth url = protectedWith newErrorFormat tkn mth url
where where
newErrorFormat = [(CI.mk "X-Garg-Error-Scheme", "new")] newErrorFormat = [(xGargErrorScheme, "new")]
getJSON :: Token -> ByteString -> WaiSession () SResponse getJSON :: Token -> ByteString -> WaiSession () SResponse
getJSON tkn url = protectedWith mempty tkn "GET" url "" getJSON tkn url = protectedWith mempty tkn "GET" url ""
...@@ -187,16 +174,18 @@ postJSONUrlEncoded tkn url queryPaths = do ...@@ -187,16 +174,18 @@ postJSONUrlEncoded tkn url queryPaths = do
Left err -> Prelude.fail $ "postJSONUrlEncoded failed when parsing " <> show (typeRep $ Proxy @a) <> ": " <> err <> "\nPayload was: " <> (T.unpack . TL.toStrict . TLE.decodeUtf8 $ simpleBody) Left err -> Prelude.fail $ "postJSONUrlEncoded failed when parsing " <> show (typeRep $ Proxy @a) <> ": " <> err <> "\nPayload was: " <> (T.unpack . TL.toStrict . TLE.decodeUtf8 $ simpleBody)
Right x -> pure x Right x -> pure x
withValidLogin :: (MonadFail m, MonadIO m) => Port -> Username -> GargPassword -> (Token -> m a) -> m a withValidLogin :: (MonadFail m, MonadIO m) => Port -> Username -> GargPassword -> (ClientEnv -> Token -> m a) -> m a
withValidLogin port ur pwd act = do withValidLogin port ur pwd act = do
baseUrl <- liftIO $ parseBaseUrl "http://localhost" baseUrl <- liftIO $ parseBaseUrl "http://localhost"
manager <- liftIO $ newManager defaultManagerSettings manager <- liftIO $ newManager defaultManagerSettings
let clientEnv = mkClientEnv manager (baseUrl { baseUrlPort = port }) let clientEnv0 = mkClientEnv manager (baseUrl { baseUrlPort = port })
let authPayload = AuthRequest ur pwd let authPayload = AuthRequest ur pwd
result <- liftIO $ runClientM (auth_api authPayload) clientEnv result <- liftIO $ runClientM (auth_api authPayload) clientEnv0
case result of case result of
Left err -> liftIO $ throwIO $ Prelude.userError (show err) Left err -> liftIO $ throwIO $ Prelude.userError (show err)
Right res -> act $ res ^. authRes_token Right res -> do
let token = res ^. authRes_token
act clientEnv0 token
-- | Poll the given job URL every second until it finishes. -- | Poll the given job URL every second until it finishes.
......
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