Test ngrams update after docs trashing

gargantext.cabal

@@ -34,6 +34,7 @@ data-files:
     ekg-assets/cross.png
     test-data/ngrams/GarganText_NgramsTerms-QuantumComputing.json
     test-data/ngrams/GarganText_DocsList-nodeId-177.json
+    test-data/ngrams/GarganText_NgramsTerms-nodeId-177.json
     test-data/ngrams/simple.json
     test-data/ngrams/simple.tsv
     test-data/phylo/bpa_phylo_test.json
@@ -249,6 +250,7 @@ library
       Gargantext.Database.Admin.Types.Hyperdata
       Gargantext.Database.Admin.Types.Hyperdata.Corpus
       Gargantext.Database.Admin.Types.Hyperdata.Document
+      Gargantext.Database.Admin.Types.Hyperdata.Folder
       Gargantext.Database.Admin.Types.Node
       Gargantext.Database.Prelude
       Gargantext.Database.Query.Facet
@@ -419,7 +421,6 @@ library
       Gargantext.Database.Admin.Types.Hyperdata.Dashboard
       Gargantext.Database.Admin.Types.Hyperdata.Default
       Gargantext.Database.Admin.Types.Hyperdata.File
-      Gargantext.Database.Admin.Types.Hyperdata.Folder
       Gargantext.Database.Admin.Types.Hyperdata.Frame
       Gargantext.Database.Admin.Types.Hyperdata.List
       Gargantext.Database.Admin.Types.Hyperdata.Model

hie.yaml

+cradle:
+  cabal:
+    - path: "./src"
+      component: "lib:gargantext"
+
+    - path: "./bin/gargantext-cli/Main.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Admin.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/FileDiff.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/FilterTermsAndCooc.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Import.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Ini.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Init.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Invitations.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/ObfuscateDB.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Parsers.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Phylo.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Phylo/Common.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Phylo/Profile.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Server/Routes.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Types.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/CLI/Upgrade.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-cli/Paths_gargantext.hs"
+      component: "gargantext:exe:gargantext-cli"
+
+    - path: "./bin/gargantext-server/Main.hs"
+      component: "gargantext:exe:gargantext-server"
+
+    - path: "./bin/gargantext-server/Paths_gargantext.hs"
+      component: "gargantext:exe:gargantext-server"
+
+    - path: "./test"
+      component: "gargantext:test:garg-test-tasty"
+
+    - path: "./bin/gargantext-cli"
+      component: "gargantext:test:garg-test-tasty"
+
+    - path: "./test"
+      component: "gargantext:test:garg-test-hspec"
+
+    - path: "./bench/Main.hs"
+      component: "gargantext:bench:garg-bench"
+
+    - path: "./bench/Paths_gargantext.hs"
+      component: "gargantext:bench:garg-bench"

test-data/ngrams/GarganText_NgramsTerms-nodeId-177.json

+{ "NgramsTerms":{ "version":1 ,"data":{ "fortran":{"size":2,"list":"MapTerm","children":[]} } }
+}

test/Test/API/Routes.hs

@@ -8,6 +8,7 @@ module Test.API.Routes where
 import Data.Text.Encoding qualified as TE
 import Fmt (Builder, (+|), (|+))
 import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, Token)
+import Gargantext.API.Admin.Orchestrator.Types (JobLog, asyncJobsAPI')
 import Gargantext.API.Errors
 import Gargantext.API.HashedResponse (HashedResponse)
 import Gargantext.API.Ngrams.Types ( NgramsTable, NgramsTablePatch, OrderBy, TabType, Versioned, VersionedWithCount )
@@ -17,18 +18,21 @@ import Gargantext.API.Routes.Named.Private hiding (tableNgramsAPI)
 import Gargantext.API.Routes.Named.Table
 import Gargantext.API.Types () -- MimeUnrender instances
 import Gargantext.Core.Text.Corpus.Query (RawQuery)
-import Gargantext.Core.Types (ListId, NodeId)
+import Gargantext.Core.Types (ListId, NodeId, NodeType, NodeTableResult)
 import Gargantext.Core.Types.Main (ListType)
 import Gargantext.Core.Types.Query (Limit, MaxSize, MinSize, Offset)
+import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Query.Facet qualified as Facet
 import Gargantext.Prelude
 import Network.HTTP.Types qualified as H
 import Network.Wai.Handler.Warp (Port)
+import Servant ((:<|>)(..))
 import Servant.API.WebSocket qualified as WS
 import Servant.Auth.Client qualified as S
 import Servant.Client (ClientM)
 import Servant.Client.Core (RunClient, HasClient(..), Request)
 import Servant.Client.Generic ( genericClient, AsClientT )
+import Servant.Job.Async
 
 
 instance RunClient m => HasClient m WS.WebSocketPending where
@@ -50,6 +54,9 @@ mkUrl :: Port -> Builder -> ByteString
 mkUrl _port urlPiece =
   "/api/" +| curApi |+ urlPiece
 
+gqlUrl :: ByteString
+gqlUrl = "/gql"
+
 
 -- | The client for the full API. It also serves as a \"proof\" that our
 -- whole API has all the required instances to be used in a client.
@@ -70,6 +77,28 @@ auth_api = clientRoutes & apiWithCustomErrorScheme
 toServantToken :: Token -> S.Token
 toServantToken = S.Token . TE.encodeUtf8
 
+update_node :: Token
+            -> NodeId
+            -> UpdateNodeParams
+            -> ClientM (JobStatus 'Safe JobLog)
+update_node (toServantToken -> token) nodeId params =
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & nodeEp
+               & nodeEndpointAPI
+               & ($ nodeId)
+               & updateAPI
+               & updateNodeEp
+               & asyncJobsAPI'
+               & (\(_ :<|> submitForm :<|> _) -> submitForm (JobInput params Nothing))
+
 get_table_ngrams :: Token
                  -> NodeId
                  -> TabType
@@ -146,3 +175,26 @@ get_table (toServantToken -> token) nodeId =
                & ($ nodeId)
                & tableAPI
                & getTableEp
+
+get_children :: Token
+             -> NodeId
+             -> Maybe NodeType
+             -> Maybe Offset
+             -> Maybe Limit
+             -> ClientM (NodeTableResult HyperdataAny)
+get_children (toServantToken -> token) nodeId =
+  clientRoutes & apiWithCustomErrorScheme
+               & ($ GES_new)
+               & backendAPI
+               & backendAPI'
+               & mkBackEndAPI
+               & gargAPIVersion
+               & gargPrivateAPI
+               & mkPrivateAPI
+               & ($ token)
+               & nodeEp
+               & nodeEndpointAPI
+               & ($ nodeId)
+               & childrenAPI
+               & summaryChildrenEp
+

test/Test/Utils.hs

@@ -7,33 +7,38 @@ module Test.Utils where
 
 import Control.Exception.Safe ()
 import Control.Monad ()
-import Data.Aeson qualified as JSON
 import Data.Aeson.KeyMap qualified as KM
+import Data.Aeson qualified as JSON
 import Data.ByteString.Char8 qualified as B
 import Data.ByteString.Lazy qualified as L
 import Data.Map.Strict qualified as Map
-import Data.Text qualified as T
 import Data.Text.Encoding qualified as TE
-import Data.Text.Lazy qualified as TL
 import Data.Text.Lazy.Encoding qualified as TLE
+import Data.Text.Lazy qualified as TL
+import Data.Text qualified as T
 import Data.TreeDiff
 import Fmt (Builder)
-import Gargantext.API.Routes.Types (xGargErrorScheme)
 import Gargantext.API.Admin.Auth.Types (AuthRequest(..), Token, authRes_token)
+import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.API.Routes.Types (xGargErrorScheme)
 import Gargantext.Core.Types.Individu (Username, GargPassword)
 import Gargantext.Prelude
 import Network.HTTP.Client (defaultManagerSettings, newManager)
-import Network.HTTP.Types (Header, Method, status200)
+import Network.HTTP.Client qualified as HTTP
 import Network.HTTP.Types.Header (hAccept, hAuthorization, hContentType)
+import Network.HTTP.Types (Header, Method, status200)
 import Network.Wai.Handler.Warp (Port)
 import Network.Wai.Test (SResponse(..))
 import Prelude qualified
-import Servant.Client (ClientEnv, baseUrlPort, mkClientEnv, parseBaseUrl, runClientM)
+import Servant.Client (ClientEnv, baseUrlPort, mkClientEnv, parseBaseUrl, runClientM, makeClientRequest, defaultMakeClientRequest)
+import Servant.Client.Core (BaseUrl)
+import Servant.Client.Core.Request qualified as Client
+import System.Environment (lookupEnv)
 import System.Timeout qualified as Timeout
 import Test.API.Routes (auth_api, mkUrl)
 import Test.Hspec.Expectations
-import Test.Hspec.Wai (MatchBody(..), WaiExpectation, WaiSession, request)
 import Test.Hspec.Wai.JSON (FromValue(..))
+import Test.Hspec.Wai (MatchBody(..), WaiExpectation, WaiSession, request)
 import Test.Hspec.Wai.Matcher (MatchHeader(..), ResponseMatcher(..), bodyEquals, formatHeader, match)
 import Test.Tasty.HUnit (Assertion, assertBool)
 import Test.Types
@@ -183,12 +188,27 @@ withValidLogin port ur pwd act = do
   case result of
     Left err  -> liftIO $ throwIO $ Prelude.userError (show err)
     Right res -> do
+      traceEnabled <- isJust <$> liftIO (lookupEnv "GARG_DEBUG_LOGS")
       let token = res ^. authRes_token
-      act clientEnv0 token
+      act (clientEnv0 { makeClientRequest = gargMkRequest traceEnabled }) token
+
+-- | Allows to enable/disable logging of the input 'Request' to check what the
+-- client is actually sending to the server.
+-- FIXME(adn) We cannot upgrade to servant-client 0.20 due to OpenAlex:
+-- https://gitlab.iscpif.fr/gargantext/crawlers/openalex/blob/main/src/OpenAlex/ServantClientLogging.hs#L24
+gargMkRequest :: Bool -> BaseUrl -> Client.Request -> HTTP.Request
+gargMkRequest traceEnabled bu clientRq =
+  let httpReq = defaultMakeClientRequest bu clientRq
+  in case traceEnabled of
+       True ->
+         traceShowId httpReq
+       False -> httpReq
 
 
 -- | Poll the given job URL every second until it finishes.
 -- Retries up to 60 times (i.e. for 1 minute, before giving up)
+-- /NOTE(adn)/: Check the content of the \"events\" logs as a stopgap
+-- measure for #390.
 pollUntilFinished :: HasCallStack
                   => Token
                   -> Port
@@ -208,7 +228,15 @@ pollUntilFinished tkn port mkUrlPiece = go 60
      | _jph_status h == "IsFailure"
      -> panicTrace $ "JobPollHandle contains a failure: " <> TE.decodeUtf8 (L.toStrict $ JSON.encode h)
      | otherwise
-     -> pure h
+     -> case any hasError (_jph_log h) of
+          True  -> panicTrace $ "JobPollHandle contains a failure: " <> TE.decodeUtf8 (L.toStrict $ JSON.encode h)
+          False -> pure h
+
+   -- FIXME(adn) This is wrong, errs should be >= 1.
+   hasError :: JobLog -> Bool
+   hasError JobLog{..} = case _scst_failed of
+     Nothing   -> False
+     Just errs -> errs > 1
 
 -- | Like HUnit's '@?=', but With a nicer error message in case the two entities are not equal.
 (@??=) :: (HasCallStack, ToExpr a, Eq a) => a -> a -> Assertion