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
0
Issues
0
List
Board
Labels
Milestones
Merge Requests
0
Merge Requests
0
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
Grégoire Locqueville
haskell-gargantext
Commits
2e060925
Commit
2e060925
authored
May 20, 2022
by
Przemyslaw Kaminski
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[auth] forgot password async endpoint
parent
001f94a7
Changes
11
Hide whitespace changes
Inline
Side-by-side
Showing
11 changed files
with
88 additions
and
9 deletions
+88
-9
gargantext.cabal
gargantext.cabal
+1
-0
package.yaml
package.yaml
+1
-0
Auth.hs
src/Gargantext/API/Admin/Auth.hs
+62
-4
Settings.hs
src/Gargantext/API/Admin/Settings.hs
+1
-1
Types.hs
src/Gargantext/API/Admin/Types.hs
+1
-1
Client.hs
src/Gargantext/API/Client.hs
+11
-0
DocumentsFromWriteNodes.hs
src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
+0
-1
Routes.hs
src/Gargantext/API/Routes.hs
+2
-1
Server.hs
src/Gargantext/API/Server.hs
+2
-1
Prelude.hs
src/Gargantext/Database/Prelude.hs
+3
-0
stack.yaml
stack.yaml
+4
-0
No files found.
gargantext.cabal
View file @
2e060925
...
...
@@ -412,6 +412,7 @@ library
, matrix
, monad-control
, monad-logger
, monad-logger-aeson
, morpheus-graphql
, morpheus-graphql-app
, morpheus-graphql-core
...
...
package.yaml
View file @
2e060925
...
...
@@ -199,6 +199,7 @@ library:
-
matrix
-
monad-control
-
monad-logger
-
monad-logger-aeson
-
morpheus-graphql
-
morpheus-graphql-app
-
morpheus-graphql-core
...
...
src/Gargantext/API/Admin/Auth.hs
View file @
2e060925
...
...
@@ -27,19 +27,27 @@ TODO-ACCESS Critical
module
Gargantext.API.Admin.Auth
(
auth
,
forgotPassword
,
forgotPasswordAsync
,
withAccess
,
ForgotPasswordAPI
,
ForgotPasswordAsyncParams
,
ForgotPasswordAsyncAPI
)
where
import
Control.Lens
(
view
,
(
#
))
--import Control.Monad.Logger.Aeson
import
Data.Aeson
import
Data.Swagger
(
ToSchema
(
..
))
import
Data.Text
(
Text
)
import
Data.Text.Lazy
(
toStrict
)
import
qualified
Data.Text.Lazy.Encoding
as
LE
import
Data.UUID
(
UUID
,
fromText
,
toText
)
import
Data.UUID.V4
(
nextRandom
)
import
GHC.Generics
(
Generic
)
import
Servant
import
Servant.Auth.Server
import
Servant.Job.Async
(
JobFunction
(
..
),
serveJobsAPI
)
import
qualified
Text.Blaze.Html.Renderer.Text
as
H
import
qualified
Text.Blaze.Html5
as
H
--import qualified Text.Blaze.Html5.Attributes as HA
...
...
@@ -47,13 +55,16 @@ import qualified Text.Blaze.Html5 as H
import
qualified
Gargantext.Prelude.Crypto.Auth
as
Auth
import
Gargantext.API.Admin.Auth.Types
import
Gargantext.API.Admin.Orchestrator.Types
(
JobLog
(
..
),
AsyncJobs
)
import
Gargantext.API.Admin.Types
import
Gargantext.API.Job
(
jobLogSuccess
)
import
Gargantext.API.Prelude
(
HasJoseError
(
..
),
joseError
,
HasServerError
,
GargServerC
,
GargServer
,
_ServerError
)
import
Gargantext.API.Types
import
Gargantext.Core.Mail
(
MailModel
(
..
),
mail
)
import
Gargantext.Core.Mail.Types
(
HasMail
,
mailSettings
)
import
Gargantext.Core.Types.Individu
(
User
(
..
),
Username
,
GargPassword
(
..
))
import
Gargantext.Core.Utils
(
randomString
)
import
Gargantext.Database.Action.Flow.Types
(
FlowCmdM
)
import
Gargantext.Database.Admin.Types.Node
(
NodeId
(
..
),
UserId
)
import
Gargantext.Database.Prelude
(
Cmd
'
,
CmdM
,
HasConnectionPool
,
HasConfig
)
import
Gargantext.Database.Query.Table.User
...
...
@@ -148,6 +159,15 @@ User can invite User in Team as NodeNode only if Team in his parents.
All users can access to the Team folder as if they were owner.
-}
newtype
ForgotPasswordAsyncParams
=
ForgotPasswordAsyncParams
{
email
::
Text
}
deriving
(
Generic
,
Show
)
instance
FromJSON
ForgotPasswordAsyncParams
where
parseJSON
=
genericParseJSON
defaultOptions
instance
ToJSON
ForgotPasswordAsyncParams
where
toJSON
=
genericToJSON
defaultOptions
instance
ToSchema
ForgotPasswordAsyncParams
type
ForgotPasswordAPI
=
Summary
"Forgot password POST API"
:>
ReqBody
'[
J
SON
]
ForgotPasswordRequest
:>
Post
'[
J
SON
]
ForgotPasswordResponse
...
...
@@ -160,7 +180,7 @@ forgotPassword :: GargServer ForgotPasswordAPI
-- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
forgotPassword
=
forgotPasswordPost
:<|>
forgotPasswordGet
forgotPasswordPost
::
(
HasSettings
env
,
HasConnectionPool
env
,
HasJoseError
err
,
HasConfig
env
,
HasMail
env
)
forgotPasswordPost
::
(
HasConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
ForgotPasswordRequest
->
Cmd'
env
err
ForgotPasswordResponse
forgotPasswordPost
(
ForgotPasswordRequest
email
)
=
do
us
<-
getUsersWithEmail
email
...
...
@@ -186,6 +206,8 @@ forgotPasswordGet (Just uuid) = do
[
u
]
->
forgotPasswordGetUser
u
_
->
throwError
$
_ServerError
#
err404
{
errBody
=
"Not found"
}
---------------------
forgotPasswordGetUser
::
(
HasSettings
env
,
HasConnectionPool
env
,
HasJoseError
err
,
HasConfig
env
,
HasMail
env
,
HasServerError
err
)
=>
UserLight
->
Cmd'
env
err
Text
forgotPasswordGetUser
(
UserLight
{
..
})
=
do
...
...
@@ -214,10 +236,11 @@ forgotPasswordGetUser (UserLight { .. }) = do
H
.
span
"Here is your password (will be shown only once): "
H
.
b
$
H
.
toHtml
password
forgotUserPassword
::
(
Has
Settings
env
,
HasConnectionPool
env
,
HasJoseError
err
,
HasConfig
env
,
HasMail
env
)
forgotUserPassword
::
(
Has
ConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
UserLight
->
Cmd'
env
err
()
forgotUserPassword
(
UserLight
{
..
})
=
do
printDebug
"[forgotUserPassword] userLight_id"
userLight_id
--printDebug "[forgotUserPassword] userLight_id" userLight_id
--logDebug $ "[forgotUserPassword]" :# ["userLight_id" .= userLight_id]
-- generate uuid for email
uuid
<-
generateForgotPasswordUUID
...
...
@@ -235,8 +258,10 @@ forgotUserPassword (UserLight { .. }) = do
pure
()
--------------------------
-- Generate a unique (in whole DB) UUID for passwords.
generateForgotPasswordUUID
::
(
Has
Settings
env
,
HasConnectionPool
env
,
HasJoseError
err
,
HasConfig
env
,
HasMail
env
)
generateForgotPasswordUUID
::
(
Has
ConnectionPool
env
,
HasConfig
env
,
HasMail
env
)
=>
Cmd'
env
err
UUID
generateForgotPasswordUUID
=
do
uuid
<-
liftBase
$
nextRandom
...
...
@@ -244,3 +269,36 @@ generateForgotPasswordUUID = do
case
us
of
[]
->
pure
uuid
_
->
generateForgotPasswordUUID
----------------------------
-- NOTE THe async endpoint is better for the "forget password"
-- request, because the delay in email sending etc won't reveal to
-- malicious users emails of our users in the db
type
ForgotPasswordAsyncAPI
=
Summary
"Forgot password asnc"
:>
AsyncJobs
JobLog
'[
J
SON
]
ForgotPasswordAsyncParams
JobLog
forgotPasswordAsync
::
GargServer
ForgotPasswordAsyncAPI
forgotPasswordAsync
=
serveJobsAPI
$
JobFunction
(
\
p
log'
->
forgotPasswordAsync'
p
(
liftBase
.
log'
)
)
forgotPasswordAsync'
::
(
FlowCmdM
env
err
m
)
=>
ForgotPasswordAsyncParams
->
(
JobLog
->
m
()
)
->
m
JobLog
forgotPasswordAsync'
(
ForgotPasswordAsyncParams
{
email
})
logStatus
=
do
let
jobLog
=
JobLog
{
_scst_succeeded
=
Just
1
,
_scst_failed
=
Just
0
,
_scst_remaining
=
Just
1
,
_scst_events
=
Just
[]
}
logStatus
jobLog
printDebug
"[forgotPasswordAsync'] email"
email
_
<-
forgotPasswordPost
$
ForgotPasswordRequest
{
_fpReq_email
=
email
}
pure
$
jobLogSuccess
jobLog
src/Gargantext/API/Admin/Settings.hs
View file @
2e060925
...
...
@@ -21,7 +21,7 @@ module Gargantext.API.Admin.Settings
-- import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
import
Codec.Serialise
(
Serialise
(),
serialise
)
import
Control.Lens
import
Control.Monad.Logger
import
Control.Monad.Logger
(
LogLevel
(
..
))
import
Control.Monad.Reader
import
Data.Maybe
(
fromMaybe
)
import
Data.Pool
(
Pool
,
createPool
)
...
...
src/Gargantext/API/Admin/Types.hs
View file @
2e060925
...
...
@@ -5,7 +5,7 @@
module
Gargantext.API.Admin.Types
where
import
Control.Lens
import
Control.Monad.Logger
import
Control.Monad.Logger
(
LogLevel
)
import
Data.ByteString
(
ByteString
)
import
GHC.Enum
import
GHC.Generics
(
Generic
)
...
...
src/Gargantext/API/Client.hs
View file @
2e060925
...
...
@@ -13,6 +13,7 @@ import Data.Text (Text)
import
Data.Time.Clock
import
Data.Vector
(
Vector
)
import
Gargantext.API
import
Gargantext.API.Admin.Auth
(
ForgotPasswordAsyncParams
)
import
Gargantext.API.Admin.Auth.Types
hiding
(
Token
)
import
Gargantext.API.Admin.Orchestrator.Types
import
Gargantext.API.Count
...
...
@@ -66,6 +67,11 @@ getBackendVersion :: ClientM Text
postAuth
::
AuthRequest
->
ClientM
AuthResponse
forgotPasswordPost
::
ForgotPasswordRequest
->
ClientM
ForgotPasswordResponse
forgotPasswordGet
::
Maybe
Text
->
ClientM
Text
postForgotPasswordAsync
::
ClientM
(
JobStatus
'S
a
fe
JobLog
)
postForgotPasswordAsyncJob
::
JobInput
Maybe
ForgotPasswordAsyncParams
->
ClientM
(
JobStatus
'S
a
fe
JobLog
)
killForgotPasswordAsyncJob
::
JobID
'U
n
safe
->
Maybe
Limit
->
Maybe
Offset
->
ClientM
(
JobStatus
'S
a
fe
JobLog
)
pollForgotPasswordAsyncJob
::
JobID
'U
n
safe
->
Maybe
Limit
->
Maybe
Offset
->
ClientM
(
JobStatus
'S
a
fe
JobLog
)
waitForgotPasswordAsyncJob
::
JobID
'U
n
safe
->
ClientM
(
JobOutput
JobLog
)
-- * admin api
getRoots
::
Token
->
ClientM
[
Node
HyperdataUser
]
...
...
@@ -442,6 +448,11 @@ getMetricsSample :<|> getMetricSample :<|> _ = client (Proxy :: Proxy (Flat EkgA
postAuth
:<|>
forgotPasswordPost
:<|>
forgotPasswordGet
:<|>
postForgotPasswordAsync
:<|>
postForgotPasswordAsyncJob
:<|>
killForgotPasswordAsyncJob
:<|>
pollForgotPasswordAsyncJob
:<|>
waitForgotPasswordAsyncJob
:<|>
getBackendVersion
:<|>
getRoots
:<|>
putRoots
...
...
src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
View file @
2e060925
...
...
@@ -48,7 +48,6 @@ type API = Summary " Documents from Write nodes."
------------------------------------------------------------------------
newtype
Params
=
Params
{
id
::
Int
}
deriving
(
Generic
,
Show
)
instance
FromJSON
Params
where
parseJSON
=
genericParseJSON
defaultOptions
instance
ToJSON
Params
where
...
...
src/Gargantext/API/Routes.hs
View file @
2e060925
...
...
@@ -28,7 +28,7 @@ import Servant.Auth.Swagger ()
import
Servant.Job.Async
import
Servant.Swagger.UI
import
Gargantext.API.Admin.Auth
(
ForgotPasswordAPI
,
withAccess
)
import
Gargantext.API.Admin.Auth
(
ForgotPasswordAPI
,
ForgotPasswordAsyncAPI
,
withAccess
)
import
Gargantext.API.Admin.Auth.Types
(
AuthRequest
,
AuthResponse
,
AuthenticatedUser
(
..
),
PathId
(
..
))
import
Gargantext.API.Admin.FrontEnd
(
FrontEndAPI
)
import
Gargantext.API.Context
...
...
@@ -73,6 +73,7 @@ type GargAPI' =
:>
ReqBody
'[
J
SON
]
AuthRequest
:>
Post
'[
J
SON
]
AuthResponse
:<|>
"forgot-password"
:>
ForgotPasswordAPI
:<|>
"async"
:>
"forgot-password"
:>
ForgotPasswordAsyncAPI
:<|>
GargVersion
-- TODO-ACCESS here we want to request a particular header for
-- auth and capabilities.
...
...
src/Gargantext/API/Server.hs
View file @
2e060925
...
...
@@ -28,7 +28,7 @@ import qualified Paths_gargantext as PG -- cabal magic build module
import
qualified
Gargantext.API.Public
as
Public
import
Gargantext.API.Admin.Auth.Types
(
AuthContext
)
import
Gargantext.API.Admin.Auth
(
auth
,
forgotPassword
)
import
Gargantext.API.Admin.Auth
(
auth
,
forgotPassword
,
forgotPasswordAsync
)
import
Gargantext.API.Admin.FrontEnd
(
frontEndServer
)
import
qualified
Gargantext.API.GraphQL
as
GraphQL
import
Gargantext.API.Prelude
...
...
@@ -45,6 +45,7 @@ serverGargAPI :: ToJSON err => Text -> GargServerM env err GargAPI
serverGargAPI
baseUrl
-- orchestrator
=
auth
:<|>
forgotPassword
:<|>
forgotPasswordAsync
:<|>
gargVersion
:<|>
serverPrivateGargAPI
:<|>
Public
.
api
baseUrl
...
...
src/Gargantext/Database/Prelude.hs
View file @
2e060925
...
...
@@ -16,6 +16,7 @@ module Gargantext.Database.Prelude where
import
Control.Exception
import
Control.Lens
(
Getter
,
view
)
import
Control.Monad.Except
--import Control.Monad.Logger (MonadLogger)
import
Control.Monad.Random
import
Control.Monad.Reader
import
Control.Monad.Trans.Control
(
MonadBaseControl
)
...
...
@@ -65,12 +66,14 @@ type CmdM'' env err m =
,
MonadError
err
m
,
MonadBaseControl
IO
m
,
MonadRandom
m
--, MonadLogger m
)
type
CmdM'
env
err
m
=
(
MonadReader
env
m
,
MonadError
err
m
,
MonadBaseControl
IO
m
--, MonadLogger m
-- , MonadRandom m
)
...
...
stack.yaml
View file @
2e060925
...
...
@@ -120,6 +120,10 @@ extra-deps:
subdirs
:
-
packages/base
-
monad-logger-aeson-0.2.0.0
# required by monad-logger-aeson
-
context-0.2.0.0@sha256:6b643adb4a64fe521873d08df0497f71f88e18b9ecff4b68b4eef938e446cfc9,1886
-
random-1.2.1
# Others dependencies (using stack resolver)
...
...
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