40 lines
1.5 KiB
Haskell
40 lines
1.5 KiB
Haskell
module Jobs.Handler.SendPasswordReset
|
|
( dispatchJobSendPasswordReset
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
import Handler.Utils.Users
|
|
|
|
import qualified Data.ByteString.Base64 as Base64
|
|
import qualified Data.ByteArray as BA
|
|
import qualified Data.HashSet as HashSet
|
|
|
|
import Text.Hamlet
|
|
|
|
dispatchJobSendPasswordReset :: UserId
|
|
-> Handler ()
|
|
dispatchJobSendPasswordReset jRecipient = userMailT jRecipient $ do
|
|
cID <- encrypt jRecipient
|
|
User{..} <- liftHandler . runDB $ getJust jRecipient
|
|
|
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
|
setSubjectI MsgMailSubjectPasswordReset
|
|
|
|
now <- liftIO getCurrentTime
|
|
let
|
|
localNow = utcToLocalTime now
|
|
tomorrowEndOfDay = case localTimeToUTC (LocalTime (addDays 2 $ localDay localNow) midnight) of
|
|
LTUUnique utc' _ -> utc'
|
|
_other -> UTCTime (addDays 2 $ utctDay now) 0
|
|
|
|
resetBearer' <- bearerToken (Right jRecipient) (Just . HashSet.singleton $ UserPasswordR cID) Nothing (Just $ Just tomorrowEndOfDay) Nothing
|
|
let resetBearer = resetBearer'
|
|
& bearerRestrict (UserPasswordR cID) (decodeUtf8 . Base64.encode . BA.convert $ computeUserAuthenticationDigest userAuthentication)
|
|
encodedBearer <- encodeBearer resetBearer
|
|
|
|
resetUrl <- toTextUrl (UserPasswordR cID, [(toPathPiece GetBearer, toPathPiece encodedBearer)])
|
|
|
|
addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/passwordReset.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
|