refactor(i18n): i18n for breadcrumbs

messages/uniworx/de-de-formal.msg

@@ -1067,6 +1067,7 @@ MenuProfileData: Persönliche Daten
 MenuTermCreate: Neues Semester anlegen
 MenuCourseNew: Neuen Kurs anlegen
 MenuTermEdit: Semester editieren
+MenuTermCurrent: Aktuelles Semester
 MenuCorrection: Korrektur
 MenuCorrections: Korrekturen
 MenuCorrectionsOwn: Meine Korrekturen
@@ -1095,8 +1096,8 @@ MenuCorrectionsUpload: Korrekturen hochladen
 MenuCorrectionsDownload: Offene Abgaben herunterladen
 MenuCorrectionsCreate: Abgaben registrieren
 MenuCorrectionsGrade: Abgaben online korrigieren
-MenuCorrectionsAssign: Zuteilung Korrekturen
-MenuCorrectionsAssignSheet name@Text: Zuteilung Korrekturen von #{name}
+MenuCorrectionsAssign: Zuteilung der Korrekturen
+MenuCorrectionsAssignSheet name@Text: Zuteilung der Korrekturen von #{name}
 MenuAuthPreds: Authorisierungseinstellungen
 MenuTutorialDelete: Tutorium löschen
 MenuTutorialEdit: Tutorium editieren
@@ -1120,6 +1121,58 @@ MenuCourseNewsEdit: Kursnachricht bearbeiten
 MenuCourseEventNew: Neuer Kurstermin
 MenuCourseEventEdit: Kurstermin bearbeiten
 
+BreadcrumbSubmissionFile: Datei
+BreadcrumbSubmissionUserInvite: Einladung zur Abgabe
+BreadcrumbCryptoIDDispatch: CryptoID-Weiterleitung
+BreadcrumbCourseAppsFiles: Bewerbungsdateien
+BreadcrumbCourseNotes: Kursnotizen
+BreadcrumbHiWis: Korrektoren
+BreadcrumbMaterial: Material
+BreadcrumbSheet: Übungsblatt
+BreadcrumbTutorial: Tutorium
+BreadcrumbExam: Prüfung
+BreadcrumbApplicant: Bewerber
+BreadcrumbCourseRegister: Anmelden
+BreadcrumbCourseRegisterTemplate: Bewerbungsvorlagen
+BreadcrumbCourseFavourite: Favorisieren
+BreadcrumbCourse: Kurs
+BreadcrumbAllocationRegister: Teilnahme registrieren
+BreadcrumbAllocation: Zentralanmeldung
+BreadcrumbTerm: Semester
+BreadcrumbSchool: Institut
+BreadcrumbUser: Benutzer
+BreadcrumbStatic: Statische Resource
+BreadcrumbFavicon: Favicon
+BreadcrumbRobots: robots.txt
+BreadcrumbLecturerInvite: Einladung zum Kursverwalter
+BreadcrumbExamOfficeUserInvite: Einladung bzgl. Prüfungsleistungen
+BreadcrumbFunctionaryInvite: Einladung zum Instituts-Funktionär
+BreadcrumbUserDelete: Nutzer-Account löschen
+BreadcrumbUserHijack: Nutzer-Sitzung übernehmen
+BreadcrumbSystemMessage: Statusmeldung
+BreadcrumbSubmission: Abgabe
+BreadcrumbCourseNews: Kursnachricht
+BreadcrumbCourseNewsDelete: Kursnachricht löschen
+BreadcrumbCourseEventDelete: Kurstermin löschen
+BreadcrumbProfile: Einstellungen
+BreadcrumbAllocationInfo: Ablauf einer Zentralanmeldung
+BreadcrumbCourseParticipantInvitation: Einladung zum Kursteilnehmer
+BreadcrumbMaterialArchive: Archiv
+BreadcrumbMaterialFile: Datei
+BreadcrumbSheetArchive: Dateien
+BreadcrumbSheetIsCorrector: Korrektor-Überprüfung
+BreadcrumbSheetPseudonym: Pseudonym
+BreadcrumbSheetCorrectorInvite: Einladung zum Korrektor
+BreadcrumbSheetFile: Datei
+BreadcrumbTutorialRegister: Anmelden
+BreadcrumbTutorInvite: Einladung zum Tutor
+BreadcrumbExamCorrectorInvite: Einladung zum Prüfungskorrektor
+BreadcrumbExamParticipantInvite: Einladung zum Prüfungsteilnehmer
+BreadcrumbExamRegister: Anmelden
+BreadcrumbApplicationFiles: Bewerbungsdateien
+BreadcrumbCourseNewsArchive: Archiv
+BreadcrumbCourseNewsFile: Datei
+
 AuthPredsInfo: Um eigene Veranstaltungen aus Sicht der Teilnehmer anzusehen, können Veranstalter und Korrektoren hier die Prüfung ihrer erweiterten Berechtigungen temporär deaktivieren. Abgewählte Prädikate schlagen immer fehl. Abgewählte Prädikate werden also nicht geprüft um Zugriffe zu gewähren, welche andernfalls nicht erlaubt wären. Diese Einstellungen gelten nur temporär bis Ihre Sitzung abgelaufen ist, d.h. bis ihr Browser-Cookie abgelaufen ist. Durch Abwahl von Prädikaten kann man sich höchstens temporär aussperren.
 AuthPredsActive: Aktive Authorisierungsprädikate
 AuthPredsActiveChanged: Authorisierungseinstellungen für aktuelle Sitzung gespeichert

src/Foundation.hs

@@ -1511,6 +1511,15 @@ redirectAccess url = do
     Authorized -> redirect url
     _          -> permissionDeniedI MsgUnauthorizedRedirect
 
+redirectAccessWith :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => Status -> Route UniWorX -> m a
+redirectAccessWith status url = do
+  -- must hide URL if not authorized
+  access <- evalAccess url False
+  case access of
+    Authorized -> redirectWith status url
+    _          -> permissionDeniedI MsgUnauthorizedRedirect
+
+
 -- | Verify that the currently logged in user is lecturer or corrector for at least one sheet for the given course
 evalAccessCorrector :: (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX)
             => TermId -> SchoolId -> CourseShorthand -> m AuthResult
@@ -1725,7 +1734,21 @@ siteLayout' headingOverride widget = do
   mcurrentRoute <- getCurrentRoute
 
   -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance.
-  (title, parents) <- breadcrumbs
+  let
+    breadcrumbs' mcRoute = do
+      mr <- getMessageRender
+      case mcRoute of
+        Nothing -> return (mr MsgErrorResponseTitleNotFound, [])
+        Just cRoute -> do
+          (title, next) <- breadcrumb cRoute
+          crumbs <- go [] next
+          return (title, crumbs)
+      where
+        go crumbs  Nothing      = return crumbs
+        go crumbs (Just cRoute) = do
+          (title, next) <- breadcrumb cRoute
+          go ((cRoute, title) : crumbs) next
+  (title, parents) <- breadcrumbs' mcurrentRoute
 
   --         let isParent :: Route UniWorX -> Bool
   --             isParent r = r == (fst parents)
@@ -1914,141 +1937,253 @@ i18nCrumb :: ( RenderMessage (HandlerSite m) msg, MonadHandler m )
           -> m (Text, Maybe (Route (HandlerSite m)))
 i18nCrumb msg mbR = do
   mr <- getMessageRender
-  return (mr msb, mbR)
-  
+  return (mr msg, mbR)
+
+-- `breadcrumb` _really_ needs to be total for _all_ routes
+--
+-- Even if routes are POST only or don't usually use `siteLayout` they will if
+-- an error occurs.
+--
+-- Keep in mind that Breadcrumbs are also shown by the 403-Handler,
+-- i.e. information might be leaked by not performing permission checks if the
+-- breadcrumb value depends on sensitive content (like an user's name).
 instance YesodBreadcrumbs UniWorX where
   breadcrumb (AuthR _)        = i18nCrumb MsgMenuLogin   $ Just HomeR
+  breadcrumb (StaticR _)      = i18nCrumb MsgBreadcrumbStatic Nothing
+  breadcrumb FaviconR         = i18nCrumb MsgBreadcrumbFavicon Nothing
+  breadcrumb RobotsR          = i18nCrumb MsgBreadcrumbRobots Nothing
+
   breadcrumb HomeR            = i18nCrumb MsgMenuHome      Nothing
   breadcrumb UsersR           = i18nCrumb MsgMenuUsers   $ Just AdminR
   breadcrumb AdminUserAddR    = i18nCrumb MsgMenuUserAdd $ Just UsersR
-  breadcrumb (AdminUserR cID) = do
+  breadcrumb (AdminUserR cID) = maybeT (i18nCrumb MsgBreadcrumbUser $ Just UsersR) $ do
+    guardM . hasReadAccessTo $ AdminUserR cID
     uid <- decrypt cID
-    User{..} <- runDB $ get404 uid
-    return (userDisplayName, Just UsersR
+    User{..} <- MaybeT . runDB $ get uid
+    return (userDisplayName, Just UsersR)
+  breadcrumb (AdminUserDeleteR cID) = i18nCrumb MsgBreadcrumbUserDelete . Just $ AdminUserR cID
+  breadcrumb (AdminHijackUserR cID) = i18nCrumb MsgBreadcrumbUserHijack . Just $ AdminUserR cID 
+  breadcrumb (UserNotificationR cID) = do
+    mayList <- hasReadAccessTo UsersR
+    if
+      | mayList
+        -> i18nCrumb MsgMenuUserNotifications . Just $ AdminUserR cID
+      | otherwise
+        -> i18nCrumb MsgMenuUserNotifications $ Just ProfileR
+  breadcrumb (UserPasswordR cID) = do
+    mayList <- hasReadAccessTo UsersR
+    if
+      | mayList
+        -> i18nCrumb MsgMenuUserPassword . Just $ AdminUserR cID
+      | otherwise
+        -> i18nCrumb MsgMenuUserPassword $ Just ProfileR
+  breadcrumb AdminNewFunctionaryInviteR = i18nCrumb MsgMenuLecturerInvite $ Just UsersR
+  breadcrumb AdminFunctionaryInviteR = i18nCrumb MsgBreadcrumbFunctionaryInvite Nothing
+
   breadcrumb AdminR           = i18nCrumb MsgAdminHeading           Nothing
   breadcrumb AdminFeaturesR   = i18nCrumb MsgAdminFeaturesHeading $ Just AdminR 
   breadcrumb AdminTestR       = i18nCrumb MsgMenuAdminTest        $ Just AdminR
-  breadcrumb AdminErrMsgR     = i18nCrumb MsgAdminErrMsg          $ Just AdminR
+  breadcrumb AdminErrMsgR     = i18nCrumb MsgMenuAdminErrMsg      $ Just AdminR
   
-  breadcrumb SchoolListR      = return ("Institute"    , Just AdminR)
-  breadcrumb (SchoolR ssh SchoolEditR) = return (original (unSchoolKey ssh), Just SchoolListR)
-  breadcrumb SchoolNewR       = return ("Neu"          , Just SchoolListR)
+  breadcrumb SchoolListR      = i18nCrumb MsgMenuSchoolList       $ Just AdminR
+  breadcrumb (SchoolR ssh SchoolEditR) = maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do
+    School{..} <- MaybeT . runDB $ get ssh
+    return (original schoolName, Just SchoolListR)
+  breadcrumb SchoolNewR       = i18nCrumb MsgMenuSchoolNew        $ Just SchoolListR
 
-  breadcrumb (ExamOfficeR EOExamsR)  = return ("Prüfungen", Nothing)
-  breadcrumb (ExamOfficeR EOFieldsR) = return ("Fächer"   , Just $ ExamOfficeR EOExamsR)
-  breadcrumb (ExamOfficeR EOUsersR)  = return ("Benutzer" , Just $ ExamOfficeR EOExamsR)
+  breadcrumb (ExamOfficeR EOExamsR)  = i18nCrumb MsgMenuExamOfficeExams    Nothing
+  breadcrumb (ExamOfficeR EOFieldsR) = i18nCrumb MsgMenuExamOfficeFields . Just $ ExamOfficeR EOExamsR
+  breadcrumb (ExamOfficeR EOUsersR)  = i18nCrumb MsgMenuExamOfficeUsers . Just $ ExamOfficeR EOExamsR
+  breadcrumb (ExamOfficeR EOUsersInviteR) = i18nCrumb MsgBreadcrumbExamOfficeUserInvite Nothing
 
-  breadcrumb InfoR            = return ("Information"  , Nothing)
-  breadcrumb InfoLecturerR    = return ("Veranstalter" , Just InfoR)
-  breadcrumb DataProtR        = return ("Datenschutz"  , Just InfoR)
-  breadcrumb InfoAllocationR  = return ("Zentralanmeldungen", Just InfoR)
-  breadcrumb ImpressumR       = return ("Impressum"    , Just InfoR)
-  breadcrumb VersionR         = return ("Versionsgeschichte", Just InfoR)
+  breadcrumb InfoR            = i18nCrumb MsgMenuInformation     Nothing
+  breadcrumb InfoLecturerR    = i18nCrumb MsgInfoLecturerTitle $ Just InfoR
+  breadcrumb DataProtR        = i18nCrumb MsgMenuDataProt      $ Just InfoR
+  breadcrumb InfoAllocationR  = i18nCrumb MsgBreadcrumbAllocationInfo $ Just InfoR
+  breadcrumb ImpressumR       = i18nCrumb MsgMenuImpressum     $ Just InfoR
+  breadcrumb VersionR         = i18nCrumb MsgMenuVersion       $ Just InfoR
 
 
-  breadcrumb HelpR            = return ("Hilfe"        , Just HomeR)
+  breadcrumb HelpR            = i18nCrumb MsgMenuHelp            Nothing
 
 
-  breadcrumb HealthR          = return ("Status"        , Nothing)
-  breadcrumb InstanceR        = return ("Identifikation", Nothing)
+  breadcrumb HealthR          = i18nCrumb MsgMenuHealth          Nothing
+  breadcrumb InstanceR        = i18nCrumb MsgMenuInstance        Nothing
 
+  breadcrumb ProfileR         = i18nCrumb MsgBreadcrumbProfile   Nothing
+  breadcrumb SetDisplayEmailR = i18nCrumb MsgUserDisplayEmail  $ Just ProfileR
+  breadcrumb ProfileDataR     = i18nCrumb MsgMenuProfileData   $ Just ProfileR
+  breadcrumb AuthPredsR       = i18nCrumb MsgMenuAuthPreds     $ Just ProfileR
+  breadcrumb CsvOptionsR      = i18nCrumb MsgCsvOptions        $ Just ProfileR
+  breadcrumb LangR            = i18nCrumb MsgMenuLanguage      $ Just ProfileR
 
-  breadcrumb ProfileR         = return ("Einstellungen"    , Just HomeR)
-  breadcrumb SetDisplayEmailR = return ("Öffentliche E-Mail Adresse", Just ProfileR)
-  breadcrumb ProfileDataR     = return ("Persönliche Daten", Just ProfileR)
-  breadcrumb AuthPredsR       = return ("Authorisierung"   , Just ProfileR)
+  breadcrumb TermShowR              = i18nCrumb MsgMenuTermShow    $ Just HomeR
+  breadcrumb TermCurrentR           = i18nCrumb MsgMenuTermCurrent $ Just TermShowR
+  breadcrumb TermEditR              = i18nCrumb MsgMenuTermCreate  $ Just TermShowR
+  breadcrumb (TermEditExistR tid)   = i18nCrumb MsgMenuTermEdit    . Just $ TermCourseListR tid
+  breadcrumb (TermCourseListR tid)  = maybeT (i18nCrumb MsgBreadcrumbTerm $ Just CourseListR) $ do -- redirect only, used in other breadcrumbs
+    guardM . lift . runDB $ isJust <$> get tid
+    i18nCrumb (ShortTermIdentifier $ unTermKey tid) $ Just CourseListR
 
-  breadcrumb TermShowR              = return ("Semester"  , Just HomeR)
-  breadcrumb TermCurrentR           = return ("Aktuell"   , Just TermShowR)
-  breadcrumb TermEditR              = return ("Neu"       , Just TermCurrentR)
-  breadcrumb (TermEditExistR tid)   = return ("Editieren" , Just $ TermCourseListR tid)
-  breadcrumb (TermCourseListR (unTermKey -> tid)) = getMessageRender <&> \mr -> (mr $ ShortTermIdentifier tid, Just CourseListR)
+  breadcrumb (TermSchoolCourseListR tid ssh) = maybeT (i18nCrumb MsgBreadcrumbSchool . Just $ TermCourseListR tid) $ do -- redirect only, used in other breadcrumbs
+    guardM . lift . runDB $
+      (&&) <$> fmap isJust (get ssh)
+           <*> fmap isJust (get tid)
+    return (original $ unSchoolKey ssh, Just $ TermCourseListR tid)
 
-  breadcrumb (TermSchoolCourseListR tid ssh)  = return (original $ unSchoolKey ssh, Just $ TermCourseListR tid)
-
-  breadcrumb AllocationListR        = return ("Zentralanmeldungen", Just HomeR)
-  breadcrumb (AllocationR tid ssh ash AShowR) = do
+  breadcrumb AllocationListR        = i18nCrumb MsgAllocationListTitle $ Just HomeR
+  breadcrumb (AllocationR tid ssh ash AShowR) = maybeT (i18nCrumb MsgBreadcrumbAllocation $ Just AllocationListR) $ do
     mr <- getMessageRender
-    Entity _ Allocation{allocationName} <- runDB . getBy404 $ TermSchoolAllocationShort tid ssh ash
+    Entity _ Allocation{allocationName} <- MaybeT . runDB . getBy $ TermSchoolAllocationShort tid ssh ash
     return ([st|#{allocationName} (#{mr (ShortTermIdentifier (unTermKey tid))}, #{original (unSchoolKey ssh)})|], Just $ AllocationListR)
+  breadcrumb (AllocationR tid ssh ash ARegisterR) = i18nCrumb MsgBreadcrumbAllocationRegister . Just $ AllocationR tid ssh ash AShowR
+  breadcrumb (AllocationR tid ssh ash (AApplyR cID)) = maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ AllocationR tid ssh ash AShowR) $ do
+    cid <- decrypt cID
+    Course{..} <- hoist runDB $ do
+      aid <- MaybeT . getKeyBy $ TermSchoolAllocationShort tid ssh ash 
+      guardM . lift $ exists [ AllocationCourseAllocation ==. aid, AllocationCourseCourse ==. cid ]
+      MaybeT $ get cid
+    return (original courseName, Just $ AllocationR tid ssh ash AShowR)
 
-  breadcrumb  CourseListR                 = return ("Kurse"    , Nothing)
-  breadcrumb  CourseNewR                  = return ("Neu"      , Just CourseListR)
-  breadcrumb (CourseR tid ssh csh CShowR) = return (original csh, Just $ TermSchoolCourseListR tid ssh)
-  --         (CourseR tid ssh csh CRegisterR) -- is POST only
-  breadcrumb (CourseR tid ssh csh CEditR)     = return ("Editieren"  , Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CUsersR)    = return ("Anmeldungen", Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CAddUserR)  = return ("Kursteilnehmer hinzufügen", Just $ CourseR tid ssh csh CUsersR)
-  breadcrumb (CourseR tid ssh csh CInviteR)   = return ("Einladung", Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CExamOfficeR) = return ("Prüfungsamter", Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh (CUserR cID)) = do
+  breadcrumb  CourseListR                 = i18nCrumb MsgMenuCourseList   Nothing
+  breadcrumb  CourseNewR                  = i18nCrumb MsgMenuCourseNew  $ Just CourseListR
+  breadcrumb (CourseR tid ssh csh CShowR) = maybeT (i18nCrumb MsgBreadcrumbCourse . Just $ TermSchoolCourseListR tid ssh) $ do
+    guardM . lift . runDB . existsBy $ TermSchoolCourseShort tid ssh csh
+    return (original csh, Just $ TermSchoolCourseListR tid ssh)
+  breadcrumb (CourseR tid ssh csh CEditR)     = i18nCrumb MsgMenuCourseEdit . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CUsersR)    = i18nCrumb MsgMenuCourseMembers . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CAddUserR)  = i18nCrumb MsgMenuCourseAddMembers . Just $ CourseR tid ssh csh CUsersR
+  breadcrumb (CourseR tid ssh csh CInviteR)   = i18nCrumb MsgBreadcrumbCourseParticipantInvitation . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CExamOfficeR) = i18nCrumb MsgMenuCourseExamOffice . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh (CUserR cID)) = maybeT (i18nCrumb MsgBreadcrumbUser . Just $ CourseR tid ssh csh CUsersR) $ do
+    guardM . hasReadAccessTo . CourseR tid ssh csh $ CUserR cID
     uid <- decrypt cID
-    User{userDisplayName} <- runDB $ get404 uid
-    return (userDisplayName, Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben" , Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CAssignR)   = return ("Zuteilung Korrekturen"  , Just $ CourseR tid ssh csh CCorrectionsR)
-  breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen"    , Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu",         Just $ CourseR tid ssh csh SheetListR)
-  breadcrumb (CourseR tid ssh csh SheetCurrentR) = return ("Aktuelles Blatt", Just $ CourseR tid ssh csh SheetListR)
-  breadcrumb (CourseR tid ssh csh SheetOldUnassignedR) = return ("Offene Abgaben", Just $ CourseR tid ssh csh SheetListR)
-  breadcrumb (CourseR tid ssh csh CCommR    ) = return ("Kursmitteilung", Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CTutorialListR) = return ("Tutorien", Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CTutorialNewR) = return ("Anlegen", Just $ CourseR tid ssh csh CTutorialListR)
+    User{userDisplayName} <- MaybeT . runDB $ get uid
+    return (userDisplayName, Just $ CourseR tid ssh csh CUsersR)
+  breadcrumb (CourseR tid ssh csh CCorrectionsR) = i18nCrumb MsgMenuSubmissions . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CAssignR)   = i18nCrumb MsgMenuCorrectionsAssign . Just $ CourseR tid ssh csh CCorrectionsR
+  breadcrumb (CourseR tid ssh csh SheetListR) = i18nCrumb MsgMenuSheetList . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh SheetNewR ) = i18nCrumb MsgMenuSheetNew . Just $ CourseR tid ssh csh SheetListR
+  breadcrumb (CourseR tid ssh csh SheetCurrentR) = i18nCrumb MsgMenuSheetCurrent . Just $ CourseR tid ssh csh SheetListR
+  breadcrumb (CourseR tid ssh csh SheetOldUnassignedR) = i18nCrumb MsgMenuSheetOldUnassigned . Just $ CourseR tid ssh csh SheetListR
+  breadcrumb (CourseR tid ssh csh CCommR    ) = i18nCrumb MsgMenuCourseCommunication . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CTutorialListR) = i18nCrumb MsgMenuTutorialList . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CTutorialNewR) = i18nCrumb MsgMenuTutorialNew . Just $ CourseR tid ssh csh CTutorialListR
+  breadcrumb (CourseR tid ssh csh CFavouriteR) = i18nCrumb MsgBreadcrumbCourseFavourite . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CRegisterR)  = i18nCrumb MsgBreadcrumbCourseRegister . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CRegisterTemplateR) = i18nCrumb MsgBreadcrumbCourseRegisterTemplate . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CLecInviteR) = i18nCrumb MsgBreadcrumbLecturerInvite . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CDeleteR) = i18nCrumb MsgMenuCourseDelete . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CHiWisR) = i18nCrumb MsgBreadcrumbHiWis . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CNotesR) = i18nCrumb MsgBreadcrumbCourseNotes . Just $ CourseR tid ssh csh CShowR
 
-  breadcrumb (CourseR tid ssh csh CNewsNewR)    = return ("Neue Nachricht", Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CNewsR tid ssh csh _ CNShowR)     = return ("Kursnachricht" , Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CNewsR tid ssh csh cID CNEditR)   = return ("Bearbeiten"    , Just $ CNewsR tid ssh csh cID CNShowR)
-  breadcrumb (CNewsR tid ssh csh cID CNDeleteR) = return ("Löschen"       , Just $ CNewsR tid ssh csh cID CNShowR)
+  breadcrumb (CourseR tid ssh csh CNewsNewR)    = i18nCrumb MsgMenuCourseNewsNew . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh (CourseNewsR cID sRoute)) = case sRoute of
+    CNShowR   -> i18nCrumb MsgBreadcrumbCourseNews . Just $ CourseR tid ssh csh CShowR
+    CNEditR   -> i18nCrumb MsgMenuCourseNewsEdit . Just $ CNewsR tid ssh csh cID CNShowR
+    CNDeleteR -> i18nCrumb MsgBreadcrumbCourseNewsDelete . Just $ CNewsR tid ssh csh cID CNShowR
+    CNArchiveR -> i18nCrumb MsgBreadcrumbCourseNewsArchive . Just $ CNewsR tid ssh csh cID CNShowR
+    CNFileR _ -> i18nCrumb MsgBreadcrumbCourseNewsFile . Just $ CNewsR tid ssh csh cID CNShowR
+  
+  breadcrumb (CourseR tid ssh csh CEventsNewR)    = i18nCrumb MsgMenuCourseEventNew . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh (CourseEventR _cID sRoute)) = case sRoute of
+    CEvEditR   -> i18nCrumb MsgMenuCourseEventEdit . Just $ CourseR tid ssh csh CShowR
+    CEvDeleteR -> i18nCrumb MsgBreadcrumbCourseEventDelete . Just $ CourseR tid ssh csh CShowR
 
-  breadcrumb (CourseR tid ssh csh CExamListR) = return ("Prüfungen", Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CExamNewR) = return ("Anlegen", Just $ CourseR tid ssh csh CExamListR)
+  breadcrumb (CourseR tid ssh csh CExamListR) = i18nCrumb MsgMenuExamList . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CExamNewR) = i18nCrumb MsgMenuExamNew . Just $ CourseR tid ssh csh CExamListR
 
-  breadcrumb (CourseR tid ssh csh CApplicationsR) = return ("Bewerbungen", Just $ CourseR tid ssh csh CShowR)
+  breadcrumb (CourseR tid ssh csh CApplicationsR) = i18nCrumb MsgMenuCourseApplications . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh CAppsFilesR) = i18nCrumb MsgBreadcrumbCourseAppsFiles . Just $ CourseR tid ssh csh CApplicationsR
 
-  breadcrumb (CApplicationR tid ssh csh _ CAEditR) = return ("Bewerbung", Just $ CourseR tid ssh csh CApplicationsR)
+  breadcrumb (CourseR tid ssh csh (CourseApplicationR cID sRoute)) = case sRoute of
+    CAEditR -> maybeT (i18nCrumb MsgBreadcrumbApplicant . Just $ CourseR tid ssh csh CApplicationsR) $ do
+      guardM . hasReadAccessTo $ CApplicationR tid ssh csh cID CAEditR
+      appId <- decrypt cID
+      User{..} <- hoist runDB $ MaybeT (get appId) >>= MaybeT . get . courseApplicationUser
+      return (userDisplayName, Just $ CourseR tid ssh csh CApplicationsR)
+    CAFilesR -> i18nCrumb MsgBreadcrumbApplicationFiles . Just $ CApplicationR tid ssh csh cID CAEditR
 
-  breadcrumb (CExamR tid ssh csh examn EShowR) = return (original examn, Just $ CourseR tid ssh csh CExamListR)
-  breadcrumb (CExamR tid ssh csh examn EEditR) = return ("Bearbeiten", Just $ CExamR tid ssh csh examn EShowR)
-  breadcrumb (CExamR tid ssh csh examn EUsersR) = return ("Teilnehmer", Just $ CExamR tid ssh csh examn EShowR)
-  breadcrumb (CExamR tid ssh csh examn EAddUserR) = return ("Prüfungsteilnehmer hinzufügen", Just $ CExamR tid ssh csh examn EUsersR)
-  breadcrumb (CExamR tid ssh csh examn EGradesR) = return ("Prüfungsleistungen", Just $ CExamR tid ssh csh examn EShowR)
+  breadcrumb (CourseR tid ssh csh (ExamR examn sRoute)) = case sRoute of
+    EShowR    -> maybeT (i18nCrumb MsgBreadcrumbExam . Just $ CourseR tid ssh csh CExamListR) $ do
+      guardM . hasReadAccessTo $ CExamR tid ssh csh examn EShowR
+      return (original examn, Just $ CourseR tid ssh csh CExamListR)
+    EEditR    -> i18nCrumb MsgMenuExamEdit . Just $ CExamR tid ssh csh examn EShowR
+    EUsersR   -> i18nCrumb MsgMenuExamUsers . Just $ CExamR tid ssh csh examn EShowR
+    EAddUserR -> i18nCrumb MsgMenuExamAddMembers . Just $ CExamR tid ssh csh examn EUsersR
+    EGradesR  -> i18nCrumb MsgMenuExamGrades . Just $ CExamR tid ssh csh examn EShowR
+    ECInviteR  -> i18nCrumb MsgBreadcrumbExamCorrectorInvite . Just $ CExamR tid ssh csh examn EShowR
+    EInviteR   -> i18nCrumb MsgBreadcrumbExamParticipantInvite . Just $ CExamR tid ssh csh examn EShowR
+    ERegisterR -> i18nCrumb MsgBreadcrumbExamRegister . Just $ CExamR tid ssh csh examn EShowR
 
-  breadcrumb (CTutorialR tid ssh csh tutn TUsersR)   = return (original tutn, Just $ CourseR tid ssh csh CTutorialListR)
-  breadcrumb (CTutorialR tid ssh csh tutn TEditR)    = return ("Bearbeiten", Just $ CTutorialR tid ssh csh tutn TUsersR)
-  breadcrumb (CTutorialR tid ssh csh tutn TDeleteR)  = return ("Löschen", Just $ CTutorialR tid ssh csh tutn TUsersR)
-  breadcrumb (CTutorialR tid ssh csh tutn TCommR)    = return ("Mitteilung", Just $ CTutorialR tid ssh csh tutn TUsersR)
+  breadcrumb (CourseR tid ssh csh (TutorialR tutn sRoute)) = case sRoute of
+    TUsersR  -> maybeT (i18nCrumb MsgBreadcrumbTutorial . Just $ CourseR tid ssh csh CTutorialListR) $ do
+      guardM . hasReadAccessTo $ CTutorialR tid ssh csh tutn TUsersR
+      return (original tutn, Just $ CourseR tid ssh csh CTutorialListR)
+    TEditR   -> i18nCrumb MsgMenuTutorialEdit . Just $ CTutorialR tid ssh csh tutn TUsersR
+    TDeleteR -> i18nCrumb MsgMenuTutorialDelete . Just $ CTutorialR tid ssh csh tutn TUsersR
+    TCommR   -> i18nCrumb MsgMenuTutorialComm . Just $ CTutorialR tid ssh csh tutn TUsersR
+    TRegisterR -> i18nCrumb MsgBreadcrumbTutorialRegister . Just $ CourseR tid ssh csh CShowR
+    TInviteR -> i18nCrumb MsgBreadcrumbTutorInvite . Just $ CTutorialR tid ssh csh tutn TUsersR
 
-  breadcrumb (CSheetR tid ssh csh shn SShowR)   = return (original shn, Just $ CourseR tid ssh csh SheetListR)
-  breadcrumb (CSheetR tid ssh csh shn SEditR)   = return ("Bearbeiten"   , Just $ CSheetR tid ssh csh shn SShowR)
-  breadcrumb (CSheetR tid ssh csh shn SDelR )   = return ("Löschen"      , Just $ CSheetR tid ssh csh shn SShowR)
-  breadcrumb (CSheetR tid ssh csh shn SSubsR)   = return ("Abgaben"      , Just $ CSheetR tid ssh csh shn SShowR)
-  breadcrumb (CSheetR tid ssh csh shn SAssignR) = return ("Zuteilung Korrekturen"     , Just $ CSheetR tid ssh csh shn SSubsR)
-  breadcrumb (CSheetR tid ssh csh shn SubmissionNewR)  = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
-  breadcrumb (CSheetR tid ssh csh shn SubmissionOwnR)  = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
-  breadcrumb (CSubmissionR tid ssh csh shn _ SubShowR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
---           (CSubmissionR tid ssh csh shn _ SubArchiveR)  -- just for Download
-  breadcrumb (CSubmissionR tid ssh csh shn cid CorrectionR) = return ("Korrektur", Just $ CSubmissionR tid ssh csh shn cid SubShowR)
---           (CSubmissionR tid ssh csh shn _ SubDownloadR) -- just for Download
-  breadcrumb (CSheetR tid ssh csh shn SCorrR) = return ("Korrektoren", Just $ CSheetR tid ssh csh shn SShowR)
-  --         (CSheetR tid ssh csh shn SFileR) -- just for Downloads
+  breadcrumb (CourseR tid ssh csh (SheetR shn sRoute)) = case sRoute of
+    SShowR -> maybeT (i18nCrumb MsgBreadcrumbSheet . Just $ CourseR tid ssh csh SheetListR) $ do
+      guardM . hasReadAccessTo $ CSheetR tid ssh csh shn SShowR
+      return (original shn, Just $ CourseR tid ssh csh SheetListR)
+    SEditR -> i18nCrumb MsgMenuSheetEdit . Just $ CSheetR tid ssh csh shn SShowR
+    SDelR  -> i18nCrumb MsgMenuSheetDelete . Just $ CSheetR tid ssh csh shn SShowR
+    SSubsR -> i18nCrumb MsgMenuSubmissions . Just $ CSheetR tid ssh csh shn SShowR
+    SAssignR -> i18nCrumb MsgMenuCorrectionsAssign . Just $ CSheetR tid ssh csh shn SSubsR
+    SubmissionNewR -> i18nCrumb MsgMenuSubmissionNew . Just $ CSheetR tid ssh csh shn SShowR
+    SubmissionOwnR -> i18nCrumb MsgMenuSubmissionOwn . Just $ CSheetR tid ssh csh shn SShowR
+    SubmissionR cid sRoute' -> case sRoute' of
+      SubShowR -> do
+        mayList <- hasReadAccessTo $ CSheetR tid ssh csh shn SSubsR
+        if
+          | mayList
+            -> i18nCrumb MsgBreadcrumbSubmission . Just $ CSheetR tid ssh csh shn SSubsR
+          | otherwise
+            -> i18nCrumb MsgBreadcrumbSubmission . Just $ CSheetR tid ssh csh shn SShowR
+      CorrectionR -> i18nCrumb MsgMenuCorrection . Just $ CSubmissionR tid ssh csh shn cid SubShowR
+      SubDelR -> i18nCrumb MsgMenuSubmissionDelete . Just $ CSubmissionR tid ssh csh shn cid SubShowR
+      SubAssignR -> i18nCrumb MsgCorrectorAssignTitle . Just $ CSubmissionR tid ssh csh shn cid SubShowR
+      SInviteR -> i18nCrumb MsgBreadcrumbSubmissionUserInvite . Just $ CSubmissionR tid ssh csh shn cid SubShowR
+      SubArchiveR sft -> i18nCrumb sft . Just $ CSubmissionR tid ssh csh shn cid SubShowR
+      SubDownloadR _ _ -> i18nCrumb MsgBreadcrumbSubmissionFile . Just $ CSubmissionR tid ssh csh shn cid SubShowR
+    SCorrR -> i18nCrumb MsgMenuCorrectors . Just $ CSheetR tid ssh csh shn SShowR
+    SArchiveR -> i18nCrumb MsgBreadcrumbSheetArchive . Just $ CSheetR tid ssh csh shn SShowR
+    SIsCorrR -> i18nCrumb MsgBreadcrumbSheetIsCorrector . Just $ CSheetR tid ssh csh shn SShowR
+    SPseudonymR -> i18nCrumb MsgBreadcrumbSheetPseudonym . Just $ CSheetR tid ssh csh shn SShowR
+    SCorrInviteR -> i18nCrumb MsgBreadcrumbSheetCorrectorInvite . Just $ CSheetR tid ssh csh shn SShowR
+    SZipR sft -> i18nCrumb sft . Just $ CSheetR tid ssh csh shn SShowR
+    SFileR _ _ -> i18nCrumb MsgBreadcrumbSheetFile . Just $ CSheetR tid ssh csh shn SShowR
 
-  breadcrumb (CourseR tid ssh csh MaterialListR) = return ("Material"     , Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh MaterialNewR ) = return ("Neu"          , Just $ CourseR tid ssh csh MaterialListR)
-  breadcrumb (CMaterialR tid ssh csh mnm MShowR) = return (original mnm, Just $ CourseR tid ssh csh MaterialListR)
-  breadcrumb (CMaterialR tid ssh csh mnm MEditR) = return ("Bearbeiten"   , Just $ CMaterialR tid ssh csh mnm MShowR)
-  breadcrumb (CMaterialR tid ssh csh mnm MDelR)  = return ("Löschen"      , Just $ CMaterialR tid ssh csh mnm MShowR)
-  --         (CMaterialR tid ssh csh mnm MFileR) -- just for Downloads
+  breadcrumb (CourseR tid ssh csh MaterialListR) = i18nCrumb MsgMenuMaterialList . Just $ CourseR tid ssh csh CShowR
+  breadcrumb (CourseR tid ssh csh MaterialNewR ) = i18nCrumb MsgMenuMaterialNew . Just $ CourseR tid ssh csh MaterialListR
+  breadcrumb (CourseR tid ssh csh (MaterialR mnm sRoute)) = case sRoute of
+    MShowR -> maybeT (i18nCrumb MsgBreadcrumbMaterial . Just $ CourseR tid ssh csh MaterialListR) $ do
+      guardM . hasReadAccessTo $ CMaterialR tid ssh csh mnm MShowR
+      return (original mnm, Just $ CourseR tid ssh csh MaterialListR)
+    MEditR -> i18nCrumb MsgMenuMaterialEdit . Just $ CMaterialR tid ssh csh mnm MShowR
+    MDelR  -> i18nCrumb MsgMenuMaterialDelete . Just $ CMaterialR tid ssh csh mnm MShowR
+    MArchiveR -> i18nCrumb MsgBreadcrumbMaterialArchive . Just $ CMaterialR tid ssh csh mnm MShowR
+    MFileR _ -> i18nCrumb MsgBreadcrumbMaterialFile . Just $ CMaterialR tid ssh csh mnm MShowR
 
-  -- Others
-  breadcrumb (CorrectionsR)       = return ("Korrekturen", Just HomeR)
-  breadcrumb (CorrectionsUploadR) = return ("Hochladen", Just CorrectionsR)
+  breadcrumb CorrectionsR         = i18nCrumb MsgMenuCorrections Nothing
+  breadcrumb CorrectionsUploadR   = i18nCrumb MsgMenuCorrectionsUpload $ Just CorrectionsR
+  breadcrumb CorrectionsCreateR   = i18nCrumb MsgMenuCorrectionsCreate $ Just CorrectionsR
+  breadcrumb CorrectionsGradeR    = i18nCrumb MsgMenuCorrectionsGrade $ Just CorrectionsR
+  breadcrumb CorrectionsDownloadR = i18nCrumb MsgMenuCorrectionsDownload $ Just CorrectionsR
+
+  breadcrumb (CryptoUUIDDispatchR _) = i18nCrumb MsgBreadcrumbCryptoIDDispatch Nothing
+  
   breadcrumb (MessageR _) = do
     mayList <- (== Authorized) <$> evalAccess MessageListR False
-    return $ if
-      | mayList   -> ("Statusmeldung", Just MessageListR)
-      | otherwise -> ("Statusmeldung", Just HomeR)
-  breadcrumb (MessageListR) = return ("Statusmeldungen", Just AdminR)
-  breadcrumb  _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
+    if
+      | mayList   -> i18nCrumb MsgBreadcrumbSystemMessage $ Just MessageListR
+      | otherwise -> i18nCrumb MsgBreadcrumbSystemMessage $ Just HomeR
+  breadcrumb (MessageListR) = i18nCrumb MsgMenuMessageList $ Just AdminR
+  -- breadcrumb  _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
 
 submissionList :: TermId -> CourseShorthand -> SheetName -> UserId -> DB [E.Value SubmissionId]
 submissionList tid csh shn uid = E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser) -> do

src/Handler/CryptoIDDispatch.hs

@@ -66,7 +66,7 @@ instance (CryptoRoute ciphertext plaintext, Dispatch ciphertext ps) => Dispatch
   
 
 getCryptoUUIDDispatchR :: UUID -> Handler ()
-getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectWith found302)
+getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectAccessWith movedPermanently301)
   where
     p :: Proxy '[ SubmissionId
                 , UserId
@@ -74,7 +74,7 @@ getCryptoUUIDDispatchR uuid = dispatchID p uuid >>= maybe notFound (redirectWith
     p = Proxy
 
 getCryptoFileNameDispatchR :: CI FilePath -> Handler ()
-getCryptoFileNameDispatchR path = dispatchID p path >>= maybe notFound (redirectWith found302)
+getCryptoFileNameDispatchR path = dispatchID p path >>= maybe notFound (redirectAccessWith movedPermanently301)
   where
     p :: Proxy '[ SubmissionId ] 
     p = Proxy

src/Utils/Lang.hs

@@ -61,7 +61,7 @@ highPrioRequestedLangs = fmap (concatMap $ fromMaybe []) . mapM runMaybeT $
   , lookupCookies "_LANG"
   , fmap pure . MaybeT $ lookupSession "_LANG"
   ]
-lowPrioRequestedLangs = fromMaybe [] . fmap (mapMaybe (either (const Nothing) Just . Text.decodeUtf8') . NWP.parseHttpAccept) <$> lookupHeader "Accept-Language"
+lowPrioRequestedLangs = maybe [] (mapMaybe (either (const Nothing) Just . Text.decodeUtf8') . NWP.parseHttpAccept) <$> lookupHeader "Accept-Language"
 
 languagesMiddleware :: forall site a. NonEmpty Lang -> HandlerFor site a -> HandlerFor site a
 languagesMiddleware avL act = do

test/MailSpec.hs

@@ -2,6 +2,7 @@ module MailSpec where
 
 import TestImport
 import Utils.DateTimeSpec ()
+import Model.Types.LanguagesSpec ()
 
 import Mail
 
@@ -9,10 +10,6 @@ instance Arbitrary MailSmtpData where
   arbitrary = genericArbitrary
   shrink = genericShrink
 
-instance Arbitrary MailLanguages where
-  arbitrary = fmap MailLanguages $ shuffle =<< sublistOf (toList appLanguages)
-  shrink = genericShrink
-
 instance Arbitrary MailContext where
   arbitrary = genericArbitrary
   shrink = genericShrink
@@ -26,8 +23,6 @@ spec = do
   parallel $ do
     lawsCheckHspec (Proxy @MailSmtpData)
       [ eqLaws, ordLaws, showReadLaws, monoidLaws ]
-    lawsCheckHspec (Proxy @MailLanguages)
-      [ eqLaws, ordLaws, showReadLaws, isListLaws, jsonLaws, hashableLaws, persistFieldLaws ]
     lawsCheckHspec (Proxy @MailContext)
       [ eqLaws, ordLaws, showReadLaws, jsonLaws, hashableLaws ]
     lawsCheckHspec (Proxy @VerpMode)

test/Model/Types/LanguagesSpec.hs

@@ -0,0 +1,14 @@
+module Model.Types.LanguagesSpec where
+
+import TestImport
+
+
+instance Arbitrary Languages where
+  arbitrary = fmap Languages $ shuffle =<< sublistOf (toList appLanguages)
+  shrink = genericShrink
+
+
+spec :: Spec
+spec = do
+  lawsCheckHspec (Proxy @Languages)
+    [ eqLaws, ordLaws, showReadLaws, isListLaws, jsonLaws, hashableLaws, persistFieldLaws ]

test/Model/TypesSpec.hs

@@ -11,6 +11,7 @@ import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
 
 import MailSpec ()
+import Model.Types.LanguagesSpec ()
 
 import System.IO.Unsafe
 import Yesod.Auth.Util.PasswordStore
@@ -279,6 +280,7 @@ instance Arbitrary Sex where
   arbitrary = genericArbitrary
 
 
+
 spec :: Spec
 spec = do
   parallel $ do

test/ModelSpec.hs

@@ -22,8 +22,6 @@ import Utils
 import System.FilePath
 import Data.Time
 
-import Mail (MailLanguages(..))
-
 
 instance Arbitrary EmailAddress where
     arbitrary = do
@@ -106,10 +104,7 @@ instance Arbitrary User where
 
     userDownloadFiles <- arbitrary
     userWarningDays <- arbitrary
-    userLanguages <- choose
-      [ pure Nothing
-      , fmap (Just . Languages) $ sublistOf =<< shuffle (toList appLanguages)
-      ]
+    userLanguages <- arbitrary
     userNotificationSettings <- arbitrary
     userCsvOptions <- arbitrary
     userShowSex <- arbitrary

test/TestImport.hs

@@ -138,7 +138,7 @@ createUser adjUser = do
     userDownloadFiles = userDefaultDownloadFiles
     userWarningDays = userDefaultWarningDays
     userShowSex = userDefaultShowSex
-    userMailLanguages = def
+    userLanguages = Nothing
     userNotificationSettings = def
     userCreated = now
     userLastLdapSynchronisation = Nothing