Commit 2e060925 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[auth] forgot password async endpoint

parent 001f94a7
Pipeline #2838 failed with stage
in 33 minutes and 21 seconds
...@@ -412,6 +412,7 @@ library ...@@ -412,6 +412,7 @@ library
, matrix , matrix
, monad-control , monad-control
, monad-logger , monad-logger
, monad-logger-aeson
, morpheus-graphql , morpheus-graphql
, morpheus-graphql-app , morpheus-graphql-app
, morpheus-graphql-core , morpheus-graphql-core
......
...@@ -199,6 +199,7 @@ library: ...@@ -199,6 +199,7 @@ library:
- matrix - matrix
- monad-control - monad-control
- monad-logger - monad-logger
- monad-logger-aeson
- morpheus-graphql - morpheus-graphql
- morpheus-graphql-app - morpheus-graphql-app
- morpheus-graphql-core - morpheus-graphql-core
......
...@@ -27,19 +27,27 @@ TODO-ACCESS Critical ...@@ -27,19 +27,27 @@ TODO-ACCESS Critical
module Gargantext.API.Admin.Auth module Gargantext.API.Admin.Auth
( auth ( auth
, forgotPassword , forgotPassword
, forgotPasswordAsync
, withAccess , withAccess
, ForgotPasswordAPI , ForgotPasswordAPI
, ForgotPasswordAsyncParams
, ForgotPasswordAsyncAPI
) )
where where
import Control.Lens (view, (#)) import Control.Lens (view, (#))
--import Control.Monad.Logger.Aeson
import Data.Aeson
import Data.Swagger (ToSchema(..))
import Data.Text (Text) import Data.Text (Text)
import Data.Text.Lazy (toStrict) import Data.Text.Lazy (toStrict)
import qualified Data.Text.Lazy.Encoding as LE import qualified Data.Text.Lazy.Encoding as LE
import Data.UUID (UUID, fromText, toText) import Data.UUID (UUID, fromText, toText)
import Data.UUID.V4 (nextRandom) import Data.UUID.V4 (nextRandom)
import GHC.Generics (Generic)
import Servant import Servant
import Servant.Auth.Server import Servant.Auth.Server
import Servant.Job.Async (JobFunction(..), serveJobsAPI)
import qualified Text.Blaze.Html.Renderer.Text as H import qualified Text.Blaze.Html.Renderer.Text as H
import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5 as H
--import qualified Text.Blaze.Html5.Attributes as HA --import qualified Text.Blaze.Html5.Attributes as HA
...@@ -47,13 +55,16 @@ import qualified Text.Blaze.Html5 as H ...@@ -47,13 +55,16 @@ import qualified Text.Blaze.Html5 as H
import qualified Gargantext.Prelude.Crypto.Auth as Auth import qualified Gargantext.Prelude.Crypto.Auth as Auth
import Gargantext.API.Admin.Auth.Types import Gargantext.API.Admin.Auth.Types
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Admin.Types import Gargantext.API.Admin.Types
import Gargantext.API.Job (jobLogSuccess)
import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC, GargServer, _ServerError) import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC, GargServer, _ServerError)
import Gargantext.API.Types import Gargantext.API.Types
import Gargantext.Core.Mail (MailModel(..), mail) import Gargantext.Core.Mail (MailModel(..), mail)
import Gargantext.Core.Mail.Types (HasMail, mailSettings) import Gargantext.Core.Mail.Types (HasMail, mailSettings)
import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..)) import Gargantext.Core.Types.Individu (User(..), Username, GargPassword(..))
import Gargantext.Core.Utils (randomString) import Gargantext.Core.Utils (randomString)
import Gargantext.Database.Action.Flow.Types (FlowCmdM)
import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId) import Gargantext.Database.Admin.Types.Node (NodeId(..), UserId)
import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig) import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig)
import Gargantext.Database.Query.Table.User import Gargantext.Database.Query.Table.User
...@@ -148,6 +159,15 @@ User can invite User in Team as NodeNode only if Team in his parents. ...@@ -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. 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" type ForgotPasswordAPI = Summary "Forgot password POST API"
:> ReqBody '[JSON] ForgotPasswordRequest :> ReqBody '[JSON] ForgotPasswordRequest
:> Post '[JSON] ForgotPasswordResponse :> Post '[JSON] ForgotPasswordResponse
...@@ -160,7 +180,7 @@ forgotPassword :: GargServer ForgotPasswordAPI ...@@ -160,7 +180,7 @@ forgotPassword :: GargServer ForgotPasswordAPI
-- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse -- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
forgotPassword = forgotPasswordPost :<|> forgotPasswordGet 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 => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
forgotPasswordPost (ForgotPasswordRequest email) = do forgotPasswordPost (ForgotPasswordRequest email) = do
us <- getUsersWithEmail email us <- getUsersWithEmail email
...@@ -186,6 +206,8 @@ forgotPasswordGet (Just uuid) = do ...@@ -186,6 +206,8 @@ forgotPasswordGet (Just uuid) = do
[u] -> forgotPasswordGetUser u [u] -> forgotPasswordGetUser u
_ -> throwError $ _ServerError # err404 { errBody = "Not found" } _ -> throwError $ _ServerError # err404 { errBody = "Not found" }
---------------------
forgotPasswordGetUser :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env, HasServerError err) forgotPasswordGetUser :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env, HasServerError err)
=> UserLight -> Cmd' env err Text => UserLight -> Cmd' env err Text
forgotPasswordGetUser (UserLight { .. }) = do forgotPasswordGetUser (UserLight { .. }) = do
...@@ -214,10 +236,11 @@ forgotPasswordGetUser (UserLight { .. }) = do ...@@ -214,10 +236,11 @@ forgotPasswordGetUser (UserLight { .. }) = do
H.span "Here is your password (will be shown only once): " H.span "Here is your password (will be shown only once): "
H.b $ H.toHtml password H.b $ H.toHtml password
forgotUserPassword :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env) forgotUserPassword :: (HasConnectionPool env, HasConfig env, HasMail env)
=> UserLight -> Cmd' env err () => UserLight -> Cmd' env err ()
forgotUserPassword (UserLight { .. }) = do 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 -- generate uuid for email
uuid <- generateForgotPasswordUUID uuid <- generateForgotPasswordUUID
...@@ -235,8 +258,10 @@ forgotUserPassword (UserLight { .. }) = do ...@@ -235,8 +258,10 @@ forgotUserPassword (UserLight { .. }) = do
pure () pure ()
--------------------------
-- Generate a unique (in whole DB) UUID for passwords. -- Generate a unique (in whole DB) UUID for passwords.
generateForgotPasswordUUID :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env) generateForgotPasswordUUID :: (HasConnectionPool env, HasConfig env, HasMail env)
=> Cmd' env err UUID => Cmd' env err UUID
generateForgotPasswordUUID = do generateForgotPasswordUUID = do
uuid <- liftBase $ nextRandom uuid <- liftBase $ nextRandom
...@@ -244,3 +269,36 @@ generateForgotPasswordUUID = do ...@@ -244,3 +269,36 @@ generateForgotPasswordUUID = do
case us of case us of
[] -> pure uuid [] -> pure uuid
_ -> generateForgotPasswordUUID _ -> 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 '[JSON] 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
...@@ -21,7 +21,7 @@ module Gargantext.API.Admin.Settings ...@@ -21,7 +21,7 @@ module Gargantext.API.Admin.Settings
-- import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction) -- import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceFreq, debounceAction)
import Codec.Serialise (Serialise(), serialise) import Codec.Serialise (Serialise(), serialise)
import Control.Lens import Control.Lens
import Control.Monad.Logger import Control.Monad.Logger (LogLevel(..))
import Control.Monad.Reader import Control.Monad.Reader
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Pool (Pool, createPool) import Data.Pool (Pool, createPool)
......
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
module Gargantext.API.Admin.Types where module Gargantext.API.Admin.Types where
import Control.Lens import Control.Lens
import Control.Monad.Logger import Control.Monad.Logger (LogLevel)
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import GHC.Enum import GHC.Enum
import GHC.Generics (Generic) import GHC.Generics (Generic)
......
...@@ -13,6 +13,7 @@ import Data.Text (Text) ...@@ -13,6 +13,7 @@ import Data.Text (Text)
import Data.Time.Clock import Data.Time.Clock
import Data.Vector (Vector) import Data.Vector (Vector)
import Gargantext.API import Gargantext.API
import Gargantext.API.Admin.Auth (ForgotPasswordAsyncParams)
import Gargantext.API.Admin.Auth.Types hiding (Token) import Gargantext.API.Admin.Auth.Types hiding (Token)
import Gargantext.API.Admin.Orchestrator.Types import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Count import Gargantext.API.Count
...@@ -66,6 +67,11 @@ getBackendVersion :: ClientM Text ...@@ -66,6 +67,11 @@ getBackendVersion :: ClientM Text
postAuth :: AuthRequest -> ClientM AuthResponse postAuth :: AuthRequest -> ClientM AuthResponse
forgotPasswordPost :: ForgotPasswordRequest -> ClientM ForgotPasswordResponse forgotPasswordPost :: ForgotPasswordRequest -> ClientM ForgotPasswordResponse
forgotPasswordGet :: Maybe Text -> ClientM Text forgotPasswordGet :: Maybe Text -> ClientM Text
postForgotPasswordAsync :: ClientM (JobStatus 'Safe JobLog)
postForgotPasswordAsyncJob :: JobInput Maybe ForgotPasswordAsyncParams -> ClientM (JobStatus 'Safe JobLog)
killForgotPasswordAsyncJob :: JobID 'Unsafe -> Maybe Limit -> Maybe Offset -> ClientM (JobStatus 'Safe JobLog)
pollForgotPasswordAsyncJob :: JobID 'Unsafe -> Maybe Limit -> Maybe Offset -> ClientM (JobStatus 'Safe JobLog)
waitForgotPasswordAsyncJob :: JobID 'Unsafe -> ClientM (JobOutput JobLog)
-- * admin api -- * admin api
getRoots :: Token -> ClientM [Node HyperdataUser] getRoots :: Token -> ClientM [Node HyperdataUser]
...@@ -442,6 +448,11 @@ getMetricsSample :<|> getMetricSample :<|> _ = client (Proxy :: Proxy (Flat EkgA ...@@ -442,6 +448,11 @@ getMetricsSample :<|> getMetricSample :<|> _ = client (Proxy :: Proxy (Flat EkgA
postAuth postAuth
:<|> forgotPasswordPost :<|> forgotPasswordPost
:<|> forgotPasswordGet :<|> forgotPasswordGet
:<|> postForgotPasswordAsync
:<|> postForgotPasswordAsyncJob
:<|> killForgotPasswordAsyncJob
:<|> pollForgotPasswordAsyncJob
:<|> waitForgotPasswordAsyncJob
:<|> getBackendVersion :<|> getBackendVersion
:<|> getRoots :<|> getRoots
:<|> putRoots :<|> putRoots
......
...@@ -48,7 +48,6 @@ type API = Summary " Documents from Write nodes." ...@@ -48,7 +48,6 @@ type API = Summary " Documents from Write nodes."
------------------------------------------------------------------------ ------------------------------------------------------------------------
newtype Params = Params { id :: Int } newtype Params = Params { id :: Int }
deriving (Generic, Show) deriving (Generic, Show)
instance FromJSON Params where instance FromJSON Params where
parseJSON = genericParseJSON defaultOptions parseJSON = genericParseJSON defaultOptions
instance ToJSON Params where instance ToJSON Params where
......
...@@ -28,7 +28,7 @@ import Servant.Auth.Swagger () ...@@ -28,7 +28,7 @@ import Servant.Auth.Swagger ()
import Servant.Job.Async import Servant.Job.Async
import Servant.Swagger.UI 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.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), PathId(..))
import Gargantext.API.Admin.FrontEnd (FrontEndAPI) import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
import Gargantext.API.Context import Gargantext.API.Context
...@@ -73,6 +73,7 @@ type GargAPI' = ...@@ -73,6 +73,7 @@ type GargAPI' =
:> ReqBody '[JSON] AuthRequest :> ReqBody '[JSON] AuthRequest
:> Post '[JSON] AuthResponse :> Post '[JSON] AuthResponse
:<|> "forgot-password" :> ForgotPasswordAPI :<|> "forgot-password" :> ForgotPasswordAPI
:<|> "async" :> "forgot-password" :> ForgotPasswordAsyncAPI
:<|> GargVersion :<|> GargVersion
-- TODO-ACCESS here we want to request a particular header for -- TODO-ACCESS here we want to request a particular header for
-- auth and capabilities. -- auth and capabilities.
......
...@@ -28,7 +28,7 @@ import qualified Paths_gargantext as PG -- cabal magic build module ...@@ -28,7 +28,7 @@ import qualified Paths_gargantext as PG -- cabal magic build module
import qualified Gargantext.API.Public as Public import qualified Gargantext.API.Public as Public
import Gargantext.API.Admin.Auth.Types (AuthContext) 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 Gargantext.API.Admin.FrontEnd (frontEndServer)
import qualified Gargantext.API.GraphQL as GraphQL import qualified Gargantext.API.GraphQL as GraphQL
import Gargantext.API.Prelude import Gargantext.API.Prelude
...@@ -45,6 +45,7 @@ serverGargAPI :: ToJSON err => Text -> GargServerM env err GargAPI ...@@ -45,6 +45,7 @@ serverGargAPI :: ToJSON err => Text -> GargServerM env err GargAPI
serverGargAPI baseUrl -- orchestrator serverGargAPI baseUrl -- orchestrator
= auth = auth
:<|> forgotPassword :<|> forgotPassword
:<|> forgotPasswordAsync
:<|> gargVersion :<|> gargVersion
:<|> serverPrivateGargAPI :<|> serverPrivateGargAPI
:<|> Public.api baseUrl :<|> Public.api baseUrl
......
...@@ -16,6 +16,7 @@ module Gargantext.Database.Prelude where ...@@ -16,6 +16,7 @@ module Gargantext.Database.Prelude where
import Control.Exception import Control.Exception
import Control.Lens (Getter, view) import Control.Lens (Getter, view)
import Control.Monad.Except import Control.Monad.Except
--import Control.Monad.Logger (MonadLogger)
import Control.Monad.Random import Control.Monad.Random
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Control (MonadBaseControl)
...@@ -65,12 +66,14 @@ type CmdM'' env err m = ...@@ -65,12 +66,14 @@ type CmdM'' env err m =
, MonadError err m , MonadError err m
, MonadBaseControl IO m , MonadBaseControl IO m
, MonadRandom m , MonadRandom m
--, MonadLogger m
) )
type CmdM' env err m = type CmdM' env err m =
( MonadReader env m ( MonadReader env m
, MonadError err m , MonadError err m
, MonadBaseControl IO m , MonadBaseControl IO m
--, MonadLogger m
-- , MonadRandom m -- , MonadRandom m
) )
......
...@@ -120,6 +120,10 @@ extra-deps: ...@@ -120,6 +120,10 @@ extra-deps:
subdirs: subdirs:
- packages/base - 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 - random-1.2.1
# Others dependencies (using stack resolver) # Others dependencies (using stack resolver)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment