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
197
Issues
197
List
Board
Labels
Milestones
Merge Requests
12
Merge Requests
12
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
Hide 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