Cleanup Settings & add option for content-disposition

config/settings.yml

@@ -44,13 +44,12 @@ ldap:
   scope:    "_env:LDAPSCOPE:WholeSubtree"
   timeout:  "_env:LDAPTIMEOUT:5"
 
-default-favourites: 12
+user-defaults:
-default-theme: Default
+  favourites: 12
-default-date-time-format: "%a %d %b %Y %R"
+  theme: Default
-default-date-format: "%d.%m.%Y"
+  date-time-format: "%a %d %b %Y %R"
-default-time-format: "%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

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

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

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
+            newUser = User
-            userTheme = appDefaultTheme
+              { userMaxFavourites  = userDefaultMaxFavourites
-            userDateTimeFormat = appDefaultDateTimeFormat
+              , userTheme          = userDefaultTheme
-            userDateFormat = appDefaultDateFormat
+              , userDateTimeFormat = userDefaultDateTimeFormat
-            userTimeFormat = appDefaultTimeFormat
+              , userDateFormat     = userDefaultDateFormat
-            newUser = User{..}
+              , userTimeFormat     = userDefaultTimeFormat
+              , userDownloadFiles  = userDefaultDownloadFiles
+              , ..
+              }
             userUpdate = [ UserMatrikelnummer =. userMatrikelnummer
                          , UserDisplayName =. userDisplayName
                          , UserEmail =. userEmail

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

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

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

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

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
+          SelFormatDateTime -> userDefaultDateTimeFormat
-          SelFormatDate     -> appDefaultDateFormat
+          SelFormatDate     -> userDefaultDateFormat
-          SelFormatTime     -> appDefaultTimeFormat
+          SelFormatTime     -> userDefaultTimeFormat
   return fmt
 
 validDateTimeFormats :: TimeLocale -> SelDateTimeFormat -> Set DateTimeFormat

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"
+        appUserDefaults           <- o .:  "user-defaults"
-        appDefaultTheme           <- o .:  "default-theme"
-        appDefaultDateTimeFormat  <- o .:  "default-date-time-format"
-        appDefaultDateFormat      <- o .:  "default-date-format"
-        appDefaultTimeFormat      <- o .:  "default-time-format"
 
-        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 {..}
 

templates/default-layout-wrapper.hamlet

@@ -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');
-        }