diff --git a/messages/uniworx/categories/user/de-de-formal.msg b/messages/uniworx/categories/user/de-de-formal.msg index 0a7682d01..5559d44f7 100644 --- a/messages/uniworx/categories/user/de-de-formal.msg +++ b/messages/uniworx/categories/user/de-de-formal.msg @@ -12,6 +12,8 @@ AdminUserTelephone: Telefonnummer AdminUserMobile: Mobiltelefonmummer AdminUserFPersonalNumber: Personalnummer (nur Fraport AG) AdminUserFDepartment: Abteilung +AdminUserPostAddress: Postalische Anschrift +AdminUserPrefersPostal: Briefe anstatt Email bevorzugt AdminUserAssimilate: Benutzer assimilieren UserAdded: Benutzer erfolgreich angelegt UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden diff --git a/messages/uniworx/categories/user/en-eu.msg b/messages/uniworx/categories/user/en-eu.msg index 8e1a5c7bc..7d7645c15 100644 --- a/messages/uniworx/categories/user/en-eu.msg +++ b/messages/uniworx/categories/user/en-eu.msg @@ -12,6 +12,8 @@ AdminUserTelephone: Phone AdminUserMobile: Mobile AdminUserFPersonalNumber: Personalnumber (Fraport AG only) AdminUserFDepartment: Department +AdminUserPostAddress: Postal Address +AdminUserPrefersPostal: Prefers postal letters over email AdminUserAssimilate: Assimilate user UserAdded: Successfully added user UserCollision: Could not create user due to uniqueness constraint diff --git a/models/users.model b/models/users.model index e4fe9d226..38fb7334d 100644 --- a/models/users.model +++ b/models/users.model @@ -11,7 +11,7 @@ User json -- Each Uni2work user has a corresponding row in this table; create surname UserSurname -- Display user names always through 'nameWidget displayName surname' displayName UserDisplayName displayEmail UserEmail - email UserEmail -- Case-insensitive eMail address + email UserEmail -- Case-insensitive eMail address -- TODO: make this nullable ident UserIdent -- Case-insensitive user-identifier authentication AuthenticationMode -- 'AuthLDAP' or ('AuthPWHash'+password-hash) lastAuthentication UTCTime Maybe -- last login date @@ -39,8 +39,10 @@ User json -- Each Uni2work user has a corresponding row in this table; create mobile Text Maybe companyPersonalNumber Text Maybe -- Company will become a new table, but if company=fraport, some information is received via LDAP companyDepartment Text Maybe -- thus we store such information for ease of reference directly, if available - examOfficeGetSynced Bool default=true -- whether synced status should be displayed for exam results by default - examOfficeGetLabels Bool default=true -- whether labels should be displayed for exam results by default + postAddress StoredMarkup Maybe + prefersPostal Bool default=false -- user prefers letters by post instead of email + examOfficeGetSynced Bool default=true -- whether synced status should be displayed for exam results by default + examOfficeGetLabels Bool default=true -- whether labels should be displayed for exam results by default UniqueAuthentication ident -- Column 'ident' can be used as a row-key in this table UniqueEmail email -- Column 'email' can be used as a row-key in this table deriving Show Eq Ord Generic -- Haskell-specific settings for runtime-value representing a row in memory diff --git a/src/Foundation/Yesod/Auth.hs b/src/Foundation/Yesod/Auth.hs index 00d8227a0..25165ff0b 100644 --- a/src/Foundation/Yesod/Auth.hs +++ b/src/Foundation/Yesod/Auth.hs @@ -268,6 +268,8 @@ upsertCampusUser upsertMode ldapData = do , userDisplayEmail = userEmail , userMatrikelnummer = Nothing -- not known from LDAP, must be derived from REST interface to AVS TODO , userTitle = Nothing + , userPostAddress = Nothing -- not known from LDAP, must be derived from REST interface to AVS TODO + , userPrefersPostal = False , .. } userUpdate = [ diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 6afaff9a2..87be13ffa 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -11,8 +11,8 @@ import Import import qualified Data.Set as Set import qualified Data.Map as Map -import qualified Data.Text as T -import qualified Data.Text.Lazy as LT +-- import qualified Data.Text as T +-- import qualified Data.Text.Lazy as LT -- import qualified Data.ByteString.Lazy as LBS import qualified Text.Pandoc as P import qualified Text.Pandoc.Builder as P @@ -98,13 +98,7 @@ mprToMeta MetaPinRenewal{..} = P.Meta $ mconcat where deOrEn = if isDe mppLang then "de" else "en" keyOpening = deOrEn <> "-opening" - keyClosing = deOrEn <> "-closing" - mbMeta :: P.ToMetaValue a => Text -> Maybe a -> Map Text P.MetaValue - mbMeta = foldMap . toMeta - toMeta :: P.ToMetaValue a => Text -> a -> Map Text P.MetaValue - toMeta k = singletonMap k . P.toMetaValue - html2textlines :: StoredMarkup -> [Text] - html2textlines sm = T.lines . LT.toStrict $ markupInput sm + keyClosing = deOrEn <> "-closing" mprToMetaUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => Entity User -> MetaPinRenewal -> m P.Meta mprToMetaUser entUser@Entity{entityVal = u} mpr = do diff --git a/src/Handler/Users/Add.hs b/src/Handler/Users/Add.hs index 554f823b0..96d83ef72 100644 --- a/src/Handler/Users/Add.hs +++ b/src/Handler/Users/Add.hs @@ -23,6 +23,8 @@ data AdminUserForm = AdminUserForm , aufTelephone :: Maybe Text , aufFPersonalNumber :: Maybe Text , aufFDepartment :: Maybe Text + , aufPostAddress :: Maybe StoredMarkup + , aufPrefersPostal :: Bool , aufEmail :: UserEmail , aufIdent :: UserIdent , aufAuth :: AuthenticationKind @@ -56,7 +58,9 @@ adminUserForm template = renderAForm FormStandard <*> aopt (textField & cfStrip) (fslI MsgAdminUserMobile) (aufMobile <$> template) <*> aopt (textField & cfStrip) (fslI MsgAdminUserTelephone) (aufTelephone <$> template) <*> aopt (textField & cfStrip) (fslI MsgAdminUserFPersonalNumber) (aufFPersonalNumber <$> template) - <*> aopt (textField & cfStrip) (fslI MsgAdminUserFDepartment) (aufFDepartment <$> template) + <*> aopt (textField & cfStrip) (fslI MsgAdminUserFDepartment) (aufFDepartment <$> template) + <*> aopt htmlField (fslI MsgAdminUserPostAddress) (aufPostAddress <$> template) + <*> areq checkBoxField (fslI MsgAdminUserPrefersPostal) (aufPrefersPostal <$> template) <*> areq (emailField & cfCI) (fslI MsgAdminUserEmail) (aufEmail <$> template) <*> areq (textField & cfStrip & cfCI) (fslI MsgAdminUserIdent) (aufIdent <$> template) <*> areq (selectField optionsFinite) (fslI MsgAdminUserAuth) (aufAuth <$> template <|> Just AuthKindLDAP) @@ -103,7 +107,9 @@ postAdminUserAddR = do , userMobile = aufMobile , userTelephone = aufTelephone , userCompanyPersonalNumber = aufFPersonalNumber - , userCompanyDepartment = aufFDepartment + , userCompanyDepartment = aufFDepartment + , userPostAddress = aufPostAddress + , userPrefersPostal = aufPrefersPostal , userMatrikelnummer = aufMatriculation , userAuthentication = mkAuthMode aufAuth } diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index 06b3c80ac..7304904dc 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -8,6 +8,7 @@ module Handler.Utils.Users , guessUser , UserAssimilateException(..), UserAssimilateExceptionReason(..) , assimilateUser + , userPrefersEmail, userPrefersLetter ) where import Import @@ -40,6 +41,13 @@ import qualified Data.Text as Text import Jobs.Types(Job, JobChildren) +userPrefersLetter :: User -> Bool +userPrefersLetter User{..} = (userPrefersPostal || Text.null (CI.original userEmail)) && isJust userPostAddress + +userPrefersEmail :: User -> Bool +userPrefersEmail = not . userPrefersLetter + + computeUserAuthenticationDigest :: AuthenticationMode -> Digest SHA3_256 computeUserAuthenticationDigest = hashlazy . JSON.encode diff --git a/src/Jobs/Handler/SendNotification/Qualification.hs b/src/Jobs/Handler/SendNotification/Qualification.hs index d6837c5a2..d662a502d 100644 --- a/src/Jobs/Handler/SendNotification/Qualification.hs +++ b/src/Jobs/Handler/SendNotification/Qualification.hs @@ -9,6 +9,7 @@ import Import import Utils.Print import Handler.Utils +import Handler.Utils.Users import Jobs.Handler.SendNotification.Utils import qualified Data.ByteString.Lazy as LBS @@ -38,16 +39,14 @@ dispatchNotificationQualificationExpiry nQualification _nExpiry jRecipient = use addHtmlMarkdownAlternatives $(ihamletFile "templates/mail/qualificationExpiry.hamlet") -checkEmailOk :: User -> Bool -checkEmailOk = const True -- TODO - - +-- NOTE: qualificationRenewal expects that LmsUser already exists for recipient dispatchNotificationQualificationRenewal :: QualificationId -> UserId -> Handler () dispatchNotificationQualificationRenewal nQualification jRecipient = do - (recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}) <- runDB $ (,,) + (recipient@User{..}, Qualification{..}, Entity _ QualificationUser{..}, Entity _ LmsUser{..}) <- runDB $ (,,,) <$> getJust jRecipient <*> getJust nQualification - <*> getJustBy (UniqueQualificationUser nQualification jRecipient) + <*> getJustBy (UniqueQualificationUser nQualification jRecipient) + <*> getJustBy (UniqueLmsQualificationUser nQualification jRecipient) let entRecipient = Entity jRecipient recipient qname = CI.original qualificationName -- content = $(i18nWidgetFile "qualification/renewal") @@ -55,18 +54,22 @@ dispatchNotificationQualificationRenewal nQualification jRecipient = do now <- liftIO getCurrentTime letterDate <- formatTimeUser SelFormatDate now $ Just entRecipient - let pdfMeta = applyMetas - [ ("recipient", userDisplayName) - , ("date" , letterDate) - , ("lang" , selectDeEn userLanguages) -- select German or English, see Utils.Lang - -- TODO: add more info to interpolate here! - ] mempty + + let prepAddress upa = userDisplayName : (upa & html2textlines) -- TODO: use supervisor's address + pdfMeta = mkMeta + [ toMeta "date" letterDate + , toMeta "lang" $ selectDeEn userLanguages -- select German or English, see Utils.Lang + , toMeta "login" (lmsUserIdent & getLmsIdent) + , toMeta "pin" lmsUserPin + , toMeta "recipient" userDisplayName + , mbMeta "address" (prepAddress <$> userPostAddress) + ] pdfRenewal pdfMeta >>= \case Left err -> do let msg = "Notify " <> tshow jRecipient <> " PDF generation failed with error: " <> err $logErrorS "LMS" msg error $ unpack msg - Right pdf | checkEmailOk recipient -> userMailT jRecipient $ do + Right pdf | userPrefersEmail recipient -> userMailT jRecipient $ do replaceMailHeader "Auto-Submitted" $ Just "auto-generated" setSubjectI $ MsgMailSubjectQualificationRenewal qname diff --git a/src/Model.hs b/src/Model.hs index 6dc11066d..b5b6cb705 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -55,6 +55,7 @@ deriving newtype instance ToSample ExternalApiId -- required Show instances for use of getByJust deriving instance Show (Unique ExamPart) deriving instance Show (Unique QualificationUser) +deriving instance Show (Unique LmsUser) -- ToMarkup and ToMessage instances for displaying selected database primary keys diff --git a/src/Model/Types/Markup.hs b/src/Model/Types/Markup.hs index d4df4a060..6def79e59 100644 --- a/src/Model/Types/Markup.hs +++ b/src/Model/Types/Markup.hs @@ -5,7 +5,8 @@ module Model.Types.Markup , markdownToStoredMarkup , esqueletoMarkupOutput , I18nStoredMarkup - , markupIsSmallish + , markupIsSmallish + , html2textlines ) where import Import.NoModel @@ -148,4 +149,8 @@ type I18nStoredMarkup = I18n StoredMarkup -- | determine whether the StoredMarkup is small-ish markupIsSmallish :: StoredMarkup -> Bool -markupIsSmallish StoredMarkup{markupInput} = GT /= LT.compareLength markupInput 32 \ No newline at end of file +markupIsSmallish StoredMarkup{markupInput} = GT /= LT.compareLength markupInput 32 + + +html2textlines :: StoredMarkup -> [Text] +html2textlines sm = LT.toStrict <$> LT.lines (markupInput sm) diff --git a/src/Utils/Print.hs b/src/Utils/Print.hs index 26f45226c..faea7a2aa 100644 --- a/src/Utils/Print.hs +++ b/src/Utils/Print.hs @@ -38,7 +38,6 @@ templateDIN5008 :: Text templateDIN5008 = decodeUtf8 $(Data.FileEmbed.embedFile "templates/letter/din5008.latex") - ---------------------- -- Pandoc Functions -- ---------------------- @@ -68,6 +67,16 @@ _Meta = lens mget mput mget (P.Pandoc m _) = m mput (P.Pandoc _ b) m = P.Pandoc m b +toMeta :: P.ToMetaValue a => Text -> a -> Map Text P.MetaValue +toMeta k = singletonMap k . P.toMetaValue + +mbMeta :: P.ToMetaValue a => Text -> Maybe a -> Map Text P.MetaValue +mbMeta = foldMap . toMeta + +-- | For convenience and to avoid importing Pandoc +mkMeta :: [Map Text P.MetaValue] -> P.Meta +mkMeta = P.Meta . mconcat + -- | Modify the Meta-Block of Pandoc appMeta :: (P.Meta -> P.Meta) -> P.Pandoc -> P.Pandoc appMeta f (P.Pandoc m bs) = P.Pandoc (f m) bs diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 6797a3515..6ffc660b7 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -111,6 +111,8 @@ fillDb = do , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing + , userPostAddress = Nothing + , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } @@ -146,6 +148,8 @@ fillDb = do , userTelephone = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing + , userPostAddress = Nothing + , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } @@ -187,6 +191,8 @@ fillDb = do , userMobile = Just "0173 69 99 646" , userCompanyPersonalNumber = Just "57138" , userCompanyDepartment = Just "AVN-AR2" + , userPostAddress = Nothing + , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } @@ -222,6 +228,8 @@ fillDb = do , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing + , userPostAddress = Nothing + , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } @@ -257,6 +265,8 @@ fillDb = do , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing + , userPostAddress = Nothing + , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } @@ -292,6 +302,8 @@ fillDb = do , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing + , userPostAddress = Nothing + , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels } @@ -327,6 +339,8 @@ fillDb = do , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing + , userPostAddress = Nothing + , userPrefersPostal = False , userExamOfficeGetSynced = False , userExamOfficeGetLabels = True } @@ -392,6 +406,8 @@ fillDb = do , userMobile = Nothing , userCompanyPersonalNumber = Nothing , userCompanyDepartment = Nothing + , userPostAddress = Nothing + , userPrefersPostal = False , userExamOfficeGetSynced = userDefaultExamOfficeGetSynced , userExamOfficeGetLabels = userDefaultExamOfficeGetLabels }