chore(legal): redirect legal to external fraport urls

config/settings.yml

@@ -32,6 +32,18 @@ mail-support:
   email:        "_env:MAILSUPPORT:uni2work@ifi.lmu.de"
 mail-retain-sent: 31470547
 
+legal-external:
+  - language:         "en"
+    imprint:          "https://www.fraport.com/en/tools/imprint.html"
+    data-protection:  "https://www.fraport.com/en/our-group/data-protection-statement.html"
+    terms-of-use:     "https://www.fraport.com/en/tools/legal-information.html"
+    payments:         "https://www.fraport.com/de/geschaeftsfelder/service/geschaeftspartner/richtlinien-und-zahlungsbedingungen.html"
+  - language:         "de"
+    imprint:          "https://www.fraport.com/de/tools/impressum.html"
+    data-protection:  "https://www.fraport.com/de/konzern/datenschutz.html"
+    terms-of-use:     "https://www.fraport.com/de/tools/disclaimer.html"
+    payments:         "https://www.fraport.com/de/geschaeftsfelder/service/geschaeftspartner/richtlinien-und-zahlungsbedingungen.html"  
+
 job-workers:        "_env:JOB_WORKERS:10"
 job-flush-interval: "_env:JOB_FLUSH:30"
 job-cron-interval:  "_env:CRON_INTERVAL:60"

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

@@ -3,6 +3,7 @@
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
 HeadingLegal: Rechtliche Informationen
+InfoSupervisorTitle: Hinweise für Ansprechpartner
 InfoLecturerTitle: Hinweise für Veranstalter:innen
 InfoLecturerCourses: Veranstaltungen
 InfoLecturerExercises: Übungsbetrieb

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

@@ -3,6 +3,7 @@
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
 HeadingLegal: Legal
+InfoSupervisorTitle: Information for Supervisors
 InfoLecturerTitle: Information for lecturers
 InfoLecturerCourses: Courses
 InfoLecturerExercises: Course Exercises

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

@@ -21,6 +21,7 @@ MenuDataProt: Datenschutzerklärung
 MenuTermsUse: Nutzungsbedingungen
 MenuCopyright: Urheberrecht
 MenuImprint: Impressum
+MenuPayments: Zahlungsbedingungen
 
 MenuInstance: Instanz-Identifikation
 MenuHealth: Instanz-Zustand

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

@@ -21,6 +21,7 @@ MenuDataProt: Data protection
 MenuTermsUse: Terms of use
 MenuCopyright: Copyright
 MenuImprint: Imprint
+MenuPayments: Payment Terms
 
 MenuInstance: Instance identification
 MenuHealth: Instance health

routes

@@ -78,10 +78,15 @@
 /instance                     InstanceR        GET              !free
 /info                         InfoR            GET              !free
 /info/lecturer                InfoLecturerR    GET              !free
+/info/supervisor              InfoSupervisorR  GET              !free
 /info/legal                   LegalR           GET              !free
 /info/allocation              InfoAllocationR  GET              !free
 /info/glossary                GlossaryR        GET              !free
 /info/faq                     FaqR             GET              !free
+/info/terms-of-use            TermsOfUseR      GET              !free
+/info/payments                PaymentsR        GET              !free
+/imprint                      ImprintR         GET              !free
+/data-protection              DataProtectionR  GET              !free
 /version                      VersionR         GET              !free
 /status                       StatusR          GET              !free
 

src/Application.hs

@@ -370,6 +370,8 @@ makeFoundation appSettings''@AppSettings{..} = do
                           }
           return . Just $ mkAvsQuery avsServer avsAuth avsEnv
 
+      when (null appLegalExternal) $ $logErrorS "Legal" "Configuration of external legal links is missing."
+
       $logDebugS "Runtime configuration" $ tshowCrop appSettings'
 
       let foundation = mkFoundation appSettings' sqlPool smtpPool ldapPool appCryptoIDKey appSessionStore appSecretBoxKey appWidgetMemcached appJSONWebKeySet appClusterID appMemcached appMemcachedLocal appUploadCache appVerpSecret appAuthKey appPersonalisedSheetFilesSeedKey appVolatileClusterSettingsCache appAvsQuery

src/Foundation/Navigation.hs

@@ -134,12 +134,18 @@ breadcrumb (ExamOfficeR EOFieldsR) = i18nCrumb MsgMenuExamOfficeFields . Just $
 breadcrumb (ExamOfficeR EOUsersR)  = i18nCrumb MsgMenuExamOfficeUsers . Just $ ExamOfficeR EOExamsR
 breadcrumb (ExamOfficeR EOUsersInviteR) = i18nCrumb MsgBreadcrumbExamOfficeUserInvite Nothing
 
-breadcrumb InfoR            = i18nCrumb MsgMenuInformation     Nothing
+breadcrumb InfoR            = i18nCrumb MsgMenuInformation            Nothing
-breadcrumb InfoLecturerR    = i18nCrumb MsgInfoLecturerTitle $ Just InfoR
+breadcrumb InfoLecturerR    = i18nCrumb MsgInfoLecturerTitle        $ Just InfoR
-breadcrumb LegalR           = i18nCrumb MsgMenuLegal         $ Just InfoR
+breadcrumb InfoSupervisorR  = i18nCrumb MsgInfoSupervisorTitle      $ Just InfoR
+breadcrumb LegalR           = i18nCrumb MsgMenuLegal                $ Just InfoR
+breadcrumb ImprintR         = i18nCrumb MsgMenuImprint              $ Just LegalR
+breadcrumb DataProtectionR  = i18nCrumb MsgMenuDataProt             $ Just LegalR
+breadcrumb TermsOfUseR      = i18nCrumb MsgMenuTermsUse             $ Just LegalR
+breadcrumb PaymentsR        = i18nCrumb MsgMenuPayments             $ Just LegalR
+
 breadcrumb InfoAllocationR  = i18nCrumb MsgBreadcrumbAllocationInfo $ Just InfoR
-breadcrumb VersionR         = i18nCrumb MsgMenuVersion       $ Just InfoR
+breadcrumb VersionR         = i18nCrumb MsgMenuVersion              $ Just InfoR
-breadcrumb FaqR             = i18nCrumb MsgBreadcrumbFaq     $ Just InfoR
+breadcrumb FaqR             = i18nCrumb MsgBreadcrumbFaq            $ Just InfoR
 
 
 breadcrumb HelpR            = i18nCrumb MsgMenuHelp            Nothing
@@ -627,17 +633,17 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
         }
   , return $ NavFooter NavLink
       { navLabel       = MsgMenuDataProt
-      , navRoute       = LegalR :#: ("data-protection" :: Text)
+      , navRoute       = DataProtectionR
       , navAccess'     = NavAccessTrue
-      , navType        = NavTypeLink { navModal = False }
+      , navType        = NavTypeLink { navModal = True }
       , navQuick'      = mempty
       , navForceActive = False
       }
   , return $ NavFooter NavLink
       { navLabel       = MsgMenuTermsUse
-      , navRoute       = LegalR :#: ("terms-of-use" :: Text)
+      , navRoute       = TermsOfUseR
       , navAccess'     = NavAccessTrue
-      , navType        = NavTypeLink { navModal = False }
+      , navType        = NavTypeLink { navModal = True }
       , navQuick'      = mempty
       , navForceActive = False
       }
@@ -651,9 +657,9 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
       }
   , return $ NavFooter NavLink
       { navLabel       = MsgMenuImprint
-      , navRoute       = LegalR :#: ("imprint" :: Text)
+      , navRoute       = ImprintR
       , navAccess'     = NavAccessTrue
-      , navType        = NavTypeLink { navModal = False }
+      , navType        = NavTypeLink { navModal = True }
       , navQuick'      = mempty
       , navForceActive = False
       }

src/Handler/Info.hs

@@ -23,6 +23,22 @@ import Auth.LDAP (ADError(..), ADInvalidCredentials(..), CampusMessage(..))
 import Yesod.Auth.Message(AuthMessage(..)) 
 
 
+pickLegalExternalLang :: Handler LegalExternal
+pickLegalExternalLang = do 
+    langMap <- $cachedHereBinary ("legal_external"::Text) makeMapLegalExternal
+    availLangs <- case nonEmpty' (Map.keys langMap) of 
+      Just ls -> pure ls
+      Nothing -> $logErrorS "Legal" "Configuration of external legal links is missing." >> notFound
+    lang <- selectLanguage availLangs
+    return $ langMap ! lang   
+  where 
+    makeMapLegalExternal :: Handler (Map Lang LegalExternal)
+    makeMapLegalExternal = do 
+      legExs <- getsYesod $ view _appLegalExternal
+      return $ Set.foldl' (\acc le -> Map.singleton (externalLanguage le) le <> acc) mempty legExs
+      -- return $ Map.fromAscList [(externalLanguage le,le) | le <- Set.toAscList legExs]
+
+ 
 -- | Versionsgeschichte
 getVersionR :: Handler TypedContent
 getVersionR = selectRep $ do
@@ -31,6 +47,29 @@ getVersionR = selectRep $ do
   provideRep getInfoR
 
 
+getImprintR :: Handler Html 
+getImprintR = do
+  le <- pickLegalExternalLang
+  redirect $ externalImprint le
+
+getDataProtectionR :: Handler Html
+getDataProtectionR = do
+  le <- pickLegalExternalLang
+  redirect $ externalDataProtection le
+
+getPaymentsR :: Handler Html
+getPaymentsR = do
+  le <- pickLegalExternalLang
+  redirect $ externalPayments le
+  
+getTermsOfUseR :: Handler Html
+getTermsOfUseR = do 
+  le <- pickLegalExternalLang
+  redirect $ externalTermsOfUse le
+
+getInfoSupervisorR :: Handler Html
+getInfoSupervisorR = error "TODO"
+
 -- | Datenschutzerklaerung und Aufbewahrungspflichten, Nutzungsbedingungen, Urheberrecht, Impressum
 getLegalR :: Handler Html
 getLegalR =

src/Settings.hs

@@ -247,6 +247,8 @@ data AppSettings = AppSettings
     
     , appFileChunkingParams     :: FastCDCParameters
 
+    , appLegalExternal          :: Set LegalExternal
+    
     } deriving Show
 
 
@@ -412,6 +414,17 @@ data SettingBotMitigation
   deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
   deriving anyclass (Universe, Finite)
 
+data LegalExternal = LegalExternal
+  { externalLanguage :: Lang 
+  , externalImprint :: Text
+  , externalDataProtection :: Text
+  , externalTermsOfUse :: Text
+  , externalPayments :: Text    
+  }
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+makeLenses_ ''LegalExternal
+
+
 nullaryPathPiece ''ApprootScope $ camelToPathPiece' 1
 pathPieceJSON ''ApprootScope
 pathPieceJSONKey ''ApprootScope
@@ -585,6 +598,14 @@ instance FromJSON ServerSessionSettings where
       , ServerSession.setPersistentCookies <$> persistentCookies
       ])
 
+instance FromJSON LegalExternal where 
+  parseJSON = withObject "LegalExternal" $ \o -> do
+    externalLanguage <- o .: "language"
+    externalImprint <- o .: "imprint"
+    externalDataProtection <- o .: "data-protection"
+    externalTermsOfUse<- o .: "terms-of-use"
+    externalPayments <- o .: "payments"
+    return LegalExternal{..}
 
 instance FromJSON AppSettings where
     parseJSON = withObject "AppSettings" $ \o -> do
@@ -779,6 +800,8 @@ instance FromJSON AppSettings where
 
         appCommunicationAttachmentsMaxSize <- o .:? "communication-attachments-max-size"
 
+        appLegalExternal <- o .: "legal-external"
+
         return AppSettings{..}
       where isValidARCConf ARCConf{..} = arccMaximumWeight > 0