feat(users): allow users to set postal address and email encryption password
This commit is contained in:
Steffen Jost
parent
9f3cb4ffe4
commit
655fcf7564
@ -27,6 +27,16 @@ WarningDaysTip: Wie viele Tage im Voraus sollen Fristen von Prüfungen etc. auf
|
||||
ShowSex: Geschlechter anderer Nutzer:innen anzeigen
|
||||
ShowSexTip: Sollen in Kursteilnehmer:innen-Tabellen u.Ä. die Geschlechter der Nutzer:innen angezeigt werden?
|
||||
|
||||
PDFPassword: Passwort zur Verschlüsselung von PDF Anhängen an Email Benachrichtigungen
|
||||
PDFPasswordTip: Achtung, dieses Passwort ist für FRADrive Administratoren einsehbar und wird unverschlüsselt gespeichert!
|
||||
PDFPasswordInvalid: Bitte ein nicht-triviales Passwort ohne Leerzeichen für PDF Email Anhänge eintragen!
|
||||
PrefersPostal: Sollen Benachrichtigung möglichst per Post versendet werden anstatt per Email?
|
||||
PostalTip: Postversand kann in Rechnung gestellt werden und ist derzeit nur für Benachrichtigungen über Erneuerung und Ablauf von Qualifikation, wie z.B. Führerscheine, verfügbar.
|
||||
PostAddress: Postalische Adresse
|
||||
PostAddressTip: Mindestens eine Zeile mit Straße und Hausnummer und eine Zeile mit Postleitzahl und Ort. Kein Empfängername, denn dieser wird später automatisch hinzugefügt.
|
||||
UserPostalInvalid: Postadresse muss mindestens eine Zeile mit Straße und Hausnummer und eine separate Zeile mit Postleitzahl und Ort enthalten!
|
||||
UserPrefersPostalInvalid: Entweder postalische Benachrichtigungen deaktivieren oder eine Postadresse angeben!
|
||||
|
||||
FormNotifications: Benachrichtigungen
|
||||
|
||||
UserSchools: Relevante Institute
|
||||
|
||||
@ -27,6 +27,16 @@ WarningDaysTip: How many days ahead should deadlines regarding exams etc. be dis
|
||||
ShowSex: Show sex of other users
|
||||
ShowSexTip: Should users' sex be displayed in (among others) lists of course participants?
|
||||
|
||||
PDFPassword: Password to lock PDF email attachments
|
||||
PDFPasswordTip: Please note that this password is displayed to FRADrive admins and is saved unencrypted
|
||||
PDFPasswordInvalid: Please supply a sensible password for encrypting PDF email attachments!
|
||||
PrefersPostal: Should notifications preferably send by post instead of email?
|
||||
PostalTip: Mailing may incur a fee and is currently only avaulable for qualification expiry notifications, such as driving lincence renewal.
|
||||
PostAddress: Postal address
|
||||
PostAddressTip: Should contain at least one line with street and house number and another line featuring zip code and town. Omit a recipient name, since it will be added later.
|
||||
UserPostalInvalid: Postal address must have at least one line with street and house number and another with zip code and town!
|
||||
UserPrefersPostalInvalid: Either deactivate postal notification or supply a valid postal address!
|
||||
|
||||
FormNotifications: Notifications
|
||||
|
||||
UserSchools: Relevant departments
|
||||
|
||||
@ -15,6 +15,7 @@ AdminUserFDepartment: Abteilung
|
||||
AdminUserPostAddress: Postalische Anschrift
|
||||
AdminUserPrefersPostal: Briefe anstatt Email bevorzugt
|
||||
AdminUserPinPassword: Passwort zur Verschlüsselung von PDF Anhängen in Emails
|
||||
AdminUserNoPassword: Kein Passwort gesetzt
|
||||
AdminUserAssimilate: Benutzer assimilieren
|
||||
UserAdded: Benutzer erfolgreich angelegt
|
||||
UserCollision: Benutzer konnte wegen Eindeutigkeit nicht angelegt werden
|
||||
|
||||
@ -14,7 +14,8 @@ AdminUserFPersonalNumber: Personalnumber (Fraport AG only)
|
||||
AdminUserFDepartment: Department
|
||||
AdminUserPostAddress: Postal Address
|
||||
AdminUserPrefersPostal: Prefers postal letters over email
|
||||
AdminUserPinPassword: Password used for all PDF attachments to emails
|
||||
AdminUserPinPassword: Password used for PDF attachments to emails
|
||||
AdminUserNoPassword: No password set
|
||||
AdminUserAssimilate: Assimilate user
|
||||
UserAdded: Successfully added user
|
||||
UserCollision: Could not create user due to uniqueness constraint
|
||||
|
||||
@ -13,6 +13,8 @@ import Import
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Profile
|
||||
|
||||
import Utils.Print (validCmdArgument)
|
||||
|
||||
-- import Colonnade hiding (fromMaybe, singleton)
|
||||
-- import Yesod.Colonnade
|
||||
import Data.Map ((!))
|
||||
@ -57,6 +59,11 @@ data SettingsForm = SettingsForm
|
||||
, stgDownloadFiles :: Bool
|
||||
, stgWarningDays :: NominalDiffTime
|
||||
, stgShowSex :: Bool
|
||||
|
||||
, stgPinPassword :: Text
|
||||
, stgPrefersPostal :: Bool
|
||||
, stgPostAddress :: Maybe StoredMarkup
|
||||
|
||||
, stgExamOfficeSettings :: ExamOfficeSettings
|
||||
, stgSchools :: Set SchoolId
|
||||
, stgNotificationSettings :: NotificationSettings
|
||||
@ -130,8 +137,13 @@ makeSettingForm template html = do
|
||||
& setTooltip MsgWarningDaysTip
|
||||
) (stgWarningDays <$> template)
|
||||
<*> apopt checkBoxField (fslI MsgShowSex & setTooltip MsgShowSexTip) (stgShowSex <$> template)
|
||||
<*> examOfficeForm (stgExamOfficeSettings <$> template)
|
||||
|
||||
<* aformSection MsgFormNotifications
|
||||
<*> areq (textField & cfStrip) (fslI MsgPDFPassword & setTooltip MsgPDFPasswordTip) (stgPinPassword <$> template)
|
||||
<*> apopt checkBoxField (fslI MsgPrefersPostal & setTooltip MsgPostalTip) (stgPrefersPostal <$> template)
|
||||
<*> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) (stgPostAddress <$> template)
|
||||
|
||||
<*> examOfficeForm (stgExamOfficeSettings <$> template)
|
||||
<*> schoolsForm (stgSchools <$> template)
|
||||
<*> notificationForm (stgNotificationSettings <$> template)
|
||||
<*> allocationNotificationForm (stgAllocationNotificationSettings <$> template)
|
||||
@ -426,10 +438,23 @@ examOfficeForm template = wFormToAForm $ do
|
||||
validateSettings :: User -> FormValidator SettingsForm Handler ()
|
||||
validateSettings User{..} = do
|
||||
userDisplayName' <- use _stgDisplayName
|
||||
|
||||
guardValidation MsgUserDisplayNameInvalid $
|
||||
validDisplayName userTitle userFirstName userSurname userDisplayName'
|
||||
|
||||
userPinPassword' <- use _stgPinPassword
|
||||
guardValidation MsgPDFPasswordInvalid $
|
||||
validCmdArgument userPinPassword' -- used as CMD argument for pdftk
|
||||
|
||||
userPostAddress' <- use _stgPostAddress
|
||||
let postalNotSet = isNothing userPostAddress'
|
||||
postalIsValid = validPostAddress userPostAddress'
|
||||
guardValidation MsgUserPostalInvalid $
|
||||
postalNotSet || postalIsValid
|
||||
|
||||
userPrefersPostal' <- use _stgPrefersPostal
|
||||
guardValidation MsgUserPrefersPostalInvalid $
|
||||
not $ userPrefersPostal' && postalNotSet
|
||||
|
||||
|
||||
data ButtonResetTokens = BtnResetTokens
|
||||
deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
|
||||
@ -478,6 +503,9 @@ postProfileR = do
|
||||
, stgNotificationSettings = userNotificationSettings
|
||||
, stgWarningDays = userWarningDays
|
||||
, stgShowSex = userShowSex
|
||||
, stgPinPassword = fromMaybe "" userPinPassword
|
||||
, stgPostAddress = userPostAddress
|
||||
, stgPrefersPostal = userPrefersPostal
|
||||
, stgExamOfficeSettings = ExamOfficeSettings
|
||||
{ eosettingsGetSynced = userExamOfficeGetSynced
|
||||
, eosettingsGetLabels = userExamOfficeGetLabels
|
||||
@ -501,6 +529,9 @@ postProfileR = do
|
||||
, UserWarningDays =. stgWarningDays
|
||||
, UserNotificationSettings =. stgNotificationSettings
|
||||
, UserShowSex =. stgShowSex
|
||||
, UserPinPassword =. Just stgPinPassword
|
||||
, UserPostAddress =. stgPostAddress
|
||||
, UserPrefersPostal =. stgPrefersPostal
|
||||
, UserExamOfficeGetSynced =. (stgExamOfficeSettings & eosettingsGetSynced)
|
||||
, UserExamOfficeGetLabels =. (stgExamOfficeSettings & eosettingsGetLabels)
|
||||
] ++ [ UserDisplayEmail =. stgDisplayEmail | userDisplayEmail == stgDisplayEmail ]
|
||||
|
||||
@ -1,12 +1,16 @@
|
||||
module Handler.Utils.Profile
|
||||
( checkDisplayName
|
||||
, validDisplayName
|
||||
, fixDisplayName
|
||||
, fixDisplayName
|
||||
, validPostAddress
|
||||
) where
|
||||
|
||||
import Import.NoFoundation
|
||||
|
||||
import Data.Char
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lazy as LT
|
||||
|
||||
import qualified Data.MultiSet as MultiSet
|
||||
import qualified Data.Set as Set
|
||||
|
||||
@ -49,3 +53,13 @@ validDisplayName (fmap Text.strip -> mTitle) (Text.strip -> fName) (Text.strip -
|
||||
isAdd = (`Set.member` addLetters)
|
||||
splitAdd = Text.split isAdd
|
||||
makeMultiSet = MultiSet.fromList . filter (not . Text.null) . splitAdd
|
||||
|
||||
-- | Primitive postal address requires at least one alphabetic character, one digit and a line break
|
||||
validPostAddress :: Maybe StoredMarkup -> Bool
|
||||
validPostAddress (Just StoredMarkup {markupInput = addr})
|
||||
| Just _ <- LT.find isLetter addr
|
||||
, Just _ <- LT.find isNumber addr
|
||||
-- , Just _ <- LT.find ((LineSeparator ==) . generalCategory) addr -- THIS DID NOT WORK
|
||||
, 1 < length (LT.lines addr)
|
||||
= True
|
||||
validPostAddress _ = False
|
||||
|
||||
@ -106,6 +106,7 @@ data Icon
|
||||
| IconReset
|
||||
| IconBlocked
|
||||
| IconPrintCenter
|
||||
| IconAt
|
||||
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite, NFData)
|
||||
|
||||
@ -144,7 +145,7 @@ iconText = \case
|
||||
IconSFTHint -> "life-ring" -- for SheetFileType only
|
||||
IconSFTSolution -> "exclamation-circle" -- for SheetFileType only
|
||||
IconSFTMarking -> "check-circle" -- for SheetFileType only
|
||||
IconEmail -> "envelope"
|
||||
IconEmail -> "envelope" -- envelope is no longer unamibuous
|
||||
IconRegisterTemplate -> "file-alt"
|
||||
IconApplyTrue -> "file-alt"
|
||||
IconApplyFalse -> "trash"
|
||||
@ -195,6 +196,7 @@ iconText = \case
|
||||
IconReset -> "undo" -- From fontawesome v6 onwards: "arrow-rotate-left"
|
||||
IconBlocked -> "ban"
|
||||
IconPrintCenter -> "mail-bulk" -- From fontawesome v6 onwards: "envelope-bulk"
|
||||
IconAt -> "at"
|
||||
|
||||
nullaryPathPiece ''Icon $ camelToPathPiece' 1
|
||||
deriveLift ''Icon
|
||||
|
||||
@ -4,6 +4,7 @@ module Utils.Print
|
||||
( pdfRenewal
|
||||
, sendLetter
|
||||
, encryptPDF
|
||||
, sanitizeCmdArg, validCmdArgument
|
||||
, templateDIN5008
|
||||
, templateRenewal
|
||||
-- , compileTemplate, makePDF
|
||||
@ -271,8 +272,8 @@ sendLetter printJobName pdf printJobRecipient printJobSender printJobCourse prin
|
||||
nameCourse = CI.original . courseShorthand <$> course
|
||||
nameQuali = CI.original . qualificationShorthand <$> quali
|
||||
let printJobAcknowledged = Nothing
|
||||
jobFullName = unpack $ T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient])
|
||||
printJobFilename = jobFullName <> ".pdf"
|
||||
jobFullName = T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient])
|
||||
printJobFilename = T.unpack $ jobFullName <> ".pdf"
|
||||
-- printJobFile <- sinkFileDB True $ yield $ LBS.toStrict pdf -- for PrintJobFile :: FileContentReference use this code
|
||||
printJobFile = LBS.toStrict pdf
|
||||
lprPDF jobFullName pdf >>= \case
|
||||
@ -328,6 +329,12 @@ readProcess' pc = do
|
||||
return (ec, st_err, st_out)
|
||||
|
||||
|
||||
sanitizeCmdArg :: Text -> Text
|
||||
sanitizeCmdArg t =
|
||||
T.snoc (T.cons '"' $ T.filter (\c -> '"' /= c && '\\' /= c) t) '"'
|
||||
-- | Pin Password is used as a commandline argument in Utils.Print.encryptPDF and hence poses a security risk
|
||||
validCmdArgument :: Text -> Bool
|
||||
validCmdArgument t = not (T.null t) && (T.cons '"' (T.snoc t '"') == sanitizeCmdArg t)
|
||||
|
||||
-----------
|
||||
-- pdftk --
|
||||
@ -342,10 +349,11 @@ readProcess' pc = do
|
||||
encryptPDF :: MonadIO m => Text -> LBS.ByteString -> m (Either Text LBS.ByteString)
|
||||
encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> readProcess pc
|
||||
where
|
||||
pc = setStdin (byteStringInput bs) $
|
||||
pw' = sanitizeCmdArg pw
|
||||
pc = setStdin (byteStringInput bs) $
|
||||
proc "pdftk" [ "-" -- read from stdin
|
||||
, "output", "-" -- write to stdout
|
||||
, "user_pw", T.unpack pw -- encrypt pdf content
|
||||
, "user_pw", T.unpack pw' -- encrypt pdf content
|
||||
, "dont_ask" -- no interaction
|
||||
, "allow", "Printing" -- allow printing despite encryption
|
||||
]
|
||||
@ -366,7 +374,7 @@ encryptPDF pw bs = over _Left (decodeUtf8 . LBS.toStrict) . exit2either <$> read
|
||||
-- > lpr -P fradrive -H fravm017173.fra.fraport.de:515 -T printJobName -
|
||||
|
||||
-- | Internal only, use `sendLetter` instead
|
||||
lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => String -> LBS.ByteString -> m (Either Text Text)
|
||||
lprPDF :: (MonadHandler m, HasAppSettings (HandlerSite m)) => Text -> LBS.ByteString -> m (Either Text Text)
|
||||
lprPDF jb bs = do
|
||||
lprServerArg <- $cachedHereBinary ("lprServer"::Text) getLprServerArg
|
||||
let pc = setStdin (byteStringInput bs) $
|
||||
@ -376,7 +384,8 @@ lprPDF jb bs = do
|
||||
, "-" -- read from stdin
|
||||
]
|
||||
jobname | null jb = []
|
||||
| otherwise = ["-J " <> jb]
|
||||
| otherwise = ["-J " <> jb']
|
||||
jb' = T.unpack $ sanitizeCmdArg jb
|
||||
exit2either <$> readProcess' pc
|
||||
where
|
||||
getLprServerArg = do
|
||||
@ -397,4 +406,4 @@ lprPDF' jb bs = do
|
||||
jobname | null jb = []
|
||||
| otherwise = ["-J " <> jb]
|
||||
exit2either <$> readProcess' pc
|
||||
-}
|
||||
-}
|
||||
|
||||
@ -19,14 +19,14 @@ $newline never
|
||||
<dd .deflist__dd>
|
||||
#{matnr}
|
||||
$maybe addr <- userPostAddress
|
||||
<dt .deflist__dt>
|
||||
_{MsgPrefersPostal}
|
||||
<dd .deflist__dd>
|
||||
#{icon (bool IconAt IconPrintCenter userPrefersPostal)}
|
||||
<dt .deflist__dt>
|
||||
_{MsgAdminUserPostAddress}
|
||||
<dd .deflist__dd>
|
||||
#{addr}
|
||||
<dt .deflist__dt>
|
||||
_{MsgAdminUserPrefersPostal}
|
||||
<dd .deflist__dd>
|
||||
#{show userPrefersPostal}
|
||||
<dt .deflist__dt>
|
||||
_{MsgTableEmail}
|
||||
<dd .deflist__dd>
|
||||
@ -39,10 +39,10 @@ $newline never
|
||||
<dt .deflist__dt>
|
||||
_{MsgAdminUserPinPassword}
|
||||
<dd .deflist__dd>
|
||||
$maybe _pass <- userPinPassword
|
||||
OK
|
||||
$maybe pass <- userPinPassword
|
||||
#{pass}
|
||||
$nothing
|
||||
NO
|
||||
_{MsgAdminUserNoPassword}
|
||||
$maybe telephonenr <- userTelephone
|
||||
<dt .deflist__dt>
|
||||
_{MsgUserTelephone}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user