chore(mail): add modal computing actual receivers at postal pref columns

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

@@ -17,7 +17,7 @@ PrintJobReprint n@Int m@Int: #{n}/#{m} #{pluralDE n "Druckauftrag" "Druckaufräg
 PrintJobAcknowledgeFailed: Keine Druckaufträge bestätigt aufgrund zwischenzeitlicher Änderungen. Bitte die Seite im Browser aktualisieren!
 PrintJobAcknowledgeQuestion n@Int d@Text: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} vom #{d} als gedruckt und versendet bestätigen?
 PrintJobAcknowledgements: Versanddatum von Briefen an
-PrintRecipient: Empfänger
+PrintRecipient: Empfänger:innen
 PrintAffected: Betroffener
 PrintSender !ident-ok: Sender
 PrintCourse: Kursarten

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

@@ -43,6 +43,7 @@ SynchroniseAvsAllUsersQueued n@Int64: AVS-Synchronisation von allen #{n} #{plura
 SynchroniseLdapUserQueued n@Int: LDAP-Synchronisation von #{n} #{pluralDE n "Benutzer:in" "Benutzer:innen"} angestoßen, die Ausführung wird mehrere Minuten benötigen!
 SynchroniseLdapAllUsersQueued: LDAP-Synchronisation von allen Benutzer:innen angestoßen, die Ausführung kann eine Weile brauchen!
 UserListTitle: Komprehensive Benutzerliste
+UserRecipientsTitle name@Text: Benachrichtigungsempfänger für #{name}
 AccessRightsSaved: Berechtigungen erfolgreich verändert
 AccessRightsNotChanged: Berechtigungen wurden nicht verändert
 AuthLDAPLookupFailed: Nutzer:in konnte aufgrund eines LDAP-Fehlers nicht nachgeschlagen werden

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

@@ -43,6 +43,7 @@ SynchroniseAvsAllUsersQueued n: Triggered AVS synchronisation of all #{n} #{plur
 SynchroniseLdapUserQueued n: Triggered LDAP synchronisation of #{n} #{pluralEN n "user" "users"}, which may take several minutes to complete.
 SynchroniseLdapAllUsersQueued: Triggered LDAP synchronisation of all users, which may take quite a while to complete.
 UserListTitle: Comprehensive list of users
+UserRecipientsTitle name: Notificationrecipients for #{name}
 AccessRightsSaved: Successfully updated permissions
 AccessRightsNotChanged: Permissions left unchanged
 AuthLDAPLookupFailed: User could not be looked up due to a LDAP error

messages/uniworx/misc/de-de-formal.msg

@@ -39,4 +39,6 @@ Unknown: ist unbekannt
 UnknownOrNotAllowed: ist unbekannt oder hier nicht erlaubt
 Ambiguous: ist uneindeutig
 Action: Aktion
-For: für
+For: für
+Address: Adresse
+NoContactAddress: Keinerlei Kontaktdaten bekannt!

messages/uniworx/misc/en-eu.msg

@@ -39,4 +39,6 @@ Unknown: is unknown
 UnknownOrNotAllowed: is unknown or not allowed here
 Ambiguous: is ambiguous
 Action: Action
-For: for
+For: for
+Address: Address
+NoContactAddress: No contact details known!

messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg

@@ -71,6 +71,7 @@ BreadcrumbError: Fehler
 BreadcrumbUpload !ident-ok: Upload
 BreadcrumbUserAdd: Benutzer:in anlegen
 BreadcrumbUserNotifications: Benachrichtigungs-Einstellungen
+BreadcrumbUserRecipients: Benachrichtigungs-Empfänger
 BreadcrumbUserPassword: Passwort
 BreadcrumbAdminHeading !ident-ok: Administration
 BreadcrumbAdminFeaturesHeading: Studiengänge

messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg

@@ -71,6 +71,7 @@ BreadcrumbError: Error
 BreadcrumbUpload: Upload
 BreadcrumbUserAdd: Add user
 BreadcrumbUserNotifications: Notification settings
+BreadcrumbUserRecipients: Notification recipients
 BreadcrumbUserPassword: Password
 BreadcrumbAdminHeading: Administration
 BreadcrumbAdminFeaturesHeading: Features of study

routes

@@ -58,6 +58,7 @@
 /users/#CryptoUUIDUser/hijack         AdminHijackUserR GET POST       !adminANDno-escalation
 /users/#CryptoUUIDUser/notifications  UserNotificationR           GET POST   !self
 /users/#CryptoUUIDUser/password       UserPasswordR               GET POST   !selfANDis-pw-hash
+/users/#CryptoUUIDUser/recipients     UserRecipientsR             GET        !self
 !/users/functionary-invite/new        AdminNewFunctionaryInviteR  GET POST
 !/users/functionary-invite            AdminFunctionaryInviteR     GET POST
 !/users/add                   AdminUserAddR    GET POST

src/Foundation/Navigation.hs

@@ -103,6 +103,7 @@ breadcrumb (UserPasswordR cID) = useRunDB $ do
       -> i18nCrumb MsgMenuUserPassword . Just $ AdminUserR cID
     | otherwise
       -> i18nCrumb MsgMenuUserPassword $ Just ProfileR
+breadcrumb (UserRecipientsR     cID) = i18nCrumb MsgBreadcrumbUserRecipients . Just $ AdminUserR cID
 breadcrumb AdminNewFunctionaryInviteR = i18nCrumb MsgMenuLecturerInvite $ Just UsersR
 breadcrumb AdminFunctionaryInviteR = i18nCrumb MsgBreadcrumbFunctionaryInvite Nothing
 

src/Handler/Profile.hs

@@ -14,11 +14,13 @@ module Handler.Profile
   , getSetDisplayEmailR, postSetDisplayEmailR
   , getCsvOptionsR, postCsvOptionsR
   , postLangR
+  , getUserRecipientsR
   ) where
 
 import Import
 
 import Handler.Utils
+import Handler.Utils.Avs
 import Handler.Utils.AvsUpdate
 import Handler.Utils.Profile
 import Handler.Utils.Users
@@ -1125,9 +1127,8 @@ mkSupervisorsTable uid = dbTableWidget' validator DBTable{..}
         -- , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal)       $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
         , sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \row ->
             let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications
-                isLetter  = row ^. resultUser . _userPrefersPostal
             in  if isReroute
-                  then iconCell IconReroute <> spacerCell <> iconFixedCell (iconLetterOrEmail isLetter)
+                  then iconCell IconReroute <> blankCell <> cellMailPrefPin (row ^. resultUser)
                   else mempty
         , sortable (Just "cshort")      (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
         , sortable (Just "reason")      (i18nCell MsgTableReason)  $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason  -> mr) -> maybeCell mr textCell
@@ -1205,6 +1206,102 @@ mkSuperviseesTable userPrefersPostal uid = dbTableWidget' validator DBTable{..}
     dbtExtraReps = []
 
 
+type TblReceiverData = DBRow (Entity User, Maybe (Entity UserSupervisor))
+instance HasEntity TblReceiverData User where
+  hasEntity = _dbrOutput . _1
+instance HasUser TblReceiverData where
+  hasUser = _dbrOutput . _1 . _entityVal
+
+-- | Table listing all supervisor of the given user
+mkReceiversTable :: UserId -> [Entity User] -> DB Widget
+mkReceiversTable uid receivers = dbTableDB' validator DBTable{..}
+  where
+    dbtIdent = "receivers" :: Text
+    dbtStyle = def
+
+    queryReceiver :: E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity UserSupervisor)) -> E.SqlExpr (Entity User)
+    queryReceiver = $(E.sqlLOJproj 2 1)
+    queryReceiverSupervisor :: E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity UserSupervisor)) -> E.SqlExpr (Maybe (Entity UserSupervisor))
+    queryReceiverSupervisor = $(E.sqlLOJproj 2 2)
+
+    resultReceiver :: Lens' TblReceiverData (Entity User)
+    resultReceiver = _dbrOutput . _1
+    resultReceiverSupervisor :: Traversal' TblReceiverData (Entity UserSupervisor)
+    resultReceiverSupervisor = _dbrOutput . _2 . _Just
+
+    dbtSQLQuery (usr `E.LeftOuterJoin` spr) = do
+        EL.on $ spr E.?. UserSupervisorSupervisor E.?=. usr E.^. UserId
+          E.&&. spr E.?. UserSupervisorUser       E.?=. E.val uid
+        E.where_ $ usr E.^. UserId `E.in_` E.vals (entityKey <$> receivers)
+        return (usr, spr)
+    dbtRowKey (usr `E.LeftOuterJoin` _) = usr E.^. UserId
+    dbtProj = dbtProjId
+
+    dbtColonnade = mconcat
+        [ colUserNameModalHdr MsgCommRecipients ForProfileDataR
+        -- , colUserEmail
+        , sortable Nothing (i18nCell MsgAddress) $ \(view resultReceiver -> rcvr) -> sqlCell $ -- recall: requires dbTableDB' above!
+            getPostalPreferenceAndAddress' rcvr >>= \case
+              (False, _, (Just eml, auto)) -> do -- email
+                return [whamlet|
+                    <p>
+                      ^{widgetMailPrefPin rcvr} #
+                      ^{updateAutomatic auto} #
+                    <p>
+                      #{mailtoHtml eml}
+                  |]
+              (True, (Just postal, auto), _) -> do -- postal
+                return [whamlet|
+                    <p>
+                      ^{widgetMailPrefPin rcvr} #
+                      ^{updateAutomatic auto}
+                    <p>
+                      #{postal}
+                  |]
+              _ -> return $ msg2widget MsgNoContactAddress
+        , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \(view $ resultReceiver . _entityKey -> ruid) -> sqlCell
+            (maybeMonoid <$> wgtCompanies ruid) -- TODO: user wgtCompanies' to check mismatch in companies
+        -- , colUserLetterEmailPin
+        -- , sortable (Just "rerouted")    (i18nCell MsgTableRerouteActive)  $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> indicatorCell <> ifIconCell b IconReroute
+        -- , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal)       $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
+        -- , sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \row ->
+        --     let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications
+        --     in  if isReroute
+        --           then iconCell IconReroute <> blankCell <> cellMailPrefPin (row ^. resultUser)
+        --           else mempty
+        , sortable (Just "cshort")      (i18nCell MsgTableCompany) $ \(preview $ resultReceiverSupervisor . _entityVal . _userSupervisorCompany . _Just -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
+        , sortable (Just "reason")      (i18nCell MsgTableReason)  $ \(preview $ resultReceiverSupervisor . _entityVal . _userSupervisorReason  . _Just -> mr) -> maybeCell mr textCell
+        ]
+    validator = def -- & defaultSorting [ SortAscBy "cshort", SortAscBy "user-name" ]
+    dbtSorting = Map.fromList
+        [ sortUserNameLink        queryReceiver
+        -- , sortUserLetterEmailPin  queryReceiver
+        , sortUserEmail           queryReceiver
+        , ("user-company"     , SortColumn (\row -> E.subSelect $ do
+              (cmp :& usrCmp) <- E.from $ E.table @Company `E.innerJoin` E.table @UserCompany `E.on` (\(cmp :& usrCmp) -> cmp E.^. CompanyId E.==. usrCmp E.^. UserCompanyCompany)
+              E.where_ $ usrCmp E.^. UserCompanyUser E.==. queryReceiver row E.^. UserId
+              E.orderBy [E.asc $ cmp E.^. CompanyName]
+              return (cmp E.^. CompanyName)
+            ))
+        -- , singletonMap "postal-pref"  $ SortColumn $ queryUser            >>> (E.^. UserPrefersPostal)
+        -- , singletonMap "rerouted"     $ SortColumn $ queryUserSupervisor  >>> (E.^. UserSupervisorRerouteNotifications)
+        -- -- , singletonMap "reroute"      $ SortColumn $ queryUserSupervisor &&& queryUser >>> (\(spr,usr) ->  mTuple (spr E.^. UserSupervisorRerouteNotifications) (usr E.^. UserPrefersPostal))
+        -- , singletonMap "reroute"      $ SortColumns  $ \row ->
+        --     [ SomeExprValue $ queryUserSupervisor row E.^. UserSupervisorRerouteNotifications
+        --     , SomeExprValue $ queryUser           row E.^. UserPrefersPostal
+        --     ]
+        , ("cshort", SortColumn $ queryReceiverSupervisor  >>> (E.?. UserSupervisorCompany))
+        , ("reason", SortColumn $ queryReceiverSupervisor  >>> (E.?. UserSupervisorReason))
+        ]
+    dbtFilter  = mconcat
+        [ singletonMap & uncurry $ fltrUserNameEmail queryReceiver
+        ]
+    dbtFilterUI = mempty
+    dbtParams = def
+    dbtCsvEncode = noCsvEncode
+    dbtCsvDecode = Nothing
+    dbtExtraReps = []
+
 getAuthPredsR, postAuthPredsR :: Handler Html
 getAuthPredsR = postAuthPredsR
 postAuthPredsR = do
@@ -1356,3 +1453,52 @@ postLangR = do
   addMessage Success . toHtml $ mr MsgLanguageChanged
 
   redirect . fromMaybe NewsR =<< lookupGlobalGetParam GetReferer
+
+
+getUserRecipientsR :: CryptoUUIDUser -> Handler Html
+getUserRecipientsR uuid = do
+  uid <- decrypt uuid
+  (usr, receivers, usrReceives) <- updateReceivers uid -- if this is two due to the AVS queries, try Handler.Utils.getReceivers instead
+  mrtbl <- case receivers of
+            []                -> return Nothing -- no receivers
+            [_] | usrReceives -> return Nothing -- only user receives for themself
+            _ -> Just <$> runDB (mkReceiversTable uid receivers)
+  let heading = MsgUserRecipientsTitle $ usr ^. _userDisplayName
+      usrWgt = userWidget usr
+      hasPwd = isJust $ usr ^. _userPinPassword
+  siteLayoutMsg heading $ do
+    setTitleI heading -- TODO: translate to i18nWidgetFile
+    [whamlet|
+      <section>
+        <p>
+          Benachrichtigungen für ^{usrWgt} ^{widgetMailPrefPin usr} #
+            $if usrReceives
+              gehen #
+              $maybe _ <- mrtbl
+                ebenfalls an die unten aufgeführten Personen:
+              $nothing
+                nur an diese Person selbst.
+            $else
+              $maybe _ <- mrtbl
+                gehen tatsächlich nur an die unten aufgeführten Personen:
+              $nothing
+                werden momentan an niemanden zugestellt!
+        $maybe tbl <- mrtbl
+          <p>
+            ^{tbl}
+          <p>
+            <h4>
+              Hinweise:
+            Mit welchem Passwort PDF Anhänge geschützt werden, hängt von der Nachricht ab. #
+
+            Zum Beispiel werden Pin Briefe für ablaufende Qualifikationen #
+            $if hasPwd
+              mit dem Passwort von ^{usrWgt} geschützt. #
+            $else
+              nicht geschützt, da kein Pin Passwort gesetzt ist. #
+
+            Für andere Benachrichtigungen wird meist das Passwort des tatsächlichen Empfängers gewählt, sofern eins gesetzt wurde.
+
+            Die Voreinstellung für das PDF Passwort ist die Hauptausweisnummer, inklusive Punkt.
+    |]
+

src/Handler/Users.hs

@@ -132,6 +132,7 @@ postUsersR = do
       , sortable (Just "last-login") (i18nCell MsgLastLogin)  $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastAuthentication
       , sortable (Just "auth-ldap")  (i18nCell MsgAuthMode)   $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication
       , colUserEmail
+      , colUserLetterEmailPin
       , sortable (Just "ldap-sync")  (i18nCell MsgLdapSynced) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastLdapSynchronisation
       , flip foldMap universeF $ \function ->
           sortable (Just $ SortingKey $ CI.mk $ toPathPiece function) (i18nCell function) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
@@ -223,6 +224,7 @@ postUsersR = do
             ) | function <- universeF
           ] ++
           [ sortUserEmail id
+          , sortUserLetterEmailPin id
           , ( "name"
             , SortColumn (E.^. UserSurname)
             )

src/Handler/Utils/Company.hs

@@ -38,14 +38,18 @@ company2msg :: CompanyId -> SomeMessage UniWorX
 company2msg = text2message . ciOriginal . unCompanyKey
 
 wgtCompanies :: UserId -> DB (Maybe Widget)
-wgtCompanies = \uid -> do
+wgtCompanies = (fst <<$>>) . wgtCompanies'
+
+-- | Given a UserId, create widgets showing top-companies (with internal link) and associated companies (unlinked)
+wgtCompanies' :: UserId -> DB (Maybe (Widget, [CompanyShorthand]))
+wgtCompanies' uid = do
     companies <- E.select $ do
       (usrComp :& comp) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @Company
         `E.on` (\(usrComp :& comp) -> usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId)
       E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
       E.orderBy [E.asc (comp E.^. CompanyName)]
       return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor, usrComp E.^. UserCompanyPriority)
-    let (mPri, topCmp, otherCmp) = procCmp mPri companies
+    let (mPri, topCmp, otherCmp, topIds) = procCmp mPri companies
         resWgt =
           [whamlet|
             $forall c <- topCmp
@@ -55,14 +59,18 @@ wgtCompanies = \uid -> do
               <p>
                 ^{c}
           |]
-    return $ toMaybe (notNull topCmp) resWgt
+    return $ toMaybe (notNull topCmp) (resWgt, topIds)
   where
-    procCmp _ [] = (0, [], [])
+    procCmp _ [] = (0, [], [], [])
     procCmp maxPri ((E.Value cmpSh, E.Value cmpName, E.Value cmpSpr, E.Value cmpPrio) : cs) =
       let isTop  = cmpPrio >= maxPri
           cmpWgt = companyWidget isTop (cmpSh, cmpName, cmpSpr)
-          (accPri,accTop,accRem) = procCmp maxPri cs
+          (accPri,accTop,accRem,accTopId) = procCmp maxPri cs
-      in (max cmpPrio accPri, bool accTop (cmpWgt : accTop) isTop, bool (cmpWgt : accRem) accRem isTop) -- lazy evaluation after repmin example, don't factor out the bool!
+      in  ( max cmpPrio accPri
+          , bool           accTop  (cmpWgt : accTop)    isTop -- lazy evaluation after repmin example, don't factor out the bool!
+          , bool (cmpWgt : accRem)           accRem     isTop
+          , bool           accTopId (cmpSh : accTopId)  isTop
+          )
 
 type AnySuperReason = Either SupervisorReason (Maybe Text)
 

src/Handler/Utils/Table/Cells.hs

@@ -32,6 +32,9 @@ spacerCell = cell [whamlet| |]
 semicolonCell :: IsDBTable m a => DBCell m a
 semicolonCell = cell [whamlet|; |]
 
+blankCell :: IsDBTable m a => DBCell m a
+blankCell = textCell " "
+
 -- | Contribute to DBResult. BEWARE: only shown cells are executed; pagination makes tellCell useless for rowcounts; instead use dbtProj for computations on all rows regardless of pagination
 tellCell :: IsDBTable m a => a -> DBCell m a -> DBCell m a
 tellCell = flip mappend . writerCell . tell
@@ -116,7 +119,7 @@ iconBoolCell :: IsDBTable m a => Bool -> DBCell m a
 iconBoolCell = cell . toWidget . boolSymbol
 
 ifIconCell :: IsDBTable m a => Bool -> Icon -> DBCell m a
-ifIconCell True  = iconCell
+ifIconCell True  = iconFixedCell . icon
 ifIconCell False = const iconSpacerCell
 
 addIconFixedWidth :: IsDBTable m a => DBCell m a -> DBCell m a
@@ -218,12 +221,22 @@ emailCell :: IsDBTable m a => CI Text -> DBCell m a
 emailCell email = cell $(widgetFile "widgets/link-email")
   where linkText= toWgt email
 
-cellMailPrefPin :: (IsDBTable m a, HasUser u) => u -> DBCell m a
+
+cellMailPrefPin :: (IsDBTable m a, HasEntity u User) => u -> DBCell m a
 cellMailPrefPin usr =
-    iconFixedCell (iconLetterOrEmail prefPost) <> ifIconCell (not prefPost && hasPin) IconPinProtect
+  let userEntity = usr ^. hasEntityUser
-  where
+      uid = userEntity ^. _entityKey
-    prefPost =         usr ^. _userPrefersPostal
+      rwgt = do
-    hasPin   = isJust (usr ^. _userPinPassword)
+              uuid <- liftHandler $ encrypt uid
+              modal (widgetMailPrefPin userEntity) (Left $ SomeRoute $ UserRecipientsR uuid)
+  in cell rwgt -- addIconFixedWidth
+
+-- cellMailPrefPin :: (IsDBTable m a, HasUser u) => u -> DBCell m a
+-- cellMailPrefPin usr =
+--     iconFixedCell (iconLetterOrEmail prefPost) <> blankCell <> ifIconCell (not prefPost && hasPin) IconPinProtect
+--   where
+--     prefPost =         usr ^. _userPrefersPostal
+--     hasPin   = isJust (usr ^. _userPinPassword)
 
 cellHasUser :: (IsDBTable m c, HasUser a) => a -> DBCell m c
 cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname)

src/Handler/Utils/Table/Columns.hs

@@ -495,7 +495,7 @@ fltrUserEmailUI mPrev =
 
 
 -- | Icon column showing whether the user prefers emails, and if so, whether a pdf password is set
-colUserLetterEmailPin ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
+colUserLetterEmailPin ::  (IsDBTable m c, HasEntity a User) => Colonnade Sortable a (DBCell m c)
 colUserLetterEmailPin = sortable (Just "user-mail-pref-pin") (i18nCell MsgPrefersPostal) cellMailPrefPin
 
 sortUserLetterEmailPin :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t r')

src/Handler/Utils/Users.hs

@@ -91,7 +91,8 @@ getUserPrimaryCompanyAddress uid prj = runMaybeT $ do
   MaybeT $ pure $ prj company
 
 
--- | result (True, Nothing, Nothing) indicates that neither userEmail nor userPostAddress is known
+-- | Compute actual address for user; returning True for Postal preference, as well as address (user or company) and primary e-mail
+--   result (True, Nothing, Nothing) indicates that neither userEmail nor userPostAddress is known
 getPostalPreferenceAndAddress :: Entity User -> DB (Bool, Maybe [Text], Maybe UserEmail)
 getPostalPreferenceAndAddress usr = do
   pa <- getPostalAddress usr

src/Handler/Utils/Widgets.hs

@@ -172,6 +172,15 @@ companyWidget isPrimary (csh, cname, isSupervisor)
       | isSupervisor = text2markup (corg <> " ")
       | otherwise    = text2markup  corg
 
+widgetMailPrefPin :: HasUser u => u -> Widget   -- TODO: move to appropriate module
+widgetMailPrefPin usr = if not prefPost && hasPin
+    then [whamlet|^{modWgt} ^{pinWgt}|]
+    else modWgt
+  where
+    prefPost :: Bool   =         usr ^. _userPrefersPostal
+    hasPin   :: Bool   = isJust (usr ^. _userPinPassword)
+    modWgt   :: Widget = toWidget $ iconLetterOrEmail prefPost
+    pinWgt   :: Widget = toWidget   iconPinProtect
 
 ---------------------
 -- Status Tooltips --

test/Database/Fill.hs

@@ -645,13 +645,13 @@ fillDb = do
             I am aware that violations in the form plagiarism or collaboration with third parties will lead to expulsion from the course.
         |]
     }
-  fraportAg <- insert' $ Company "Fraport AG"                                          "Fraport"    1    True  (Just $ markdownToStoredMarkup ("Frankfurt Airport Services Worldwide\n60547 Frankfurt am Main"::Text)) (Just "fraport@fraport.de")
+  fraportAg <- insert' $ Company "Fraport AG"                                          "Fraport"    1    True  (Just $ markdownToStoredMarkup ("Frankfurt Airport Services Worldwide\n60547 Frankfurt am Main"::Text)) (Just "fraport@fraport.de")              False
-  fraGround <- insert' $ Company "Fraport Ground Handling Professionals GmbH"          "FraGround"  2    True  (Just $ markdownToStoredMarkup ("Sauerbierstraße 772 \nBürokomplex 80/C/1\n112233 Nieder-Tupfing-Hohen-Kreisingen\nTöpferbezirk"::Text)) Nothing
+  fraGround <- insert' $ Company "Fraport Ground Handling Professionals GmbH"          "FraGround"  2    True  (Just $ markdownToStoredMarkup ("Sauerbierstraße 772 \nBürokomplex 80/C/1\n112233 Nieder-Tupfing-Hohen-Kreisingen\nTöpferbezirk"::Text)) Nothing True
-  nice      <- insert' $ Company "N*ICE Aircraft Services & Support GmbH"              "N*ICE"      33   False (Just $ markdownToStoredMarkup ("69 Nevermore Blvd.\nHarlaemn\nNew York\nUSA"::Text)) (Just "badguy@nice.com")
+  nice      <- insert' $ Company "N*ICE Aircraft Services & Support GmbH"              "N*ICE"      33   False (Just $ markdownToStoredMarkup ("69 Nevermore Blvd.\nHarlaemn\nNew York\nUSA"::Text)) (Just "badguy@nice.com")                                   False
-  ffacil    <- insert' $ Company "Fraport Facility Services GmbH"                      "GCS"        44   False Nothing $ Just "gcs@gcs.com"
+  ffacil    <- insert' $ Company "Fraport Facility Services GmbH"                      "GCS"        44   False Nothing(Just "gcs@gcs.com") True
-  bpol      <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main"  "BPol"       5555 False Nothing Nothing
+  bpol      <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main"  "BPol"       5555 False Nothing Nothing False
-  _noone    <- insert' $ Company "Vollautomaten GmbH"                                  "NoOne"      3    True  Nothing Nothing
+  _noone    <- insert' $ Company "Vollautomaten GmbH"                                  "NoOne"      3    True  Nothing Nothing True
-  randComps <- insertMany [Company rcName rcShort n neven Nothing Nothing | n <- [1001..2002]
+  randComps <- insertMany [Company rcName rcShort n neven Nothing Nothing True | n <- [1001..2002]
                           , let neven   = even n
                           , let rcName  = CI.mk $ "Random Corp " <> tshow n <> bool "" " GmbH" (even n)
                           , let rcShort = CI.mk $ "RC" <> tshow n