[worker] async worker implemented for ForgotPassword

gargantext.cabal

@@ -232,6 +232,7 @@ library
       Gargantext.Core.Viz.Types
       Gargantext.Core.Worker
       Gargantext.Core.Worker.Jobs
+      Gargantext.Core.Worker.Jobs.Types
       Gargantext.Core.Worker.TOML
       Gargantext.Database.Action.Flow
       Gargantext.Database.Action.Flow.Types

src/Gargantext/API/Admin/Auth.hs

@@ -40,11 +40,12 @@ module Gargantext.API.Admin.Auth
   , withNamedAccess
 
   , ForgotPasswordAsyncParams
+
+  , forgotUserPassword
   )
   where
 
 import Control.Lens (view, (#))
-import Data.Text qualified as Text
 import Data.Text.Lazy.Encoding qualified as LE
 import Data.UUID (UUID, fromText, toText)
 import Data.UUID.V4 (nextRandom)
@@ -58,6 +59,8 @@ import Gargantext.API.Prelude (authenticationError, HasServerError, GargServerC,
 import Gargantext.Core.Mail (MailModel(..), mail)
 import Gargantext.Core.Mail.Types (mailSettings)
 import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
+import Gargantext.Core.Worker.Jobs qualified as Jobs
+import Gargantext.Core.Worker.Jobs.Types qualified as Jobs
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.User.New (guessUserName)
 import Gargantext.Database.Admin.Types.Node (NodeId(..))
@@ -238,13 +241,14 @@ forgotPassword = Named.ForgotPasswordAPI
   , forgotPasswordGetEp  = forgotPasswordGet
   }
 
-forgotPasswordPost :: (CmdCommon env)
+forgotPasswordPost :: (CmdCommon env, HasSettings env)
      => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
 forgotPasswordPost (ForgotPasswordRequest email) = do
-  us <- getUsersWithEmail (Text.toLower email)
-  case us of
-    [u] -> forgotUserPassword u
-    _ -> pure ()
+  Jobs.sendJob $ Jobs.ForgotPassword { Jobs._fp_email = email }
+  -- us <- getUsersWithEmail (Text.toLower email)
+  -- case us of
+  --   [u] -> forgotUserPassword u
+  --   _ -> pure ()
 
   -- NOTE Sending anything else here could leak information about
   -- users' emails
@@ -329,7 +333,7 @@ forgotPasswordAsync :: Named.ForgotPasswordAsyncAPI (AsServerT (GargM Env Backen
 forgotPasswordAsync = Named.ForgotPasswordAsyncAPI $ AsyncJobs $
   serveJobsAPI ForgotPasswordJob $ \jHandle p -> forgotPasswordAsync' p jHandle
 
-forgotPasswordAsync' :: (FlowCmdM env err m, MonadJobStatus m)
+forgotPasswordAsync' :: (FlowCmdM env err m, MonadJobStatus m, HasSettings env)
   => ForgotPasswordAsyncParams
   -> JobHandle m
   -> m ()

src/Gargantext/API/Admin/Auth/Types.hs

@@ -118,17 +118,17 @@ type Email = Text
 type Password = Text
 
 data ForgotPasswordRequest = ForgotPasswordRequest { _fpReq_email :: Email }
-  deriving (Generic )
+  deriving (Generic)
 instance ToSchema ForgotPasswordRequest where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpReq_")
 
 data ForgotPasswordResponse = ForgotPasswordResponse { _fpRes_status :: Text }
-  deriving (Generic )
+  deriving (Generic)
 instance ToSchema ForgotPasswordResponse where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpRes_")
 
 data ForgotPasswordGet = ForgotPasswordGet {_fpGet_password :: Password}
-  deriving (Generic )
+  deriving (Generic)
 instance ToSchema ForgotPasswordGet where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fpGet_")
 

src/Gargantext/Core/Worker.hs

@@ -19,38 +19,52 @@ import Async.Worker qualified as Worker
 import Async.Worker.Types qualified as Worker
 import Async.Worker.Types (HasWorkerBroker)
 import Data.Text qualified as T
-import Database.Redis qualified as Redis
+import Gargantext.API.Admin.Auth (forgotUserPassword)
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.Core.Worker.Jobs
-import Gargantext.Core.Worker.TOML (WorkerDefinition(..))
+import Gargantext.Core.Worker.Jobs.Types (Job(..))
+import Gargantext.Core.Worker.TOML (WorkerDefinition(..), wdToRedisConnectInfo)
+import Gargantext.Database.Prelude (CmdCommon)
+import Gargantext.Database.Query.Table.User (getUsersWithEmail)
 import Gargantext.Prelude
 
   
 
-withRedisWorker :: (HasWorkerBroker RedisBroker Job)
-                => Redis.ConnectInfo
+withRedisWorker :: (HasWorkerBroker RedisBroker Job, HasSettings env, CmdCommon env)
+                => env
                 -> WorkerDefinition
                 -> (Async () -> Worker.State RedisBroker Job -> IO ())
                 -> IO ()
-withRedisWorker connInfo (WorkerDefinition { .. }) cb = do
-  broker <- initializeRedisBroker connInfo
+withRedisWorker env wd@(WorkerDefinition { .. }) cb = do
+  case wdToRedisConnectInfo wd of
+    Nothing -> panicTrace $ "worker definition: could not create redis conn info"
+    Just connInfo -> do
+      broker <- initializeRedisBroker connInfo
+    
+      let state' = Worker.State { broker
+                                , queueName = _wdQueue
+                                , name = T.unpack _wdName
+                                , performAction = performAction env
+                                , onMessageReceived = Nothing
+                                , onJobFinish = Nothing
+                                , onJobTimeout = Nothing
+                                , onJobError = Nothing }
+    
+      withAsync (Worker.run state') (\a -> cb a state')
 
-  let state' = Worker.State { broker
-                            , queueName = _wdQueue
-                            , name = T.unpack _wdName
-                            , performAction
-                            , onMessageReceived = Nothing
-                            , onJobFinish = Nothing
-                            , onJobTimeout = Nothing
-                            , onJobError = Nothing }
 
-  withAsync (Worker.run state') (\a -> cb a state')
-
-
-performAction :: (HasWorkerBroker b Job)
-              => Worker.State b Job
+performAction :: (HasWorkerBroker b Job, HasSettings env, CmdCommon env)
+              => env
+              -> Worker.State b Job
               -> BrokerMessage b (Worker.Job Job)
               -> IO ()
-performAction _state bm = do
+performAction env _state bm = do
   let job' = toA $ getMessage bm
   case Worker.job job' of
     Ping -> putStrLn ("ping" :: Text)
+    ForgotPassword { _fp_email } -> flip runReaderT env $ do
+      liftBase $ putStrLn ("forgot password: " <> _fp_email)
+      us <- getUsersWithEmail (T.toLower _fp_email)
+      case us of
+        [u] -> forgotUserPassword u
+        _ -> pure ()

src/Gargantext/Core/Worker/Jobs.hs

@@ -19,28 +19,14 @@ import Async.Worker qualified as Worker
 import Async.Worker.Types qualified as Worker
 import Async.Worker.Types (HasWorkerBroker)
 import Control.Lens (view)
-import Data.Aeson ((.:), (.=), object, withObject)
-import Data.Aeson.Types (prependFailure, typeMismatch)
 import Database.Redis qualified as Redis
 import Gargantext.API.Admin.Types (HasSettings, settings, workerSettings)
-import Gargantext.Core.Worker.TOML (findDefinitionByName, WorkerDefinition(..))
+import Gargantext.Core.Worker.Jobs.Types (Job(..))
+import Gargantext.Core.Worker.TOML (WorkerSettings(..), WorkerDefinition(..), wdToRedisConnectInfo)
 import Gargantext.Database.Prelude (Cmd')
 import Gargantext.Prelude
 
 
-data Job =
-  Ping
-  deriving (Show, Eq)
-instance FromJSON Job where
-  parseJSON = withObject "Job" $ \o -> do
-    type_ <- o .: "type"
-    case type_ of
-      "Ping" -> return Ping
-      s -> prependFailure "parsing job type failed, " (typeMismatch "type" s)
-instance ToJSON Job where
-  toJSON Ping = object [("type" .= ("Ping" :: Text))]
-
-
 initializeRedisBroker :: (HasWorkerBroker RedisBroker Job)
                       => Redis.ConnectInfo
                       -> IO (Broker RedisBroker (Worker.Job Job))
@@ -51,17 +37,19 @@ initializeRedisBroker connInfo = do
 
 
 sendJob :: (HasWorkerBroker RedisBroker Job, HasSettings env)
-        => Redis.ConnectInfo
-        -> Text
-        -> Job
+        => Job
         -> Cmd' env err ()
-sendJob connInfo workerName job = do
+sendJob job = do
   ws <- view $ settings . workerSettings
-  let mWd = findDefinitionByName ws workerName
+  -- TODO Try to guess which worker should get this job
+  -- let mWd = findDefinitionByName ws workerName
+  let mWd = head $ _wsDefinitions ws
   case mWd of
-    Nothing -> panicTrace $ "worker definition not found for " <> workerName
+    Nothing -> panicTrace $ "worker definition not found"
     Just wd -> liftBase $ do
-      b <- initializeRedisBroker connInfo
-      let queueName = _wdQueue wd
-      _ <- Worker.sendJob' $ Worker.mkDefaultSendJob' b queueName job
-      pure ()
+      case wdToRedisConnectInfo wd of
+        Nothing -> panicTrace $ "worker definition: could not create redis conn info"
+        Just connInfo -> do
+          b <- initializeRedisBroker connInfo
+          let queueName = _wdQueue wd
+          void $ Worker.sendJob' $ Worker.mkDefaultSendJob' b queueName job

src/Gargantext/Core/Worker/Jobs/Types.hs

+{-|
+Module      : Gargantext.Core.Worker.Jobs.Types
+Description : Worker job definitions
+Copyright   : (c) CNRS, 2024
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+
+module Gargantext.Core.Worker.Jobs.Types where
+
+
+import Data.Aeson ((.:), (.=), object, withObject)
+import Data.Aeson.Types (prependFailure, typeMismatch)
+import Gargantext.Prelude
+
+
+data Job =
+    Ping
+  | ForgotPassword { _fp_email :: Text }
+  deriving (Show, Eq)
+instance FromJSON Job where
+  parseJSON = withObject "Job" $ \o -> do
+    type_ <- o .: "type"
+    case type_ of
+      "Ping" -> return Ping
+      "ForgotPassword" -> do
+        _fp_email <- o .: "email"
+        return $ ForgotPassword { _fp_email }
+      s -> prependFailure "parsing job type failed, " (typeMismatch "type" s)
+instance ToJSON Job where
+  toJSON Ping = object [ ("type" .= ("Ping" :: Text)) ]
+  toJSON (ForgotPassword { _fp_email }) = object [ ("type" .= ("ForgotPassword" :: Text))
+                                                 , ("email" .= _fp_email) ]

src/Gargantext/Database/Query/Tree/Root.hs

@@ -14,6 +14,7 @@ module Gargantext.Database.Query.Tree.Root
   where
 
 import Control.Arrow (returnA)
+import Gargantext.API.Admin.Types (HasSettings)
 import Gargantext.Core (HasDBid(..))
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main (CorpusName)
@@ -30,7 +31,6 @@ import Gargantext.Database.Schema.Node (NodePoly(..), NodeRead, queryNodeTable)
 import Gargantext.Prelude
 import Opaleye (restrict, (.==), Select)
 import Opaleye.SqlTypes (sqlStrictText, sqlInt4)
-import Gargantext.API.Admin.Types (HasSettings)
 
 
 getRootId :: (HasNodeError err) => User -> DBCmd err NodeId

test/Test/Core/Worker.hs

@@ -13,7 +13,7 @@ module Test.Core.Worker where
 
 import Data.Aeson qualified as Aeson
 import Gargantext.Core.Methods.Similarities.Conditional
-import Gargantext.Core.Worker.Jobs (Job(..))
+import Gargantext.Core.Worker.Jobs.Types (Job(..))
 import Gargantext.Prelude
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -21,7 +21,11 @@ import Test.Tasty.QuickCheck hiding (Positive, Negative)
 
 
 instance Arbitrary Job where
-  arbitrary = oneof [ pure Ping ]
+  arbitrary = oneof [ pure Ping, forgotPasswordGen ]
+    where
+      forgotPasswordGen = do
+        _fp_email <- arbitrary
+        return $ ForgotPassword { _fp_email }
 
 
 tests :: TestTree