fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lpr: add postal address field to user table

Browse Source
This commit is contained in:
Steffen Jost 2022-08-24 18:25:34 +02:00
parent 1ea047263c
commit d3314b3e36
12 changed files with 80 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/categories/user/de-de-formal.msg
View File

@ -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

2
messages/uniworx/categories/user/en-eu.msg
View File

@ -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

8
models/users.model
View File

@ -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

2
src/Foundation/Yesod/Auth.hs
View File

@ -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 = [

12
src/Handler/PrintCenter.hs
View File

@ -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

10
src/Handler/Users/Add.hs
View File

@ -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
}

8
src/Handler/Utils/Users.hs
View File

@ -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

29
src/Jobs/Handler/SendNotification/Qualification.hs
View File

@ -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

1
src/Model.hs
View File

@ -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

9
src/Model/Types/Markup.hs
View File

@ -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
markupIsSmallish StoredMarkup{markupInput} = GT /= LT.compareLength markupInput 32
html2textlines :: StoredMarkup -> [Text]
html2textlines sm = LT.toStrict <$> LT.lines (markupInput sm)

11
src/Utils/Print.hs
View File

@ -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

16
test/Database/Fill.hs
View File

@ -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
}