[worker] remove HasJobEnv, tasty tests pass

gargantext.cabal

@@ -296,7 +296,6 @@ library
       Gargantext.API.EKG
       Gargantext.API.GraphQL
       Gargantext.API.GraphQL.Annuaire
-      Gargantext.API.GraphQL.AsyncTask
       Gargantext.API.GraphQL.Context
       Gargantext.API.GraphQL.IMT
       Gargantext.API.GraphQL.NLP

src/Gargantext/API/Admin/EnvTypes.hs

@@ -52,8 +52,6 @@ import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..))
 import Network.HTTP.Client (Manager)
 import Servant.Auth.Server (JWTSettings)
 import Servant.Client (BaseUrl)
-import Servant.Job.Async (HasJobEnv(..), Job)
-import Servant.Job.Core qualified
 import System.Log.FastLogger qualified as FL
 
 data Mode = Dev | Mock | Prod
@@ -101,7 +99,6 @@ data Env = Env
   , _env_nodeStory        :: ~NodeStoryEnv
   , _env_manager          :: ~Manager
   , _env_self_url         :: ~BaseUrl
-  , _env_scrapers         :: ~ScrapersEnv
   , _env_config           :: ~GargConfig
   , _env_central_exchange :: ~ThreadId
   , _env_dispatcher       :: ~Dispatcher
@@ -138,12 +135,6 @@ instance HasNLPServer Env where
 instance HasDispatcher Env Dispatcher where
   hasDispatcher = env_dispatcher
 
-instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where
-  _env = env_scrapers . Servant.Job.Core._env
-
-instance HasJobEnv Env JobLog JobLog where
-  job_env = env_scrapers
-
 instance CET.HasCentralExchangeNotification Env where
   ce_notify m = do
     c <- asks (view env_config)

src/Gargantext/API/Admin/Settings.hs

@@ -38,7 +38,6 @@ import Gargantext.Prelude
 import Gargantext.System.Logging
 import Network.HTTP.Client.TLS (newTlsManager)
 import Servant.Client (parseBaseUrl)
-import Servant.Job.Async (newJobEnv, defaultSettings)
 import System.Directory (renameFile)
 import System.IO (hClose)
 import System.IO.Temp (withTempFile)
@@ -160,7 +159,6 @@ newEnv logger port settingsFile = do
   !self_url_env  <- parseBaseUrl $ "http://0.0.0.0:" <> show port
   !pool          <- newPool $ _gc_database_config config_env
   !nodeStory_env <- fromDBNodeStoryEnv pool
-  !scrapers_env  <- newJobEnv defaultSettings manager_env
 
   -- secret        <- Jobs.genSecret
   -- let jobs_settings = (Jobs.defaultJobSettings 1 secret)
@@ -180,7 +178,6 @@ newEnv logger port settingsFile = do
     , _env_pool      = pool
     , _env_nodeStory = nodeStory_env
     , _env_manager   = manager_env
-    , _env_scrapers  = scrapers_env
     , _env_self_url  = self_url_env
     , _env_config    = config_env
     , _env_central_exchange = central_exchange

src/Gargantext/API/GraphQL.hs

@@ -27,11 +27,9 @@ import Data.Morpheus.Subscriptions ( Event (..), httpPubApp )
 import Data.Morpheus.Types ( GQLRequest, GQLResponse, GQLType, RootResolver(..), Undefined, defaultRootResolver)
 -- import Data.Proxy
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser)
-import Gargantext.API.Admin.Orchestrator.Types (JobLog)
 import Gargantext.API.Auth.PolicyCheck
 import Gargantext.API.Errors.Types
 import Gargantext.API.GraphQL.Annuaire qualified as GQLA
-import Gargantext.API.GraphQL.AsyncTask qualified as GQLAT
 import Gargantext.API.GraphQL.Context qualified as GQLCTX
 import Gargantext.API.GraphQL.IMT qualified as GQLIMT
 import Gargantext.API.GraphQL.NLP qualified as GQLNLP
@@ -41,7 +39,6 @@ import Gargantext.API.GraphQL.TreeFirstLevel qualified as GQLTree
 import Gargantext.API.GraphQL.User qualified as GQLUser
 import Gargantext.API.GraphQL.UserInfo qualified as GQLUserInfo
 import Gargantext.API.Prelude (GargM)
-import Gargantext.API.Prelude (HasJobEnv')
 import Gargantext.API.Types
 import Gargantext.Core.Config (HasJWTSettings)
 import Gargantext.Core.NLP (HasNLPServer)
@@ -61,7 +58,6 @@ data Query m
     , contexts            :: GQLCTX.NodeContextArgs -> m [GQLCTX.NodeContextGQL]
     , contexts_for_ngrams :: GQLCTX.ContextsForNgramsArgs -> m [GQLCTX.ContextGQL]
     , imt_schools         :: m [GQLIMT.School]
-    , job_logs            :: GQLAT.JobLogArgs -> m (Map Int JobLog)
     , languages           :: m [GQLNLP.LanguageTuple]
     , nodes               :: GQLNode.NodeArgs -> m [GQLNode.Node]
     , nodes_corpus        :: GQLNode.CorpusArgs -> m [GQLNode.Corpus]
@@ -102,7 +98,7 @@ data Contet m
 -- | The main GraphQL resolver: how queries, mutations and
 -- subscriptions are handled.
 rootResolver
-  :: (CmdCommon env, HasNLPServer env, HasJobEnv' env, HasJWTSettings env)
+  :: (CmdCommon env, HasNLPServer env, HasJWTSettings env)
   => AuthenticatedUser
   -> AccessPolicyManager
   -> RootResolver (GargM env BackendInternalError) e Query Mutation Undefined
@@ -113,7 +109,6 @@ rootResolver authenticatedUser policyManager =
                             , contexts            = GQLCTX.resolveNodeContext
                             , contexts_for_ngrams = GQLCTX.resolveContextsForNgrams
                             , imt_schools         = GQLIMT.resolveSchools
-                            , job_logs            = GQLAT.resolveJobLogs
                             , languages           = GQLNLP.resolveLanguages
                             , nodes               = GQLNode.resolveNodes authenticatedUser policyManager
                             , nodes_corpus        = GQLNode.resolveNodesCorpus
@@ -134,7 +129,7 @@ rootResolver authenticatedUser policyManager =
 
 -- | Main GraphQL "app".
 app
-  :: (Typeable env, CmdCommon env, HasJobEnv' env, HasNLPServer env, HasJWTSettings env)
+  :: (Typeable env, CmdCommon env, HasNLPServer env, HasJWTSettings env)
   => AuthenticatedUser
   -> AccessPolicyManager
   -> App (EVENT (GargM env BackendInternalError)) (GargM env BackendInternalError)
@@ -172,7 +167,7 @@ data GraphQLAPIEndpoints mode = GraphQLAPIEndpoints
 
 -- | Implementation of our API.
 api
-  :: (Typeable env, CmdCommon env, HasJobEnv' env, HasJWTSettings env)
+  :: (Typeable env, CmdCommon env, HasJWTSettings env)
   => GraphQLAPI (AsServerT (GargM env BackendInternalError))
 api = GraphQLAPI $ \case
   (SAS.Authenticated auser)

src/Gargantext/API/GraphQL/AsyncTask.hs

-{-|
-Module      : Gargantext.API.GraphQL.AsyncTask
-Description :
-Copyright   : (c) CNRS, 2017
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
--}
-
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-
-module Gargantext.API.GraphQL.AsyncTask where
-
-import Control.Lens
-import Data.IntMap.Strict qualified as IntMap
-import Data.Map.Strict qualified as Map
-import Data.Morpheus.Types ( GQLType, Resolver, QUERY )
-import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
-import Gargantext.API.Errors.Types
-import Gargantext.API.Prelude (GargM, HasJobEnv')
-import Gargantext.Core.Config (HasConfig)
-import Gargantext.Database.Prelude (HasConnectionPool)
-import Gargantext.Prelude
-import Servant.Job.Async (HasJobEnv(job_env), jenv_jobs, job_async)
-import Servant.Job.Core (env_item, env_map, env_state_mvar)
-
-data JobLogArgs
-  = JobLogArgs
-    { job_log_id :: Int
-    } deriving (Generic, GQLType)
-
-type GqlM e env = Resolver QUERY e (GargM env BackendInternalError)
-
-resolveJobLogs
-  :: (HasConnectionPool env, HasConfig env, HasJobEnv' env)
-  => JobLogArgs -> GqlM e env (Map Int JobLog)
-resolveJobLogs JobLogArgs { job_log_id } = dbJobLogs job_log_id
-
-dbJobLogs
-  :: (HasConnectionPool env, HasConfig env, HasJobEnv' env)
-  => Int -> GqlM e env (Map Int JobLog)
-dbJobLogs _job_log_id = do
-  --getJobLogs job_log_id
-  lift $ do
-    env <- ask
-    --val <- liftBase $ readMVar $ env ^. job_env . jenv_jobs . env_state_mvar
-    var <- liftIO $ readMVar (env ^. job_env . jenv_jobs . env_state_mvar)
-    let envItems = var ^. env_map
-    -- printDebug "[dbJobLogs] env ^. job_env ^. jenv_jobs" $ length $ IntMap.keys envItems
-    -- printDebug "[dbJobLogs] job_log_id" job_log_id
-    --pure $ IntMap.elems val
-    liftIO $ do
-      let jobsList = IntMap.toList $ IntMap.map (\e -> e ^. env_item . job_async) envItems
-      results <- mapM (\(k, v) -> do
-                          p <- poll v
-                          let kv = case p of
-                                Nothing -> Nothing
-                                Just p' -> case p' of
-                                  Left _ -> Nothing
-                                  Right p'' -> Just (k, p'')
-                          pure kv) jobsList
-      pure $ Map.fromList $ catMaybes results

src/Gargantext/API/Prelude.hs

@@ -22,7 +22,6 @@ module Gargantext.API.Prelude
 import Control.Lens ((#))
 import Data.Aeson.Types
 import Gargantext.API.Admin.Auth.Types (AuthenticationError)
-import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Errors.Class
 import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification)
 import Gargantext.Core.Config (HasConfig)
@@ -37,17 +36,13 @@ import Gargantext.Prelude
 import Gargantext.System.Logging
 import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..), JobHandle)
 import Servant
-import Servant.Job.Async
 import Servant.Job.Core (HasServerError(..), serverError)
 
 authenticationError :: (MonadError e m, HasAuthenticationError e) => AuthenticationError -> m a
 authenticationError = throwError . (_AuthenticationError #)
 
-type HasJobEnv' env = HasJobEnv env JobLog JobLog
-
 type EnvC env =
   ( HasConnectionPool env
-  , HasJobEnv         env JobLog JobLog
   , HasConfig         env
   , HasNodeStoryEnv   env
   , HasMail           env

test/Test/API/Setup.hs

@@ -106,6 +106,7 @@ newTestEnv testEnv logger port = do
     , _env_jwt_settings
     }
 
+
 -- | Run the gargantext server on a random port, picked by Warp, which allows
 -- for concurrent tests to be executed in parallel, if we need to.
 withTestDBAndPort :: (SpecContext () -> IO ()) -> IO ()
@@ -139,6 +140,7 @@ withTestDBAndPort action =
     let stgs = Warp.defaultSettings { settingsOnExceptionResponse = showDebugExceptions }
     Warp.testWithApplicationSettings stgs (pure app) $ \port -> action (SpecContext testEnv port app ())
 
+
 withTestDBAndNotifications :: D.Dispatcher -> (((TestEnv, Warp.Port), Application) -> IO ()) -> IO ()
 withTestDBAndNotifications dispatcher action = do
   withTestDB $ \testEnv -> do    

test/Test/API/UpdateList.hs

@@ -116,6 +116,7 @@ uploadJSONList port token cId pathToNgrams = do
 
   pure listId
 
+
 tests :: Spec
 tests = sequential $ aroundAll withTestDBAndPort $ do
   describe "UpdateList API" $ do