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

[MERGE] fix conflicts

parents f262753d 9360652c
......@@ -33,6 +33,7 @@ data-files:
ekg-assets/chart_line_add.png
ekg-assets/cross.png
test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
test-data/ngrams/GarganText_DocsList-nodeId-177.json
test-data/ngrams/simple.json
test-data/ngrams/simple.tsv
test-data/phylo/bpa_phylo_test.json
......@@ -130,6 +131,7 @@ library
Gargantext.API.Ngrams.Types
Gargantext.API.Node
Gargantext.API.Node.Corpus.New
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.Types
Gargantext.API.Node.Corpus.Update
Gargantext.API.Node.File
......@@ -193,13 +195,14 @@ library
Gargantext.Core.Text.Corpus.API.OpenAlex
Gargantext.Core.Text.Corpus.API.Pubmed
Gargantext.Core.Text.Corpus.Parsers
Gargantext.Core.Text.Corpus.Parsers.TSV
Gargantext.Core.Text.Corpus.Parsers.Date
Gargantext.Core.Text.Corpus.Parsers.Date.Parsec
Gargantext.Core.Text.Corpus.Parsers.TSV
Gargantext.Core.Text.Corpus.Query
Gargantext.Core.Text.List
Gargantext.Core.Text.List.Group.WithStem
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.CharByChar
Gargantext.Core.Text.Metrics.Count
......@@ -315,7 +318,6 @@ library
Gargantext.API.Node.Corpus.Export
Gargantext.API.Node.Corpus.Export.Types
Gargantext.API.Node.Corpus.New.File
Gargantext.API.Node.Corpus.New.Types
Gargantext.API.Node.Corpus.Searx
Gargantext.API.Node.Document.Export
Gargantext.API.Node.Document.Export.Types
......@@ -383,7 +385,6 @@ library
Gargantext.Core.Text.List.Group.WithScores
Gargantext.Core.Text.List.Learn
Gargantext.Core.Text.List.Merge
Gargantext.Core.Text.List.Social
Gargantext.Core.Text.List.Social.Find
Gargantext.Core.Text.List.Social.Patch
Gargantext.Core.Text.List.Social.Prelude
......@@ -932,9 +933,12 @@ test-suite garg-test-tasty
other-modules:
CLI.Phylo.Common
Paths_gargantext
Test.Core.AsyncUpdates
Test.API.Private.Share
Test.API.Authentication
Test.API.Routes
Test.API.Setup
Test.Core.AsyncUpdates
Test.API.UpdateList
Test.Core.Similarity
Test.Core.Text
Test.Core.Text.Corpus.Query
......
......@@ -8,6 +8,7 @@ module Gargantext.API.Errors (
-- * Types
, GargErrorScheme(..)
, renderGargErrorScheme
-- * Conversion functions
, backendErrorToFrontendError
......@@ -48,6 +49,11 @@ data GargErrorScheme
-- https://spec.graphql.org/June2018/#sec-Errors
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
-- 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.
......@@ -105,12 +111,11 @@ frontendErrorToServerError fe@(FrontendError diag ty _) =
}
internalServerErrorToFrontendError :: ServerError -> FrontendError
internalServerErrorToFrontendError = \case
ServerError{..}
internalServerErrorToFrontendError ServerError{..}
| 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
-> 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 = \case
......
......@@ -86,7 +86,7 @@ data GargPrivateAPI' mode = GargPrivateAPI'
:> Capture "tree_id" NodeId
:> NamedRoutes TreeFlatAPI
, membersAPI :: mode :- "members" :> Summary "Team node members" :> NamedRoutes MembersAPI
, addWithFormEp :: mode :- NamedRoutes AddWithForm
, addWithFormAPI :: mode :- NamedRoutes AddWithForm
, addWithQueryEp :: mode :- NamedRoutes AddWithQuery
, listGetAPI :: mode :- NamedRoutes List.GETAPI
, listJsonAPI :: mode :- NamedRoutes List.JSONAPI
......
......@@ -5,6 +5,7 @@ module Gargantext.API.Routes.Types where
import Control.Lens
import Data.ByteString (ByteString)
import Data.CaseInsensitive qualified as CI
import Data.List qualified as L
import Data.Proxy
import Data.Set qualified as Set
......@@ -12,16 +13,21 @@ import Gargantext.API.Errors
import Network.Wai hiding (responseHeaders)
import Prelude
import Servant.API.Routes
import Servant.API.Routes.Internal.Response (unResponses)
import Servant.API.Routes.Route
import Servant.Client hiding (responseHeaders)
import Servant.Client.Core.Request (addHeader)
import Servant.Ekg
import Servant.Server
import Servant.Server.Internal.Delayed
import Servant.Server.Internal.DelayedIO
import Servant.API.Routes.Route
import Servant.API.Routes.Internal.Response (unResponses)
import Network.HTTP.Types (HeaderName)
data WithCustomErrorScheme a
xGargErrorScheme :: HeaderName
xGargErrorScheme = CI.mk "X-Garg-Error-Scheme"
instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx where
type ServerT (WithCustomErrorScheme subApi) m = GargErrorScheme -> ServerT subApi m
hoistServerWithContext _ pc nt s = hoistServerWithContext (Proxy :: Proxy subApi) pc nt . s
......@@ -30,7 +36,7 @@ instance (HasServer subApi ctx) => HasServer (WithCustomErrorScheme subApi) ctx
getErrorScheme :: DelayedIO GargErrorScheme
getErrorScheme = withRequest $ \rq -> do
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
Just "new" -> pure GES_new
Just _ -> pure GES_old
......@@ -41,7 +47,9 @@ instance HasEndpoint sub => HasEndpoint (WithCustomErrorScheme sub) where
instance HasClient m sub => HasClient m (WithCustomErrorScheme sub) where
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
......@@ -49,5 +57,5 @@ instance (HasRoutes subApi) => HasRoutes (WithCustomErrorScheme subApi) where
getRoutes =
let apiRoutes = getRoutes @subApi
errHeader = mkHeaderRep @"X-Garg-Error-Scheme" @ByteString
addHeader rt = rt & routeResponse . unResponses . traversed . responseHeaders %~ Set.insert errHeader
in addHeader <$> apiRoutes
addHeader' rt = rt & routeResponse . unResponses . traversed . responseHeaders %~ Set.insert errHeader
in addHeader' <$> apiRoutes
......@@ -58,7 +58,7 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
, treeAPI = Tree.treeAPI authenticatedUser
, treeFlatAPI = Tree.treeFlatAPI authenticatedUser
, membersAPI = members
, addWithFormEp = addCorpusWithForm (RootId userNodeId)
, addWithFormAPI = addCorpusWithForm (RootId userNodeId)
, addWithQueryEp = addCorpusWithQuery (RootId userNodeId)
, listGetAPI = List.getAPI
, listJsonAPI = List.jsonAPI
......
......@@ -83,6 +83,7 @@ instance ToSchema FlowSocialListWith where
instance FromHttpApiData FlowSocialListWith
where
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 "NoList" = pure $ NoList True
parseUrlPiece x = panicTrace $ "[G.C.T.L.Social] TODO FromHttpApiData FlowSocialListWith error: " <> (show x)
......
......@@ -127,7 +127,8 @@ getOccByNgramsOnlyFast cId lId nt = do
WITH cnnv AS
( SELECT DISTINCT context_node_ngrams.context_id,
context_node_ngrams.ngrams_id,
nodes_contexts.node_id
nodes_contexts.node_id,
nodes_contexts.category
FROM nodes_contexts
JOIN context_node_ngrams ON context_node_ngrams.context_id = nodes_contexts.context_id
),
......@@ -135,7 +136,7 @@ getOccByNgramsOnlyFast cId lId nt = do
(SELECT context_id, ngrams_id, terms
FROM cnnv
JOIN ngrams ON cnnv.ngrams_id = ngrams.id
WHERE node_id = ?
WHERE node_id = ? AND cnnv.category > 0
),
ncids_agg AS
(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
it "returns the old error by default" $ \((_testEnv, port), 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") ""
case res of
SResponse{..}
......@@ -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
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") ""
case res of
SResponse{..}
......
......@@ -28,7 +28,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
createAliceAndBob testEnv
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 expected = [json| {"data":{"user_infos":[{"ui_id":2,"ui_email":"alice@gargan.text"}]}} |]
protected token "POST" "/gql" query `shouldRespondWithFragment` expected
......@@ -36,7 +36,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
describe "nodes" $ do
it "returns node_type" $ \((_testEnv, port), 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 expected = [json| {"data":{"nodes":[{"node_type":"NodeFolderPrivate"}]}} |]
protected token "POST" "/gql" query `shouldRespondWithFragment` expected
......@@ -44,21 +44,21 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
describe "check error format" $ do
it "returns the new error if header X-Garg-Error-Scheme: new is passed" $ \((_testEnv, port), 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 expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
protectedNewError token "POST" "/gql" query `shouldRespondWithFragment` expected
it "returns the old error (though this is deprecated)" $ \((_testEnv, port), 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 expected = [json| {"errors": [{"locations":[{"column":13,"line":1}],"message":"Unknown Argument \"id\" on Field \"languages\"."}] } |]
protected token "POST" "/gql" query `shouldRespondWithFragment` expected
it "check new errors with 'type'" $ \((_testEnv, port), 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 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
......
......@@ -33,7 +33,7 @@ privateTests =
describe "Private API" $ do
baseUrl <- runIO $ parseBaseUrl "http://localhost"
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
......@@ -45,17 +45,17 @@ privateTests =
let gargAdminClient = (genericClient :: GargAdminAPI (AsClientT ClientM))
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
-- FIXME(adn): unclear if this is useful at all. Doesn't do permission checking.
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))
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"
describe "GET /api/v1.0/node" $ do
......@@ -66,13 +66,13 @@ privateTests =
it "allows 'alice' to see her own node info" $ \((_testEnv, port), 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") ""
`shouldRespondWithFragment` [json| {"id":8,"user_id":2,"name":"alice" } |]
it "forbids 'alice' to see others node private info" $ \((_testEnv, port), 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
describe "GET /api/v1.0/tree" $ do
......@@ -82,13 +82,13 @@ privateTests =
it "allows 'alice' to see her own node info" $ \((_testEnv, port), 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") ""
`shouldRespondWithFragment` [json| { "node": {"id":8, "name":"alice", "type": "NodeUser" } } |]
it "forbids 'alice' to see others node private info" $ \((_testEnv, port), 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
......
......@@ -16,7 +16,6 @@ import Gargantext.API.Routes.Named.Share
import Gargantext.Core.Types
import Gargantext.Core.Types.Individu
import Gargantext.Prelude
import Network.HTTP.Client hiding (responseBody)
import Prelude (fail)
import Servant.Auth.Client qualified as SC
import Servant.Client
......@@ -49,14 +48,10 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
-- Let's create the Alice user.
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
withApplication app $ do
withValidLogin serverPort "alice" (GargPassword "alice") $ \token -> do
url <- liftIO $ runClientM (shareURL (toServantToken token) Nothing Nothing) (clientEnv serverPort)
withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
url <- liftIO $ runClientM (shareURL (toServantToken token) Nothing Nothing) clientEnv
case url of
Left (FailureResponse _req res)
-> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node Type" . T.pack)
......@@ -64,8 +59,8 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "should fail if no node ID is specified" $ \((_testEnv, serverPort), app) -> do
withApplication app $ do
withValidLogin serverPort "alice" (GargPassword "alice") $ \token -> do
url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) Nothing) (clientEnv serverPort)
withValidLogin serverPort "alice" (GargPassword "alice") $ \clientEnv token -> do
url <- liftIO $ runClientM (shareURL (toServantToken token) (Just NodeCorpus) Nothing) clientEnv
case url of
Left (FailureResponse _req res)
-> liftIO $ (CL8.unpack $ responseBody res) `shouldSatisfy` (T.isInfixOf "Invalid node ID" . T.pack)
......@@ -73,9 +68,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "should return a valid URL" $ \((testEnv, serverPort), 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"
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
Left err
-> fail (show err)
......@@ -84,9 +79,9 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "should include the port if needed (like localhost)" $ \((testEnv, serverPort), 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"
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
Left err
-> fail (show err)
......
......@@ -4,8 +4,10 @@ module Test.API.Setup where
import Control.Concurrent.Async qualified as Async
import Control.Concurrent.MVar
import Control.Exception
import Control.Lens
import Control.Monad.Reader
import Data.ByteString.Lazy.Char8 qualified as C8L
import Data.Cache qualified as InMemory
import Data.Streaming.Network (bindPortTCP)
import Gargantext.API (makeApp)
......@@ -38,7 +40,9 @@ import Gargantext.Utils.Jobs.Monad qualified as Jobs
import Gargantext.Utils.Jobs.Queue qualified as Jobs
import Gargantext.Utils.Jobs.Settings qualified as Jobs
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 qualified as Warp
import Network.Wai.Handler.Warp.Internal
......@@ -127,7 +131,8 @@ withTestDBAndPort action =
app <- withLoggerHoisted Mock $ \ioLogger -> do
env <- newTestEnv testEnv ioLogger 8080
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
-- a random port, the latter at a predictable port.
......@@ -169,6 +174,11 @@ createAliceAndBob testEnv = do
void $ new_user nur1
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
-- 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
{ settingsBeforeMainLoop =
notify started () >> settingsBeforeMainLoop Warp.defaultSettings
, settingsPort = userPort
, settingsOnExceptionResponse = showDebugExceptions
}
sock <- bindPortTCP userPort "127.0.0.1"
result <-
......
......@@ -14,6 +14,7 @@ module Test.API.UpdateList (
import Control.Lens (mapped, over)
import Control.Monad.Fail (fail)
import Data.Aeson qualified as JSON
import Data.Aeson.QQ
import Data.Map.Strict qualified as Map
import Data.Map.Strict.Patch qualified as PM
......@@ -23,9 +24,18 @@ import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Fmt
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.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.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.Types ( CorpusId, ListId, ListType(..), NodeId, _NodeId )
import Gargantext.Core.Types.Individu
......@@ -36,8 +46,10 @@ import Gargantext.Database.Query.Tree.Root
import Gargantext.Prelude hiding (get)
import Network.Wai.Handler.Warp qualified as Wai
import Paths_gargantext (getDataFileName)
import Servant.Client (runClientM)
import Test.API.Routes (mkUrl, table_ngrams_get_api, table_ngrams_put_api)
import Servant
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.Database.Types
import Test.Hspec
......@@ -45,7 +57,7 @@ import Test.Hspec.Wai (shouldRespondWith)
import Test.Hspec.Wai.Internal (withApplication, WaiSession)
import Test.Hspec.Wai.JSON (json)
import Test.Types (JobPollHandle(..))
import Test.Utils (authenticatedServantClient, getJSON, pollUntilFinished, postJSONUrlEncoded, protectedJSON, withValidLogin)
import Test.Utils (getJSON, pollUntilFinished, postJSONUrlEncoded, protectedJSON, withValidLogin)
import Web.FormUrlEncoded
......@@ -102,7 +114,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "allows uploading a JSON ngrams file" $ \((testEnv, port), app) -> do
cId <- newCorpusForUser testEnv "alice"
withApplication app $ do
withValidLogin port "alice" (GargPassword "alice") $ \token -> do
withValidLogin port "alice" (GargPassword "alice") $ \_clientEnv token -> do
listId <- uploadJSONList port token cId
-- Now check that we can retrieve the ngrams
......@@ -124,14 +136,12 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "does not create duplicates when uploading JSON (#313)" $ \((testEnv, port), app) -> do
cId <- newCorpusForUser testEnv "alice"
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
let importedTerm = NgramsTerm "abelian group"
-- this is the new term, under which importedTerm will be grouped
let newTerm = NgramsTerm "new abelian group"
clientEnv <- liftIO $ authenticatedServantClient port token
listId <- uploadJSONList port token cId
let checkNgrams expected = do
......@@ -198,7 +208,7 @@ tests = sequential $ aroundAll withTestDBAndPort $ do
it "allows uploading a CSV ngrams file" $ \((testEnv, port), app) -> do
cId <- newCorpusForUser testEnv "alice"
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"}|]
-- Upload the CSV doc
simpleNgrams <- liftIO (TIO.readFile =<< getDataFileName "test-data/ngrams/simple.tsv")
......@@ -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
import Data.Aeson.KeyMap qualified as KM
import Data.ByteString.Char8 qualified as B
import Data.ByteString.Lazy qualified as L
import Data.CaseInsensitive qualified as CI
import Data.Map.Strict qualified as Map
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
......@@ -19,6 +18,7 @@ import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TLE
import Data.TreeDiff
import Fmt (Builder)
import Gargantext.API.Routes.Types (xGargErrorScheme)
import Gargantext.API.Admin.Auth.Types (AuthRequest(..), Token, authRes_token)
import Gargantext.Core.Types.Individu (Username, GargPassword)
import Gargantext.Prelude
......@@ -111,19 +111,6 @@ containsJSON expected = MatchBody matcher
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.
protected :: HasCallStack
=> Token
......@@ -171,7 +158,7 @@ protectedWith extraHeaders tkn mth url payload =
protectedNewError :: HasCallStack => Token -> Method -> ByteString -> L.ByteString -> WaiSession () SResponse
protectedNewError tkn mth url = protectedWith newErrorFormat tkn mth url
where
newErrorFormat = [(CI.mk "X-Garg-Error-Scheme", "new")]
newErrorFormat = [(xGargErrorScheme, "new")]
getJSON :: Token -> ByteString -> WaiSession () SResponse
getJSON tkn url = protectedWith mempty tkn "GET" url ""
......@@ -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)
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
baseUrl <- liftIO $ parseBaseUrl "http://localhost"
manager <- liftIO $ newManager defaultManagerSettings
let clientEnv = mkClientEnv manager (baseUrl { baseUrlPort = port })
let clientEnv0 = mkClientEnv manager (baseUrl { baseUrlPort = port })
let authPayload = AuthRequest ur pwd
result <- liftIO $ runClientM (auth_api authPayload) clientEnv
result <- liftIO $ runClientM (auth_api authPayload) clientEnv0
case result of
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.
......
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