{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.Interaction.User
  ( makeResetPasswordLinkAction,
    doPasswordResetAction,
    deleteUserAction,
    inviteUserAction,
  )
where

import Data.Text (pack, unpack)
import NeatInterpolation
import Network.HTTP.Base qualified
import Relude
import WikiMusic.Free.MailCommand
import WikiMusic.Free.UserCommand as UC
import WikiMusic.Free.UserQuery as UQ
import WikiMusic.Interaction.Model.User
import WikiMusic.Model.Mail
import WikiMusic.Protolude

makeResetPasswordLinkAction ::
  (UserCommand :<: f, MailCommand :<: f) =>
  Env ->
  Text ->
  Free f (Either UserError MakeResetPasswordLinkResponse)
makeResetPasswordLinkAction :: forall (f :: * -> *).
(UserCommand :<: f, MailCommand :<: f) =>
Env
-> Text -> Free f (Either UserError MakeResetPasswordLinkResponse)
makeResetPasswordLinkAction Env
env Text
userEmail = do
  Either UserCommandError Text
maybeToken <- Env -> UserEmail -> Free f (Either UserCommandError Text)
forall (f :: * -> *).
(UserCommand :<: f) =>
Env -> UserEmail -> Free f (Either UserCommandError Text)
makeResetPasswordLink Env
env (Text -> UserEmail
UC.UserEmail Text
userEmail)
  Env
-> Either UserCommandError Text
-> Text
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall (f :: * -> *).
(UserCommand :<: f, MailCommand :<: f) =>
Env
-> Either UserCommandError Text
-> Text
-> Free f (Either UserError MakeResetPasswordLinkResponse)
doSendMailFromResetToken Env
env Either UserCommandError Text
maybeToken Text
userEmail

doPasswordResetAction :: (UserCommand :<: f, UserQuery :<: f, MailCommand :<: f) => Env -> DoPasswordResetRequest -> Free f (Either UserError ())
doPasswordResetAction :: forall (f :: * -> *).
(UserCommand :<: f, UserQuery :<: f, MailCommand :<: f) =>
Env -> DoPasswordResetRequest -> Free f (Either UserError ())
doPasswordResetAction Env
env DoPasswordResetRequest
req
  | (DoPasswordResetRequest
req DoPasswordResetRequest
-> Optic' A_Lens NoIx DoPasswordResetRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DoPasswordResetRequest Text
#password) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (DoPasswordResetRequest
req DoPasswordResetRequest
-> Optic' A_Lens NoIx DoPasswordResetRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DoPasswordResetRequest Text
#passwordConfirm) = do
      Either UserQueryError Bool
isTokenMatch <- Env
-> UserEmail -> UserToken -> Free f (Either UserQueryError Bool)
forall (f :: * -> *).
(UserQuery :<: f) =>
Env
-> UserEmail -> UserToken -> Free f (Either UserQueryError Bool)
doesTokenMatchByEmail Env
env (Text -> UserEmail
UQ.UserEmail (Text -> UserEmail) -> Text -> UserEmail
forall a b. (a -> b) -> a -> b
$ DoPasswordResetRequest
req DoPasswordResetRequest
-> Optic' A_Lens NoIx DoPasswordResetRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DoPasswordResetRequest Text
#email) (Text -> UserToken
UserToken (Text -> UserToken) -> Text -> UserToken
forall a b. (a -> b) -> a -> b
$ DoPasswordResetRequest
req DoPasswordResetRequest
-> Optic' A_Lens NoIx DoPasswordResetRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DoPasswordResetRequest Text
#token)
      case Either UserQueryError Bool
isTokenMatch of
        Left UserQueryError
e -> Either UserError () -> Free f (Either UserError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserError () -> Free f (Either UserError ()))
-> (UserQueryError -> Either UserError ())
-> UserQueryError
-> Free f (Either UserError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserError -> Either UserError ()
forall a b. a -> Either a b
Left (UserError -> Either UserError ())
-> (UserQueryError -> UserError)
-> UserQueryError
-> Either UserError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UserError
SomeError (Text -> UserError)
-> (UserQueryError -> Text) -> UserQueryError -> UserError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (UserQueryError -> String) -> UserQueryError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserQueryError -> String
forall b a. (Show a, IsString b) => a -> b
show (UserQueryError -> Free f (Either UserError ()))
-> UserQueryError -> Free f (Either UserError ())
forall a b. (a -> b) -> a -> b
$ UserQueryError
e
        Right Bool
doesMatch -> Env
-> DoPasswordResetRequest -> Bool -> Free f (Either UserError ())
forall (f :: * -> *).
(UserCommand :<: f) =>
Env
-> DoPasswordResetRequest -> Bool -> Free f (Either UserError ())
whenTokenMatches Env
env DoPasswordResetRequest
req Bool
doesMatch
  | Bool
otherwise = Either UserError () -> Free f (Either UserError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserError () -> Free f (Either UserError ()))
-> (Text -> Either UserError ())
-> Text
-> Free f (Either UserError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserError -> Either UserError ()
forall a b. a -> Either a b
Left (UserError -> Either UserError ())
-> (Text -> UserError) -> Text -> Either UserError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UserError
SomeError (Text -> Free f (Either UserError ()))
-> Text -> Free f (Either UserError ())
forall a b. (a -> b) -> a -> b
$ Text
"Passwords must match!"

whenTokenMatches ::
  (UserCommand :<: f) =>
  Env ->
  DoPasswordResetRequest ->
  Bool ->
  Free f (Either UserError ())
whenTokenMatches :: forall (f :: * -> *).
(UserCommand :<: f) =>
Env
-> DoPasswordResetRequest -> Bool -> Free f (Either UserError ())
whenTokenMatches Env
_ DoPasswordResetRequest
_ Bool
False = Either UserError () -> Free f (Either UserError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserError () -> Free f (Either UserError ()))
-> (UserError -> Either UserError ())
-> UserError
-> Free f (Either UserError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserError -> Either UserError ()
forall a b. a -> Either a b
Left (UserError -> Free f (Either UserError ()))
-> UserError -> Free f (Either UserError ())
forall a b. (a -> b) -> a -> b
$ UserError
AccessUnauthorizedError
whenTokenMatches Env
env DoPasswordResetRequest
req Bool
True = do
  Either UserCommandError ()
hasChangedPass <- Env
-> UserEmail -> UserPassword -> Free f (Either UserCommandError ())
forall (f :: * -> *).
(UserCommand :<: f) =>
Env
-> UserEmail -> UserPassword -> Free f (Either UserCommandError ())
changePasswordByEmail Env
env (Text -> UserEmail
UC.UserEmail (Text -> UserEmail) -> Text -> UserEmail
forall a b. (a -> b) -> a -> b
$ DoPasswordResetRequest
req DoPasswordResetRequest
-> Optic' A_Lens NoIx DoPasswordResetRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DoPasswordResetRequest Text
#email) (Text -> UserPassword
UC.UserPassword (Text -> UserPassword) -> Text -> UserPassword
forall a b. (a -> b) -> a -> b
$ DoPasswordResetRequest
req DoPasswordResetRequest
-> Optic' A_Lens NoIx DoPasswordResetRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DoPasswordResetRequest Text
#password)
  case Either UserCommandError ()
hasChangedPass of
    Left UserCommandError
e -> Either UserError () -> Free f (Either UserError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserError () -> Free f (Either UserError ()))
-> (UserCommandError -> Either UserError ())
-> UserCommandError
-> Free f (Either UserError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserError -> Either UserError ()
forall a b. a -> Either a b
Left (UserError -> Either UserError ())
-> (UserCommandError -> UserError)
-> UserCommandError
-> Either UserError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UserError
SomeError (Text -> UserError)
-> (UserCommandError -> Text) -> UserCommandError -> UserError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (UserCommandError -> String) -> UserCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserCommandError -> String
forall b a. (Show a, IsString b) => a -> b
show (UserCommandError -> Free f (Either UserError ()))
-> UserCommandError -> Free f (Either UserError ())
forall a b. (a -> b) -> a -> b
$ UserCommandError
e
    Right ()
_ -> do
      Either UserCommandError ()
hasInvalidatedToken <- Env -> UserEmail -> Free f (Either UserCommandError ())
forall (f :: * -> *).
(UserCommand :<: f) =>
Env -> UserEmail -> Free f (Either UserCommandError ())
invalidateResetTokenByEmail Env
env (Text -> UserEmail
UC.UserEmail (Text -> UserEmail) -> Text -> UserEmail
forall a b. (a -> b) -> a -> b
$ DoPasswordResetRequest
req DoPasswordResetRequest
-> Optic' A_Lens NoIx DoPasswordResetRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DoPasswordResetRequest Text
#email)
      Either UserError () -> Free f (Either UserError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserError () -> Free f (Either UserError ()))
-> Either UserError () -> Free f (Either UserError ())
forall a b. (a -> b) -> a -> b
$ (UserCommandError -> UserError)
-> Either UserCommandError () -> Either UserError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> UserError
SomeError (Text -> UserError)
-> (UserCommandError -> Text) -> UserCommandError -> UserError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (UserCommandError -> String) -> UserCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserCommandError -> String
forall b a. (Show a, IsString b) => a -> b
show) Either UserCommandError ()
hasInvalidatedToken

deleteUserAction ::
  (UserCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  DeleteUsersRequest ->
  Free f (Either UserError ())
deleteUserAction :: forall (f :: * -> *).
(UserCommand :<: f) =>
Env
-> WikiMusicUser
-> DeleteUsersRequest
-> Free f (Either UserError ())
deleteUserAction Env
env WikiMusicUser
authUser DeleteUsersRequest
req = do
  WikiMusicUser
-> ([UserRole] -> Bool)
-> UserError
-> Free f (Either UserError ())
-> Free f (Either UserError ())
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastSuperUser UserError
AccessUnauthorizedError (Free f (Either UserError ()) -> Free f (Either UserError ()))
-> Free f (Either UserError ()) -> Free f (Either UserError ())
forall a b. (a -> b) -> a -> b
$ do
    Either UserCommandError ()
s <- Env
-> WikiMusicUser
-> UserEmail
-> Free f (Either UserCommandError ())
forall (f :: * -> *).
(UserCommand :<: f) =>
Env
-> WikiMusicUser
-> UserEmail
-> Free f (Either UserCommandError ())
deleteUser Env
env WikiMusicUser
authUser (Text -> UserEmail
UC.UserEmail (Text -> UserEmail) -> Text -> UserEmail
forall a b. (a -> b) -> a -> b
$ DeleteUsersRequest
req DeleteUsersRequest
-> Optic' An_Iso NoIx DeleteUsersRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx DeleteUsersRequest Text
#email)
    Either UserError () -> Free f (Either UserError ())
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserError () -> Free f (Either UserError ()))
-> Either UserError () -> Free f (Either UserError ())
forall a b. (a -> b) -> a -> b
$ (UserCommandError -> UserError)
-> Either UserCommandError () -> Either UserError ()
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> UserError
SomeError (Text -> UserError)
-> (UserCommandError -> Text) -> UserCommandError -> UserError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (UserCommandError -> String) -> UserCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserCommandError -> String
forall b a. (Show a, IsString b) => a -> b
show) Either UserCommandError ()
s

inviteUserAction ::
  (UserCommand :<: f, MailCommand :<: f) =>
  Env ->
  WikiMusicUser ->
  InviteUsersRequest ->
  Free f (Either UserError MakeResetPasswordLinkResponse)
inviteUserAction :: forall (f :: * -> *).
(UserCommand :<: f, MailCommand :<: f) =>
Env
-> WikiMusicUser
-> InviteUsersRequest
-> Free f (Either UserError MakeResetPasswordLinkResponse)
inviteUserAction Env
env WikiMusicUser
authUser InviteUsersRequest
req = do
  WikiMusicUser
-> ([UserRole] -> Bool)
-> UserError
-> Free f (Either UserError MakeResetPasswordLinkResponse)
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall (f :: * -> *) p b.
Applicative f =>
WikiMusicUser
-> ([UserRole] -> Bool) -> p -> f (Either p b) -> f (Either p b)
doWithRoles' WikiMusicUser
authUser [UserRole] -> Bool
isAtLeastMaintainer UserError
AccessUnauthorizedError (Free f (Either UserError MakeResetPasswordLinkResponse)
 -> Free f (Either UserError MakeResetPasswordLinkResponse))
-> Free f (Either UserError MakeResetPasswordLinkResponse)
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall a b. (a -> b) -> a -> b
$ do
    Either UserCommandError Text
maybeToken <- Env
-> WikiMusicUser
-> UserEmail
-> UserName
-> UserRole
-> Maybe Text
-> Free f (Either UserCommandError Text)
forall (f :: * -> *).
(UserCommand :<: f) =>
Env
-> WikiMusicUser
-> UserEmail
-> UserName
-> UserRole
-> Maybe Text
-> Free f (Either UserCommandError Text)
inviteUser Env
env WikiMusicUser
authUser (Text -> UserEmail
UC.UserEmail (Text -> UserEmail) -> Text -> UserEmail
forall a b. (a -> b) -> a -> b
$ InviteUsersRequest
req InviteUsersRequest
-> Optic' A_Lens NoIx InviteUsersRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx InviteUsersRequest Text
#email) (Text -> UserName
UC.UserName (Text -> UserName) -> Text -> UserName
forall a b. (a -> b) -> a -> b
$ InviteUsersRequest
req InviteUsersRequest
-> Optic' A_Lens NoIx InviteUsersRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx InviteUsersRequest Text
#displayName) (InviteUsersRequest
req InviteUsersRequest
-> Optic' A_Lens NoIx InviteUsersRequest UserRole -> UserRole
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx InviteUsersRequest UserRole
#role) (InviteUsersRequest
req InviteUsersRequest
-> Optic' A_Lens NoIx InviteUsersRequest (Maybe Text) -> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx InviteUsersRequest (Maybe Text)
#description)
    Env
-> Either UserCommandError Text
-> Text
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall (f :: * -> *).
(UserCommand :<: f, MailCommand :<: f) =>
Env
-> Either UserCommandError Text
-> Text
-> Free f (Either UserError MakeResetPasswordLinkResponse)
doSendMailFromResetToken Env
env Either UserCommandError Text
maybeToken (InviteUsersRequest
req InviteUsersRequest
-> Optic' A_Lens NoIx InviteUsersRequest Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx InviteUsersRequest Text
#email)

doSendMailFromResetToken ::
  (UserCommand :<: f, MailCommand :<: f) =>
  Env ->
  Either UserCommandError Text ->
  Text ->
  Free f (Either UserError MakeResetPasswordLinkResponse)
doSendMailFromResetToken :: forall (f :: * -> *).
(UserCommand :<: f, MailCommand :<: f) =>
Env
-> Either UserCommandError Text
-> Text
-> Free f (Either UserError MakeResetPasswordLinkResponse)
doSendMailFromResetToken Env
env Either UserCommandError Text
maybeToken Text
userEmail = do
  case Either UserCommandError Text
maybeToken of
    Left UserCommandError
e -> Either UserError MakeResetPasswordLinkResponse
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserError MakeResetPasswordLinkResponse
 -> Free f (Either UserError MakeResetPasswordLinkResponse))
-> (UserCommandError
    -> Either UserError MakeResetPasswordLinkResponse)
-> UserCommandError
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserError -> Either UserError MakeResetPasswordLinkResponse
forall a b. a -> Either a b
Left (UserError -> Either UserError MakeResetPasswordLinkResponse)
-> (UserCommandError -> UserError)
-> UserCommandError
-> Either UserError MakeResetPasswordLinkResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UserError
SomeError (Text -> UserError)
-> (UserCommandError -> Text) -> UserCommandError -> UserError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (UserCommandError -> String) -> UserCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserCommandError -> String
forall b a. (Show a, IsString b) => a -> b
show (UserCommandError
 -> Free f (Either UserError MakeResetPasswordLinkResponse))
-> UserCommandError
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall a b. (a -> b) -> a -> b
$ UserCommandError
e
    Right Text
token -> do
      let mailCss :: Text
mailCss = Env
env Env -> Optic' A_Lens NoIx Env Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx Env Text
#mailCss
      let resetLink :: Text
resetLink =
            (Env
env Env -> Optic' A_Lens NoIx Env Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic A_Lens NoIx Env Env AppConfig AppConfig
#cfg Optic A_Lens NoIx Env Env AppConfig AppConfig
-> Optic
     A_Lens NoIx AppConfig AppConfig WebFrontendConfig WebFrontendConfig
-> Optic A_Lens NoIx Env Env WebFrontendConfig WebFrontendConfig
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens NoIx AppConfig AppConfig WebFrontendConfig WebFrontendConfig
#webFrontend Optic A_Lens NoIx Env Env WebFrontendConfig WebFrontendConfig
-> Optic An_Iso NoIx WebFrontendConfig WebFrontendConfig Text Text
-> Optic' A_Lens NoIx Env Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_Iso NoIx WebFrontendConfig WebFrontendConfig Text Text
#baseUrl)
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/passwords/do-reset?"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text)
-> ([(String, String)] -> String) -> [(String, String)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> String
Network.HTTP.Base.urlEncodeVars ([(String, String)] -> Text) -> [(String, String)] -> Text
forall a b. (a -> b) -> a -> b
$ [(String
"token", Text -> String
unpack Text
token)])
          mailBody :: Text
mailBody =
            [trimming|
                       <style>
                       $mailCss
                       </style>
                       <h1>Reset your password on WikiMusic</h1>                  
                       <p>We have received a request to reset the password for your user on WikiMusic.</p>
                       <a href="$resetLink">Go reset your password on WikiMusic!</a>
                       <p>Feel free to ignore this e-mail if you did not request it</p>
                       <br/>
                       <small>If you had trouble clicking that link, please manually copy paste it:<br/>$resetLink</small>
                     |]
      Either MailCommandError MailCommandOutcome
mailR <- Env
-> MailSendRequest
-> Free f (Either MailCommandError MailCommandOutcome)
forall (f :: * -> *).
(MailCommand :<: f) =>
Env
-> MailSendRequest
-> Free f (Either MailCommandError MailCommandOutcome)
sendMail Env
env (MailSendRequest {$sel:subject:MailSendRequest :: Text
subject = Text
"WikiMusic - Reset Password", $sel:email:MailSendRequest :: Text
email = Text
userEmail, $sel:name:MailSendRequest :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing, $sel:body:MailSendRequest :: Text
body = Text
mailBody})
      case Either MailCommandError MailCommandOutcome
mailR of
        Left MailCommandError
e -> Either UserError MakeResetPasswordLinkResponse
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserError MakeResetPasswordLinkResponse
 -> Free f (Either UserError MakeResetPasswordLinkResponse))
-> (MailCommandError
    -> Either UserError MakeResetPasswordLinkResponse)
-> MailCommandError
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserError -> Either UserError MakeResetPasswordLinkResponse
forall a b. a -> Either a b
Left (UserError -> Either UserError MakeResetPasswordLinkResponse)
-> (MailCommandError -> UserError)
-> MailCommandError
-> Either UserError MakeResetPasswordLinkResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UserError
SomeError (Text -> UserError)
-> (MailCommandError -> Text) -> MailCommandError -> UserError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (MailCommandError -> String) -> MailCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserCommandError -> String
forall b a. (Show a, IsString b) => a -> b
show (UserCommandError -> String)
-> (MailCommandError -> UserCommandError)
-> MailCommandError
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UserCommandError
NotificationError (Text -> UserCommandError)
-> (MailCommandError -> Text)
-> MailCommandError
-> UserCommandError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text)
-> (MailCommandError -> String) -> MailCommandError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MailCommandError -> String
forall b a. (Show a, IsString b) => a -> b
show (MailCommandError
 -> Free f (Either UserError MakeResetPasswordLinkResponse))
-> MailCommandError
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall a b. (a -> b) -> a -> b
$ MailCommandError
e
        Right MailCommandOutcome
_ -> Either UserError MakeResetPasswordLinkResponse
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall a. a -> Free f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either UserError MakeResetPasswordLinkResponse
 -> Free f (Either UserError MakeResetPasswordLinkResponse))
-> (MakeResetPasswordLinkResponse
    -> Either UserError MakeResetPasswordLinkResponse)
-> MakeResetPasswordLinkResponse
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MakeResetPasswordLinkResponse
-> Either UserError MakeResetPasswordLinkResponse
forall a b. b -> Either a b
Right (MakeResetPasswordLinkResponse
 -> Free f (Either UserError MakeResetPasswordLinkResponse))
-> MakeResetPasswordLinkResponse
-> Free f (Either UserError MakeResetPasswordLinkResponse)
forall a b. (a -> b) -> a -> b
$ MakeResetPasswordLinkResponse {$sel:user:MakeResetPasswordLinkResponse :: Text
user = Text
userEmail}