From cb62d48f0e203ee90bace55465950c28c386948b Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 3 Aug 2018 16:57:18 +0200 Subject: [PATCH 01/52] Minor renaming --- messages/uniworx/de.msg | 3 ++- src/Handler/Course.hs | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 89626f375..941e705f0 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -59,7 +59,8 @@ CourseHomepage: Homepage CourseShorthand: Kürzel CourseShorthandUnique: Muss innerhalb des Semesters eindeutig sein CourseSemester: Semester -CourseSchool: Fachbereich +CourseSchool: Institut +CourseSchoolShort: Fach CourseSecretTip: Anmeldung zum Kurs erfordert Eingabe des Passworts, sofern gesetzt CourseRegisterFromTip: Ohne Datum ist keine Anmeldung möglich CourseRegisterToTip: Anmeldung darf auch ohne Begrenzung möglich sein diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index f65c92a73..269c07d97 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -84,7 +84,7 @@ colSchool = sortable (Just "school") (i18nCell MsgCourseSchool) cell [whamlet|#{display schoolName}|] colSchoolShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) -colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchool) +colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort) $ \DBRow{ dbrOutput=(_, _, _, Entity _ School{..}) } -> cell [whamlet|#{display schoolShorthand}|] From 747362c2612622e30c807c4a10ef4c54e674c4bb Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 6 Aug 2018 11:46:46 +0200 Subject: [PATCH 02/52] Cleanup Settings & add option for content-disposition --- config/settings.yml | 15 ++++--- messages/uniworx/de.msg | 2 + models | 1 + src/Foundation.hs | 17 ++++---- src/Handler/Profile.hs | 6 +++ src/Handler/Sheet.hs | 3 +- src/Handler/Submission.hs | 3 +- src/Handler/Utils.hs | 13 ++++++- src/Handler/Utils/DateTime.hs | 8 ++-- src/Settings.hs | 52 +++++++++++++------------ templates/default-layout-wrapper.hamlet | 12 ------ 11 files changed, 73 insertions(+), 59 deletions(-) diff --git a/config/settings.yml b/config/settings.yml index 1b0913f6f..eddd1859b 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -44,13 +44,12 @@ ldap: scope: "_env:LDAPSCOPE:WholeSubtree" timeout: "_env:LDAPTIMEOUT:5" -default-favourites: 12 -default-theme: Default -default-date-time-format: "%a %d %b %Y %R" -default-date-format: "%d.%m.%Y" -default-time-format: "%R" +user-defaults: + favourites: 12 + theme: Default + date-time-format: "%a %d %b %Y %R" + date-format: "%d.%m.%Y" + time-format: "%R" + download-files: true cryptoid-keyfile: "_env:CRYPTOID_KEYFILE:cryptoid_key.bf" - -copyright: ©Institute for Informatics, LMU Munich -#analytics: UA-YOURCODE diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 4512f8e17..9e899f3e5 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -247,6 +247,8 @@ UserListTitle: Komprehensive Benutzerliste DateTimeFormat: Datums- und Uhrzeitformat DateFormat: Datumsformat TimeFormat: Uhrzeitformat +DownloadFiles: Dateien automatisch herunterladen +DownloadFilesTip: Wenn gesetzt werden Dateien von Abgaben und Übungsblättern automatisch als Download behandelt, ansonsten ist das Verhalten Browserabhängig (es können z.B. PDFs im Browser geöffnet werden). InvalidDateTimeFormat: Ungültiges Datums- und Zeitformat, JJJJ-MM-TTTHH:MM[:SS] Format erwartet AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC konvertieren diff --git a/models b/models index e68c47c43..bd1c1ef8c 100644 --- a/models +++ b/models @@ -9,6 +9,7 @@ User json dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" dateFormat DateTimeFormat "default='%d.%m.%Y'" timeFormat DateTimeFormat "default='%R'" + downloadFiles Bool default='true' UniqueAuthentication plugin ident UniqueEmail email deriving Show diff --git a/src/Foundation.hs b/src/Foundation.hs index 6931f8eb7..b084badb5 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1112,7 +1112,7 @@ instance YesodAuth UniWorX where acceptExisting = maybe (UserError $ IdentifierNotFound credsIdent) (Authenticated . entityKey) <$> getBy uAuth $logDebugS "auth" $ tshow Creds{..} - AppSettings{..} <- getsYesod appSettings + AppSettings{ appUserDefaults = UserDefaultConf{..}, ..} <- getsYesod appSettings flip catches excHandlers $ case appLdapConf of Just ldapConf -> fmap (either id id) . runExceptT $ do @@ -1146,12 +1146,15 @@ instance YesodAuth UniWorX where -> throwError $ ServerError "Could not decode user matriculation" let - userMaxFavourites = appDefaultMaxFavourites - userTheme = appDefaultTheme - userDateTimeFormat = appDefaultDateTimeFormat - userDateFormat = appDefaultDateFormat - userTimeFormat = appDefaultTimeFormat - newUser = User{..} + newUser = User + { userMaxFavourites = userDefaultMaxFavourites + , userTheme = userDefaultTheme + , userDateTimeFormat = userDefaultDateTimeFormat + , userDateFormat = userDefaultDateFormat + , userTimeFormat = userDefaultTimeFormat + , userDownloadFiles = userDefaultDownloadFiles + , .. + } userUpdate = [ UserMatrikelnummer =. userMatrikelnummer , UserDisplayName =. userDisplayName , UserEmail =. userEmail diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index c5d92dc48..1d340adba 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -25,6 +25,7 @@ data SettingsForm = SettingsForm , stgDateTime :: DateTimeFormat , stgDate :: DateTimeFormat , stgTime :: DateTimeFormat + , stgDownloadFiles :: Bool } makeSettingForm :: Maybe SettingsForm -> Form SettingsForm @@ -38,6 +39,9 @@ makeSettingForm template = identForm FIDsettings $ \html -> do <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template) <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template) <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template) + <*> areq checkBoxField (fslI MsgDownloadFiles + & setTooltip MsgDownloadFilesTip + ) (stgDownloadFiles <$> template) <* submitButton return (result, widget) -- no validation required here @@ -52,6 +56,7 @@ getProfileR = do , stgDateTime = userDateTimeFormat , stgDate = userDateFormat , stgTime = userTimeFormat + , stgDownloadFiles = userDownloadFiles } ((res,formWidget), formEnctype) <- runFormPost $ makeSettingForm settingsTemplate case res of @@ -62,6 +67,7 @@ getProfileR = do , UserDateTimeFormat =. stgDateTime , UserDateFormat =. stgDate , UserTimeFormat =. stgTime + , UserDownloadFiles =. stgDownloadFiles ] when (stgMaxFavourties < userMaxFavourites) $ do -- prune Favourites to user-defined size diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 8284164c1..5e9973f2e 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -357,7 +357,8 @@ getSFileR tid csh shn typ title = do case results of [(E.Value fileTitle, E.Value fileContent)] | Just fileContent' <- fileContent -> do - addHeader "Content-Disposition" [st|attachment; filename="#{takeFileName fileTitle}"|] + whenM downloadFiles $ + addHeader "Content-Disposition" [st|attachment; filename="#{takeFileName fileTitle}"|] return $ TypedContent (defaultMimeLookup (pack fileTitle) <> "; charset=utf-8") (toContent fileContent') | otherwise -> sendResponseStatus noContent204 () [] -> notFound diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 73f68f988..c25381e42 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -335,7 +335,8 @@ getSubDownloadR tid csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = let fileName = Text.pack $ takeFileName path case results of [Entity _ File{ fileContent = Just c, fileTitle }] -> do - addHeader "Content-Disposition" [st|attachment; filename="#{takeFileName fileTitle}"|] + whenM downloadFiles $ + addHeader "Content-Disposition" [st|attachment; filename="#{takeFileName fileTitle}"|] return $ TypedContent (defaultMimeLookup (pack fileTitle) <> "; charset=utf-8") (toContent c) [Entity _ File{ fileContent = Nothing }] -> sendResponseStatus noContent204 () other -> do diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index b173b2219..284e31fcf 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -2,13 +2,14 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} module Handler.Utils ( module Handler.Utils ) where - +import Import import Handler.Utils.DateTime as Handler.Utils import Handler.Utils.Term as Handler.Utils @@ -21,3 +22,13 @@ import Handler.Utils.Rating as Handler.Utils hiding (extractRatings) import Handler.Utils.Submission as Handler.Utils import Handler.Utils.Sheet as Handler.Utils import Handler.Utils.Templates as Handler.Utils + + +downloadFiles :: (MonadHandler m, HandlerSite m ~ UniWorX) => m Bool +downloadFiles = do + mauth <- liftHandlerT maybeAuth + case mauth of + Just (Entity _ User{..}) -> return userDownloadFiles + Nothing -> do + AppSettings{ appUserDefaults = UserDefaultConf{..} } <- getsYesod appSettings + return userDefaultDownloadFiles diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs index ced936b06..c9d465366 100644 --- a/src/Handler/Utils/DateTime.hs +++ b/src/Handler/Utils/DateTime.hs @@ -57,7 +57,7 @@ getTimeLocale = getTimeLocale' <$> languages getDateTimeFormat :: (MonadHandler m, HandlerSite m ~ UniWorX) => SelDateTimeFormat -> m DateTimeFormat getDateTimeFormat sel = do mauth <- liftHandlerT maybeAuth - AppSettings{..} <- getsYesod appSettings + AppSettings{ appUserDefaults = UserDefaultConf{..} } <- getsYesod appSettings let fmt | Just (Entity _ User{..}) <- mauth @@ -67,9 +67,9 @@ getDateTimeFormat sel = do SelFormatTime -> userTimeFormat | otherwise = case sel of - SelFormatDateTime -> appDefaultDateTimeFormat - SelFormatDate -> appDefaultDateFormat - SelFormatTime -> appDefaultTimeFormat + SelFormatDateTime -> userDefaultDateTimeFormat + SelFormatDate -> userDefaultDateFormat + SelFormatTime -> userDefaultTimeFormat return fmt validDateTimeFormats :: TimeLocale -> SelDateTimeFormat -> Set DateTimeFormat diff --git a/src/Settings.hs b/src/Settings.hs index 399e029e7..33e0a8242 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -42,6 +42,7 @@ data AppSettings = AppSettings , appDatabaseConf :: PostgresConf -- ^ Configuration settings for accessing the database. , appLdapConf :: Maybe LdapConf + -- ^ Configuration settings for accessing the LDAP-directory , appRoot :: Maybe Text -- ^ Base for all generated URLs. If @Nothing@, determined -- from the request headers. @@ -63,29 +64,36 @@ data AppSettings = AppSettings -- ^ Assume that files in the static dir may change after compilation , appSkipCombining :: Bool -- ^ Perform no stylesheet/script combining - - , appDefaultTheme :: Theme - , appDefaultMaxFavourites :: Int - , appDefaultDateTimeFormat :: DateTimeFormat - , appDefaultDateFormat :: DateTimeFormat - , appDefaultTimeFormat :: DateTimeFormat - - -- Example app-specific configuration values. - , appCopyright :: Text - -- ^ Copyright text to appear in the footer of the page - , appAnalytics :: Maybe Text - -- ^ Google Analytics code - , appCryptoIDKeyFile :: FilePath - , appAuthDummyLogin :: Bool -- ^ Indicate if auth dummy login should be enabled. - , appAuthPWFile :: Maybe FilePath - -- ^ If set authenticate against a local password file , appAllowDeprecated :: Bool -- ^ Indicate if deprecated routes are accessible for everyone + , appUserDefaults :: UserDefaultConf + + , appCryptoIDKeyFile :: FilePath + , appAuthPWFile :: Maybe FilePath + -- ^ If set authenticate against a local password file } +data UserDefaultConf = UserDefaultConf + { userDefaultTheme :: Theme + , userDefaultMaxFavourites :: Int + , userDefaultDateTimeFormat, userDefaultDateFormat, userDefaultTimeFormat :: DateTimeFormat + , userDefaultDownloadFiles :: Bool + } + +instance FromJSON UserDefaultConf where + parseJSON = withObject "UserDefaultConf" $ \o -> do + userDefaultTheme <- o .: "theme" + userDefaultMaxFavourites <- o .: "favourites" + userDefaultDateTimeFormat <- o .: "date-time-format" + userDefaultDateFormat <- o .: "date-format" + userDefaultTimeFormat <- o .: "time-format" + userDefaultDownloadFiles <- o .: "download-files" + + return UserDefaultConf{..} + data LdapConf = LdapConf { ldapHost :: Ldap.Host, ldapPort :: Ldap.PortNumber , ldapDn :: Ldap.Dn, ldapPassword :: Ldap.Password @@ -139,20 +147,14 @@ instance FromJSON AppSettings where appReloadTemplates <- o .:? "reload-templates" .!= defaultDev appMutableStatic <- o .:? "mutable-static" .!= defaultDev appSkipCombining <- o .:? "skip-combining" .!= defaultDev + appAuthDummyLogin <- o .:? "auth-dummy-login" .!= defaultDev + appAllowDeprecated <- o .:? "allow-deprecated" .!= defaultDev - appDefaultMaxFavourites <- o .: "default-favourites" - appDefaultTheme <- o .: "default-theme" - appDefaultDateTimeFormat <- o .: "default-date-time-format" - appDefaultDateFormat <- o .: "default-date-format" - appDefaultTimeFormat <- o .: "default-time-format" + appUserDefaults <- o .: "user-defaults" - appCopyright <- o .: "copyright" - appAnalytics <- o .:? "analytics" appCryptoIDKeyFile <- o .: "cryptoid-keyfile" - appAuthDummyLogin <- o .:? "auth-dummy-login" .!= defaultDev appAuthPWFile <- ((\f -> f <$ guard (not $ null f)) =<<) <$> o .:? "auth-pwfile" - appAllowDeprecated <- o .:? "allow-deprecated" .!= defaultDev return AppSettings {..} diff --git a/templates/default-layout-wrapper.hamlet b/templates/default-layout-wrapper.hamlet index d963d1431..ceb3c44b4 100644 --- a/templates/default-layout-wrapper.hamlet +++ b/templates/default-layout-wrapper.hamlet @@ -45,15 +45,3 @@ $newline never document.body.classList.remove('no-js'); ^{pageBody pc} - - $maybe analytics <- appAnalytics $ appSettings master -