Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
haskell-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
142
Issues
142
List
Board
Labels
Milestones
Merge Requests
8
Merge Requests
8
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
haskell-gargantext
Commits
c6620db7
Verified
Commit
c6620db7
authored
Aug 23, 2024
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[worker] more refactoring for jobs
parent
36a4c23f
Pipeline
#6525
failed with stages
in 20 minutes and 29 seconds
Changes
5
Pipelines
1
Show whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
21 additions
and
41 deletions
+21
-41
Auth.hs
src/Gargantext/API/Admin/Auth.hs
+4
-27
Types.hs
src/Gargantext/API/Admin/Auth/Types.hs
+1
-1
Worker.hs
src/Gargantext/Core/Worker.hs
+4
-3
Types.hs
src/Gargantext/Core/Worker/Jobs/Types.hs
+7
-6
Instances.hs
test/Test/Instances.hs
+5
-4
No files found.
src/Gargantext/API/Admin/Auth.hs
View file @
c6620db7
...
...
@@ -61,7 +61,6 @@ 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
(
..
))
import
Gargantext.Database.Admin.Types.Node
(
UserId
)
...
...
@@ -73,7 +72,7 @@ import Gargantext.Database.Schema.Node (NodePoly(_node_id))
import
Gargantext.Prelude
hiding
(
Handler
,
reverse
,
to
)
import
Gargantext.Prelude.Crypto.Auth
qualified
as
Auth
import
Gargantext.Prelude.Crypto.Pass.User
(
gargPass
)
import
Gargantext.Utils.Jobs
(
serveJobsAPI
,
MonadJobStatus
(
..
)
)
import
Gargantext.Utils.Jobs
(
serveJobsAPI
)
import
Servant
import
Servant.API.Generic
()
import
Servant.Auth.Server
...
...
@@ -243,15 +242,7 @@ forgotPassword = Named.ForgotPasswordAPI
forgotPasswordPost
::
(
CmdCommon
env
,
HasSettings
env
)
=>
ForgotPasswordRequest
->
Cmd'
env
err
ForgotPasswordResponse
forgotPasswordPost
(
ForgotPasswordRequest
email
)
=
do
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
forgotPasswordPost
(
ForgotPasswordRequest
_email
)
=
do
pure
$
ForgotPasswordResponse
"ok"
forgotPasswordGet
::
(
HasSettings
env
,
CmdCommon
env
,
HasAuthenticationError
err
,
HasServerError
err
)
...
...
@@ -331,19 +322,5 @@ generateForgotPasswordUUID = do
-- malicious users emails of our users in the db
forgotPasswordAsync
::
Named
.
ForgotPasswordAsyncAPI
(
AsServerT
(
GargM
Env
BackendInternalError
))
forgotPasswordAsync
=
Named
.
ForgotPasswordAsyncAPI
$
AsyncJobs
$
serveJobsAPI
ForgotPasswordJob
$
\
jHandle
p
->
forgotPasswordAsync'
p
jHandle
forgotPasswordAsync'
::
(
FlowCmdM
env
err
m
,
MonadJobStatus
m
,
HasSettings
env
)
=>
ForgotPasswordAsyncParams
->
JobHandle
m
->
m
()
forgotPasswordAsync'
(
ForgotPasswordAsyncParams
{
email
})
jobHandle
=
do
markStarted
2
jobHandle
markProgress
1
jobHandle
-- printDebug "[forgotPasswordAsync'] email" email
_
<-
forgotPasswordPost
$
ForgotPasswordRequest
{
_fpReq_email
=
email
}
markComplete
jobHandle
serveJobsAPI
ForgotPasswordJob
$
\
_jHandle
p
->
do
Jobs
.
sendJob
$
Jobs
.
ForgotPasswordAsync
{
Jobs
.
_fpa_args
=
p
}
src/Gargantext/API/Admin/Auth/Types.hs
View file @
c6620db7
...
...
@@ -134,7 +134,7 @@ instance ToSchema ForgotPasswordGet where
newtype
ForgotPasswordAsyncParams
=
ForgotPasswordAsyncParams
{
email
::
Text
}
deriving
(
Generic
,
Show
)
deriving
(
Generic
,
Show
,
Eq
)
instance
FromJSON
ForgotPasswordAsyncParams
where
parseJSON
=
genericParseJSON
defaultOptions
instance
ToJSON
ForgotPasswordAsyncParams
where
...
...
src/Gargantext/Core/Worker.hs
View file @
c6620db7
...
...
@@ -20,6 +20,7 @@ import Async.Worker.Types qualified as Worker
import
Async.Worker.Types
(
HasWorkerBroker
)
import
Data.Text
qualified
as
T
import
Gargantext.API.Admin.Auth
(
forgotUserPassword
)
import
Gargantext.API.Admin.Auth.Types
(
ForgotPasswordAsyncParams
(
..
))
import
Gargantext.API.Admin.Types
(
HasSettings
)
import
Gargantext.Core.Worker.Jobs
import
Gargantext.Core.Worker.Jobs.Types
(
Job
(
..
))
...
...
@@ -68,9 +69,9 @@ 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
)
ForgotPassword
Async
{
_fpa_args
=
ForgotPasswordAsyncParams
{
email
}
}
->
flip
runReaderT
env
$
do
liftBase
$
putStrLn
(
"forgot password: "
<>
email
)
us
<-
getUsersWithEmail
(
T
.
toLower
email
)
case
us
of
[
u
]
->
forgotUserPassword
u
_
->
pure
()
...
...
src/Gargantext/Core/Worker/Jobs/Types.hs
View file @
c6620db7
...
...
@@ -15,13 +15,14 @@ module Gargantext.Core.Worker.Jobs.Types where
import
Data.Aeson
((
.:
),
(
.=
),
object
,
withObject
)
import
Data.Aeson.Types
(
prependFailure
,
typeMismatch
)
import
Gargantext.API.Admin.Auth.Types
(
ForgotPasswordAsyncParams
)
import
Gargantext.API.Admin.EnvTypes
(
GargJob
)
import
Gargantext.Prelude
data
Job
=
Ping
|
ForgotPassword
{
_fp_email
::
Text
}
|
ForgotPassword
Async
{
_fpa_args
::
ForgotPasswordAsyncParams
}
|
GargJob
{
_gj_garg_job
::
GargJob
}
deriving
(
Show
,
Eq
)
instance
FromJSON
Job
where
...
...
@@ -29,16 +30,16 @@ instance FromJSON Job where
type_
<-
o
.:
"type"
case
type_
of
"Ping"
->
return
Ping
"ForgotPassword"
->
do
_fp
_email
<-
o
.:
"email
"
return
$
ForgotPassword
{
_fp_email
}
"ForgotPassword
Async
"
->
do
_fp
a_args
<-
o
.:
"args
"
return
$
ForgotPassword
Async
{
_fpa_args
}
"GargJob"
->
do
_gj_garg_job
<-
o
.:
"garg_job"
return
$
GargJob
{
_gj_garg_job
}
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
)
]
toJSON
(
ForgotPassword
Async
{
_fpa_args
})
=
object
[
(
"type"
.=
(
"ForgotPasswordAsync
"
::
Text
))
,
(
"args"
.=
_fpa_args
)
]
toJSON
(
GargJob
{
_gj_garg_job
})
=
object
[
(
"type"
.=
(
"GargJob"
::
Text
))
,
(
"garg_job"
.=
_gj_garg_job
)
]
test/Test/Instances.hs
View file @
c6620db7
module
Test.Instances
where
import
Gargantext.API.Admin.EnvTypes
as
EnvTypes
import
Gargantext.API.Admin.Auth.Types
(
ForgotPasswordAsyncParams
(
..
))
import
Gargantext.Core.Worker.Jobs.Types
(
Job
(
..
))
import
Gargantext.Prelude
import
Text.Parsec.Error
(
ParseError
,
Message
(
..
),
newErrorMessage
)
...
...
@@ -31,12 +32,12 @@ instance Arbitrary EnvTypes.GargJob where
instance
Arbitrary
Job
where
arbitrary
=
oneof
[
pure
Ping
,
forgotPasswordGen
,
forgotPassword
Async
Gen
,
gargJobGen
]
where
forgotPasswordGen
=
do
_fp_
email
<-
arbitrary
return
$
ForgotPassword
{
_fp_email
}
forgotPassword
Async
Gen
=
do
email
<-
arbitrary
return
$
ForgotPassword
Async
(
ForgotPasswordAsyncParams
{
email
})
gargJobGen
=
do
_gj_garg_job
<-
arbitrary
return
$
GargJob
{
_gj_garg_job
}
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment