137 lines
6.4 KiB
Haskell
137 lines
6.4 KiB
Haskell
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results
|
|
|
|
module Jobs.Handler.SendNotification.Qualification
|
|
( dispatchNotificationQualificationExpiry
|
|
, dispatchNotificationQualificationRenewal
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Utils.Print
|
|
import Handler.Utils
|
|
import Handler.Utils.Users
|
|
import Jobs.Handler.SendNotification.Utils
|
|
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
|
|
import qualified Data.Text as Text
|
|
|
|
-- import Handler.Info (FAQItem(..))
|
|
import qualified Data.CaseInsensitive as CI
|
|
import Text.Hamlet
|
|
|
|
-- import qualified Database.Esqueleto.Experimental as E
|
|
-- import qualified Database.Esqueleto.Utils as E
|
|
|
|
|
|
-- TODO: refactor! Do not call error in Jobs, as this results in locked jobs. Abort graceful!
|
|
|
|
dispatchNotificationQualificationExpiry :: QualificationId -> Day -> UserId -> Handler ()
|
|
dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = userMailT jRecipient $ do
|
|
(recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- liftHandler . runDB $ (,,)
|
|
<$> getJust jRecipient
|
|
<*> getJust nQualification
|
|
<*> getJustBy (UniqueQualificationUser nQualification jRecipient)
|
|
|
|
encRecipient :: CryptoUUIDUser <- liftHandler $ encrypt jRecipient
|
|
let entRecipient = Entity jRecipient recipient
|
|
qname = CI.original qualificationName
|
|
expiryDate <- formatTimeUser SelFormatDate qualificationUserValidUntil $ Just entRecipient
|
|
|
|
$logDebugS "LMS" $ "Notify " <> tshow encRecipient <> " about expiry of qualification " <> qname
|
|
|
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
|
setSubjectI $ MsgMailSubjectQualificationExpiry qname
|
|
|
|
editNotifications <- mkEditNotifications jRecipient
|
|
|
|
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpiry.hamlet")
|
|
|
|
|
|
-- NOTE: qualificationRenewal expects that LmsUser already exists for recipient
|
|
dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler ()
|
|
dispatchNotificationQualificationRenewal nQualification jRecipient = do
|
|
(recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}, Entity luid LmsUser{..}) <- runDB $ (,,,)
|
|
<$> getJust jRecipient
|
|
<*> getJust nQualification
|
|
<*> getJustBy (UniqueQualificationUser nQualification jRecipient)
|
|
<*> getJustBy (UniqueLmsQualificationUser nQualification jRecipient)
|
|
|
|
encRecipient :: CryptoUUIDUser <- encrypt jRecipient
|
|
let entRecipient = Entity jRecipient recipient
|
|
qname = CI.original qualificationName
|
|
|
|
$logInfoS "LMS" $ "Notify " <> tshow encRecipient <> " for renewal of qualification " <> qname
|
|
|
|
now <- liftIO getCurrentTime
|
|
letterDate <- formatTimeUser SelFormatDate now $ Just entRecipient
|
|
expiryDate <- formatTimeUser SelFormatDate qualificationUserValidUntil $ Just entRecipient
|
|
|
|
let printJobName = "RenewalPin"
|
|
fileName = printJobName <> "_" <> abbrvName recipient <> ".pdf"
|
|
lmsIdent = lmsUserIdent & getLmsIdent
|
|
lmsUrl = "https://drive.fraport.de"
|
|
lmsLogin = lmsUrl <> "/?login=" <> lmsIdent
|
|
prepAddress upa = userDisplayName : (upa & html2textlines) -- TODO: use supervisor's address
|
|
pdfMeta = mkMeta
|
|
[ toMeta "date" letterDate
|
|
, toMeta "lang" (selectDeEn userLanguages) -- select either German or English only, see Utils.Lang
|
|
, toMeta "login" lmsIdent
|
|
, toMeta "pin" lmsUserPin
|
|
, toMeta "recipient" userDisplayName
|
|
, mbMeta "address" (prepAddress <$> userPostAddress)
|
|
, toMeta "expiry" expiryDate
|
|
, mbMeta "validduration" (show <$> qualificationValidDuration)
|
|
, toMeta "url-text" lmsUrl
|
|
, toMeta "url" lmsLogin
|
|
]
|
|
emailRenewal attachment
|
|
| Text.null (CI.original userEmail) = do -- if neither email nor postal address is known, we must abort!
|
|
let msg = "Notify " <> tshow encRecipient <> " failed: no email nor address for user known!"
|
|
$logErrorS "LMS" msg
|
|
return False
|
|
| otherwise = do
|
|
userMailT jRecipient $ do
|
|
replaceMailHeader "Auto-Submitted" $ Just "auto-generated"
|
|
setSubjectI $ MsgMailSubjectQualificationRenewal qname
|
|
whenIsJust attachment $ \afile ->
|
|
addPart (File { fileTitle = Text.unpack fileName
|
|
, fileModified = now
|
|
, fileContent = Just $ yield $ LBS.toStrict afile
|
|
} :: PureFile)
|
|
editNotifications <- mkEditNotifications jRecipient
|
|
addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationRenewal.hamlet")
|
|
return True
|
|
|
|
notifyOk <- pdfRenewal pdfMeta >>= \case
|
|
Right pdf | userPrefersLetter recipient -> -- userPrefersLetter is false if both userEmail and userPostAddress are null
|
|
let printSender = Nothing
|
|
in runDB (sendLetter printJobName pdf (Just jRecipient, printSender) Nothing (Just nQualification)) >>= \case
|
|
Left err -> do
|
|
let msg = "Notify " <> tshow encRecipient <> ": PDF printing to send letter failed with error " <> cropText err
|
|
$logErrorS "LMS" msg
|
|
return False
|
|
Right (msg,_)
|
|
| null msg -> return True
|
|
| otherwise -> do
|
|
$logWarnS "LMS" $ "PDF printing to send letter with lpr returned ExitSucces and the following message: " <> msg
|
|
return True
|
|
|
|
Right pdf -> do
|
|
attch <- case userPinPassword of
|
|
Nothing -> return $ Just pdf -- attach unencrypted, since there is no password set
|
|
Just passwd -> encryptPDF passwd pdf >>= \case
|
|
Right encPdf -> return $ Just encPdf -- attach encrypted
|
|
Left err -> do -- send email without attachment, so that the user is at least notified about the expiry
|
|
let msg = "Notify " <> tshow encRecipient <> " PDF encryption failed with error: " <> cropText err
|
|
$logErrorS "LMS" msg
|
|
return Nothing
|
|
emailRenewal attch
|
|
|
|
Left err -> do
|
|
let msg = "Notify " <> tshow encRecipient <> " PDF generation failed with error: " <> cropText err
|
|
$logErrorS "LMS" msg
|
|
emailRenewal Nothing
|
|
|
|
when notifyOk $ runDB $ update luid [ LmsUserNotified =. Just now]
|
|
|