Cleanup Settings & add option for content-disposition

This commit is contained in:
Gregor Kleen 2018-08-06 11:46:46 +02:00
parent 6f75b90108
commit 747362c261
11 changed files with 73 additions and 59 deletions

View File

@ -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

View File

@ -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

1
models
View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 {..}

View File

@ -45,15 +45,3 @@ $newline never
document.body.classList.remove('no-js');
^{pageBody pc}
$maybe analytics <- appAnalytics $ appSettings master
<script>
if(!window.location.href.match(/localhost/)){
(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
(i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
})(window,document,'script','https://www.google-analytics.com/analytics.js','ga');
ga('create', '#{analytics}', 'auto');
ga('send', 'pageview');
}