Add test for loop detection

test/Test/API/UpdateList.hs

@@ -81,6 +81,7 @@ import Text.Printf (printf)
 import qualified Data.Text.Encoding as TE
 import qualified Data.ByteString as BIO
 import Control.Lens (view)
+import Gargantext.API.Admin.Orchestrator.Types
 
 
 uploadJSONList :: LogConfig
@@ -608,6 +609,90 @@ tests = sequential $ aroundAll withTestDBAndPort $ beforeAllWith dbEnvSetup $ do
             let exportedNgrams2 = view v_data <$> Map.lookup NgramsTerms exported2
             liftIO $ exportedNgrams `shouldBe` exportedNgrams2
 
+      -- We test that if we try to import terms which, when merged with the existing,
+      -- would cause a loop, GGTX is capable of rejecting the request.
+      it "refuses to import terms which will lead to a loop" $ \(SpecContext testEnv port app _) -> do
+        cId <- newCorpusForUser testEnv "alice"
+        let log_cfg = (test_config testEnv) ^. gc_logging
+        withApplication app $ do
+          withValidLogin port "alice" (GargPassword "alice") $ \clientEnv token -> do
+            -- Import the initial terms
+            let (Right initialTerms) = JSON.eitherDecode @NgramsList $ [json|
+                  {
+                    "Authors": {
+                      "version": 1,
+                      "data": {}
+                    },
+                    "Institutes": {
+                      "version": 1,
+                      "data": {}
+                    },
+                    "Sources": {
+                      "version": 1,
+                      "data": {}
+                    },
+                    "NgramsTerms": {
+                      "version": 1,
+                      "data": {
+                        "foo": {
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": ["bar"]
+                        },
+                        "bar": {
+                          "root": "foo",
+                          "parent": "foo",
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": [
+                            "quux"
+                          ]
+                        },
+                        "quux": {
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": []
+                        } } } }
+                        |]
+            listId <- uploadJSONListBS log_cfg port token cId (BL.toStrict $ JSON.encode initialTerms) clientEnv
+            let (Right secondBatch) = JSON.eitherDecode @NgramsList $ [json|
+                  {
+                    "Authors": {
+                      "version": 1,
+                      "data": {}
+                    },
+                    "Institutes": {
+                      "version": 1,
+                      "data": {}
+                    },
+                    "Sources": {
+                      "version": 1,
+                      "data": {}
+                    },
+                    "NgramsTerms": {
+                      "version": 1,
+                      "data": {
+                        "bar": {
+                          "size": 1,
+                          "list": "MapTerm",
+                          "children": ["foo"]
+                        }
+                        } } }
+                        |]
+            let params = WithJsonFile { _wjf_data = TE.decodeUtf8 (BL.toStrict $ JSON.encode secondBatch)
+                                      , _wjf_name = "simple_ngrams.json"
+                                      }
+            ji <- checkEither $ liftIO $ runClientM (add_form_to_list token listId params) clientEnv
+            ji' <- pollUntilWorkFinished log_cfg port ji
+            -- Unfortunately we don't have a better way then to match on the stringified exception, sigh.
+            case _scst_events ji' of
+              Just [ScraperEvent{..}]
+                | Just msg <- _scev_message
+                -> liftIO $ msg `shouldSatisfy` \txt -> "BFE_loop_detected" `T.isInfixOf` txt
+                | otherwise
+                -> fail "No suitable message in ScraperEvent."
+              _ -> fail "Expected job to fail, but it didn't"
+
 createDocsList :: FilePath
                -> TestEnv
                -> Int