[refactor] constraints cleanup, move errors arbitrary to test.instances

src/Gargantext/API/Admin/Auth.hs

@@ -250,7 +250,7 @@ forgotPasswordPost (ForgotPasswordRequest email) = do
   -- users' emails
   pure $ ForgotPasswordResponse "ok"
 
-forgotPasswordGet :: (CmdCommon env, HasAuthenticationError err, HasServerError err)
+forgotPasswordGet :: (CmdCommon env, HasServerError err)
      => Maybe Text -> Cmd' env err ForgotPasswordGet
 forgotPasswordGet Nothing = pure $ ForgotPasswordGet ""
 forgotPasswordGet (Just uuid) = do
@@ -267,7 +267,7 @@ forgotPasswordGet (Just uuid) = do
 
 ---------------------
 
-forgotPasswordGetUser :: ( CmdCommon env, HasAuthenticationError err, HasServerError err)
+forgotPasswordGetUser :: ( CmdCommon env)
      => UserLight -> Cmd' env err ForgotPasswordGet
 forgotPasswordGetUser (UserLight { .. }) = do
   -- pick some random password

src/Gargantext/API/Errors/Types.hs

@@ -8,6 +8,7 @@ Stability   : experimental
 Portability : POSIX
 -}
 
+{-# OPTIONS_GHC -Wredundant-constraints #-}
 
 {-# LANGUAGE ConstraintKinds          #-}
 {-# LANGUAGE LambdaCase               #-}
@@ -39,9 +40,6 @@ module Gargantext.API.Errors.Types (
   -- * Evidence carrying
   , Dict(..)
   , IsFrontendErrorData(..)
-
-  -- * Generating test cases
-  , genFrontendErr
   ) where
 
 import Control.Lens (makePrisms)
@@ -51,7 +49,7 @@ import Data.Aeson.Types (typeMismatch, emptyArray)
 import Data.List.NonEmpty qualified as NE
 import Data.Singletons.TH ( SingI(sing), SingKind(fromSing) )
 import Data.Text qualified as T
-import Data.Validity (Validation(..), ValidationChain (..), prettyValidation)
+import Data.Validity (Validation(..))
 import Gargantext.API.Admin.Auth.Types (AuthenticationError)
 import Gargantext.API.Errors.Class (HasAuthenticationError(..))
 import Gargantext.API.Errors.TH ( deriveIsFrontendErrorData )
@@ -67,8 +65,6 @@ import Gargantext.Utils.Jobs.Monad qualified as Jobs
 import Servant (ServerError)
 import Servant.Job.Core ( HasServerError(..) )
 import Servant.Job.Types qualified as SJ
-import Test.QuickCheck
-import Test.QuickCheck.Instances.Text ()
 
 -- | A 'WithStacktrace' carries an error alongside its
 -- 'CallStack', to be able to print the correct source location
@@ -574,121 +570,6 @@ instance FromJSON (ToFrontendErrorData 'EC_500__job_generic_exception) where
     jege_error <- o .: "error"
     pure FE_job_generic_exception{..}
 
-----------------------------------------------------------------------------
--- Arbitrary instances and test data generation
-----------------------------------------------------------------------------
-
-instance Arbitrary BackendErrorCode where
-  arbitrary = arbitraryBoundedEnum
-
-genFrontendErr :: BackendErrorCode -> Gen FrontendError
-genFrontendErr be = do
-  txt <- arbitrary
-  case be of
-
-    -- node errors
-    EC_404__node_list_not_found
-      -> arbitrary >>= \lid -> pure $ mkFrontendErr' txt $ FE_node_list_not_found lid
-    EC_404__node_root_not_found
-      -> pure $ mkFrontendErr' txt FE_node_root_not_found
-    EC_404__node_corpus_not_found
-      -> pure $ mkFrontendErr' txt FE_node_corpus_not_found
-    EC_500__node_not_implemented_yet
-      -> pure $ mkFrontendErr' txt FE_node_not_implemented_yet
-    EC_404__node_lookup_failed_not_found
-      -> do nodeId <- arbitrary
-            pure $ mkFrontendErr' txt (FE_node_lookup_failed_not_found nodeId)
-    EC_404__node_lookup_failed_parent_not_found
-      -> do nodeId <- arbitrary
-            pure $ mkFrontendErr' txt (FE_node_lookup_failed_parent_not_found nodeId)
-    EC_404__node_lookup_failed_user_not_found
-      -> do userId <- arbitrary
-            pure $ mkFrontendErr' txt (FE_node_lookup_failed_user_not_found userId)
-    EC_404__node_lookup_failed_username_not_found
-      -> do username <- arbitrary
-            pure $ mkFrontendErr' txt (FE_node_lookup_failed_username_not_found username)
-    EC_400__node_lookup_failed_user_too_many_roots
-      -> do userId <- arbitrary
-            roots  <- arbitrary
-            pure $ mkFrontendErr' txt (FE_node_lookup_failed_user_too_many_roots userId roots)
-    EC_404__node_context_not_found
-      -> do contextId <- arbitrary
-            pure $ mkFrontendErr' txt (FE_node_context_not_found contextId)
-    EC_400__node_creation_failed_no_parent
-      -> do userId   <- arbitrary
-            pure $ mkFrontendErr' txt (FE_node_creation_failed_no_parent userId)
-    EC_400__node_creation_failed_parent_exists
-      -> do userId   <- arbitrary
-            parentId <- arbitrary
-            pure $ mkFrontendErr' txt (FE_node_creation_failed_parent_exists userId parentId)
-    EC_400__node_creation_failed_insert_node
-      -> do userId   <- arbitrary
-            parentId <- arbitrary
-            pure $ mkFrontendErr' txt $ FE_node_creation_failed_insert_node parentId userId
-    EC_400__node_creation_failed_user_negative_id
-      ->    pure $ mkFrontendErr' txt (FE_node_creation_failed_user_negative_id (UnsafeMkUserId (-42)))
-    EC_500__node_generic_exception
-      -> do err <- arbitrary
-            pure $ mkFrontendErr' txt $ FE_node_generic_exception err
-    EC_400__node_needs_configuration
-      ->    pure $ mkFrontendErr' txt $ FE_node_needs_configuration
-
-    -- validation error
-    EC_400__validation_error
-      -> do let genValChain = oneof [ Violated <$> arbitrary, Location <$> arbitrary <*> genValChain ]
-            chain <- listOf1 genValChain
-            pure $ mkFrontendErr' txt $ FE_validation_error (T.pack $ fromMaybe "unknown_validation_error" $ prettyValidation $ Validation chain)
-
-    -- authentication error
-    EC_403__login_failed_error
-      -> do nid <- arbitrary
-            uid <- arbitrary
-            pure $ mkFrontendErr' txt $ FE_login_failed_error nid uid
-
-    EC_403__login_failed_invalid_username_or_password
-      -> do
-            pure $ mkFrontendErr' txt $ FE_login_failed_invalid_username_or_password
-
-    EC_403__user_not_authorized
-      -> do
-            uid <- arbitrary
-            msg <- arbitrary
-            pure $ mkFrontendErr' txt $ FE_user_not_authorized uid msg
-
-    -- internal error
-    EC_500__internal_server_error
-      -> do err <- arbitrary
-            pure $ mkFrontendErr' txt $ FE_internal_server_error err
-
-    EC_405__not_allowed
-      -> do err <- arbitrary
-            pure $ mkFrontendErr' txt $ FE_not_allowed err
-
-    -- tree errors
-    EC_404__tree_root_not_found
-      -> pure $ mkFrontendErr' txt $ FE_tree_root_not_found
-    EC_404__tree_empty_root
-      -> pure $ mkFrontendErr' txt $ FE_tree_empty_root
-    EC_500__tree_too_many_roots
-      -> do nodes <- getNonEmpty <$> arbitrary
-            pure $ mkFrontendErr' txt $ FE_tree_too_many_roots (NE.fromList nodes)
-
-    -- job errors
-    EC_500__job_invalid_id_type
-      -> do idTy <- arbitrary
-            pure $ mkFrontendErr' txt $ FE_job_invalid_id_type idTy
-    EC_500__job_expired
-      -> do jobId <- getPositive <$> arbitrary
-            pure $ mkFrontendErr' txt $ FE_job_expired jobId
-    EC_500__job_invalid_mac
-      -> do macId <- arbitrary
-            pure $ mkFrontendErr' txt $ FE_job_expired macId
-    EC_500__job_unknown_job
-      -> do jobId <- getPositive <$> arbitrary
-            pure $ mkFrontendErr' txt $ FE_job_unknown_job jobId
-    EC_500__job_generic_exception
-      -> do err <- arbitrary
-            pure $ mkFrontendErr' txt $ FE_job_generic_exception err
 
 instance ToJSON BackendErrorCode where
   toJSON = String . T.pack . show

src/Gargantext/API/Metrics.hs

@@ -260,7 +260,7 @@ updatePie cId maybeListId tabType maybeLimit = do
   _ <- updatePie' cId listId tabType maybeLimit
   pure ()
 
-updatePie' :: (HasNodeStory env err m, HasNodeError err)
+updatePie' :: (HasNodeStory env err m)
            => CorpusId
            -> ListId
            -> TabType

src/Gargantext/API/Ngrams.hs

@@ -99,7 +99,6 @@ import Gargantext.Core.Types (ListType(..), NodeId, ListId, TODO, assertValid, H
 import Gargantext.Core.Types.Query (Limit(..), Offset(..), MinSize(..), MaxSize(..))
 import Gargantext.Database.Action.Metrics.NgramsByContext (getOccByNgramsOnlyFast)
 import Gargantext.Database.Query.Table.Ngrams ( text2ngrams, insertNgrams )
-import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Prelude hiding (log, to, toLower, (%), isInfixOf)
 import Gargantext.Prelude.Clock (hasTime, getTime)
 import Text.Collate qualified as Unicode
@@ -256,7 +255,6 @@ newNgramsFromNgramsStatePatch p =
 
 
 commitStatePatch :: ( HasNodeStory env err m
-                    , HasNodeStoryImmediateSaver env
                     , HasNodeArchiveStoryImmediateSaver env )
                  => ListId
                  ->    Versioned NgramsStatePatch'
@@ -364,7 +362,6 @@ tableNgramsPull listId ngramsType p_version = do
 -- client.
 -- TODO-ACCESS check
 tableNgramsPut :: ( HasNodeStory    env err m
-                  , HasNodeStoryImmediateSaver env
                   , HasNodeArchiveStoryImmediateSaver env
                   , HasValidationError     err
                   )
@@ -520,8 +517,7 @@ unicodeDUCETSorter :: Text -> Text -> Ordering
 unicodeDUCETSorter = Unicode.collate Unicode.rootCollator
 
 getTableNgrams :: forall env err m.
-                  ( HasNodeStory env err m
-                  , HasNodeError err )
+                  ( HasNodeStory env err m )
                => NodeId
                -> ListId
                -> TabType
@@ -535,8 +531,7 @@ getTableNgrams nodeId listId tabType searchQuery = do
 
 -- | Helper function to get the ngrams table with scores.
 getNgramsTable' :: forall env err m.
-                   ( HasNodeStory env err m
-                   , HasNodeError err )
+                   ( HasNodeStory env err m )
                 => NodeId
                 -> ListId
                 -> NgramsType
@@ -549,8 +544,7 @@ getNgramsTable' nId listId ngramsType = do
 -- | Helper function to set scores on an `NgramsTable`.
 setNgramsTableScores :: forall env err m t.
                         ( Each t t NgramsElement NgramsElement
-                        , HasNodeStory env err m
-                        , HasNodeError err )
+                        , HasNodeStory env err m )
                      => NodeId
                      -> ListId
                      -> NgramsType
@@ -586,8 +580,7 @@ needsScores (Just ScoreAsc)  = True
 needsScores (Just ScoreDesc) = True
 needsScores _ = False
 
-getTableNgramsCorpus :: ( HasNodeStory env err m
-                        , HasNodeError err )
+getTableNgramsCorpus :: ( HasNodeStory env err m )
                      => NodeId
                      -> TabType
                      -> ListId

src/Gargantext/API/Node.hs

@@ -21,8 +21,6 @@ Node API
 
 -}
 
-{-# OPTIONS_GHC -Wredundant-constraints #-}
-
 {-# LANGUAGE ScopedTypeVariables  #-}
 {-# LANGUAGE TemplateHaskell      #-}
 {-# LANGUAGE TypeOperators        #-}

test/Test/Instances.hs

@@ -12,12 +12,17 @@ Portability : POSIX
 
 {-# LANGUAGE StandaloneDeriving #-}
 
-module Test.Instances where
+module Test.Instances
+where
 
+import Data.List.NonEmpty qualified as NE
 import Data.Map.Strict qualified as Map
 import Data.Map.Strict.Patch qualified as PM
 import Data.Patch.Class (Replace(Keep), replace)
+import Data.Text qualified as T
+import Data.Validity (Validation(..), ValidationChain (..), prettyValidation)
 import EPO.API.Client.Types qualified as EPO
+import Gargantext.API.Errors.Types qualified as Errors
 import Gargantext.API.Ngrams.Types qualified as Ngrams
 import Gargantext.API.Node.Corpus.New (ApiInfo(..))
 import Gargantext.API.Node.Types (RenameNode(..), WithQuery(..))
@@ -26,8 +31,9 @@ import Gargantext.Core.AsyncUpdates.Dispatcher.Types qualified as DET
 import Gargantext.Core.NodeStory.Types qualified as NS
 import Gargantext.Core.Text.Ngrams (NgramsType(..))
 import Gargantext.Core.Types.Main (ListType(CandidateTerm, StopTerm, MapTerm))
+import Gargantext.Database.Admin.Types.Node (UserId(UnsafeMkUserId))
 import Gargantext.Database.Admin.Types.Hyperdata qualified as Hyperdata
-import Gargantext.Prelude hiding (replace)
+import Gargantext.Prelude hiding (replace, Location)
 import Servant.Job.Core qualified as SJ
 import Servant.Job.Types qualified as SJ
 import Test.QuickCheck
@@ -221,3 +227,120 @@ ngramsMockTable = Ngrams.NgramsTable
 --                    [ (n ^. Ngrams.ne_ngrams, Ngrams.ngramsElementToRepo n)
 --                    | n <- ngramsMockTable ^. Ngrams._NgramsTable
 --                    ]
+
+
+
+instance Arbitrary Errors.BackendErrorCode where
+  arbitrary = arbitraryBoundedEnum
+----------------------------------------------------------------------------
+-- Arbitrary instances and test data generation
+----------------------------------------------------------------------------
+
+genFrontendErr :: Errors.BackendErrorCode -> Gen Errors.FrontendError
+genFrontendErr be = do
+  txt <- arbitrary
+  case be of
+
+    -- node errors
+    Errors.EC_404__node_list_not_found
+      -> arbitrary >>= \lid -> pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_list_not_found lid
+    Errors.EC_404__node_root_not_found
+      -> pure $ Errors.mkFrontendErr' txt Errors.FE_node_root_not_found
+    Errors.EC_404__node_corpus_not_found
+      -> pure $ Errors.mkFrontendErr' txt Errors.FE_node_corpus_not_found
+    Errors.EC_500__node_not_implemented_yet
+      -> pure $ Errors.mkFrontendErr' txt Errors.FE_node_not_implemented_yet
+    Errors.EC_404__node_lookup_failed_not_found
+      -> do nodeId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_not_found nodeId)
+    Errors.EC_404__node_lookup_failed_parent_not_found
+      -> do nodeId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_parent_not_found nodeId)
+    Errors.EC_404__node_lookup_failed_user_not_found
+      -> do userId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_not_found userId)
+    Errors.EC_404__node_lookup_failed_username_not_found
+      -> do username <- arbitrary
+            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_username_not_found username)
+    Errors.EC_400__node_lookup_failed_user_too_many_roots
+      -> do userId <- arbitrary
+            roots  <- arbitrary
+            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_lookup_failed_user_too_many_roots userId roots)
+    Errors.EC_404__node_context_not_found
+      -> do contextId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_context_not_found contextId)
+    Errors.EC_400__node_creation_failed_no_parent
+      -> do userId   <- arbitrary
+            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_creation_failed_no_parent userId)
+    Errors.EC_400__node_creation_failed_parent_exists
+      -> do userId   <- arbitrary
+            parentId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt (Errors.FE_node_creation_failed_parent_exists userId parentId)
+    Errors.EC_400__node_creation_failed_insert_node
+      -> do userId   <- arbitrary
+            parentId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_creation_failed_insert_node parentId userId
+    Errors.EC_400__node_creation_failed_user_negative_id
+      ->    pure $ Errors.mkFrontendErr' txt (Errors.FE_node_creation_failed_user_negative_id (UnsafeMkUserId (-42)))
+    Errors.EC_500__node_generic_exception
+      -> do err <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_generic_exception err
+    Errors.EC_400__node_needs_configuration
+      ->    pure $ Errors.mkFrontendErr' txt $ Errors.FE_node_needs_configuration
+
+    -- validation error
+    Errors.EC_400__validation_error
+      -> do let genValChain = oneof [ Violated <$> arbitrary, Location <$> arbitrary <*> genValChain ]
+            chain <- listOf1 genValChain
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_validation_error (T.pack $ fromMaybe "unknown_validation_error" $ prettyValidation $ Validation chain)
+
+    -- authentication error
+    Errors.EC_403__login_failed_error
+      -> do nid <- arbitrary
+            uid <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_login_failed_error nid uid
+
+    Errors.EC_403__login_failed_invalid_username_or_password
+      -> do
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_login_failed_invalid_username_or_password
+
+    Errors.EC_403__user_not_authorized
+      -> do
+            uid <- arbitrary
+            msg <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_user_not_authorized uid msg
+
+    -- internal error
+    Errors.EC_500__internal_server_error
+      -> do err <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_internal_server_error err
+
+    Errors.EC_405__not_allowed
+      -> do err <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_not_allowed err
+
+    -- tree errors
+    Errors.EC_404__tree_root_not_found
+      -> pure $ Errors.mkFrontendErr' txt $ Errors.FE_tree_root_not_found
+    Errors.EC_404__tree_empty_root
+      -> pure $ Errors.mkFrontendErr' txt $ Errors.FE_tree_empty_root
+    Errors.EC_500__tree_too_many_roots
+      -> do nodes <- getNonEmpty <$> arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_tree_too_many_roots (NE.fromList nodes)
+
+    -- job errors
+    Errors.EC_500__job_invalid_id_type
+      -> do idTy <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_job_invalid_id_type idTy
+    Errors.EC_500__job_expired
+      -> do jobId <- getPositive <$> arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_job_expired jobId
+    Errors.EC_500__job_invalid_mac
+      -> do macId <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_job_expired macId
+    Errors.EC_500__job_unknown_job
+      -> do jobId <- getPositive <$> arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_job_unknown_job jobId
+    Errors.EC_500__job_generic_exception
+      -> do err <- arbitrary
+            pure $ Errors.mkFrontendErr' txt $ Errors.FE_job_generic_exception err

test/Test/Offline/JSON.hs

@@ -17,7 +17,7 @@ import Gargantext.Core.Types.Phylo
 import Gargantext.Database.Admin.Types.Node
 import Paths_gargantext
 import Prelude
-import Test.Instances ()
+import Test.Instances (genFrontendErr)
 import Test.Tasty
 import Test.Tasty.HUnit
 import Test.Tasty.QuickCheck