This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Jobs/Handler/LecturerInvitation.hs
Gregor Kleen 98026b2a40 Fix hlint
2019-04-20 22:17:17 +02:00

42 lines
1.6 KiB
Haskell

module Jobs.Handler.LecturerInvitation
( dispatchJobLecturerInvitation
) where
import Import
import Text.Hamlet
import qualified Data.HashSet as HashSet
import qualified Data.CaseInsensitive as CI
import Utils.Lens
dispatchJobLecturerInvitation :: UserId -> LecturerInvitation -> Handler ()
dispatchJobLecturerInvitation jInviter jLecturerInvitation@LecturerInvitation{..} = do
ctx <- runDB . runMaybeT $ do
course <- MaybeT $ get lecturerInvitationCourse
void . MaybeT $ getByValue jLecturerInvitation
user <- MaybeT $ get jInviter
return (course, user)
case ctx of
Just (Course{..}, User{..}) -> do
let baseRoute = CourseR courseTerm courseSchool courseShorthand $ CLecInviteR lecturerInvitationEmail
jwt <- encodeToken =<< bearerToken jInviter (Just $ HashSet.singleton baseRoute) Nothing Nothing Nothing
let
invitationUrl :: SomeRoute UniWorX
invitationUrl = SomeRoute (baseRoute, [(toPathPiece GetBearer, toPathPiece jwt)])
invitationUrl' <- toTextUrl invitationUrl
mailT def $ do
_mailTo .= [Address Nothing $ CI.original lecturerInvitationEmail]
replaceMailHeader "Reply-To" . Just . renderAddress $ Address (Just userDisplayName) (CI.original userEmail)
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
setSubjectI $ MsgMailSubjectLecturerInvitation courseTerm courseSchool courseShorthand
addPart ($(ihamletFile "templates/mail/lecturerInvitation.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
Nothing -> runDB .
deleteBy $ UniqueLecturerInvitation lecturerInvitationEmail lecturerInvitationCourse