fradrive/src/Jobs/Handler/LecturerInvitation.hs
2019-04-12 14:08:55 +02:00

44 lines
1.7 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
import Control.Monad.Trans.Maybe
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