Merge branch 'fradrive/company'

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

@@ -20,6 +20,8 @@ UnauthorizedTokenInvalidAuthorityValue: Ihr Authorisierungs-Token basiert auf Re
 UnauthorizedTokenInvalidImpersonation: Ihr Authorisierungs-Token enthält die Anweisung sich als ein Nutzer:in auszugeben, dies ist jedoch nicht allen Benutzer:innen, auf deren Rechten ihr Authorisierungs-Token basiert, erlaubt.
 UnauthorizedToken404: Authorisierungs-Tokens können nicht auf Fehlerseiten ausgewertet werden.
 UnauthorizedSupervisor: Sie sind kein Ansprechpartner:in für diesen Benutzer:in.
+UnauthorizedAnySupervisor: Sie sind kein Ansprechpartner:in.
+UnauthorizedCompanySupervisor fsh@CompanyShorthand: Sie sind kein Standard Ansprechpartner:in für Firma #{fsh}.
 UnauthorizedSiteAdmin: Sie sind nicht System-weiter Administrator:in.
 UnauthorizedSchoolAdmin: Sie sind nicht als Administrator:in für diesen Bereich eingetragen.
 UnauthorizedAdminEscalation: Sie sind nicht Administrator:in für alle Bereiche, für die dieser Nutzer/diese Nutzerin Administrator:in oder Veranstalter:in ist.

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

@@ -20,6 +20,8 @@ UnauthorizedTokenInvalidAuthorityValue: The specification of the rights in which
 UnauthorizedTokenInvalidImpersonation: Your authorisation-token contains an instruction to impersonate an user. Not all users on whose rights your token is based however are permitted to do so.
 UnauthorizedToken404: Authorisation-tokens cannot be processed on error pages.
 UnauthorizedSupervisor: You are not a supervisor for the requested user.
+UnauthorizedAnySupervisor: You are not a supervisor.
+UnauthorizedCompanySupervisor fsh: You are not a default supervisor for company #{fsh}.
 UnauthorizedSiteAdmin: You are no system-wide administrator.
 UnauthorizedSchoolAdmin: You are no administrator for this department.
 UnauthorizedAdminEscalation: You aren't an administrator for all departments for which this user is an administrator.

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

@@ -0,0 +1,39 @@
+# SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de>
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
+FirmAssociates: Firmenangehörige
+FirmEmail: Allgemeine Email
+FirmAddress: Postanschrift
+FirmDefaultPreferenceInfo: Diese Voreinstellungen gelten nur für neue Firmenangehörige
+FirmAllActNotify: Mitteilung versenden
+FirmAllActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen
+FirmAllActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten?
+FirmAllActResetMutualSupervision: Ansprechpartner beaufsichtigen sich gegenseitig
+FirmUserActNotify: Mitteilung versenden
+FirmUserActResetSupervision: Ansprechpartner auf Firmenstandard zurücksetzen
+FirmUserActMkSuper: Zum Firmenansprechpartner ernennen
+FirmResetSupervision rem@Int64 set@Int64: #{tshow set} Ansprechpartner gesetzt#{bool mempty (", " <> tshow rem <> " zuvor gelöscht") (rem > 0)}
+FirmSuperActNotify: Mitteilung versenden
+FirmSuperActRMSuperDef: Standard Firmenansprechpartner entfernen
+FirmSuperActRMSuperAll: Als aktiven Ansprechpartner komplett entfernen
+FirmsNotification: Firmen Benachrichtigung versenden
+FirmNotification fsh@CompanyShorthand: Benachrichtigung an #{fsh} versenden
+FirmsNotificationTitle: Firmen benachrichtigen
+FirmNotificationTitle fsh@CompanyShorthand: #{fsh} benachrichtigen
+FilterSupervisor: Hat aktiven Ansprechpartner
+FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, #{fsh} der angehört
+FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört
+FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
+FilterFirmExtern: Externe Firma
+FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
+FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit
+FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}
+NoCompanySelected: Bitte wählen Sie mindestens eine Firm aus.
+TableIsDefaultSupervisor: Standardansprechpartner
+TableIsDefaultReroute: Standardumleitung
+ASReqPostal: Benachrichtigungseinstellung
+ASReqPostalTip: Gilt für alle Benachrichtigungen an diese Person, nicht nur für Umleitungen an diesen Ansprechpartner
+ASReqEmpty: Es konnten keine Ansprechpartner hinzugefügt werden
+ASReqSetSupers n@Int64 postal@(Maybe Bool): #{n} Standardansprechpartner eingetragen #{maybeBoolMessage postal "" "und auf Briefversand geschaltet" "und Benachrichtigungen per Email gesetzt"}, aber nicht nicht aktiviert.
+RemoveDefaultSupervisors n@Int64: #{n} Standard Ansprechpartner entfernt, aber noch nicht deaktiviert.

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

@@ -0,0 +1,39 @@
+# SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de>
+#
+# SPDX-License-Identifier: AGPL-3.0-or-later
+
+FirmAssociates: Company associated users
+FirmEmail: General company email
+FirmAddress: Postal address
+FirmDefaultPreferenceInfo: Default setting for new company associates only
+FirmAllActNotify: Send message
+FirmAllActResetSupervision: Reset supervisors for all company associates
+FirmUserActNotify: Send message
+FirmAllActResetSuperKeep: Additionally keep existing supervisors of company associates?
+FirmAllActResetMutualSupervision: Supervisors supervise each other
+FirmUserActResetSupervision: Reset supervisors to company default
+FirmResetSupervision rem set: #{tshow set} supervisors set#{bool mempty (", " <> tshow rem <> " deleted before") (rem > 0)}
+FirmUserActMkSuper: Mark as company supervisor
+FirmSuperActNotify: Send message
+FirmSuperActRMSuperDef: Remove as default supervisor
+FirmSuperActRMSuperAll: Remove all active supervisions for this company
+FirmsNotification: Send company notification
+FirmNotification fsh: Send notification to company #{fsh}
+FirmsNotificationTitle: Company notification
+FirmNotificationTitle fsh@CompanyShorthand: #{fsh} notification
+FilterSupervisor: Has active supervisor
+FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh}
+FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh}
+FilterForeignSupervisor: Has company-external supervisors
+FilterFirmExtern: External company
+FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh}
+FirmSupervisorIndependent: Independent supervisors
+FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users
+NoCompanySelected: Select at least one company, please.
+TableIsDefaultSupervisor: Default supervisor
+TableIsDefaultReroute: Default reroute
+ASReqPostal: Notification type
+ASReqPostalTip: Affects all notifications to this person, not just reroutes to this supervisor
+ASReqEmpty: No supervisors added
+ASReqSetSupers n postal: #{n} default company supervisors set #{maybeBoolMessage postal "" "and switched to postal notifications" "and switched to email notifications"}, but not yet activated.
+RemoveDefaultSupervisors n: #{n} default supervisors removed, but not yet deactivated.

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

@@ -15,7 +15,6 @@ ResetPassword: FRADrive-Passwort ändern bzw. setzen
 MailSubjectChangeUserDisplayEmail: E-Mail-Adresse in FRADrive verwenden
 MailIntroChangeUserDisplayEmail displayEmail@UserEmail: Der oben genannte Benutzer/Die oben genannte Benutzerin möchte „#{displayEmail}“ als E-Mail-Adresse in FRADrive verwenden. Wenn Sie diese Aktion nicht selbst ausgelöst haben, ignorieren Sie diese Mitteilung bitte!
 MailTitleChangeUserDisplayEmail displayName@Text: #{displayName} möchte diese E-Mail-Adresse in FRADrive verwenden
-CommCourseSubject: Kursartmitteilung
 InvitationAcceptDecline: Einladung annehmen/ablehnen
 InvitationFromTip displayName@Text: Sie erhalten diese Einladung, weil #{displayName} ihren Versand in FRADrive ausgelöst hat.
 InvitationFromTipAnonymous: Sie erhalten diese Einladung, weil ein nicht eingeloggter Benutzer/eine nichteingeloggte Benutzerin ihren Versand in FRADrive ausgelöst hat.

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

@@ -15,7 +15,6 @@ ResetPassword: Reselt FRADrive password
 MailSubjectChangeUserDisplayEmail: Set email address in FRADrive
 MailIntroChangeUserDisplayEmail displayEmail: The user mentioned above wants to set “#{displayEmail}” as their own email address. If you have not caused this email to be sent, please ignore it!
 MailTitleChangeUserDisplayEmail displayName: #{displayName} wants to set this email address as their own in FRADrive
-CommCourseSubject: Course type message
 InvitationAcceptDecline: Accept/Decline invitation
 InvitationFromTip displayName: You are receiving this invitation because #{displayName} has caused it to be sent from within FRADrive.
 InvitationFromTipAnonymous: You are receiving this invitiation because an user who didn't log in has caused it to be send from within FRADrive.

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

@@ -37,7 +37,8 @@ PDFPassword: Passwort zur Verschlüsselung von PDF Anhängen an Email Benachrich
 PDFPasswordTip: Achtung, dieses Passwort ist für FRADrive Administratoren einsehbar und wird unverschlüsselt gespeichert!
 PDFPasswordInvalid c@Char: Bitte ein nicht-triviales Passwort für PDF Email Anhänge eintragen! Ungültiges Zeichen: #{char2Text c}
 PDFPasswordTooShort n@Int: Bitte ein PDF Passwort mit mindestens #{show n} Zeichen wählen oder Post-Versand aktivieren
-PrefersPostal: Sollen Benachrichtigung möglichst per Post versendet werden anstatt per Email?
+PrefersPostal: Bevorzugte Benachrichtigung
+PrefersPostalExp: 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.

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

@@ -37,7 +37,8 @@ PDFPassword: Password to lock PDF email attachments
 PDFPasswordTip: Please note that this password is displayed to FRADrive admins and is saved unencrypted
 PDFPasswordInvalid c: Please supply a sensible password for encrypting PDF email attachments! Invalid character #{char2Text c}
 PDFPasswordTooShort n: Please provide a password with at least #{show n} characters or choose postal mail
-PrefersPostal: Should notifications preferably send by post instead of email?
+PrefersPostal: Notification preference
+PrefersPostalExp: 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.

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

@@ -133,6 +133,11 @@ MenuLmsFake: Testnutzer generieren
 MenuLmsLearners: Export Benutzer E‑Learning
 MenuLmsReport: Ergebnisse E‑Learning
 
+MenuFirms: Firmen
+MenuFirmUsers: Angehörige
+MenuFirmSupervisors: Ansprechpartner
+MenuFirmsComm: Mitteilung
+
 MenuSap: SAP Schnittstelle
 
 MenuAvs: AVS Schnittstelle

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

@@ -134,6 +134,11 @@ MenuLmsFake: Generate Test Users
 MenuLmsLearners: E‑learning Users
 MenuLmsReport: E‑learning Results
 
+MenuFirms: Companies
+MenuFirmUsers: Associates
+MenuFirmSupervisors: Supervisors
+MenuFirmsComm: Messaging
+
 MenuSap: SAP Interface 
 
 MenuAvs: AVS Interface

messages/uniworx/utils/table_column/de-de-formal.msg

@@ -75,8 +75,23 @@ TableExamOfficeLabelStatus: Label-Farbe
 TableExamOfficeLabelPriority: Label-Priorität
 TableQualifications: Qualifikationen
 TableCompany: Firma
+TableCompanyFilter: Firma oder Nummer
+TableCompanyShort: Firmenkürzel
 TableCompanies: Firmen
+TableCompanyNo: Firmennummer
 TableCompanyNos: Firmennummern
+TableCompanyUser: Firmenangehöriger
+TableCompanyNrUsers: Firmenangehörige
+TableCompanyNrSupers: Ansprechpartner
+TableCompanyNrEmpSupervised: Firmenangehörige mit Ansprechpartner
+TableCompanyNrEmpRerouted: Firmenangehörige mit Umleitung
+TableCompanyNrEmpRerPost: Firmenangehörige mit postalischer Umleitung
+TableCompanyNrSupersActive: Mitarbeiter mit Ansprechpartner
+TableCompanyNrSupersDefault: Standard Ansprechpartner
+TableCompanyNrForeignSupers: Firmenfremde Ansprechpartner
+TableCompanyNrRerouteDefault: Standard Umleitungen
+TableCompanyNrRerouteActive: Aktive Umleitungen
+TableCompanyPostalPreference: Benachrichtigungspräferenz neue Firmenangehörige
 TableSupervisor: Ansprechpartner
 TableCreationTime: Erstellungszeit
 TableJob !ident-ok: Job
@@ -88,3 +103,5 @@ ActJobDelete: Job entfernen
 TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} Jobs entfernt
 TableFilterComma: Es können mehrere alternative Suchkriterien mit Komma getrennt angegeben werden, wovon mindestens eines erfüllt werden muss.
 TableFilterCommaPlus: Mehrere alternative Suchkriterien mit Komma trennen. Mindestens ein Suchkriterium muss erfüllt werden, zusätzlich zu allen Suchkriterien mit vorangestelltem Plus-Symbol.
+TableFilterCommaName: Mehrere Namen mit Komma trennen.
+TableFilterCommaNameNr: Mehrere Namen oder Nummern mit Komma trennen. Nummern werden nur exakt gesucht.

messages/uniworx/utils/table_column/en-eu.msg

@@ -75,8 +75,23 @@ TableExamOfficeLabelStatus: Label colour
 TableExamOfficeLabelPriority: Label priority
 TableQualifications: Qualifications
 TableCompany: Company
+TableCompanyFilter: Company/Nr
+TableCompanyShort: Company shorthand
 TableCompanies: Companies
+TableCompanyNo: Company number
 TableCompanyNos: Company numbers
+TableCompanyUser: Associate
+TableCompanyNrUsers: Associates
+TableCompanyNrSupers: Supervisors
+TableCompanyNrEmpSupervised: Supervised employees 
+TableCompanyNrEmpRerouted: Employees having reroute
+TableCompanyNrEmpRerPost: Employees having postal reroute
+TableCompanyNrSupersActive: Associates having supervisors
+TableCompanyNrSupersDefault: Default supervisors
+TableCompanyNrForeignSupers: External Supervisors
+TableCompanyNrRerouteDefault: Default reroutes
+TableCompanyNrRerouteActive: Active reroutes
+TableCompanyPostalPreference: Default notification preference
 TableSupervisor: Supervisor
 TableCreationTime: Creation
 TableJob !ident-ok: Job
@@ -88,3 +103,5 @@ ActJobDelete: Delete job
 TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} queued jobs deleted
 TableFilterComma: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled.
 TableFilterCommaPlus: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled in addition to all criteria preceded by a plus symbol.
+TableFilterCommaName: Separate names by comma.
+TableFilterCommaNameNr: Separate names and numbers by comma. Numbers have to match exact.

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

@@ -13,10 +13,13 @@ RGCourseUnacceptedApplicants: Nicht akzeptierte Bewerber:innen
 RecipientToggleAll: Alle/Keine
 CommCourseTestSubject customSubject@Text !ident-ok: [TEST] #{customSubject}
 UtilCommCourseSubject: Kursartmitteilung
+UtilCommFirmSubject: Firmenmitteilung
 CommRecipients: Empfänger:innen
 CommRecipientsTip: Sie selbst erhalten immer eine Kopie der Nachricht
 CommRecipientsList: Die an Sie selbst verschickte Kopie der Nachricht wird, zu Archivierungszwecken, eine vollständige Liste aller Empfänger:innen enthalten. Die Empfängerliste wird im CSV-Format an die E-Mail angehängt. Andere Empfänger:innen erhalten die Liste nicht. Bitte entfernen Sie dementsprechend den Anhang bevor Sie die E-Mail weiterleiten oder anderweitig mit Dritten teilen.
 UtilEMail: E-Mail
+UtilPostal: Brief
+UtilUnchanged: Nicht verändern
 UtilMultiEmailFieldTip: Es sind mehrere, Komma-separierte, E-Mail-Adressen möglich
 RGTutorialParticipants tutn@TutorialName: Kursteilnehmer:innen (#{tutn})
 RGExamRegistered examn@ExamName: Angemeldet zur Prüfung „#{examn}“
@@ -93,6 +96,7 @@ RoomReferenceLinkLink !ident-ok: Link
 RoomReferenceLinkLinkPlaceholder !ident-ok: URL
 RoomReferenceLinkInstructions: Anweisungen
 RoomReferenceLinkInstructionsPlaceholder: Anweisungen
+UtilEmptyChoice: Auswahl war leer
 
 #invitation.hs
 InvitationAction: Aktion

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

@@ -13,10 +13,13 @@ RGCourseUnacceptedApplicants: Applicants not accepted
 RecipientToggleAll: All/None
 CommCourseTestSubject customSubject: [TEST] #{customSubject}
 UtilCommCourseSubject: Course type message
+UtilCommFirmSubject: Company message 
 CommRecipients: Recipients
 CommRecipientsTip: You always receive a copy of the message
 CommRecipientsList: For archival purposes the copy of the message sent to you will contain a complete list of all recipients. The list of recipients will be attached to the email in CSV-format. Other recipients do not receive the list. Thus, please remove the attachment before you forward the email or otherwise share it with third parties.
 UtilEMail: Email
+UtilPostal: Postal
+UtilUnchanged: No change
 UtilMultiEmailFieldTip: Multiple emails addresses may be specified (comma-separated)
 RGTutorialParticipants tutn: Course participants (#{tutn})
 RGExamRegistered examn: Registered for exam “#{examn}”
@@ -93,6 +96,7 @@ RoomReferenceLinkLink: Link
 RoomReferenceLinkLinkPlaceholder: URL
 RoomReferenceLinkInstructions: Instructions
 RoomReferenceLinkInstructionsPlaceholder: Instructions
+UtilEmptyChoice: Empty selection
 
 #invitation.hs
 InvitationAction: Action

models/company.model

@@ -10,6 +10,7 @@ Company
   avsId           Int     default=0       -- primary key from avs
   prefersPostal   Bool    default=false   -- new company users prefers letters by post instead of email
   postAddress     StoredMarkup Maybe      -- default company postal address 
+  email           UserEmail Maybe         -- Case-insensitive generic company eMail address
   UniqueCompanyName name 
   UniqueCompanyShorthand shorthand
   -- UniqueCompanyAvsId avsId             -- should be the case, unclear if enforcing works here, since we cannot query avs by company id

package.yaml

@@ -259,6 +259,7 @@ ghc-options:
   - -j
   - -freduction-depth=0
   - -fprof-auto-calls
+  - -g
 when:
   - condition: flag(pedantic)
     ghc-options:

routes

@@ -113,6 +113,12 @@
 /for/#CryptoUUIDUser/user         ForProfileR       GET POST    !supervisor !self
 /for/#CryptoUUIDUser/user/profile ForProfileDataR   GET         !supervisor !self
 
+/firms                          FirmAllR            GET POST		!supervisor
+/firms/comm/+Companies          FirmsCommR          GET POST
+/firm/#CompanyShorthand         FirmR               GET POST
+/firm/#CompanyShorthand/comm    FirmCommR						GET POST
+/firm/#CompanyShorthand/users   FirmUsersR          GET POST    !supervisor
+/firm/#CompanyShorthand/supers  FirmSupersR         GET POST    !supervisor
 
 /exam-office               ExamOfficeR                         !exam-office:
   /                        EOExamsR            GET POST        !system-exam-office

src/Application.hs

@@ -159,6 +159,7 @@ import Handler.SAP
 import Handler.PrintCenter
 import Handler.ApiDocs
 import Handler.Swagger
+import Handler.Firm
 
 import ServantApi () -- YesodSubDispatch instances
 import Servant.API

src/Database/Esqueleto/Utils.hs

@@ -18,7 +18,7 @@ module Database.Esqueleto.Utils
   , or, and
   , any, all
   , subSelectAnd, subSelectOr
-  , mkExactFilter, mkExactFilterWith
+  , mkExactFilter, mkExactFilterWith, mkExactFilterWithComma
   , mkExactFilterLast, mkExactFilterLastWith
   , mkExactFilterMaybeLast, mkExactFilterMaybeLast'
   , mkContainsFilter, mkContainsFilterWith
@@ -43,8 +43,10 @@ module Database.Esqueleto.Utils
   , (->.), (->>.), (#>>.)
   , fromSqlKey
   , unKey
+  , subSelectCountDistinct
   , selectCountRows, selectCountDistinct
   , selectMaybe
+  , num2text
   , day, day', dayMaybe, interval, diffDays, diffTimes
   , exprLift
   , explicitUnsafeCoerceSqlExprValue
@@ -225,8 +227,8 @@ explicitUnsafeCoerceSqlExprValue typ (E.ERaw _m1 f1) = E.ERaw E.noMeta $ \_nPare
       )
 
 and, or :: Foldable f => f (E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
-and = F.foldr (E.&&.) true
+and = F.foldl' (E.&&.) true -- we can use foldl' since Postgresql reorders conditions anyway
-or = F.foldr (E.||.) false
+or = F.foldl' (E.||.) false
 
 -- | Given a test and a set of values, check whether anyone succeeds the test
 --   WARNING: SQL leaves it explicitely unspecified whether `||` is short curcuited (i.e. lazily evaluated)
@@ -283,6 +285,17 @@ mkExactFilterWith cast lenslike row criterias
   | Set.null criterias = true
   | otherwise = lenslike row `E.in_` E.valList (cast <$> Set.toList criterias)
 
+-- | like `mkExactFilterWith` but splits comma separared Texts into multiple criteria
+mkExactFilterWithComma :: (PersistField b)
+  => (Text -> Maybe b)                   -- ^ type conversion
+  -> (t -> E.SqlExpr (E.Value b))  -- ^ getter from query to searched element
+  -> t                             -- ^ query row
+  -> Set.Set Text                  -- ^ needle collection
+  -> E.SqlExpr (E.Value Bool)
+mkExactFilterWithComma cast lenslike row (foldMap commaSeparatedText -> criterias)
+  | Set.null criterias = true
+  | otherwise = lenslike row `E.in_` E.valList (mapMaybe cast $ Set.toList criterias)
+
 -- | generic filter creation for dbTable
 --   Given a lens-like function, make filter for exact matches against last element of a collection
 mkExactFilterLast :: (PersistField a)
@@ -638,6 +651,12 @@ unKey :: ( Coercible (Key entity) a
       => E.SqlExpr (E.Value (Key entity)) -> E.SqlExpr (E.Value a)
 unKey = E.veryUnsafeCoerceSqlExprValue
 
+-- | distinct version of `Database.Esqueleto.subSelectCount`
+subSelectCountDistinct :: (Num a, PersistField a) => Ex.SqlQuery (Ex.SqlExpr (Ex.Value typ)) -> Ex.SqlExpr (Ex.Value a)
+subSelectCountDistinct query = Ex.subSelectUnsafe (Ex.countDistinct <$> query)
+  
+-- PersistField a => SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a)
+-- countDistinct :: Num a => SqlExpr (Value typ) -> SqlExpr (Value a)
 
 selectCountRows :: (Num a, PersistField a, MonadIO m) => E.SqlQuery ignored -> E.SqlReadT m a
 selectCountRows q = do
@@ -660,10 +679,14 @@ selectCountDistinct q = do
 selectMaybe :: (E.SqlSelect a r, MonadIO m) => E.SqlQuery a -> E.SqlReadT m (Maybe r)
 selectMaybe = fmap listToMaybe . E.select . (<* E.limit 1)
 
+-- | cast numeric type to text, which is safe and allows for an inefficient but safe comparison of numbers stored as text and numbers
+num2text :: Num n => E.SqlExpr (E.Value n) -> E.SqlExpr (E.Value Text)
+num2text = E.unsafeSqlCastAs "text"
 
 day :: E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value Day)
 day = E.unsafeSqlCastAs "date"
 
+-- | cast text to day, truly unsafe
 day' :: E.SqlExpr (E.Value Text) -> E.SqlExpr (E.Value Day)
 day' = E.unsafeSqlCastAs "date"
 

src/Foundation/Authorization.hs

@@ -539,8 +539,11 @@ tagAccessPredicate AuthAdmin = cacheAPSchoolFunction SchoolAdmin (Just $ Right d
         return Authorized
 
 tagAccessPredicate AuthSupervisor = APDB $ \_ _ mAuthId route _ -> case route of 
-    ForProfileR     cID -> checkSupervisor (mAuthId, cID)
+    ForProfileR     cID -> checkSupervisor        (mAuthId, cID)
-    ForProfileDataR cID -> checkSupervisor (mAuthId, cID)
+    ForProfileDataR cID -> checkSupervisor        (mAuthId, cID)
+    FirmAllR            -> checkAnySupervisor      mAuthId
+    FirmUsersR      fsh -> checkCompanySupervisor (mAuthId, fsh)
+    FirmSupersR     fsh -> checkCompanySupervisor (mAuthId, fsh)
     r -> $unsupportedAuthPredicate AuthSupervisor r    
   where 
     checkSupervisor sup@(mAuthId, cID) = $cachedHereBinary sup . exceptT return return $ do
@@ -549,6 +552,16 @@ tagAccessPredicate AuthSupervisor = APDB $ \_ _ mAuthId route _ -> case route of
       isSupervisor <- lift . existsBy $ UniqueUserSupervisor authId uid
       guardMExceptT isSupervisor (unauthorizedI MsgUnauthorizedSupervisor)
       return Authorized
+    checkCompanySupervisor sup@(mAuthId, fsh) = $cachedHereBinary sup . exceptT return return $ do
+      authId <- maybeExceptT AuthenticationRequired $ return mAuthId      
+      isSupervisor <- lift . existsBy $ UniqueUserCompany authId $ CompanyKey fsh
+      guardMExceptT isSupervisor (unauthorizedI $ MsgUnauthorizedCompanySupervisor fsh)
+      return Authorized
+    checkAnySupervisor mAuthId = $cachedHereBinary mAuthId . exceptT return return $ do
+      authId <- maybeExceptT AuthenticationRequired $ return mAuthId      
+      isSupervisor <- lift $ exists [UserSupervisorSupervisor ==. authId]
+      guardMExceptT isSupervisor (unauthorizedI MsgUnauthorizedAnySupervisor)
+      return Authorized
 
 tagAccessPredicate AuthSystemExamOffice = cacheAPSystemFunction SystemExamOffice (Just $ Right diffHour) $ \mAuthId' _ _ examOfficeList -> if
   | maybe True (`Set.notMember` examOfficeList) mAuthId' -> Right $ if

src/Foundation/I18n.hs

@@ -1,7 +1,12 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
+-- To add new language files:
+--   1. include new statement, e.g. mkMessageAddition ''UniWorX "Print" "messages/uniworx/categories/print" "de-de-formal"
+--   2. create appropriate translation files in the specified folder
+--   3. add constructor to list of module exports
+
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -20,6 +25,7 @@ module Foundation.I18n
   , UniWorXI18nMessage(..),UniWorXJobsHandlerMessage(..), UniWorXModelTypesMessage(..), UniWorXYesodMiddlewareMessage(..)
   , UniWorXQualificationMessage(..)
   , UniWorXPrintMessage(..)
+  , UniWorXFirmMessage(..)
   , UniWorXAvsMessage(..)
   , UniWorXAuthorshipStatementMessage(..)
   , ShortTermIdentifier(..)
@@ -197,6 +203,11 @@ maybeToMessage :: ToMessage m => Text -> Maybe m -> Text -> Text
 maybeToMessage _      Nothing  _     = mempty
 maybeToMessage before (Just x) after = before <> toMessage x <> after
 
+maybeBoolMessage :: Maybe Bool -> Text -> Text -> Text -> Text
+maybeBoolMessage Nothing      n _ _ = n
+maybeBoolMessage (Just True)  _ t _ = t
+maybeBoolMessage (Just False) _ _ f = f
+
 
 newtype ShortTermIdentifier = ShortTermIdentifier TermIdentifier
   deriving stock (Eq, Ord, Read, Show)
@@ -233,6 +244,7 @@ mkMessageAddition ''UniWorX "Send" "messages/uniworx/categories/send" "de-de-for
 mkMessageAddition ''UniWorX "YesodMiddleware" "messages/uniworx/categories/yesod_middleware" "de-de-formal"
 mkMessageAddition ''UniWorX "User" "messages/uniworx/categories/user" "de-de-formal"
 mkMessageAddition ''UniWorX "Print" "messages/uniworx/categories/print" "de-de-formal"
+mkMessageAddition ''UniWorX "Firm" "messages/uniworx/categories/firm" "de-de-formal"
 mkMessageAddition ''UniWorX "Button" "messages/uniworx/utils/buttons" "de-de-formal"
 mkMessageAddition ''UniWorX "Form" "messages/uniworx/utils/handler_form" "de-de-formal"
 mkMessageAddition ''UniWorX "TableColumn" "messages/uniworx/utils/table_column" "de-de-formal"

src/Foundation/Navigation.hs

@@ -123,6 +123,13 @@ breadcrumb ProblemFbutNoR       = i18nCrumb MsgProblemsRWithoutFHeading   $ Just
 breadcrumb ProblemAvsSynchR     = i18nCrumb MsgProblemsAvsSynchHeading    $ Just AdminProblemsR
 breadcrumb ProblemAvsErrorR     = i18nCrumb MsgProblemsAvsErrorHeading    $ Just ProblemAvsSynchR
 
+breadcrumb FirmAllR         = i18nCrumb MsgMenuFirms              Nothing
+breadcrumb FirmsCommR{}     = i18nCrumb MsgMenuFirmsComm        $ Just   FirmAllR
+breadcrumb FirmR{}          = i18nCrumb MsgMenuAdminHeading     $ Just   FirmAllR  -- TODO: change heading or remove
+breadcrumb FirmUsersR{}     = i18nCrumb MsgMenuFirmUsers        $ Just   FirmAllR
+breadcrumb (FirmSupersR fsh)= i18nCrumb MsgMenuFirmSupervisors  $ Just $ FirmUsersR fsh
+breadcrumb (FirmCommR   fsh)= i18nCrumb MsgMenuFirmsComm        $ Just $ FirmUsersR fsh                       
+
 breadcrumb PrintCenterR     = i18nCrumb MsgMenuApc              Nothing
 breadcrumb PrintSendR       = i18nCrumb MsgMenuPrintSend      $ Just PrintCenterR
 breadcrumb PrintDownloadR{} = i18nCrumb MsgMenuPrintDownload  $ Just PrintCenterR
@@ -754,6 +761,18 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
         , navForceActive = False
         }
       }
+  , return NavHeader
+      { navHeaderRole = NavHeaderPrimary
+      , navIcon       = IconCompany
+      , navLink       = NavLink
+        { navLabel       = MsgMenuFirms
+        , navRoute       = FirmAllR
+        , navAccess'     = NavAccessTrue
+        , navType        = NavTypeLink { navModal = False }
+        , navQuick'      = mempty
+        , navForceActive = False
+        }
+      }
   , return NavHeader
       { navHeaderRole = NavHeaderPrimary
       , navIcon       = IconPrintCenter
@@ -2398,6 +2417,28 @@ pageActions ApiDocsR = return
     , navChildren = []
     }
   ]
+pageActions (FirmR fsh) = return
+  [ NavPageActionPrimary
+    { navLink = defNavLink MsgTableCompanyNrSupers $ FirmSupersR fsh
+    , navChildren = []
+    }
+  , NavPageActionPrimary
+    { navLink = defNavLink MsgTableCompanyNrUsers  $ FirmUsersR fsh
+    , navChildren = []
+    }
+  ]
+pageActions (FirmUsersR fsh) = return
+  [ NavPageActionPrimary
+    { navLink = defNavLink MsgTableCompanyNrSupers $ FirmSupersR fsh
+    , navChildren = []
+    }  
+  ]
+pageActions (FirmSupersR fsh) = return
+  [ NavPageActionPrimary
+    { navLink = defNavLink MsgTableCompanyNrUsers  $ FirmUsersR fsh
+    , navChildren = []
+    }
+  ]
 pageActions PrintCenterR = do
   openDays <- useRunDB $ Ex.select $ do
     pj <- Ex.from $ Ex.table @PrintJob

src/Handler/Admin/Avs.hs

@@ -555,11 +555,12 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
               E.on $ 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.^. CompanyName, usrComp E.^. UserCompanySupervisor)
+              return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
-            let companies = intersperse (text2markup ", ") $
+            let icnSuper  = toWidget $ text2markup " " <> icon IconSupervisor
-                  (\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
+                companies = 
-                icnSuper = text2markup " " <> icon IconSupervisor
+                  (\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
-            pure $ toWgt $ mconcat companies
+                
+            pure $ intercalate (text2widget "; ") companies
         , sortable (Just "qualification") (i18nCell MsgTableQualifications)          $ \(preview   resultQualification -> q) -> cellMaybe lmsShortCell q
         , sortable (Just "first-held")    (i18nCell MsgTableQualificationFirstHeld)  $ \(preview $ resultQualUser . _entityVal . _qualificationUserFirstHeld   -> d)  -> cellMaybe dayCell d
         , sortable (Just "last-refresh")  (i18nCell MsgTableQualificationLastRefresh)$ \(preview $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d)  -> cellMaybe dayCell d

src/Handler/Course/Communication.hs

@@ -64,8 +64,10 @@ postCCommR tid ssh csh = do
 
     return (cid, tuts, exams, sheets)
 
+  let heading = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommCourseHeading
   commR CommunicationRoute
-    { crHeading    = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommCourseHeading
+    { crHeading    = heading
+    , crTitle      = heading
     , crUltDest    = SomeRoute $ CourseR tid ssh csh CCommR
     , crJobs       = crJobsCourseCommunication cid
     , crTestJobs   = crTestJobsCourseCommunication cid

src/Handler/LMS.hs

@@ -3,7 +3,6 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}      -- needed for HasEntity instances
-{-# OPTIONS -Wno-unused-top-binds #-}      -- TODO: remove me, for debugging only
 {-# LANGUAGE TypeApplications #-}
 
 module Handler.LMS
@@ -42,7 +41,7 @@ import qualified Data.Set as Set
 import qualified Data.Map as Map
 import qualified Data.Csv as Csv
 import qualified Data.Text as T
-import qualified Data.CaseInsensitive as CI
+-- import qualified Data.CaseInsensitive as CI
 import qualified Data.Conduit.List as C
 import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Experimental as Ex -- needs TypeApplications Lang-Pragma
@@ -360,9 +359,8 @@ data LmsTableAction = LmsActNotify
                     | LmsActReset
                     | LmsActRestart
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
+  deriving anyclass (Universe, Finite)
   
-instance Universe LmsTableAction
-instance Finite LmsTableAction
 nullaryPathPiece ''LmsTableAction $ camelToPathPiece' 2
 embedRenderMessage ''UniWorX ''LmsTableAction id
 
@@ -445,7 +443,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
     cmps <- selectList [] [] -- [Asc CompanyShorthand]
     return $ Map.fromList $ fmap (\Entity{..} -> (entityKey, entityVal)) cmps
   let            
-    csvName = T.replace " " "-" $ CI.original (quali ^. _qualificationName)
+    csvName = T.replace " " "-" $ ciOriginal (quali ^. _qualificationName)
     dbtIdent :: Text
     dbtIdent = "lms"
     dbtSQLQuery = lmsTableQuery now qid
@@ -506,7 +504,7 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
                 let testname = (E.val criterion :: E.SqlExpr (E.Value (CI Text))) `E.isInfixOf`
                                 (E.explicitUnsafeCoerceSqlExprValue "citext" (comp E.^. CompanyName) :: E.SqlExpr (E.Value (CI Text)))
                     testnumber nr = E.val nr E.==. comp E.^. CompanyAvsId
-                    testcrit = maybe testname testnumber $ readMay $ CI.original criterion
+                    testcrit = maybe testname testnumber $ readMay $ ciOriginal criterion
                 E.on $     usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId
                 E.where_ $ usrComp E.^. UserCompanyUser    E.==. queryUser row E.^. UserId E.&&. testcrit
         )        
@@ -633,18 +631,15 @@ postLmsR sid qsh = do
               <*  aformMessage msgRestartWarning              
           ]        
         colChoices cmpMap = mconcat
-          [ if not isAdmin then mempty else dbSelect (applying _2) id (return . view (resultUser . _entityKey))
+          [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultUser . _entityKey))
           , colUserNameModalHdr MsgLmsUser AdminUserR
           , colUserEmail
           , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
-              let icnSuper = text2markup " " <> icon IconSupervisor
+              let cs =  [ companyCell (unCompanyKey cmpId) cmpName cmpSpr
-                  cs =  [ (cmpName, cmpSpr) 
                         | Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
                         , let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap                        
                         ]
-                  companies = intercalate (text2markup ", ") $
+              in intercalate spacerCell cs
-                    (\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs
-              in wgtCell companies            
           , colUserMatriclenr
           -- , sortable (Just "validity")      (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)          
           , sortable (Just "first-held")    (i18nCell MsgTableQualificationFirstHeld)  $ \(   view $ resultQualUser . _entityVal . _qualificationUserFirstHeld   -> d)  -> dayCell d

src/Handler/Profile.hs

@@ -130,7 +130,7 @@ makeSettingForm template html = do
 
         <*  aformSection MsgFormNotifications
         <*> aopt  (textField & cfStrip) (fslI MsgPDFPassword   & setTooltip MsgPDFPasswordTip) (stgPinPassword   <$> template)
-        <*> apopt checkBoxField         (fslI MsgPrefersPostal & setTooltip MsgPostalTip)      (stgPrefersPostal <$> template)
+        <*> apopt checkBoxField         (fslI MsgPrefersPostalExp & setTooltip MsgPostalTip)      (stgPrefersPostal <$> template)
         <*> aopt  htmlField             (fslI MsgPostAddress   & setTooltip MsgPostAddressTip) (stgPostAddress   <$> template)
 
         <*> examOfficeForm (stgExamOfficeSettings <$> template)        

src/Handler/Qualification.hs

@@ -504,8 +504,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
       , dbParamsFormAttrs  = []
       , dbParamsFormSubmit = FormSubmit
       , dbParamsFormAdditional
-          = renderAForm FormStandard
+          = renderAForm FormStandard $ (, mempty) . First . Just
-                $  (, mempty) . First . Just
               <$> multiActionA acts (fslI MsgTableAction) Nothing
       , dbParamsFormEvaluate = liftHandler . runFormPost
       , dbParamsFormResult   = id
@@ -587,14 +586,11 @@ postQualificationR sid qsh = do
           , colUserNameModalHdr MsgLmsUser linkUserName
           , colUserEmail          
           , sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \( view resultCompanyUser -> cmps) ->
-              let icnSuper = text2markup " " <> icon IconSupervisor
+              let cs =  [ companyCell (unCompanyKey cmpId) cmpName cmpSpr
-                  cs =  [ (cmpName, cmpSpr) 
                         | Entity _ UserCompany{userCompanyCompany=cmpId, userCompanySupervisor=cmpSpr} <- cmps
                         , let cmpName = maybe (unCompanyKey cmpId) companyName $ Map.lookup cmpId cmpMap                        
                         ]
-                  companies = intercalate (text2markup ", ") $
+              in intercalate spacerCell cs
-                    (\(cmpName, cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> cs
-              in wgtCell companies
           , guardMonoid isAdmin colUserMatriclenr
           -- , sortable (Just "validity")      (i18nCell MsgQualificationValidIndicator) (qualificationValidIconCell nowaday . view resultQualUser)
           , sortable (Just "first-held")    (i18nCell MsgTableQualificationFirstHeld)  $    \(   view $ resultQualUser . _entityVal . _qualificationUserFirstHeld   -> d)  -> dayCell d

src/Handler/Tutorial/Communication.hs

@@ -32,9 +32,10 @@ postTCommR tid ssh csh tutn = do
              )
     return (tutData, usertuts)
 
-
+  let heading = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommTutorialHeading
   commR CommunicationRoute
-    { crHeading    = SomeMessage . prependCourseTitle tid ssh csh $ SomeMessage MsgCommTutorialHeading
+    { crHeading    = heading
+    , crTitle      = heading
     , crUltDest    = SomeRoute $ CTutorialR tid ssh csh tutn TCommR
     , crJobs       = crJobsCourseCommunication cid
     , crTestJobs   = crTestJobsCourseCommunication cid

src/Handler/Users.hs

@@ -106,15 +106,16 @@ postUsersR = do
               E.on $ 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.^. CompanyName, usrComp E.^. UserCompanySupervisor)
+              return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)            
-            let companies = intersperse (text2markup ", ") $
+            let icnSuper  = toWidget $ text2markup " " <> icon IconSupervisor
-                  (\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
+                companies = 
-                icnSuper = text2markup " " <> icon IconSupervisor
+                  (\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
-            pure $ toWgt $ mconcat companies
+            pure $ intercalate (text2widget "; ") companies
-      , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
+      -- , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
-          (AdminUserR <$> encrypt uid)
+      --     (AdminUserR <$> encrypt uid)
-          (toWgt userCompanyPersonalNumber)
+      --     (toWgt userCompanyPersonalNumber)
-      , sortable (Just "company-department") (i18nCell MsgCompanyDepartment) $ \DBRow{ dbrOutput = Entity _uid User{..} } -> cellMaybe textCell userCompanyDepartment
+      , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity _uid User{..} } -> cellMaybe textCell userCompanyPersonalNumber
+      , sortable (Just "company-department") (i18nCell MsgCompanyDepartment)  $ \DBRow{ dbrOutput = Entity _uid User{..} } -> cellMaybe textCell userCompanyDepartment
 --       , sortable (Just "last-name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
 --           (AdminUserR <$> encrypt uid)
 --           (toWidget . display $ last $ impureNonNull $ words $ userDisplayName)

src/Handler/Utils/Communication.hs

@@ -8,6 +8,7 @@ module Handler.Utils.Communication
   , Communication(..)
   , commR
   , crJobsCourseCommunication, crTestJobsCourseCommunication
+  , crJobsFirmCommunication, crTestFirmCommunication
   -- * Re-Exports
   , Job(..)
   ) where
@@ -27,9 +28,11 @@ import qualified Data.Conduit.Combinators as C
 
 
 data RecipientGroup = RGCourseParticipants | RGCourseLecturers | RGCourseCorrectors | RGCourseTutors | RGCourseParticipantsInTutorial | RGCourseUnacceptedApplicants
+  -- WARNING: no RenderMessage instance, but a pattern match in templates/widgets/communication/recipientLayout.hamlet that needs to be extended
                     | RGTutorialParticipants CryptoUUIDTutorial
                     | RGExamRegistered CryptoUUIDExam
                     | RGSheetSubmittor CryptoUUIDSheet
+                    | RGFirmSupervisor CompanyShorthand | RGFirmEmployees CompanyShorthand | RGFirmIndependent
   deriving (Eq, Ord, Read, Show, Generic)
 
 instance LowerBounded RecipientGroup where
@@ -77,6 +80,7 @@ data CommunicationRoute = CommunicationRoute
   , crRecipientAuth :: Maybe (UserId -> DB AuthResult) -- ^ Only resolve userids given as GET-Parameter if they fulfil this criterion
   , crJobs, crTestJobs :: Communication -> ConduitT () Job (YesodDB UniWorX) ()
   , crHeading       :: SomeMessage UniWorX
+  , crTitle         :: SomeMessage UniWorX
   , crUltDest       :: SomeRoute UniWorX
   }
 
@@ -107,107 +111,126 @@ crTestJobsCourseCommunication jCourse comm = do
   crJobsCourseCommunication jCourse comm' .| C.filter ((== Right jSender) . jRecipientEmail)
 
 
+crJobsFirmCommunication :: Companies -> Communication -> ConduitT () Job (YesodDB UniWorX) ()
+crJobsFirmCommunication jCompanies Communication{..} = do
+  jSender <- requireAuthId
+  let jMailContent = cContent
+      allRecipients = Set.toList $ Set.insert (Right jSender) cRecipients
+  jMailObjectUUID <- liftIO getRandom
+  jAllRecipientAddresses <- lift . fmap Set.fromList . forM allRecipients $ \case
+    Left email -> return . Address Nothing $ CI.original email
+    Right rid  -> userAddress <$> getJust rid
+  forM_ allRecipients $ \jRecipientEmail ->
+    yield JobSendFirmCommunication{..}
+
+crTestFirmCommunication :: Companies -> Communication -> ConduitT () Job (YesodDB UniWorX) ()
+crTestFirmCommunication jCompanies comm = do
+  jSender <- requireAuthId
+  MsgRenderer mr <- getMsgRenderer
+  let comm' = comm & _cContent . _ccSubject %~ Just . mr . MsgCommCourseTestSubject . fromMaybe (mr MsgUtilCommFirmSubject)
+  crJobsFirmCommunication jCompanies comm' .| C.filter ((== Right jSender) . jRecipientEmail)
+
+
+
+
 commR :: CommunicationRoute -> Handler Html
 commR CommunicationRoute{..} =  do
-  cUser <- maybeAuth
+  let decrypt' :: CryptoUUIDUser -> DB (Maybe (Entity User))
-
-  MsgRenderer mr <- getMsgRenderer
-  mbCurrentRoute <- getCurrentRoute
-
-  (suggestedRecipients, chosenRecipients) <- runDB $ do
-    suggestedUsers <- for crRecipients $ \(_,user) -> E.select user
-    let suggested = zip (view _1 <$> crRecipients) suggestedUsers
-
-    let
-      decrypt' :: CryptoUUIDUser -> DB (Maybe (Entity User))
       decrypt' cID = do
         uid <- decrypt cID
         whenIsJust crRecipientAuth $ guardAuthResult <=< ($ uid)
         getEntity uid
+  cUser <- maybeAuth
+  (chosenRecipients, suggestedRecipients) <- runDB $ (,)
+    <$> (maybe id cons cUser . catMaybes <$> (mapM decrypt' =<< lookupGlobalGetParams GetRecipient))
+    <*> (filter (notNull . snd) <$> for crRecipients (\(grp,usrQry) -> (grp,) <$> E.select usrQry))
+  $logWarnS "COMM" ("Communication handlerwith (sugg:" <> tshow (length suggestedRecipients) <> ", chosen:" <> tshow (length chosenRecipients) <> ")")
 
-    chosen' <- fmap (maybe id cons cUser . catMaybes) $ mapM decrypt' =<< lookupGlobalGetParams GetRecipient
+  MsgRenderer mr <- getMsgRenderer
-
+  mbCurrentRoute <- getCurrentRoute
-    return (suggested, chosen')
 
   let
-    lookupUser :: UserId -> User
+    lookupUser :: UserId -> (UserDisplayName,UserSurname)
-    lookupUser lId
+    lookupUser =
-      = entityVal . unsafeHead . filter ((== lId) . entityKey) $ concat (view _2 <$> suggestedRecipients) ++ chosenRecipients
+      let usrMap  = Map.fromList $ fmap (\u -> (entityKey u, entityVal u)) $ chosenRecipients ++ concatMap (view _2) suggestedRecipients
+          usrNames Nothing = ("???","???") -- this case only happens during runFormPost when POST Data is present and no form is display
+          usrNames (Just User{userDisplayName, userSurname}) = (userDisplayName, userSurname)
+      in usrNames . flip Map.lookup usrMap
 
-  let chosenRecipients' = Map.fromList $
+    chosenRecipients' = Map.fromList $
-        [ ( (BoundedPosition $ RecipientGroup g, pos)
+      [ ( (BoundedPosition $ RecipientGroup g, pos)
-          , (Right recp, recp `elem` map entityKey chosenRecipients)
+        , (Right recp, recp `elem` map entityKey chosenRecipients)
-          )
+        )
-        | (g, recps) <- suggestedRecipients
+      | (g, recps) <- suggestedRecipients
-        , (pos, recp) <- zip [0..] $ map entityKey recps
+      , (pos, recp) <- zip [0..] $ map entityKey recps
-        ] ++
+      ] ++
-        [ ( (BoundedPosition   RecipientCustom, pos)
+      [ ( (BoundedPosition   RecipientCustom, pos)
-          , (Right recp, True)
+        , (Right recp, True)
-          )
+        )
-        | (pos, recp) <- zip [0..] . Set.toList $ Set.fromList (map entityKey chosenRecipients) \\ Set.fromList (concatMap (map entityKey) $ view _2 <$> suggestedRecipients)
+      | (pos, recp) <- zip [0..] . Set.toList $ Set.fromList (map entityKey chosenRecipients) \\ Set.fromList (concatMap (map entityKey) $ view _2 <$> suggestedRecipients)
-        ]
+      ]
-      activeCategories = map RecipientGroup (view _1 <$> suggestedRecipients) `snoc` RecipientCustom
+    activeCategories = map RecipientGroup (view _1 <$> suggestedRecipients) `snoc` RecipientCustom
 
-  let recipientAForm :: AForm Handler (Set (Either UserEmail UserId))
+    recipientAForm :: AForm Handler (Set (Either UserEmail UserId))
-      recipientAForm = postProcess <$> massInputA MassInput{..} (fslI MsgCommRecipients & setTooltip MsgCommRecipientsTip) True (Just chosenRecipients')
+    recipientAForm = postProcess <$> massInputA MassInput{..} (fslI MsgCommRecipients & setTooltip MsgCommRecipientsTip) True (Just chosenRecipients')
-        where
+      where
-          miAdd pos@(BoundedPosition RecipientCustom, 0) dim@1 liveliness nudge submitView = guardOn (miAllowAdd pos dim liveliness) $ \csrf -> do
+        miAdd pos@(BoundedPosition RecipientCustom, 0) dim@1 liveliness nudge submitView = guardOn (miAllowAdd pos dim liveliness) $ \csrf -> do
-            (addRes, addView) <- mpreq (multiUserField True Nothing) (fslpI MsgUtilEMail (mr MsgUtilEMail) & setTooltip MsgUtilMultiEmailFieldTip & addName (nudge "email")) Nothing
+          (addRes, addView) <- mpreq (multiUserField True Nothing) (fslpI MsgUtilEMail (mr MsgUtilEMail) & setTooltip MsgUtilMultiEmailFieldTip & addName (nudge "email")) Nothing
-            let
+          let
-              addRes' = addRes <&> \nEmails ((Map.elems &&& maybe 0 (succ . snd . fst) . Map.lookupMax) . Map.filterWithKey (\(BoundedPosition c, _) _ -> c == RecipientCustom) -> (oEmails, kStart)) -> FormSuccess . Map.fromList . zip (map (BoundedPosition RecipientCustom, ) [kStart..]) . Set.toList $ nEmails `Set.difference` Set.fromList oEmails
+            addRes' = addRes <&> \nEmails ((Map.elems &&& maybe 0 (succ . snd . fst) . Map.lookupMax) . Map.filterWithKey (\(BoundedPosition c, _) _ -> c == RecipientCustom) -> (oEmails, kStart)) -> FormSuccess . Map.fromList . zip (map (BoundedPosition RecipientCustom, ) [kStart..]) . Set.toList $ nEmails `Set.difference` Set.fromList oEmails
-            return (addRes', $(widgetFile "widgets/communication/recipientAdd"))
+          return (addRes', $(widgetFile "widgets/communication/recipientAdd"))
-          miAdd _ _ _ _ _ = Nothing
+        miAdd _ _ _ _ _ = Nothing
-          miCell _ (Left (CI.original -> email)) initRes nudge csrf = do
+        miCell _ (Left (CI.original -> email)) initRes nudge csrf = do
-            (tickRes, tickView) <- mpreq checkBoxField ("" & addName (nudge "tick")) $ initRes <|> Just True
+          (tickRes, tickView) <- mpreq checkBoxField ("" & addName (nudge "tick")) $ initRes <|> Just True
-            return (tickRes, $(widgetFile "widgets/communication/recipientEmail"))
+          return (tickRes, $(widgetFile "widgets/communication/recipientEmail"))
-          miCell _ (Right uid@(lookupUser -> User{..})) initRes nudge csrf = do
+        miCell _ (Right uid@(lookupUser -> (userDisplayName, userSurname))) initRes nudge csrf = do
-            (tickRes, tickView) <- if
+          (tickRes, tickView) <- if
-              | fmap entityKey cUser == Just uid
+            | fmap entityKey cUser == Just uid
-                -> mforced checkBoxField ("" & addName (nudge "tick"))   True
+              -> mforced checkBoxField ("" & addName (nudge "tick"))   True
-              | otherwise
+            | otherwise
-                -> mpreq   checkBoxField ("" & addName (nudge "tick")) $ initRes <|> Just True
+              -> mpreq   checkBoxField ("" & addName (nudge "tick")) $ initRes <|> Just True
-            return (tickRes, $(widgetFile "widgets/communication/recipientName"))
+          return (tickRes, $(widgetFile "widgets/communication/recipientName"))
-          miAllowAdd (BoundedPosition RecipientCustom, 0) 1 _ = True
+        miAllowAdd (BoundedPosition RecipientCustom, 0) 1 _ = True
-          miAllowAdd _ _ _ = False
+        miAllowAdd _ _ _ = False
-          miAddEmpty _ 0 _ = Set.singleton (BoundedPosition RecipientCustom, 0)
+        miAddEmpty _ 0 _ = Set.singleton (BoundedPosition RecipientCustom, 0)
-          miAddEmpty _ _ _ = Set.empty
+        miAddEmpty _ _ _ = Set.empty
-          miButtonAction :: forall p . PathPiece p => p -> Maybe (SomeRoute UniWorX)
+        miButtonAction :: forall p . PathPiece p => p -> Maybe (SomeRoute UniWorX)
-          miButtonAction anchor = SomeRoute . (:#: anchor) <$> mbCurrentRoute
+        miButtonAction anchor = SomeRoute . (:#: anchor) <$> mbCurrentRoute
-          miLayout :: MapLiveliness (BoundedLiveliness RecipientCategory) ListLength
+        miLayout :: MapLiveliness (BoundedLiveliness RecipientCategory) ListLength
-                   -> Map (BoundedPosition RecipientCategory, ListPosition) (_, FormResult Bool)
+                  -> Map (BoundedPosition RecipientCategory, ListPosition) (_, FormResult Bool)
-                   -> Map (BoundedPosition RecipientCategory, ListPosition) Widget
+                  -> Map (BoundedPosition RecipientCategory, ListPosition) Widget
-                   -> Map (BoundedPosition RecipientCategory, ListPosition) (FieldView UniWorX)
+                  -> Map (BoundedPosition RecipientCategory, ListPosition) (FieldView UniWorX)
-                   -> Map (Natural, (BoundedPosition RecipientCategory, ListPosition)) Widget
+                  -> Map (Natural, (BoundedPosition RecipientCategory, ListPosition)) Widget
-                   -> Widget
+                  -> Widget
-          miLayout liveliness cState cellWdgts _delButtons addWdgts = do
+        miLayout liveliness cState cellWdgts _delButtons addWdgts = do
-            checkedIdentBase <- newIdent
+          checkedIdentBase <- newIdent
-            let checkedCategories = Set.mapMonotonic (unBoundedPosition . fst) . Set.filter (\k' -> Map.foldrWithKey (\k (_, checkState) -> (||) $ k == k' && checkState /= FormSuccess False && (checkState /= FormMissing || maybe True snd (chosenRecipients' !? k))) False cState) $ Map.keysSet cState
+          let checkedCategories = Set.mapMonotonic (unBoundedPosition . fst) . Set.filter (\k' -> Map.foldrWithKey (\k (_, checkState) -> (||) $ k == k' && checkState /= FormSuccess False && (checkState /= FormMissing || maybe True snd (chosenRecipients' !? k))) False cState) $ Map.keysSet cState
-                checkedIdent c = checkedIdentBase <> "-" <> toPathPiece c
+              checkedIdent c = checkedIdentBase <> "-" <> toPathPiece c
-                hasContent c = not (null $ categoryIndices c) || Map.member (1, (BoundedPosition c, 0)) addWdgts
+              hasContent c = not (null $ categoryIndices c) || Map.member (1, (BoundedPosition c, 0)) addWdgts
-                categoryIndices c = Set.filter ((== c) . unBoundedPosition . fst) $ review liveCoords liveliness
+              categoryIndices c = Set.filter ((== c) . unBoundedPosition . fst) $ review liveCoords liveliness
-                rgTutorialParticipantsCaption :: CryptoUUIDTutorial -> Widget
+              rgTutorialParticipantsCaption :: CryptoUUIDTutorial -> Widget
-                rgTutorialParticipantsCaption cID = do
+              rgTutorialParticipantsCaption cID = do
-                  tutId <- decrypt cID
+                tutId <- decrypt cID
-                  Tutorial{..} <- liftHandler . runDBRead $ get404 tutId
+                Tutorial{..} <- liftHandler . runDBRead $ get404 tutId
-                  i18n $ MsgRGTutorialParticipants tutorialName
+                i18n $ MsgRGTutorialParticipants tutorialName
-                rgExamRegisteredCaption :: CryptoUUIDExam -> Widget
+              rgExamRegisteredCaption :: CryptoUUIDExam -> Widget
-                rgExamRegisteredCaption cID = do
+              rgExamRegisteredCaption cID = do
-                  eId <- decrypt cID
+                eId <- decrypt cID
-                  Exam{..} <- liftHandler . runDBRead $ get404 eId
+                Exam{..} <- liftHandler . runDBRead $ get404 eId
-                  i18n $ MsgRGExamRegistered examName
+                i18n $ MsgRGExamRegistered examName
-                rgSheetSubmittorCaption :: CryptoUUIDSheet -> Widget
+              rgSheetSubmittorCaption :: CryptoUUIDSheet -> Widget
-                rgSheetSubmittorCaption cID = do
+              rgSheetSubmittorCaption cID = do
-                  sId <- decrypt cID
+                sId <- decrypt cID
-                  Sheet{..} <- liftHandler . runDBRead $ get404 sId
+                Sheet{..} <- liftHandler . runDBRead $ get404 sId
-                  i18n $ MsgRGSheetSubmittor sheetName
+                i18n $ MsgRGSheetSubmittor sheetName
-            $(widgetFile "widgets/communication/recipientLayout")
+          $(widgetFile "widgets/communication/recipientLayout")
-          miDelete :: Map (BoundedPosition RecipientCategory, ListPosition) (Either UserEmail UserId) -> (BoundedPosition RecipientCategory, ListPosition) -> MaybeT (MForm Handler) (Map (BoundedPosition RecipientCategory, ListPosition) (BoundedPosition RecipientCategory, ListPosition))
+        miDelete :: Map (BoundedPosition RecipientCategory, ListPosition) (Either UserEmail UserId) -> (BoundedPosition RecipientCategory, ListPosition) -> MaybeT (MForm Handler) (Map (BoundedPosition RecipientCategory, ListPosition) (BoundedPosition RecipientCategory, ListPosition))
-          -- miDelete liveliness@(MapLiveliness lMap) (BoundedPosition RecipientCustom, delPos) = mappend (Map.fromSet id . Set.filter (\(BoundedPosition c, _) -> c /= RecipientCustom) $ review liveCoords liveliness) . fmap (BoundedPosition RecipientCustom, ) . Map.mapKeysMonotonic (BoundedPosition RecipientCustom, ) <$> miDeleteList (lMap ! BoundedPosition RecipientCustom) delPos
+        -- miDelete liveliness@(MapLiveliness lMap) (BoundedPosition RecipientCustom, delPos) = mappend (Map.fromSet id . Set.filter (\(BoundedPosition c, _) -> c /= RecipientCustom) $ review liveCoords liveliness) . fmap (BoundedPosition RecipientCustom, ) . Map.mapKeysMonotonic (BoundedPosition RecipientCustom, ) <$> miDeleteList (lMap ! BoundedPosition RecipientCustom) delPos
-          miDelete _ _ = mzero
+        miDelete _ _ = mzero
-          miIdent :: Text
+        miIdent :: Text
-          miIdent = "recipients"
+        miIdent = "recipients"
-          postProcess :: Map (BoundedPosition RecipientCategory, ListPosition) (Either UserEmail UserId, Bool) -> Set (Either UserEmail UserId)
+        postProcess :: Map (BoundedPosition RecipientCategory, ListPosition) (Either UserEmail UserId, Bool) -> Set (Either UserEmail UserId)
-          postProcess = Set.fromList . map fst . filter snd . Map.elems
+        postProcess = Set.fromList . map fst . filter snd . Map.elems
 
   recipientsListMsg <- messageI Info MsgCommRecipientsList
   
@@ -221,13 +244,15 @@ commR CommunicationRoute{..} =  do
         , fieldMaxFileSize = Nothing, fieldMaxCumulativeSize = attachmentsMaxSize
         , fieldAllEmptyOk = True
         }
+
   ((commRes,commWdgt),commEncoding) <- runFormPost . identifyForm FIDCommunication . withButtonForm' universeF . renderAForm FormStandard $ Communication
     <$> recipientAForm
     <*  aformMessage recipientsListMsg
     <*> ( CommunicationContent
             <$> aopt textField (fslI MsgCommSubject & addAttr "uw-enter-as-tab" "") Nothing
             <*> (markupOutput <$> areq htmlField (fslI MsgCommBody) Nothing)
-            <*> fmap fold (aopt (convertFieldM (runConduit . (.| C.foldMap Set.singleton)) yieldMany attachmentField) (fslI MsgCommAttachments & setTooltip MsgCommAttachmentsTip) Nothing)
+            <*> fmap fold (aopt (convertFieldM (runConduit . (.| C.foldMap Set.singleton)) yieldMany attachmentField) 
+                              (fslI MsgCommAttachments & setTooltip MsgCommAttachmentsTip) Nothing)
         )    
   formResult commRes $ \case
     (comm, BtnCommunicationSend) -> do
@@ -245,7 +270,7 @@ commR CommunicationRoute{..} =  do
         , formSubmit   = FormNoSubmit
         }  
   siteLayoutMsg crHeading $ do
-    setTitleI crHeading
+    setTitleI crTitle
     let commTestTip = $(i18nWidgetFile "comm-test-tip")
     [whamlet|
        $newline never

src/Handler/Utils/Company.hs

@@ -40,14 +40,14 @@ upsertCompany cName cAddr =
       Nothing  -> do
         let cShort  = companyShorthandFromName cName            
         cShort' <- findShort cName' $ CI.mk cShort
-        let compy  = Company cName' cShort' 0 False cAddr -- TODO: Fix this once AVS CR3 SCF-165 is implemented
+        let compy  = Company cName' cShort' 0 False cAddr Nothing -- TODO: Fix this once AVS CR3 SCF-165 is implemented
         either entityKey id <$> insertBy compy
   where 
     findShort :: CompanyName -> CompanyShorthand -> DB CompanyShorthand    
     findShort fna fsh = aux 0
       where 
         aux n = let fsh' = if n==0 then fsh else fsh <> CI.mk (tshow n) in
-                checkUnique (Company fna fsh' 0 False Nothing) >>= \case
+                checkUnique (Company fna fsh' 0 False Nothing Nothing) >>= \case
                   Nothing -> return fsh'
                   _other  -> aux (n+1)
 

src/Handler/Utils/Form.hs

@@ -1498,7 +1498,20 @@ boolField mkNone = radioGroupField mkNone $ do
       _other -> Nothing
     }
 
-
+-- | like `boolField` but with custom labels
+boolFieldCustom :: (MonadHandler m, HandlerSite m ~ UniWorX)
+  => SomeMessage UniWorX -> SomeMessage UniWorX -> Maybe (SomeMessage UniWorX) -> Field m Bool
+boolFieldCustom mkTrue mkFalse mkNone  = radioGroupField mkNone $ do
+  mr <- getMessageRender
+  return OptionList
+    { olOptions = [ Option (mr mkFalse) False "false"
+                  , Option (mr mkTrue)  True  "true"
+                  ]
+    , olReadExternal = \case
+      "false" -> Just False
+      "true"  -> Just True
+      _other  -> Nothing
+    }
 
 sectionedFuncForm  :: forall f k v m sec.
                       ( TraversableWithIndex k f

src/Handler/Utils/Table/Cells.hs

@@ -29,6 +29,9 @@ type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with Wit
 spacerCell :: IsDBTable m a => DBCell m a
 spacerCell = cell [whamlet| |]
 
+semicolonCell :: IsDBTable m a => DBCell m a
+semicolonCell = cell [whamlet|; |]
+
 tellCell :: IsDBTable m a => a -> DBCell m a -> DBCell m a
 tellCell = flip mappend . writerCell . tell
 
@@ -91,6 +94,7 @@ guardAuthCell mkParams = over cellContents $ \act -> do
 ---------------------
 -- Icon cells
 
+-- to be used with icons directly, for results of `icon`, use either `wgtCell` or `iconFixedCell`
 iconCell :: IsDBTable m a => Icon -> DBCell m a
 iconCell = cell . toWidget . icon
 
@@ -307,6 +311,16 @@ courseCell Course{..} = anchorCell link name `mappend` desc
                 ^{modal "Beschreibung" (Right $ toWidget descr)}
               |]
 
+companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a
+companyCell cid cname isSupervisor = anchorCell link name
+  where
+    link = FirmR cid
+    corg = ciOriginal cname
+    name 
+      | isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor
+      | otherwise    = text2markup  corg
+
+
 qualificationCell :: (IsDBTable m c, HasQualification a) => a -> DBCell m c
 qualificationCell (view hasQualification -> Qualification{..}) = anchorCell link name
   where

src/Handler/Utils/Table/Columns.hs

@@ -753,6 +753,49 @@ sortUserCompany queryUser = ( "user-company"
                 return (comp E.^. CompanyName)
             ))
 
+-- | Search companies by name or shorthand
+fltrCompanyName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+   => (a -> E.SqlExpr (Entity Company))
+   -> (d, FilterColumn t fs)
+fltrCompanyName query = ( "company-name", FilterColumn $ anyFilter
+    [ mkContainsFilterWithComma CI.mk $ query >>> (E.^. CompanyName)
+    , mkContainsFilterWithComma CI.mk $ query >>> (E.^. CompanyShorthand)
+    -- , mkExactFilterWithComma    id    $ query >>> (E.num2text . (E.^. CompanyAvsId))
+    ]
+  )
+
+fltrCompanyNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrCompanyNameUI = fltrCompanyNameNrHdrUI MsgTableCompany
+
+fltrCompanyNameHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrCompanyNameHdrUI msg mPrev =
+  prismAForm (singletonFilter "company-name") mPrev $ aopt textField (fslI msg & setTooltip MsgTableFilterCommaNameNr)
+
+
+
+fltrCompanyNameNr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d)
+   => (a -> E.SqlExpr (Entity Company))
+   -> (d, FilterColumn t fs)
+fltrCompanyNameNr query = ("company-name-number", FilterColumn $ \needle (setFoldMap commaSeparatedText -> criterias) ->
+    let numCrits    = setMapMaybe readMay criterias
+        fltrCName   = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyName))      needle criterias
+        fltrCShort  = mkContainsFilterWith CI.mk (query >>> (E.^. CompanyShorthand)) needle criterias
+        fltrCno     = mkExactFilter              (query >>> (E.^. CompanyAvsId))     needle numCrits       
+    in if null numCrits
+        then fltrCName E.||. fltrCShort
+        else fltrCName E.||. fltrCShort E.||. fltrCno      
+    )
+  where 
+    setFoldMap :: (Text -> Set.Set Text) -> Set.Set Text -> Set.Set Text
+    setFoldMap = foldMap
+
+fltrCompanyNameNrUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrCompanyNameNrUI = fltrCompanyNameNrHdrUI MsgTableCompanyFilter
+
+fltrCompanyNameNrHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text])
+fltrCompanyNameNrHdrUI msg mPrev =
+  prismAForm (singletonFilter "company-name-number") mPrev $ aopt textField (fslI msg & setTooltip MsgTableFilterCommaNameNr)
+
 
 ----------------------------
 -- Colonnade manipulation --

src/Handler/Utils/Table/Pagination.hs

@@ -1,10 +1,20 @@
--- SPDX-FileCopyrightText: 2022 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-23 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
 
+
+{- FOP - Frequently occurring problems using dbTable:
+
+  - When changing a dbTable to a form, eg. using `dbSelect` then change the colonnade defnition from `dbColonnade` to `formColonnade`!
+    Both functions are equal to id, but the types are quite different.
+
+  - Don't mix up the row type alias traditionally ending with ...Data and the Action-Result-Type also ending with ...Data
+
+-}
+
 module Handler.Utils.Table.Pagination
   ( module Handler.Utils.Table.Pagination.Types
   , dbFilterKey
@@ -27,7 +37,7 @@ module Handler.Utils.Table.Pagination
   , dbtProjFilteredPostId, dbtProjFilteredPostSimple
   , noCsvEncode, simpleCsvEncode, simpleCsvEncodeM
   , withCsvExtraRep
-  , singletonFilter
+  , singletonFilter, multiFilter
   , DBParams(..)
   , cellAttrs, cellContents
   , addCellClass
@@ -637,6 +647,13 @@ singletonFilter key = prism' fromInner (fmap Just . fromOuter)
       fromInner = maybe Map.empty $ Map.singleton key . pure
       fromOuter = Map.lookup key >=> listToMaybe
 
+multiFilter :: Ord k => k -> Prism' (Map k [v]) (Maybe [v])
+-- ^ for use with @prismAForm@
+multiFilter key = prism' fromInner fromOuter
+    where
+      -- prism' :: (Maybe [v] -> (Map k [v])) -> ((Map k [v]) -> Maybe (Maybe [v])) -> Prism' (Map k [v]) (Maybe [v])
+      fromInner = maybe Map.empty (Map.singleton key)
+      fromOuter = Just . Map.lookup key
   
 data DBTCsvEncode r' k' csv = forall exportData filename sheetName.
   ( ToNamedRecord csv, CsvColumnsExplained csv
@@ -1654,10 +1671,12 @@ widgetColonnade :: Colonnade h r (DBCell (HandlerFor UniWorX) x)
                 -> Colonnade h r (DBCell (HandlerFor UniWorX) x)
 widgetColonnade = id
 
+-- | force the column list type for tables that cotain forms, especially those constructed with dbSelect, avoids explicit type signatures
 formColonnade :: Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX)) (FormResult a))
               -> Colonnade h r (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerFor UniWorX)) (FormResult a))
 formColonnade = id
 
+-- | force the column list type for simple tables that do not contain forms, and especially no dbSelect, avoids explicit type signatures
 dbColonnade :: Colonnade h r (DBCell DB x)
             -> Colonnade h r (DBCell DB x)
 dbColonnade = id

src/Jobs/Handler/LMS.hs

@@ -204,7 +204,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
                               luser E.?. LmsUserUser           E.?=. quser   E.^. QualificationUserUser
                         E.&&. luser E.?. LmsUserQualification  E.?=. quser   E.^. QualificationUserQualification)
           E.where_ $ quser E.^. QualificationUserQualification E.==. E.val qid
-              -- E.&&.  luser E.?. LmsUserQualification           E.?=. E.val qid
+              -- E.&&.  luser E.?. LmsUserQualification        E.?=. E.val qid
               -- E.&&.  E.isNothing (luser E.^. LmsUserStatus)
               -- E.&&.  E.isNothing (luser E.^. LmsUserEnded)
               E.&&.  E.not_ (validQualification now quser)

src/Jobs/Handler/SendCourseCommunication.hs

@@ -4,6 +4,7 @@
 
 module Jobs.Handler.SendCourseCommunication
   ( dispatchJobSendCourseCommunication
+  , dispatchJobSendFirmCommunication
   ) where
 
 import Import
@@ -37,7 +38,35 @@ dispatchJobSendCourseCommunication jRecipientEmail jAllRecipientAddresses jCours
     _mailFrom .= userAddressFrom sender
     addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|]
     addMailHeader "Auto-Submitted" "no"
-    setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgCommCourseSubject) SomeMessage ccSubject
+    setSubjectI . prependCourseTitle courseTerm courseSchool courseShorthand $ maybe (SomeMessage MsgUtilCommCourseSubject) SomeMessage ccSubject
+    addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/courseCommunication.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+    forM_ ccAttachments $ addPart' . toMailPart
+    when (jRecipientEmail == Right jSender) $
+      addPart' $ do
+        partIsAttachmentCsv MsgCommAllRecipients
+        toMailPart (MsgCommAllRecipientsSheet, toDefaultOrderedCsvRendered jAllRecipientAddresses)
+
+
+dispatchJobSendFirmCommunication :: Either UserEmail UserId
+                                   -> Set Address
+                                   -> Companies
+                                   -> UserId
+                                   -> UUID
+                                   -> CommunicationContent
+                                   -> JobHandler UniWorX
+dispatchJobSendFirmCommunication jRecipientEmail jAllRecipientAddresses _jCompanies jSender jMailObjectUUID CommunicationContent{..} = JobHandlerException $ do
+  -- (sender,mbComp) <- runDB $ (,)
+  --   <$> getJust jSender
+  --   <*> ifMaybeM jCompany Nothing get
+  sender <- runDB $ getJust jSender    
+  either (\email -> mailT def . (assign _mailTo (pure . Address Nothing $ CI.original email) *>)) userMailT jRecipientEmail $ do
+    MsgRenderer mr <- getMailMsgRenderer
+
+    void $ setMailObjectUUID jMailObjectUUID
+    _mailFrom .= userAddressFrom sender
+    addMailHeader "Cc" [st|#{mr MsgCommUndisclosedRecipients}:;|]
+    addMailHeader "Auto-Submitted" "no"
+    setSubjectI $ maybe (SomeMessage MsgUtilCommFirmSubject) SomeMessage ccSubject
     addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/courseCommunication.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
     forM_ ccAttachments $ addPart' . toMailPart
     when (jRecipientEmail == Right jSender) $

src/Jobs/Handler/SendNotification/Qualification.hs

@@ -81,7 +81,7 @@ dispatchNotificationQualificationExpired nQualification jRecipient = do
               $logInfoS  "LMS" $ "Notified " <> tshow encRecipient <> " about expired qualification " <> qname
             else
               $logErrorS "LMS" $ "Failed to notify " <> tshow encRecipient <> " about expired qualification " <> qname
-        else  $logErrorS "LMS" $ "Suppressed repeated notification " <> tshow encRecipient <> " about expired qualification " <> qname
+        else  $logInfoS  "LMS" $ "Suppressed repeated notification " <> tshow encRecipient <> " about expired qualification " <> qname
     _ ->  $logErrorS "LMS" $ "Failed to notify " <> tshow encRecipient <> " about expired qualification " <> tshow nQualification
 
 

src/Jobs/Types.hs

@@ -74,6 +74,13 @@ data Job
                                , jMailObjectUUID :: UUID
                                , jMailContent :: CommunicationContent
                                }
+  | JobSendFirmCommunication   { jRecipientEmail :: Either UserEmail UserId
+                               , jAllRecipientAddresses :: Set Address
+                               , jCompanies :: Companies
+                               , jSender :: UserId
+                               , jMailObjectUUID :: UUID
+                               , jMailContent :: CommunicationContent
+                               }
   | JobInvitation { jInviter :: Maybe UserId
                   , jInvitee :: UserEmail
                   , jInvitationUrl :: Text

src/Model/Migration/Definitions.hs

@@ -141,6 +141,8 @@ migrateManual = do
     , ("idx_print_job_apc_ident"             ,"CREATE INDEX idx_print_job_apc_ident ON \"print_job\" (\"apc_ident\")")
     , ("idx_user_avs_card_person_id"         ,"CREATE INDEX idx_user_avs_card_person_id ON \"user_avs_card\" (\"person_id\")")
     , ("idx_lms_report_log_q_ident_time"     ,"CREATE INDEX idx_lms_report_log_q_ident_time ON \"lms_report_log\" (\"qualification\",\"ident\",\"timestamp\")")
+    , ("idx_user_company_company"            ,"CREATE INDEX idx_user_company_company ON \"user_company\" (\"company\")") -- composed index from unique cannot be used for frequently used filters on company
+    , ("idx_user_supervisor_user"            ,"CREATE INDEX idx_user_supervisor_user ON \"user_supervisor\" (\"user\")") -- composed index from unique cannot be used for frequently used filters on user
     ]
   where
     addIndex :: Text -> Sql -> Migration

src/Model/Types/Common.hs

@@ -43,6 +43,7 @@ type SchoolShorthand      = CI Text
 
 type CompanyName          = CI Text
 type CompanyShorthand     = CI Text
+type Companies            = [CI Text]
 
 type CourseName           = CI Text
 type CourseShorthand      = CI Text

src/Utils.hs

@@ -305,6 +305,10 @@ tshowCrop = cropText . tshow
 stripCI :: Text -> CI Text 
 stripCI = CI.mk . Text.strip
 
+-- | just to avoid adding an import for this
+ciOriginal :: CI Text -> Text 
+ciOriginal = CI.original
+
 citext2lower :: CI Text -> Text 
 citext2lower = Text.toLower . CI.original
 
@@ -360,6 +364,9 @@ text2asciiAlphaNum = Text.filter (\c -> Char.isAlphaNum c && Char.isAscii c)
 text2Html :: Text -> Html
 text2Html = toHtml
 
+citext2Html :: CI Text -> Html
+citext2Html = toHtml . CI.original  
+
 char2Text :: Char -> Text
 char2Text c 
   | isSpace c = "<Space>"
@@ -839,8 +846,8 @@ _MapUnit = iso Map.keysSet $ Map.fromSet (const ())
 
 -- | Just @flip (.)@ for convenient formatting in some cases,
 --   Deprecated in favor of Control.Arrow.(>>>)
-compose :: (a -> b) -> (b -> c) -> (a -> c)
+-- compose :: (a -> b) -> (b -> c) -> (a -> c)
-compose = flip (.)
+-- compose = flip (.)
 
 
 -----------

src/Utils/Form.hs

@@ -316,6 +316,7 @@ data FormIdentifier
   | FIDBtnAvsImportUnknown
   | FIDBtnAvsRevokeUnknown
   | FIDHijackUser
+  | FIDAddSupervisor
   deriving (Eq, Ord, Read, Show)
 
 instance PathPiece FormIdentifier where

src/Utils/Icon.hs

@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-23 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -109,11 +109,14 @@ data Icon
   | IconLetter
   | IconAt
   | IconSupervisor
+  | IconSupervisorForeign
   -- | IconWaitingForUser
   | IconExpired
   | IconLocked
   | IconUnlocked
   | IconResetTries -- also see IconReset
+  | IconCompany
+  
   deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
   deriving anyclass (Universe, Finite, NFData)
 
@@ -152,7 +155,7 @@ iconText = \case
     IconSFTHint                 -> "life-ring"          -- for SheetFileType only
     IconSFTSolution             -> "exclamation-circle" -- for SheetFileType only
     IconSFTMarking              -> "check-circle"       -- for SheetFileType only
-    IconEmail                   -> "envelope" -- envelope is no longer unamibuous
+    IconEmail                   -> "envelope" -- envelope is no longer unamibuous, use IconAt or IconLetter if email and postal need to be distinguished
     IconRegisterTemplate        -> "file-alt"
     IconNoCorrectors            -> "user-slash"
     IconRemoveUser              -> "user-slash"
@@ -198,13 +201,15 @@ iconText = \case
     IconCertificate             -> "badge-check"
     IconPrintCenter             -> "mail-bulk" -- From fontawesome v6 onwards: "envelope-bulk"
     IconLetter                  -> "mail-bulk" -- Problem "envelope" already used for email as well
-    IconAt                      -> "at"
+    IconAt                      -> "at"        -- alternative for IconEmail to distinguish from IconLetter
     IconSupervisor              -> "head-side" -- must be notably different to user
+    IconSupervisorForeign       -> "alien"
     -- IconWaitingForUser          -> "user-cog"  -- Waiting on a user to do something
     IconExpired                 -> "hourglass-end"
     IconLocked                  -> "lock"
     IconUnlocked                -> "lock-open-alt"
     IconResetTries              -> "trash-undo"
+    IconCompany                 -> "building"  
 
 nullaryPathPiece ''Icon $ camelToPathPiece' 1
 deriveLift ''Icon

templates/firm-users.hamlet

@@ -0,0 +1,68 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2023 Steffen Jost <jost@tcs.ifi.lmu.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<section .profile>     
+  <dl .deflist.profile-dl>
+    $maybe fem <- companyEmail
+      <dt .deflist__dt>
+        _{MsgFirmEmail} #{iconLetterOrEmail False} 
+      <dd .deflist__dd .email>
+        #{mailtoHtml fem}
+    $maybe addr <- companyPostAddress
+      <dt .deflist__dt>
+        _{MsgFirmAddress} #{iconLetterOrEmail True} 
+      <dd .deflist__dd>
+        #{addr}
+
+<section>        
+  <div .scrolltable .scrolltable--bordered>
+    <table .table>      
+        <tr .table__row .table__row--head>
+          <th .table__th>_{MsgTableCompanyNrSupersDefault}
+          <th .table__th>_{MsgTableCompanyNrRerouteDefault}
+          <th .table__th colspan=2>_{MsgPrefersPostal}           
+        <tr .table__row>         
+          <td .table__td>#{nrCompanySupervisors}
+          <td .table__td>#{nrCompanyDefaultReroutes}
+          <td .table__td>#{iconLetterOrEmail companyPrefersPostal}
+          <td .table__td>_{MsgFirmDefaultPreferenceInfo}          
+        <tr .table__row .table__row--head>          
+          <th .table__th>_{MsgTableCompanyNrUsers}
+          <th .table__th colspan=3>_{MsgTableCompanyNrForeignSupers}
+        <tr .table__row>          
+          <td .table__td>#{nrCompanyUsers}
+          <td .table__td>#{nrCompanyForeignSupers}          
+          <td .table__td colspan=2>
+              Anzahl der firmenfremden Ansprechpartner, welche mindestens einen Firmenangehörigen betreuen. Bei manchen Firmen ist es normal, dass die Ansprechpartner einer anderen Firma angehören, aber oft ist nur ein Fehler durch Firmenwechsel.
+
+        <tr .table__row .table__row--head>          
+          <th .table__th>_{MsgTableCompanyNrEmpSupervised}
+          <th .table__th>_{MsgTableCompanyNrEmpRerouted}
+          <th .table__th>_{MsgTableCompanyNrEmpRerPost}          
+          <th .table__th>_{MsgTableCompanyNrRerouteActive}          
+        <tr .table__row>          
+          <td .table__td>#{nrCompanyEmployeeSupervised}
+          <td .table__td>#{nrCompanyEmployeeRerouted}
+          <td .table__td>#{nrCompanyEmployeeRerPost}          
+          <td .table__td>#{nrCompanyActiveReroutes}
+        <tr .table__row>
+          <td .table__td>
+            Ansprechpartner müssen nicht notwendigerweise der gleichen Firma angehören!
+          <td .table__td>
+            Mindestens ein Ansprechpartner mit Umleitung.
+          <td .table__td>
+            Email oder Brief ist individuelle Einstellung des Ansprechpartners und gilt für alle Benachrichtigungen an diesen Ansprechpartner.
+          <td .table__td>
+            Gesamtzahl aller aktiven Benachrichtigungsumleitungen. #
+            <em>
+              Beispiel: Für eine Firma mit 2 Angehörigen, für die ein Mitarbeiter 1 Ansprechpartner mit aktiver Umleitung und einen Mitarbeiter mit 3 Ansprechpartnern mit aktiver Umleitung hätte, #
+              würde hier die Zahl 4 stehen, da bei einer Benachrichtigung an beide Mitarbeiter insgesamt 4 Briefe oder Emails versendet würden.
+
+<section>
+  <h2>
+    _{MsgFirmAssociates}
+  <p>
+    ^{fusrTable}

templates/i18n/firm-all/de-de-formal.hamlet

@@ -0,0 +1,15 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<section>
+
+
+  <p>
+    Die Daten der Firmen wurden aus dem Ausweisverwaltungssystem (AVS) der Fraport AG #
+    importiert und werden regelmäßig aktualisiert, #
+    wenn Fahrlizenzinhaber oder deren Verwalter über das AVS einer Firma zugeordnet wurden.
+  <p>
+    ^{firmTable}

templates/i18n/firm-all/en-eu.hamlet

@@ -0,0 +1,16 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<section>
+
+
+  <p>
+    Data of all companies that were taken from the id card management system (AVS) of Fraport AG.
+    A company is importet and regularly update if a driving licence holder or their supervisor
+    are associated with that company through the AVS.
+
+  <p>
+    ^{firmTable}

templates/i18n/firm-supervisors/de-de-formal.hamlet

@@ -0,0 +1,27 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<section>
+  Bitte beachten, dass Ansprechpartner-Beziehung unabhängig von Firmenzugehörigkeit zwischen Einzelpersonen bestehen.
+  Daraus folgt zum Beispiel, dass wenn <em>x</em> ein Standard-Ansprechpartner für Firma <em>a</em> ist 
+  und wenn <em>y</em> sowohl Firma <em>a</em> als auch <em>b</em> angehört, 
+  dass dann <em>x</em> als firmenfremd in der Liste der Ansprechpartner von Firma <em>b</em> angezeigt wird.
+<section .profile>     
+  <dl .deflist.profile-dl>
+    $maybe fem <- companyEmail
+      <dt .deflist__dt>
+        _{MsgFirmEmail} #{iconLetterOrEmail False} 
+      <dd .deflist__dd .email>
+        #{mailtoHtml fem}
+    $maybe addr <- companyPostAddress
+      <dt .deflist__dt>
+        _{MsgFirmAddress} #{iconLetterOrEmail True} 
+      <dd .deflist__dd>
+        #{addr}
+<section>
+  ^{fsprTable}
+<section>
+  ^{addSuperForm}

templates/i18n/firm-supervisors/en-eu.hamlet

@@ -0,0 +1,26 @@
+$newline never
+
+$# SPDX-FileCopyrightText: 2023 Steffen Jost <s.jost@fraport.de>
+$#
+$# SPDX-License-Identifier: AGPL-3.0-or-later
+
+<section>
+  Note that supervision is company independent. 
+  For example, if <em>x</em> is a regular supervisor for company <em>a</em> and <em>y</em> belongs to companies <em>a</em> and <em>b</em>, 
+  then <em>x</em> will be listed as a foreign supervisor for company <em>b</em>.
+<section .profile>     
+  <dl .deflist.profile-dl>
+    $maybe fem <- companyEmail
+      <dt .deflist__dt>
+        _{MsgFirmEmail} #{iconLetterOrEmail False} 
+      <dd .deflist__dd .email>
+        #{mailtoHtml fem}
+    $maybe addr <- companyPostAddress
+      <dt .deflist__dt>
+        _{MsgFirmAddress} #{iconLetterOrEmail True} 
+      <dd .deflist__dd>
+        #{addr}
+<section>
+  ^{fsprTable}
+<section>
+  ^{addSuperForm}  

templates/profileData.hamlet

@@ -49,7 +49,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
         <dd .deflist__dd>
           ^{formatTimeW SelFormatDate bday}      
       <dt .deflist__dt>
-        _{MsgPrefersPostal}
+        _{MsgPrefersPostalExp}
       <dd .deflist__dd>
         #{iconLetterOrEmail userPrefersPostal}
       $maybe addr <- userPostAddress

templates/widgets/communication/recipientLayout.hamlet

@@ -31,6 +31,12 @@ $if not (null activeCategories)
               ^{rgSheetSubmittorCaption sid}
             $of RecipientGroup RGCourseUnacceptedApplicants
               _{MsgRGCourseUnacceptedApplicants}
+            $of RecipientGroup (RGFirmSupervisor fsh)
+              _{MsgFirmSupervisorOf fsh}
+            $of RecipientGroup (RGFirmEmployees  fsh)
+              _{MsgFirmEmployeeOf fsh}
+            $of RecipientGroup (RGFirmIndependent)
+              _{MsgFirmSupervisorIndependent}
 
         $if hasContent category
           <fieldset .recipient-category__fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{checkedIdent category}>

test/Database/Fill.hs

@@ -569,7 +569,7 @@ fillDb = do
         userDisplayEmail' = CI.mk $ case userSurname of 
           "Walker"    -> "AVSNO:" <> userMatrikelnummer'
           "Clark"     ->      "E" <> userMatrikelnummer' <> "@fraport.de"
-          "Elizabeth" -> ""
+          "Jackson"   -> ""
           _           -> userIdent
 
   matrikel <- toMatrikel <$> getRandomRs (0 :: Int, 9 :: Int)
@@ -624,11 +624,12 @@ 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    False Nothing 
+  fraportAg <- insert' $ Company "Fraport AG"                                          "Fraport"    1    True  (Just $ markdownToStoredMarkup ("Frankfurt Airport Services Worldwide\n60547 Frankfurt am Main"::Text)) (Just "fraport@fraport.de")
-  fraGround <- insert' $ Company "Fraport Ground Handling Professionals GmbH"          "FraGround"  2    False Nothing -- TODO: better testcases
+  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
-  nice      <- insert' $ Company "N*ICE Aircraft Services & Support GmbH"              "N*ICE"      33   False Nothing
+  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")
-  ffacil    <- insert' $ Company "Fraport Facility Services GmbH"                      "GCS"        44   False Nothing
+  ffacil    <- insert' $ Company "Fraport Facility Services GmbH"                      "GCS"        44   False Nothing $ Just "gcs@gcs.com"
-  bpol      <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main"  "BPol"       5555 False Nothing 
+  bpol      <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main"  "BPol"       5555 False Nothing Nothing
+  _noone    <- insert' $ Company "Vollautomaten GmbH"                                  "NoOne"      3    True  Nothing Nothing
   void . insert' $ UserCompany jost    fraportAg    True   True 
   void . insert' $ UserCompany svaupel nice         True   False 
   void . insert' $ UserCompany gkleen  nice         False  False 
@@ -636,6 +637,11 @@ fillDb = do
   void . insert' $ UserCompany fhamann bpol         False  False 
   void . insert' $ UserCompany fhamann ffacil       True   True 
   void . insert' $ UserCompany fhamann nice         False  False
+  -- need more tests
+  insertMany_ [UserCompany uid fraGround False False| Entity uid User{userFirstName = "John"} <- matUsers]
+  insertMany_ [UserCompany uid bpol False False| Entity uid User{userFirstName = "Elizabeth"} <- matUsers]
+  insertMany_ [UserCompany uid bpol True True| Entity uid User{userFirstName = "Clark", userSurname = dn} <- matUsers, dn == "Walker" || dn == "Robinson"]
+  insertMany_ [UserCompany uid ffacil False False| Entity uid User{userSurname = "Walker"} <- matUsers]
   -- void . insert' $ UserSupervisor jost gkleen       True
   -- void . insert' $ UserSupervisor jost svaupel      False
   -- void . insert' $ UserSupervisor jost sbarth       False
@@ -647,13 +653,17 @@ fillDb = do
               , UserSupervisor jost svaupel      False
               , UserSupervisor jost sbarth       False
               , UserSupervisor jost tinaTester   True
+              , UserSupervisor jost jost         True
               , UserSupervisor svaupel gkleen    False
               , UserSupervisor svaupel fhamann   True
               , UserSupervisor sbarth tinaTester True
               , UserSupervisor gkleen fhamann    False
+              , UserSupervisor gkleen gkleen     True
+              , UserSupervisor tinaTester tinaTester False
               ] 
-              ++ take 333 [ UserSupervisor fhamann uid False | Entity uid _ <-          matUsers ]
+              ++ take 333 [ UserSupervisor fhamann uid True  | Entity uid _ <-          matUsers, uid /= jost]
-              ++ take 111 [ UserSupervisor gkleen  uid False | Entity uid _ <- drop 300 matUsers ]
+              ++ take 111 [ UserSupervisor gkleen  uid True  | Entity uid _ <- drop 300 matUsers ]
+              ++ take  11 [ UserSupervisor jost    uid False | Entity uid _ <- drop 401 matUsers ]
   upsertManyWhere supvs [] [] [] 
   -- upsertManyWhere supvs [] [] [] -- NOTE: multiple calls like this are ok  
   -- insertMany_ supvs              -- NOTE: multiple calls like this throw an error!