feat(users): allow users to set postal address and email encryption password

messages/uniworx/categories/settings/de-de-formal.msg

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

messages/uniworx/categories/settings/en-eu.msg

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

messages/uniworx/categories/user/de-de-formal.msg

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

messages/uniworx/categories/user/en-eu.msg

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

src/Handler/Profile.hs

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

src/Handler/Utils/Profile.hs

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

src/Utils/Icon.hs

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

src/Utils/Print.hs

@@ -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]) 
+      jobFullName          = T.replace " " "-" (T.intercalate "_" . catMaybes $ [Just printJobName, nameQuali, nameCourse, nameSender, nameRecipient]) 
-      printJobFilename     = jobFullName <> ".pdf"
+      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
--}
+-}

templates/profileData.hamlet

@@ -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
+        $maybe pass <- userPinPassword
-          OK
+          #{pass}
         $nothing
-          NO
+          _{MsgAdminUserNoPassword}
       $maybe telephonenr <- userTelephone
         <dt .deflist__dt>
           _{MsgUserTelephone}