[forgot password] more forgot password work

NOTE: This doesn't compile yet because of HTML types.

gargantext.cabal

@@ -145,6 +145,7 @@ library
       Gargantext.API.Swagger
       Gargantext.API.Table
       Gargantext.API.ThrowAll
+      Gargantext.API.Types
       Gargantext.Core.Ext.IMT
       Gargantext.Core.Ext.IMTUser
       Gargantext.Core.Flow.Ngrams

src/Gargantext/API/Admin/Auth.hs

@@ -22,18 +22,21 @@ TODO-ACCESS Critical
 
 {-# LANGUAGE MonoLocalBinds      #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators      #-}
 
 module Gargantext.API.Admin.Auth
   ( auth
   , forgotPassword
   , withAccess
+  , ForgotPasswordAPI
   )
   where
 
 import Control.Lens (view)
+import Data.Text (Text)
 import Data.Text.Lazy (toStrict)
-import Data.Text.Lazy.Encoding (decodeUtf8)
-import Data.UUID (UUID)
+import qualified Data.Text.Lazy.Encoding as LE
+import Data.UUID (UUID, toText)
 import Data.UUID.V4 (nextRandom)
 import Servant
 import Servant.Auth.Server
@@ -41,8 +44,10 @@ import qualified Gargantext.Prelude.Crypto.Auth as Auth
 
 import Gargantext.API.Admin.Auth.Types
 import Gargantext.API.Admin.Types
-import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC)
-import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.API.Prelude (HasJoseError(..), joseError, HasServerError, GargServerC, GargServer)
+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.Database.Admin.Types.Node (NodeId(..), UserId)
 import Gargantext.Database.Prelude (Cmd', CmdM, HasConnectionPool, HasConfig)
@@ -62,7 +67,7 @@ makeTokenForUser uid = do
   jwtS <- view $ settings . jwtSettings
   e <- liftBase $ makeJWT (AuthenticatedUser uid) jwtS Nothing
   -- TODO-SECURITY here we can implement token expiration ^^.
-  either joseError (pure . toStrict . decodeUtf8) e
+  either joseError (pure . toStrict . LE.decodeUtf8) e
   -- TODO not sure about the encoding...
 
 checkAuthRequest :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env)
@@ -138,9 +143,21 @@ 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.
 -}
 
-forgotPassword :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env)
+type ForgotPasswordAPI = Summary "Forgot password POST API"
+                           :> ReqBody '[JSON] ForgotPasswordRequest
+                           :> Post '[JSON] ForgotPasswordResponse
+                         :<|> Summary "Forgot password GET API"
+                           :> QueryParam "uuid" Text
+                           :> Get '[HTML] Text
+
+  
+forgotPassword :: GargServer ForgotPasswordAPI
+     -- => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
+forgotPassword = forgotPasswordPost :<|> forgotPasswordGet
+
+forgotPasswordPost :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env)
      => ForgotPasswordRequest -> Cmd' env err ForgotPasswordResponse
-forgotPassword (ForgotPasswordRequest email) = do
+forgotPasswordPost (ForgotPasswordRequest email) = do
   us <- getUsersWithEmail email
   case us of
     [u] -> forgotUserPassword u
@@ -150,6 +167,11 @@ forgotPassword (ForgotPasswordRequest email) = do
   -- users' emails
   pure $ ForgotPasswordResponse "ok"
 
+forgotPasswordGet :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env)
+     => Maybe Text -> Cmd' env err Text
+forgotPasswordGet Nothing = pure ""
+forgotPasswordGet (Just uuid) = pure uuid
+
 forgotUserPassword :: (HasSettings env, HasConnectionPool env, HasJoseError err, HasConfig env, HasMail env)
      => UserLight -> Cmd' env err ()
 forgotUserPassword user@(UserLight { .. }) = do
@@ -160,7 +182,11 @@ forgotUserPassword user@(UserLight { .. }) = do
   -- save user with that uuid
   _ <- updateUserForgotPasswordUUID user uuid
 
+  let userUUID = UserLight { userLight_forgot_password_uuid = Just $ toText uuid, .. }
+
   -- send email with uuid link
+  cfg <- view $ mailSettings
+  mail cfg (ForgotPassword { user = userUUID })
 
   -- on uuid link enter: change user password and present it to the
   -- user

src/Gargantext/API/Client.hs

@@ -64,7 +64,8 @@ getBackendVersion :: ClientM Text
 
 -- * auth API
 postAuth :: AuthRequest -> ClientM AuthResponse
-forgotPassword :: ForgotPasswordRequest -> ClientM ForgotPasswordResponse
+forgotPasswordPost :: ForgotPasswordRequest -> ClientM ForgotPasswordResponse
+forgotPasswordGet :: Maybe Text -> ClientM Text
 
 -- * admin api
 getRoots :: Token -> ClientM [Node HyperdataUser]
@@ -439,7 +440,8 @@ clientApi = client (flatten apiGarg)
 getMetricsSample :<|> getMetricSample :<|> _ = client (Proxy :: Proxy (Flat EkgAPI))
 
 postAuth
-  :<|> forgotPassword
+  :<|> forgotPasswordPost
+  :<|> forgotPasswordGet
   :<|> getBackendVersion
   :<|> getRoots
   :<|> putRoots

src/Gargantext/API/GraphQL.hs

+{-# OPTIONS_GHC -fprint-potential-instances #-}
+
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DuplicateRecordFields #-}  -- permit duplications for field names in multiple constructors
 {-# LANGUAGE KindSignatures #-}  -- for use of Endpoint (name :: Symbol)
@@ -9,7 +11,6 @@ module Gargantext.API.GraphQL where
 import Data.ByteString.Lazy.Char8
   ( ByteString
   )
-import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Map (Map)
 import Data.Morpheus
   ( App
@@ -41,19 +42,16 @@ import qualified Gargantext.API.GraphQL.User as GQLUser
 import qualified Gargantext.API.GraphQL.UserInfo as GQLUserInfo
 import qualified Gargantext.API.GraphQL.TreeFirstLevel as GQLTree
 import Gargantext.API.Prelude (GargM, GargError)
+import Gargantext.API.Types
 import Gargantext.Core.Mail.Types (HasMail)
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import Gargantext.Prelude
 import GHC.Generics (Generic)
-import Network.HTTP.Media ((//), (/:))
-import qualified Prelude
 import Servant
   ( (:<|>) (..)
   , (:>)
-  , Accept (..)
   , Get
   , JSON
-  , MimeRender (..)
   , Post
   , ReqBody
   ,  ServerT
@@ -62,6 +60,7 @@ import qualified Servant.Auth as SA
 import qualified Servant.Auth.Server as SAS
 import Gargantext.API.Admin.Types (HasSettings)
 
+
 -- | Represents possible GraphQL queries.
 data Query m
   = Query
@@ -124,13 +123,6 @@ app = deriveApp rootResolver
 -- Now for some boilerplate to integrate the above GraphQL app with
 -- servant.
 
--- | HTML type is needed for the GraphQL Playground.
-data HTML deriving (Typeable)
-instance Accept HTML where
-  contentTypes _ = "text" // "html" /: ("charset", "utf-8") :| ["text" // "html"]
-instance MimeRender HTML ByteString where
-  mimeRender _ = Prelude.id
-
 -- | Servant route for the app we defined above.
 type GQAPI = ReqBody '[JSON] GQLRequest :> Post '[JSON] GQLResponse
 -- type Schema = "schema" :> Get '[PlainText] Text

src/Gargantext/API/Ngrams/List.hs

@@ -16,7 +16,6 @@ module Gargantext.API.Ngrams.List
   where
 
 import Control.Lens hiding (elements, Indexed)
-import Data.Aeson
 import Data.Either (Either(..))
 import Data.HashMap.Strict (HashMap)
 import Data.Map (Map, toList)
@@ -31,6 +30,7 @@ import Gargantext.API.Ngrams.Prelude (getNgramsList)
 import Gargantext.API.Ngrams.Tools (getTermsWith)
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude (GargServer)
+import Gargantext.API.Types
 import Gargantext.Core.NodeStory
 import Gargantext.Core.Text.Terms (ExtractedNgrams(..))
 import Gargantext.Core.Text.Terms.WithList (buildPatterns, termsInText)
@@ -46,7 +46,6 @@ import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Node (_node_parent_id)
 import Gargantext.Database.Types (Indexed(..))
 import Gargantext.Prelude
-import Network.HTTP.Media ((//), (/:))
 import Servant
 import Servant.Job.Async
 import qualified Data.ByteString.Lazy as BSL
@@ -67,12 +66,6 @@ type GETAPI = Summary "Get List"
 getApi :: GargServer GETAPI
 getApi = get
 
-data HTML
-instance Accept HTML where
-  contentType _ = "text" // "html" /: ("charset", "utf-8")
-instance ToJSON a => MimeRender HTML a where
-  mimeRender _ = encode
-
 ----------------------
 type JSONAPI = Summary "Update List"
           :> "lists"

src/Gargantext/API/Routes.hs

@@ -28,8 +28,8 @@ import Servant.Auth.Swagger ()
 import Servant.Job.Async
 import Servant.Swagger.UI
 
-import Gargantext.API.Admin.Auth (withAccess)
-import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), ForgotPasswordRequest, ForgotPasswordResponse, PathId(..))
+import Gargantext.API.Admin.Auth (ForgotPasswordAPI, withAccess)
+import Gargantext.API.Admin.Auth.Types (AuthRequest, AuthResponse, AuthenticatedUser(..), PathId(..))
 import Gargantext.API.Admin.FrontEnd (FrontEndAPI)
 import Gargantext.API.Context
 import Gargantext.API.Count  (CountAPI, count, Query)
@@ -72,9 +72,7 @@ type GargAPI' =
                 "auth"  :> Summary "AUTH API"
                         :> ReqBody '[JSON] AuthRequest
                         :> Post    '[JSON] AuthResponse
-          :<|> "forgotPassword" :> Summary "Forgot password API"
-                                :> ReqBody '[JSON] ForgotPasswordRequest
-                                :> Post '[JSON] ForgotPasswordResponse
+          :<|> "forgot-password" :> ForgotPasswordAPI
           :<|> GargVersion
                    -- TODO-ACCESS here we want to request a particular header for
            -- auth and capabilities.

src/Gargantext/API/Types.hs

+{-# OPTIONS_GHC -fprint-potential-instances #-}
+
+module Gargantext.API.Types where
+
+import Data.Aeson
+import Data.ByteString.Lazy.Char8 (ByteString)
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.Typeable
+import Network.HTTP.Media ((//), (/:))
+import qualified Prelude
+import Servant
+  ( Accept(..)
+  , MimeRender(..) )
+
+data HTML deriving (Typeable)
+instance Accept HTML where
+  contentTypes _ = "text" // "html" /: ("charset", "utf-8") :| ["text" // "html"]
+instance MimeRender HTML ByteString where
+  mimeRender _ = Prelude.id
+instance ToJSON a => MimeRender HTML a where
+  mimeRender _ = encode

src/Gargantext/Core/Mail.hs

@@ -14,6 +14,7 @@ module Gargantext.Core.Mail where
 import Control.Lens (view)
 import Data.Text (Text, unlines, splitOn)
 import Gargantext.Core.Types.Individu
+import Gargantext.Database.Schema.User (UserLight(..))
 import Gargantext.Prelude
 import Gargantext.Prelude.Config (gc_url)
 import Gargantext.Database.Prelude
@@ -39,6 +40,7 @@ data MailModel = Invitation { invitation_user :: NewUser GargPassword }
                | MailInfo   { mailInfo_username :: Name
                             , mailInfo_address  :: EmailAddress
                             }
+               | ForgotPassword { user :: UserLight }
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 mail :: (CmdM env err m) => MailConfig -> MailModel -> m ()
@@ -66,6 +68,7 @@ email_to :: MailModel -> (EmailAddress, Name)
 email_to (Invitation user) = email_to' user
 email_to (PassUpdate user) = email_to' user
 email_to (MailInfo { .. })    = (mailInfo_address, mailInfo_username)
+email_to (ForgotPassword { user = UserLight { .. }}) = (userLight_email, userLight_username)
 
 email_to' :: NewUser GargPassword -> (EmailAddress, Name)
 email_to' (NewUser u m _) = (m,u)
@@ -80,12 +83,21 @@ bodyWith server (PassUpdate u) = [ "Your account password have been updated on t
                                  ] <> (email_credentials server u)
 
 bodyWith server (MailInfo _ _) = [ "Your last analysis is over on the server: " <> server]
+bodyWith _server (ForgotPassword { user = UserLight { userLight_forgot_password_uuid = Nothing }}) =
+  [ "Cannot send you link to forgot password, no UUID" ]
+bodyWith server (ForgotPassword { user = UserLight { userLight_forgot_password_uuid = Just uuid }}) =
+  [ "Click on this link to restore your password: "
+  , forgot_password_link server uuid ]
+
+forgot_password_link :: ServerAddress -> Text -> Text
+forgot_password_link server uuid = server <> "/forgot-password?uuid=" <> uuid
 
 ------------------------------------------------------------------------
 email_subject :: MailModel -> Text
 email_subject (Invitation _) = "[GarganText] Invitation"
 email_subject (PassUpdate _) = "[GarganText] Update"
 email_subject (MailInfo _ _) = "[GarganText] Info"
+email_subject (ForgotPassword _) = "[GarganText] Forgot Password"
 
 
 email_credentials :: ServerAddress -> NewUser GargPassword -> [Text]

stack.yaml

@@ -26,7 +26,8 @@ nix:
 
 allow-newer: true
 
-#ghc-options:
+ghc-options:
+  "$everything": -fprint-potential-instances
 #  "$everything": -haddock
 
 extra-deps: