From 0575ba5ccfa6a3d581bf6aa093326cccb08f03ee Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sat, 27 Oct 2018 10:53:36 +0200
Subject: [PATCH 1/6] Include referer in support messages

---
 templates/mail/support.hamlet | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/templates/mail/support.hamlet b/templates/mail/support.hamlet
index e239edf53..51f7f8502 100644
--- a/templates/mail/support.hamlet
+++ b/templates/mail/support.hamlet
@@ -28,5 +28,9 @@ $newline never
               <dd>#{lang}
       <dt>Zeit
       <dd>#{rtime}
+      <dt>Referer
+      <dd>
+        <a href=#{jReferer} style="font-family: monospace">
+          #{jReferer}
     <p style="white-space: pre-wrap; font-family: monospace">
       #{jHelpRequest}

From b214c80f2cd48ff5bcb693ed07915461bc0e3554 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sat, 27 Oct 2018 11:09:28 +0200
Subject: [PATCH 2/6] Fix build

---
 templates/mail/support.hamlet | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/templates/mail/support.hamlet b/templates/mail/support.hamlet
index 51f7f8502..43555df6f 100644
--- a/templates/mail/support.hamlet
+++ b/templates/mail/support.hamlet
@@ -28,9 +28,10 @@ $newline never
               <dd>#{lang}
       <dt>Zeit
       <dd>#{rtime}
-      <dt>Referer
-      <dd>
-        <a href=#{jReferer} style="font-family: monospace">
-          #{jReferer}
+      $maybe referer <- jReferer
+        <dt>Referer
+        <dd>
+          <a href=#{referer} style="font-family: monospace">
+            #{referer}
     <p style="white-space: pre-wrap; font-family: monospace">
       #{jHelpRequest}

From 90e942f5b47075f4db0ca92980d0afe9dd3ba597 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sat, 27 Oct 2018 22:24:43 +0200
Subject: [PATCH 3/6] Better error messages, Store config in db

Fixes #197
Fixes #93
---
 .gitignore                      |   2 -
 config/settings.yml             |   8 +-
 messages/uniworx/de.msg         |  18 +-
 models                          |   6 +-
 package.yaml                    |   3 +
 src/Application.hs              |  53 +++++-
 src/Foundation.hs               | 298 +++++++++++++++++---------------
 src/Handler/Home.hs             |   4 +-
 src/Model.hs                    |   1 +
 src/Settings.hs                 |  29 +++-
 src/Settings/Cluster.hs         | 134 ++++++++++++++
 src/Utils/TH.hs                 |  68 +++++++-
 stack.nix                       |   2 +-
 stack.yaml                      |   2 +
 templates/default-layout.hamlet |   8 +-
 15 files changed, 463 insertions(+), 173 deletions(-)
 create mode 100644 src/Settings/Cluster.hs

diff --git a/.gitignore b/.gitignore
index f744360b3..84a8fe8a9 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,8 +1,6 @@
 dist*
 static/tmp/
 static/combined/
-client_session_key.aes
-cryptoid_key.bf
 *.hi
 *.o
 *.sqlite3
diff --git a/config/settings.yml b/config/settings.yml
index f4602cd0e..373385dee 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -26,6 +26,7 @@ job-stale-threshold: 300
 notification-rate-limit: 3600
 notification-collate-delay: 300
 notification-expiration: 259201
+session-timeout: 7200
 
 log-settings:
   log-detailed:      "_env:DETAILED_LOGGING:false"
@@ -41,10 +42,12 @@ auth-pw-hash:
   strength: 14
 
 # Optional values with the following production defaults.
-# In development, they default to true.
+# In development, they default to the opposite.
 # reload-templates: false
 # mutable-static: false
 # skip-combining: false
+# encrypt-errors: true
+encrypt-errors: true
 
 database:
   user:     "_env:PGUSER:uniworx"
@@ -86,5 +89,4 @@ user-defaults:
   time-format:      "%R"
   download-files:   false
 
-cryptoid-keyfile: "_env:CRYPTOID_KEYFILE:cryptoid_key.bf"
-instance-idfile: "_env:INSTANCEID_FILE:instance"
+instance-idfile: "_env:INSTANCE_ID:instance"
diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 898b4385a..da3c0a31e 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -376,7 +376,7 @@ NotificationTriggerSubmissionRated: Meine Abgabe wurde korrigiert
 NotificationTriggerSheetActive: Ich kann ein neues Übungsblatt herunterladen
 NotificationTriggerSheetSoonInactive: Ich kann ein Übungsblatt bald nicht mehr abgeben
 NotificationTriggerSheetInactive: Abgabefrist eines meiner Übungsblätter ist abgelaufen
-NotificationCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugeteilt
+NotificationTriggerCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugeteilt
 
 CorrCreate: Abgaben erstellen
 UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}"
@@ -440,4 +440,18 @@ MessageWarning: Warnung
 MessageInfo: Information
 MessageSuccess: Erfolg
 
-InvalidLangFormat: Ungültiger Sprach-Code (RFC1766)
\ No newline at end of file
+InvalidLangFormat: Ungültiger Sprach-Code (RFC1766)
+
+ErrorResponseTitleNotFound: Ressource nicht gefunden
+ErrorResponseTitleInternalError internalError@Text: Ein interner Fehler ist aufgetreten
+ErrorResponseTitleInvalidArgs invalidArgs@Texts: Anfrage-Nachricht enthielt ungültige Argumente
+ErrorResponseTitleNotAuthenticated: Anfrage benötigt Authentifizierung
+ErrorResponseTitlePermissionDenied permissionDenied@Text: Mangelnde Authorisierung
+ErrorResponseTitleBadMethod requestMethod@Method: HTTP-Methode nicht unterstützt
+
+UnknownErrorResponse: Ein nicht weiter klassifizierter Fehler ist aufgetreten:
+ErrorResponseNotFound: Unter der von Ihrem Browser angefragten URL wurde keine Seite gefunden.
+ErrorResponseNotAuthenticated: Um Zugriff auf einige Teile des Systems zu erhalten müssen Sie sich zunächst anmelden.
+ErrorResponseBadMethod requestMethodText@Text: Ihr Browser kann auf mehrere verschiedene Arten versuchen mit den vom System angebotenen Ressourcen zu interagieren. Die aktuell versuchte Methode (#{requestMethodText}) wird nicht unterstützt.
+
+ErrorResponseEncrypted: Um keine sensiblen Daten preiszugeben wurden nähere Details verschlüsselt. Wenn Sie eine Anfrage an den Support schicken fügen Sie bitte die unten aufgeführten verschlüsselten Daten mit an.
\ No newline at end of file
diff --git a/models b/models
index 1398a65a5..88e88243f 100644
--- a/models
+++ b/models
@@ -255,4 +255,8 @@ SystemMessageTranslation
     language            Lang
     content             Html
     summary             Html Maybe
-    UniqueSystemMessageTranslation message language
\ No newline at end of file
+    UniqueSystemMessageTranslation message language
+ClusterConfig
+    setting             ClusterSettingsKey
+    value               Value
+    Primary setting
\ No newline at end of file
diff --git a/package.yaml b/package.yaml
index 4a48ee43d..44695edb0 100644
--- a/package.yaml
+++ b/package.yaml
@@ -48,6 +48,7 @@ dependencies:
 - wai
 - cryptonite
 - cryptonite-conduit
+- saltine
 - base64-bytestring
 - memory
 - http-api-data
@@ -67,6 +68,7 @@ dependencies:
 - cryptoids
 - cryptoids-class
 - binary
+- cereal
 - mtl
 - sandi
 - esqueleto
@@ -107,6 +109,7 @@ dependencies:
 - postgresql-simple
 - word24
 - mmorph
+- clientsession
 
 # The library contains all of our application code. The executable
 # defined below is just a thin wrapper.
diff --git a/src/Application.hs b/src/Application.hs
index 9ffcf2106..f52c180e9 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -6,6 +6,9 @@
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Application
     ( getApplicationDev, getAppDevSettings
@@ -26,7 +29,7 @@ module Application
 import Control.Monad.Logger                 (liftLoc, LoggingT(..), MonadLoggerIO(..))
 import Database.Persist.Postgresql          (createPostgresqlPool, pgConnStr,
                                              pgPoolSize, runSqlPool)
-import Import
+import Import hiding (Proxy)
 import Language.Haskell.TH.Syntax           (qLocation)
 import Network.Wai (Middleware)
 import Network.Wai.Handler.Warp             (Settings, defaultSettings,
@@ -67,6 +70,12 @@ import qualified Yesod.Core.Types as Yesod (Logger(..))
 import qualified Data.HashMap.Strict as HashMap
 
 import Control.Lens ((&))
+
+import Data.Proxy
+
+import qualified Data.Aeson as Aeson
+
+import System.Exit (exitFailure)
   
 -- Import all relevant handler modules here.
 -- (HPack takes care to add new modules to our cabal file nowadays.)
@@ -105,8 +114,7 @@ makeFoundation appSettings@(AppSettings{..}) = do
       return $ Yesod.Logger loggerSet tgetter
     appStatic <- liftIO $ bool static staticDevel appMutableStatic appStaticDir
 
-    appCryptoIDKey <- readKeyFile appCryptoIDKeyFile
-    appInstanceID <- liftIO $ maybe UUID.nextRandom readInstanceIDFile appInstanceIDFile
+    appInstanceID <- liftIO $ maybe UUID.nextRandom (either readInstanceIDFile return) appInitialInstanceID
 
     (appJobCtl, recvChans) <- fmap unzip . atomically . replicateM appJobWorkers $ do
         chan <- newBroadcastTMChan
@@ -120,11 +128,16 @@ makeFoundation appSettings@(AppSettings{..}) = do
     -- logging function. To get out of this loop, we initially create a
     -- temporary foundation without a real connection pool, get a log function
     -- from there, and then create the real foundation.
-    let mkFoundation appConnPool appSmtpPool = UniWorX {..}
+    let mkFoundation appConnPool appSmtpPool appCryptoIDKey appSessionKey appErrorMsgKey = UniWorX {..}
         -- The UniWorX {..} syntax is an example of record wild cards. For more
         -- information, see:
         -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
-        tempFoundation = mkFoundation (error "connPool forced in tempFoundation") (error "smtpPool forced in tempFoundation")
+        tempFoundation = mkFoundation
+          (error "connPool forced in tempFoundation")
+          (error "smtpPool forced in tempFoundation")
+          (error "cryptoIDKey forced in tempFoundation")
+          (error "sessionKey forced in tempFoundation")
+          (error "errorMsgKey forced in tempFoundation")
         logFunc = messageLoggerSource tempFoundation appLogger
 
     flip runLoggingT logFunc $ do
@@ -140,12 +153,38 @@ makeFoundation appSettings@(AppSettings{..}) = do
     
       -- Perform database migration using our application's logging settings.
       migrateAll `runSqlPool` sqlPool
+      appCryptoIDKey <- clusterSetting (Proxy :: Proxy 'ClusterCryptoIDKey) `runSqlPool` sqlPool
+      appSessionKey <- clusterSetting (Proxy :: Proxy 'ClusterClientSessionKey) `runSqlPool` sqlPool
+      appErrorMsgKey <- if
+        | appEncryptErrors -> Just <$> clusterSetting (Proxy :: Proxy 'ClusterErrorMessageKey) `runSqlPool` sqlPool
+        | otherwise -> return Nothing
 
-      handleJobs recvChans $ mkFoundation sqlPool smtpPool
+      let foundation = mkFoundation sqlPool smtpPool appCryptoIDKey appSessionKey appErrorMsgKey
+
+      handleJobs recvChans foundation
 
       -- Return the foundation
-      return $ mkFoundation sqlPool smtpPool
+      return foundation
 
+clusterSetting :: forall key m p.
+                  ( MonadIO m
+                  , ClusterSetting key
+                  , MonadLogger m
+                  )
+               => p (key :: ClusterSettingsKey)
+               -> ReaderT SqlBackend m (ClusterSettingValue key)
+clusterSetting proxy@(knownClusterSetting -> key) = do
+  current' <- get (ClusterConfigKey key)
+  case Aeson.fromJSON . clusterConfigValue <$> current' of
+    Just (Aeson.Success c) -> return c
+    Just (Aeson.Error str) -> do
+      $logErrorS "clusterSetting" $ "Could not parse JSON-Value for " <> toPathPiece key
+      liftIO exitFailure
+    Nothing -> do
+      new <- initClusterSetting proxy
+      void . insert $ ClusterConfig key (Aeson.toJSON new)
+      return new
+  
 readInstanceIDFile :: MonadIO m => FilePath -> m UUID
 readInstanceIDFile idFile = liftIO . handle generateInstead $ LBS.readFile idFile >>= parseBS
   where
diff --git a/src/Foundation.hs b/src/Foundation.hs
index fe478f1ca..2634974fb 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -20,6 +20,8 @@ import Database.Persist.Sql (ConnectionPool, runSqlPool)
 import Text.Hamlet          (hamletFile)
 import Text.Jasmine         (minifym)
 
+import qualified Web.ClientSession as ClientSession
+
 import Yesod.Auth.Message
 import Yesod.Auth.Dummy
 import Auth.LDAP
@@ -96,6 +98,10 @@ import qualified Yesod.Auth.Message as Auth
 
 import qualified Data.Conduit.List as C
 
+import qualified Crypto.Saltine.Core.SecretBox as SecretBox
+import qualified Crypto.Saltine.Class as Saltine
+import qualified Data.Binary as Binary
+
 
 instance DisplayAble b => DisplayAble (E.CryptoID a b) where
   display = display . ciphertext
@@ -127,6 +133,8 @@ data UniWorX = UniWorX
     , appCryptoIDKey :: CryptoIDKey
     , appInstanceID  :: InstanceId
     , appJobCtl      :: [TMChan JobCtl]
+    , appErrorMsgKey :: Maybe SecretBox.Key
+    , appSessionKey  :: ClientSession.Key
     }
 
 type SMTPPool = Pool SMTPConnection
@@ -197,14 +205,8 @@ instance RenderMessage UniWorX TermIdentifier where
     Winter -> renderMessage' $ MsgWinterTerm year
     where renderMessage' = renderMessage foundation ls
 
-instance RenderMessage UniWorX StudyFieldType where
-  renderMessage foundation ls = renderMessage foundation ls . \case
-    FieldPrimary -> MsgFieldPrimary
-    FieldSecondary -> MsgFieldSecondary
-
 newtype ShortTermIdentifier = ShortTermIdentifier TermIdentifier
   deriving (Eq, Ord, Read, Show)
-
 instance RenderMessage UniWorX ShortTermIdentifier where
   renderMessage foundation ls (ShortTermIdentifier TermIdentifier{..}) = case season of
     Summer -> renderMessage' $ MsgSummerTermShort year
@@ -214,33 +216,12 @@ instance RenderMessage UniWorX ShortTermIdentifier where
 instance RenderMessage UniWorX String where
   renderMessage f ls str = renderMessage f ls $ Text.pack str
 
-instance RenderMessage UniWorX SheetFileType where
-  renderMessage foundation ls = renderMessage foundation ls . \case
-      SheetExercise -> MsgSheetExercise
-      SheetHint     -> MsgSheetHint
-      SheetSolution -> MsgSheetSolution
-      SheetMarking  -> MsgSheetMarking
-
-instance RenderMessage UniWorX CorrectorState where
-  renderMessage foundation ls = renderMessage foundation ls . \case
-      CorrectorNormal  -> MsgCorrectorNormal
-      CorrectorMissing -> MsgCorrectorMissing
-      CorrectorExcused -> MsgCorrectorExcused
-
-
 instance RenderMessage UniWorX Load where
   renderMessage foundation ls = renderMessage foundation ls . \case
       (Load {byTutorial=Nothing   , byProportion=p}) -> MsgCorByProportionOnly p
       (Load {byTutorial=Just True , byProportion=p}) -> MsgCorByProportionIncludingTutorial p
       (Load {byTutorial=Just False, byProportion=p}) -> MsgCorByProportionExcludingTutorial p
 
-instance RenderMessage UniWorX SheetType where
-  renderMessage foundation ls = renderMessage foundation ls . \case
-      Bonus{..} -> MsgSheetTypeBonus' maxPoints
-      Normal{..} -> MsgSheetTypeNormal' maxPoints
-      Pass{..} -> MsgSheetTypePass' maxPoints passingPoints
-      NotGraded{} -> MsgSheetTypeNotGraded'
-
 newtype MsgLanguage = MsgLanguage Lang
   deriving (Eq, Ord, Show, Read)
 instance RenderMessage UniWorX MsgLanguage where
@@ -250,24 +231,18 @@ instance RenderMessage UniWorX MsgLanguage where
     where
       mr = renderMessage foundation ls
 
-instance RenderMessage UniWorX NotificationTrigger where
-  renderMessage foundation ls = renderMessage foundation ls . \case
-    NTSubmissionRatedGraded -> MsgNotificationTriggerSubmissionRatedGraded
-    NTSubmissionRated -> MsgNotificationTriggerSubmissionRated
-    NTSheetActive -> MsgNotificationTriggerSheetActive
-    NTSheetSoonInactive -> MsgNotificationTriggerSheetSoonInactive
-    NTSheetInactive -> MsgNotificationTriggerSheetInactive 
-    NTCorrectionsAssigned -> MsgNotificationCorrectionsAssigned
-
 instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where
   renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route)
 
-instance RenderMessage UniWorX MessageClass where
-  renderMessage f ls = renderMessage f ls . \case
-    Error -> MsgMessageError
-    Warning -> MsgMessageWarning
-    Info -> MsgMessageInfo
-    Success -> MsgMessageSuccess
+embedRenderMessage ''UniWorX ''MessageClass ("Message" <>)
+embedRenderMessage ''UniWorX ''NotificationTrigger $ ("NotificationTrigger" <>) . concat . drop 1 . splitCamel
+embedRenderMessage ''UniWorX ''SheetType $ \st -> "SheetType" <> st <> "'"
+embedRenderMessage ''UniWorX ''StudyFieldType id
+embedRenderMessage ''UniWorX ''SheetFileType id
+embedRenderMessage ''UniWorX ''CorrectorState id
+
+newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
+embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)
 
 
 data instance ButtonCssClass UniWorX = BCDefault | BCPrimary | BCSuccess | BCInfo | BCWarning | BCDanger | BCLink
@@ -573,9 +548,9 @@ instance Yesod UniWorX where
 
     -- Store session data on the client in encrypted cookies,
     -- default session idle timeout is 120 minutes
-    makeSessionBackend _ = Just <$> defaultClientSessionBackend
-        120    -- timeout in minutes
-        "client_session_key.aes"
+    makeSessionBackend UniWorX{appSessionKey,appSettings=AppSettings{appSessionTimeout}} = do
+      (getCachedDate, _) <- clientSessionDateCacher appSessionTimeout
+      return . Just $ clientSessionBackend appSessionKey getCachedDate
 
     maximumContentLength _ _ = Just $ 50 * 2^20
 
@@ -627,101 +602,49 @@ instance Yesod UniWorX where
             $logDebugS "normalizeRouteMiddleware" [st|Redirecting to #{tshow route'}|]
             redirectWith movedPermanently301 route'
 
-    defaultLayout widget = do
-        master <- getYesod
-        let AppSettings { appUserDefaults = UserDefaultConf{..}, .. } = appSettings master
+    -- Since we implement `errorHandler` ourselves we don't need `defaultMessageWidget`
+    defaultMessageWidget _title _body = error "defaultMessageWidget: undefined"
 
-        applySystemMessages
-        mmsgs  <- getMessages
+    errorHandler err = do
+      mr <- getMessageRender
+      let
+        encrypted :: ToJSON a => a -> Widget -> Widget
+        encrypted plaintextJson plaintext = do
+          errKey <- getsYesod appErrorMsgKey
+          case errKey of
+            Nothing -> plaintext
+            Just key -> do
+              nonce <- liftIO SecretBox.newNonce
+              let ciphertext = SecretBox.secretbox key nonce . Lazy.ByteString.toStrict $ encode plaintextJson
+                  encoded = decodeUtf8 . Base64.encode . Lazy.ByteString.toStrict $ Binary.encode (Saltine.encode nonce, ciphertext)
+                  formatted = Text.intercalate "\n" . map (Text.intercalate " " . Text.chunksOf 4) $ Text.chunksOf 72 encoded
+              [whamlet|
+                <p>_{MsgErrorResponseEncrypted}
+                <pre .errMsg>
+                  #{formatted}
+              |]
+        
+        errPage = case err of
+          NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
+          InternalError err -> encrypted err [whamlet|<p .errMsg>#{err}|]
+          InvalidArgs errs -> [whamlet|
+              <ul>
+                $forall err <- errs
+                  <li .errMsg>#{err}
+            |]
+          NotAuthenticated -> [whamlet|<p>_{MsgErrorResponseNotAuthenticated}|]
+          PermissionDenied err -> [whamlet|<p .errMsg>#{err}|]
+          BadMethod method -> [whamlet|<p>_{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
+      fmap toTypedContent . siteLayout (Just . toHtml . mr $ ErrorResponseTitle err) $ do
+        toWidget
+          [cassius|
+            .errMsg
+              white-space: pre-wrap
+              font-family: monospace
+          |]
+        errPage
 
-        mcurrentRoute <- getCurrentRoute
-
-        -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance.
-        (title, parents) <- breadcrumbs
-
---         let isParent :: Route UniWorX -> Bool
---             isParent r = r == (fst parents)
-
-        let menu = defaultLinks ++ maybe [] pageActions mcurrentRoute
-
-        menuTypes <- mapM (\x -> (x, ) <$> newIdent) =<< filterM (menuItemAccessCallback . menuItem) menu
-
-        isAuth <- isJust <$> maybeAuthId
-
-        -- Lookup Favourites & Theme if possible -- TODO: cache this info in a cookie?!
-        (favourites', currentTheme) <- do
-            muid <- maybeAuthPair
-            case muid of
-                Nothing         -> return ([],userDefaultTheme)
-                (Just (uid,user)) -> do
-                    favs <- runDB $ E.select . E.from $ \(course `E.InnerJoin` courseFavourite) -> do
-                        E.on (course E.^. CourseId E.==. courseFavourite E.^. CourseFavouriteCourse)
-                        E.where_ (courseFavourite E.^. CourseFavouriteUser E.==. E.val uid)
-                        E.orderBy [ E.asc $ course E.^. CourseShorthand ]
-                        return course
-                    return (favs, userTheme user)
-        favourites <- forM favourites' $ \(Entity _ c@Course{..})
-            -> let
-                   courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
-               in (c, courseRoute, ) <$> filterM (menuItemAccessCallback . menuItem) (pageActions courseRoute)
-
-        let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority
-            highlight = let crumbs = mcons mcurrentRoute $ fst <$> reverse parents
-                            navItems = map snd3 favourites ++ map (menuItemRoute . menuItem . fst) menuTypes
-                            highR  = find (`elem` navItems) . uncurry (++) $ partition (`elem` map snd3 favourites) crumbs
-                        in \r -> Just r == highR
-            favouriteTerms :: [TermIdentifier]
-            favouriteTerms = Set.toDescList $ foldMap (\(Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites
-            favouriteTerm :: TermIdentifier -> [(Course, Route UniWorX, [MenuTypes])]
-            favouriteTerm tid = filter (\(Course{..}, _, _) -> unTermKey courseTerm == tid) favourites
-
-        -- We break up the default layout into two components:
-        -- default-layout is the contents of the body tag, and
-        -- default-layout-wrapper is the entire page. Since the final
-        -- value passed to hamletToRepHtml cannot be a widget, this allows
-        -- you to use normal widget features in default-layout.
-
-
-        let
-            navbar :: Widget
-            navbar = $(widgetFile "widgets/navbar")
-            asidenav :: Widget
-            asidenav = $(widgetFile "widgets/asidenav")
-            contentHeadline :: Maybe Widget
-            contentHeadline = pageHeading =<< mcurrentRoute
-            breadcrumbs :: Widget
-            breadcrumbs = $(widgetFile "widgets/breadcrumbs")
-            pageactionprime :: Widget
-            pageactionprime = $(widgetFile "widgets/pageactionprime") -- TODO: rename, since it also shows secondary pageActions now
-            -- functions to determine if there are page-actions (primary or secondary)
-            isPageActionPrime :: MenuTypes -> Bool
-            isPageActionPrime (PageActionPrime _)     = True
-            isPageActionPrime (PageActionSecondary _) = True
-            isPageActionPrime _ = False
-            hasPageActions :: Bool
-            hasPageActions = any (isPageActionPrime . fst) menuTypes
-
-        pc <- widgetToPageContent $ do
-            addStylesheetRemote "https://fonts.googleapis.com/css?family=Source+Sans+Pro:300,400,600,800,900|Roboto:300,400,600"
-            addScript $ StaticR js_zepto_js
-            addScript $ StaticR js_fetchPolyfill_js
-            addScript $ StaticR js_urlPolyfill_js
-            addScript $ StaticR js_featureChecker_js
-            addScript $ StaticR js_flatpickr_js
-            addScript $ StaticR js_tabber_js
-            addStylesheet $ StaticR css_flatpickr_css
-            addStylesheet $ StaticR css_tabber_css
-            addStylesheet $ StaticR css_fonts_css
-            addStylesheet $ StaticR css_fontawesome_css
-            $(widgetFile "default-layout")
-            $(widgetFile "standalone/modal")
-            $(widgetFile "standalone/showHide")
-            $(widgetFile "standalone/inputs")
-            $(widgetFile "standalone/tooltip")
-            $(widgetFile "standalone/tabber")
-            $(widgetFile "standalone/alerts")
-            $(widgetFile "standalone/datepicker")
-        withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
+    defaultLayout = siteLayout Nothing
 
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
@@ -768,6 +691,105 @@ instance Yesod UniWorX where
     makeLogger = return . appLogger
 
 
+siteLayout :: Maybe Html -- ^ Optionally override `pageHeading`
+           -> Widget -> Handler Html
+siteLayout headingOverride widget = do
+  master <- getYesod
+  let AppSettings { appUserDefaults = UserDefaultConf{..}, .. } = appSettings master
+
+  applySystemMessages
+  mmsgs  <- getMessages
+
+  mcurrentRoute <- getCurrentRoute
+
+  -- Get the breadcrumbs, as defined in the YesodBreadcrumbs instance.
+  (title, parents) <- breadcrumbs
+
+  --         let isParent :: Route UniWorX -> Bool
+  --             isParent r = r == (fst parents)
+
+  let menu = defaultLinks ++ maybe [] pageActions mcurrentRoute
+
+  menuTypes <- mapM (\x -> (x, ) <$> newIdent) =<< filterM (menuItemAccessCallback . menuItem) menu
+
+  isAuth <- isJust <$> maybeAuthId
+
+  -- Lookup Favourites & Theme if possible -- TODO: cache this info in a cookie?!
+  (favourites', currentTheme) <- do
+      muid <- maybeAuthPair
+      case muid of
+          Nothing         -> return ([],userDefaultTheme)
+          (Just (uid,user)) -> do
+              favs <- runDB $ E.select . E.from $ \(course `E.InnerJoin` courseFavourite) -> do
+                  E.on (course E.^. CourseId E.==. courseFavourite E.^. CourseFavouriteCourse)
+                  E.where_ (courseFavourite E.^. CourseFavouriteUser E.==. E.val uid)
+                  E.orderBy [ E.asc $ course E.^. CourseShorthand ]
+                  return course
+              return (favs, userTheme user)
+  favourites <- forM favourites' $ \(Entity _ c@Course{..})
+      -> let
+             courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
+         in (c, courseRoute, ) <$> filterM (menuItemAccessCallback . menuItem) (pageActions courseRoute)
+
+  let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority
+      highlight = let crumbs = mcons mcurrentRoute $ fst <$> reverse parents
+                      navItems = map snd3 favourites ++ map (menuItemRoute . menuItem . fst) menuTypes
+                      highR  = find (`elem` navItems) . uncurry (++) $ partition (`elem` map snd3 favourites) crumbs
+                  in \r -> Just r == highR
+      favouriteTerms :: [TermIdentifier]
+      favouriteTerms = Set.toDescList $ foldMap (\(Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites
+      favouriteTerm :: TermIdentifier -> [(Course, Route UniWorX, [MenuTypes])]
+      favouriteTerm tid = filter (\(Course{..}, _, _) -> unTermKey courseTerm == tid) favourites
+
+  -- We break up the default layout into two components:
+  -- default-layout is the contents of the body tag, and
+  -- default-layout-wrapper is the entire page. Since the final
+  -- value passed to hamletToRepHtml cannot be a widget, this allows
+  -- you to use normal widget features in default-layout.
+
+
+  let
+      navbar :: Widget
+      navbar = $(widgetFile "widgets/navbar")
+      asidenav :: Widget
+      asidenav = $(widgetFile "widgets/asidenav")
+      contentHeadline :: Maybe Widget
+      contentHeadline = (toWidget <$> headingOverride) <|> (pageHeading =<< mcurrentRoute)
+      breadcrumbs :: Widget
+      breadcrumbs = $(widgetFile "widgets/breadcrumbs")
+      pageactionprime :: Widget
+      pageactionprime = $(widgetFile "widgets/pageactionprime") -- TODO: rename, since it also shows secondary pageActions now
+      -- functions to determine if there are page-actions (primary or secondary)
+      isPageActionPrime :: MenuTypes -> Bool
+      isPageActionPrime (PageActionPrime _)     = True
+      isPageActionPrime (PageActionSecondary _) = True
+      isPageActionPrime _ = False
+      hasPageActions :: Bool
+      hasPageActions = any (isPageActionPrime . fst) menuTypes
+
+  pc <- widgetToPageContent $ do
+      addStylesheetRemote "https://fonts.googleapis.com/css?family=Source+Sans+Pro:300,400,600,800,900|Roboto:300,400,600"
+      addScript $ StaticR js_zepto_js
+      addScript $ StaticR js_fetchPolyfill_js
+      addScript $ StaticR js_urlPolyfill_js
+      addScript $ StaticR js_featureChecker_js
+      addScript $ StaticR js_flatpickr_js
+      addScript $ StaticR js_tabber_js
+      addStylesheet $ StaticR css_flatpickr_css
+      addStylesheet $ StaticR css_tabber_css
+      addStylesheet $ StaticR css_fonts_css
+      addStylesheet $ StaticR css_fontawesome_css
+      $(widgetFile "default-layout")
+      $(widgetFile "standalone/modal")
+      $(widgetFile "standalone/showHide")
+      $(widgetFile "standalone/inputs")
+      $(widgetFile "standalone/tooltip")
+      $(widgetFile "standalone/tabber")
+      $(widgetFile "standalone/alerts")
+      $(widgetFile "standalone/datepicker")
+  withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
+
+
 applySystemMessages :: (MonadHandler m, HandlerSite m ~ UniWorX) => m ()
 applySystemMessages = liftHandlerT . runDB . runConduit $ selectSource [] [] .| C.mapM_ applyMessage
   where
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index c0660967a..458e3d766 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -279,10 +279,8 @@ helpForm mReferer mUid = HelpForm
       , (HIAnonymous, pure $ Left Nothing)
       ]
 
-getHelpR :: Handler Html
+getHelpR, postHelpR :: Handler Html
 getHelpR = postHelpR
-
-postHelpR :: Handler Html
 postHelpR = do
   mUid <- maybeAuthId
   mRefererBS <- requestHeaderReferer <$> waiRequest
diff --git a/src/Model.hs b/src/Model.hs
index 76a543723..bd56ab5a2 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -33,6 +33,7 @@ import Data.CaseInsensitive (CI)
 import Data.CaseInsensitive.Instances ()
 
 import Utils.Message (MessageClass)
+import Settings.Cluster (ClusterSettingsKey)
 
 -- You can define all of your database entities in the entities file.
 -- You can find more information on persistent and how to declare entities
diff --git a/src/Settings.hs b/src/Settings.hs
index c246311a7..da5fc9336 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -7,6 +7,9 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -- | Settings are centralized, as much as possible, into this file. This
@@ -14,12 +17,17 @@
 -- In addition, you can configure a number of different aspects of Yesod
 -- by overriding methods in the Yesod typeclass. That instance is
 -- declared in the Foundation.hs file.
-module Settings where
+module Settings
+  ( module Settings
+  , module Settings.Cluster
+  ) where
 
-import           ClassyPrelude.Yesod
+import           ClassyPrelude.Yesod hiding (Proxy)
+import Data.UUID (UUID)
 import qualified Control.Exception           as Exception
-import           Data.Aeson                  (Result (..), fromJSON, withObject,
-                                              (.!=), (.:?), withScientific)
+import           Data.Aeson                  (Result (..), fromJSON, withObject
+                                             ,(.!=), (.:?), withScientific
+                                             )
 import qualified Data.Aeson.Types as Aeson
 import           Data.Aeson.TH
 import           Data.FileEmbed              (embedFile)
@@ -57,6 +65,7 @@ import Network.Mail.Mime (Address)
 import Mail (VerpMode)
 
 import Model
+import Settings.Cluster
 
 -- | Runtime settings to configure this application. These settings can be
 -- loaded from various sources: defaults, environment variables, config files,
@@ -91,6 +100,7 @@ data AppSettings = AppSettings
     , appNotificationRateLimit  :: NominalDiffTime
     , appNotificationCollateDelay :: NominalDiffTime
     , appNotificationExpiration :: NominalDiffTime
+    , appSessionTimeout         :: NominalDiffTime
 
     , appInitialLogSettings     :: LogSettings
 
@@ -104,12 +114,12 @@ data AppSettings = AppSettings
     -- ^ Indicate if auth dummy login should be enabled.
     , appAllowDeprecated        :: Bool
     -- ^ Indicate if deprecated routes are accessible for everyone
+    , appEncryptErrors          :: Bool
 
     , appUserDefaults           :: UserDefaultConf
     , appAuthPWHash             :: PWHashConf
 
-    , appCryptoIDKeyFile        :: FilePath
-    , appInstanceIDFile         :: Maybe FilePath
+    , appInitialInstanceID      :: Maybe (Either FilePath UUID)
     } deriving (Show)
 
 data LogSettings = LogSettings
@@ -264,7 +274,6 @@ deriveFromJSON
   ''Address
 
 
-
 instance FromJSON AppSettings where
     parseJSON = withObject "AppSettings" $ \o -> do
         let defaultDev =
@@ -298,19 +307,21 @@ instance FromJSON AppSettings where
         appNotificationCollateDelay <- o .: "notification-collate-delay"
         appNotificationExpiration <- o .: "notification-expiration"
 
+        appSessionTimeout         <- o .: "session-timeout"
+
         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
+        appEncryptErrors          <- o .:? "encrypt-errors"   .!= not defaultDev
 
         appInitialLogSettings     <- o .:  "log-settings"
 
         appUserDefaults           <- o .:  "user-defaults"
         appAuthPWHash             <- o .:  "auth-pw-hash"
 
-        appCryptoIDKeyFile        <- o .:  "cryptoid-keyfile"
-        appInstanceIDFile         <- o .:? "instance-idfile"
+        appInitialInstanceID      <- (o .:? "instance-id") >>= maybe (return Nothing) (\v -> Just <$> ((Right <$> parseJSON v) <|> (Left <$> parseJSON v)))
 
         return AppSettings {..}
 
diff --git a/src/Settings/Cluster.hs b/src/Settings/Cluster.hs
new file mode 100644
index 000000000..94bce92e0
--- /dev/null
+++ b/src/Settings/Cluster.hs
@@ -0,0 +1,134 @@
+{-# LANGUAGE NoImplicitPrelude
+           , DataKinds
+           , TypeFamilies
+           , ScopedTypeVariables
+           , TemplateHaskell
+           , OverloadedStrings
+           , FlexibleContexts
+  #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Settings.Cluster
+  ( ClusterSettingsKey(..)
+  , ClusterSetting(..)
+  ) where
+
+import ClassyPrelude.Yesod
+import Database.Persist.Sql
+import Web.HttpApiData
+
+import Utils
+import Control.Lens
+import Data.Universe
+
+import Data.Aeson ( FromJSON(..), ToJSON(..)
+                  , Options(..), defaultOptions
+                  , FromJSONKey(..), ToJSONKey(..), FromJSONKeyFunction(..)
+                  )
+import Data.Aeson.TH (deriveJSON)
+import Data.Aeson.Types (toJSONKeyText)
+import qualified Data.Aeson as Aeson
+
+import qualified Web.ClientSession as ClientSession
+import qualified Crypto.Saltine.Core.SecretBox as SecretBox
+import qualified Crypto.Saltine.Class as Saltine
+
+import Data.CryptoID.ByteString (CryptoIDKey)
+import qualified Data.CryptoID.ByteString as CryptoID
+
+import qualified Data.Binary as Binary
+import qualified Data.Serialize as Serialize
+import qualified Data.ByteString.Base64.URL as Base64
+
+
+data ClusterSettingsKey
+  = ClusterCryptoIDKey
+  | ClusterClientSessionKey
+  | ClusterErrorMessageKey
+  deriving (Eq, Ord, Enum, Bounded, Show, Read)
+
+instance Universe ClusterSettingsKey
+instance Finite ClusterSettingsKey
+
+$(return [])
+
+instance PathPiece ClusterSettingsKey where
+  toPathPiece = $(nullaryToPathPiece ''ClusterSettingsKey [intercalate "-" . map toLower . drop 1 . splitCamel])
+  fromPathPiece = finiteFromPathPiece
+
+deriveJSON
+  defaultOptions
+    { constructorTagModifier = intercalate "-" . map toLower . drop 1 . splitCamel
+    }
+  ''ClusterSettingsKey
+
+instance ToJSONKey ClusterSettingsKey where
+  toJSONKey = toJSONKeyText $ \v -> let String t = toJSON v in t
+
+instance FromJSONKey ClusterSettingsKey where
+  fromJSONKey = FromJSONKeyTextParser $ parseJSON . String
+
+instance PersistField ClusterSettingsKey where
+  toPersistValue = PersistText . toPathPiece
+  fromPersistValue (PersistText t) = maybe (Left $ "Could not parse " <> t) Right $ fromPathPiece t
+  fromPersistValue _other = Left "Expecting PersistText"
+
+instance PersistFieldSql ClusterSettingsKey where
+  sqlType _ = SqlString
+
+instance ToHttpApiData ClusterSettingsKey where
+  toUrlPiece = toPathPiece
+instance FromHttpApiData ClusterSettingsKey where
+  parseUrlPiece = maybe (Left "Could not parse url piece") Right . fromPathPiece
+
+  
+class (ToJSON (ClusterSettingValue key), FromJSON (ClusterSettingValue key)) => ClusterSetting (key :: ClusterSettingsKey) where
+  type ClusterSettingValue key :: *
+  initClusterSetting :: forall m p. MonadIO m => p key -> m (ClusterSettingValue key)
+  knownClusterSetting :: forall p. p key -> ClusterSettingsKey
+
+
+instance ClusterSetting 'ClusterCryptoIDKey where
+  type ClusterSettingValue 'ClusterCryptoIDKey = CryptoIDKey
+  initClusterSetting _ = CryptoID.genKey
+  knownClusterSetting _ = ClusterCryptoIDKey
+
+instance ToJSON CryptoIDKey where
+  toJSON = Aeson.String . decodeUtf8 . Base64.encode . toStrict . Binary.encode
+
+instance FromJSON CryptoIDKey where
+  parseJSON = Aeson.withText "CryptoIDKey" $ \t -> do
+    bytes <- either fail (return . fromStrict) . Base64.decode $ encodeUtf8 t
+    case Binary.decodeOrFail bytes of
+      Left (_, _, err) -> fail err
+      Right (bs, _, ret)
+        | null bs -> return ret
+        | otherwise -> fail $ show (length bs) ++ " extra bytes"
+
+
+instance ClusterSetting 'ClusterClientSessionKey where
+  type ClusterSettingValue 'ClusterClientSessionKey = ClientSession.Key
+  initClusterSetting _ = liftIO $ view _2 <$> ClientSession.randomKey
+  knownClusterSetting _ = ClusterClientSessionKey
+
+instance ToJSON ClientSession.Key where
+  toJSON = Aeson.String . decodeUtf8 . Base64.encode . Serialize.encode
+
+instance FromJSON ClientSession.Key where
+  parseJSON = Aeson.withText "Key" $ \t -> do
+    bytes <- either fail return . Base64.decode $ encodeUtf8 t
+    either fail return $ Serialize.decode bytes
+
+
+instance ClusterSetting 'ClusterErrorMessageKey where
+  type ClusterSettingValue 'ClusterErrorMessageKey = SecretBox.Key
+  initClusterSetting _ = liftIO $ SecretBox.newKey
+  knownClusterSetting _ = ClusterErrorMessageKey
+
+instance ToJSON SecretBox.Key where
+  toJSON = Aeson.String . decodeUtf8 . Base64.encode . Saltine.encode
+
+instance FromJSON SecretBox.Key where
+  parseJSON = Aeson.withText "Key" $ \t -> do
+    bytes <- either fail return . Base64.decode $ encodeUtf8 t
+    maybe (fail "Could not parse key") return $ Saltine.decode bytes
diff --git a/src/Utils/TH.hs b/src/Utils/TH.hs
index 3f5579269..c2d050bde 100644
--- a/src/Utils/TH.hs
+++ b/src/Utils/TH.hs
@@ -1,19 +1,24 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Utils.TH where
 -- Common Utility Functions that require TemplateHaskell
 
 -- import Data.Char
 
-import Prelude
+import ClassyPrelude.Yesod
 import Language.Haskell.TH
+import Language.Haskell.TH.Datatype
 -- import Control.Monad
 -- import Control.Monad.Trans.Class
 -- import Control.Monad.Trans.Maybe
 -- import Control.Monad.Trans.Except
 
+import Data.List ((!!), foldl)
+
 ------------
 -- Tuples --
 ------------
@@ -45,7 +50,7 @@ altFun perm = lamE pat rhs
   where pat = map varP $ fn:xs
         rhs = foldl appE (varE fn) $ map varE ps
 --         rhs = appE (varE fn) (varE $ xs!!1)        
-        mx  = maximum perm
+        mx  = maximum $ impureNonNull perm
         xs  = [ mkName $ "x" ++ show j | j <- [1..mx] ]
         ps  = [ xs !! (j-1) | j <- perm ]
         fn  = mkName "fn" 
@@ -78,3 +83,62 @@ deriveSimpleWith cls fun strOp ty = do
       in return $ Clause pats body []
     genClause _ = fail "deriveShowTheme: constructors not allowed to have arguments"
 
+embedRenderMessage :: Name -- ^ Foundation type
+                   -> Name -- ^ Type to embed into message type
+                   -> (Text -> Text) -- ^ Mangle constructor names
+                   -> DecsQ
+-- ^ @embedRenderMessage ''Foundation ''MessageType mangle@ declares a
+--   `RenderMessage Foundation MessageType` instance expecting the default
+--   message-datatype (@FoundationMessage@) to contain one constructor for each
+--   constructor of @MessageType@, taking the same arguments:
+--
+-- > data NewMessage = NewMessageOne | NewMessageTwo
+-- > data FoundationMessage = MsgOne | MsgTwo
+-- >
+-- > -- embedRenderMessage ''Foundation ''NewMessage (drop 2 . splitCamel)
+-- > instance RenderMessage Foundation NewMessage where
+-- >   renderMessage f ls = renderMessage f ls . \case
+-- >     NewMessageOne -> MsgOne
+-- >     NewMessageTwo -> MsgTwo
+embedRenderMessage f inner mangle = do
+  DatatypeInfo{..} <- reifyDatatype inner
+  let
+    matches :: [MatchQ]
+    matches = flip map datatypeCons $ \ConstructorInfo{..} -> do
+      vars <- forM constructorFields $ \_ -> newName "x"
+      let body = foldl (\e v -> e `appE` varE v) (conE . mkName . unpack $ "Msg" <> mangle (pack $ nameBase constructorName)) vars
+      match (conP constructorName $ map varP vars) (normalB body) []
+
+  f' <- newName "f"
+  ls <- newName "ls"
+  
+  pure <$> instanceD (cxt []) [t|RenderMessage $(conT f) $(conT inner)|]
+    [ funD 'renderMessage
+      [ clause [varP f', varP ls] (normalB $ [e|renderMessage $(varE f') $(varE ls) . $(lamCaseE matches)|]) [] 
+      ]
+    ]
+
+embedRenderMessageVariant :: Name -- ^ Foundation Type
+                          -> Name -- ^ Name of newtype
+                          -> (Text -> Text) -- ^ Mangle constructor names
+                          -> DecsQ
+embedRenderMessageVariant f newT mangle = do
+  [ConstructorInfo{ constructorName = newtypeName, constructorFields = [ ConT newtypeInner ] }] <- datatypeCons <$> reifyDatatype newT
+  DatatypeInfo{..} <- reifyDatatype newtypeInner
+
+  let
+    matches :: [MatchQ]
+    matches = flip map datatypeCons $ \ConstructorInfo{..} -> do
+      vars <- forM constructorFields $ \_ -> newName "x"
+      let body = foldl (\e v -> e `appE` varE v) (conE . mkName . unpack $ "Msg" <> mangle (pack $ nameBase constructorName)) vars
+      match (conP newtypeName [conP constructorName $ map varP vars]) (normalB body) []
+
+  f' <- newName "f"
+  ls <- newName "ls"
+  
+  pure <$> instanceD (cxt []) [t|RenderMessage $(conT f) $(conT newT)|]
+    [ funD 'renderMessage
+      [ clause [varP f', varP ls] (normalB $ [e|renderMessage $(varE f') $(varE ls) . $(lamCaseE matches)|]) [] 
+      ]
+    ]
+  
diff --git a/stack.nix b/stack.nix
index 93d072683..971fbc175 100644
--- a/stack.nix
+++ b/stack.nix
@@ -7,7 +7,7 @@ in haskell.lib.buildStackProject {
   inherit ghc;
   name = "stackenv";
   buildInputs = (with pkgs;
-    [ postgresql zlib openldap cyrus_sasl.dev
+    [ postgresql zlib openldap cyrus_sasl.dev libsodium
     ]) ++ (with haskellPackages;
     [ yesod-bin
     ]);
diff --git a/stack.yaml b/stack.yaml
index 8f93444f8..2551d1ab6 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -36,4 +36,6 @@ extra-deps:
 
   - persistent-2.7.3.1
 
+  - saltine-0.1.0.1
+
 resolver: lts-10.5
diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet
index 788577105..63ecb972a 100644
--- a/templates/default-layout.hamlet
+++ b/templates/default-layout.hamlet
@@ -14,13 +14,11 @@
 
     <div .main__content-body>
 
-      <h1>
-        <!-- $maybe back <- lastMaybe parents
+      $maybe headline <- contentHeadline
+        <h1>
+          <!-- $maybe back <- lastMaybe parents
             <a .breadcrumbs__link href="@{fst back}">#{snd back}  -->
-        $maybe headline <- contentHeadline
           ^{headline}
-        $nothing
-          HEADLINE MISSING!
 
       <!-- prime page actions -->
       ^{pageactionprime}

From 302c1c6708ab4ae30e7adcfd652c356dae818a3c Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sat, 27 Oct 2018 23:45:51 +0200
Subject: [PATCH 4/6] don't always encrypt errors

---
 config/settings.yml | 1 -
 1 file changed, 1 deletion(-)

diff --git a/config/settings.yml b/config/settings.yml
index 373385dee..658b10f55 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -47,7 +47,6 @@ auth-pw-hash:
 # mutable-static: false
 # skip-combining: false
 # encrypt-errors: true
-encrypt-errors: true
 
 database:
   user:     "_env:PGUSER:uniworx"

From 849e3eb347d949e420538bbe1bcb9d1b895383be Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 28 Oct 2018 14:14:27 +0100
Subject: [PATCH 5/6] Interface for decrypting error messages

---
 messages/uniworx/de.msg |  9 ++++++++-
 routes                  |  1 +
 src/Application.hs      |  6 ++----
 src/Foundation.hs       | 43 ++++++++++++++++++++++++---------------
 src/Handler/Admin.hs    | 45 +++++++++++++++++++++++++++++++++++++++++
 src/Utils/Form.hs       |  9 ++++++---
 6 files changed, 89 insertions(+), 24 deletions(-)

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index da3c0a31e..f27bdb02b 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -454,4 +454,11 @@ ErrorResponseNotFound: Unter der von Ihrem Browser angefragten URL wurde keine S
 ErrorResponseNotAuthenticated: Um Zugriff auf einige Teile des Systems zu erhalten müssen Sie sich zunächst anmelden.
 ErrorResponseBadMethod requestMethodText@Text: Ihr Browser kann auf mehrere verschiedene Arten versuchen mit den vom System angebotenen Ressourcen zu interagieren. Die aktuell versuchte Methode (#{requestMethodText}) wird nicht unterstützt.
 
-ErrorResponseEncrypted: Um keine sensiblen Daten preiszugeben wurden nähere Details verschlüsselt. Wenn Sie eine Anfrage an den Support schicken fügen Sie bitte die unten aufgeführten verschlüsselten Daten mit an.
\ No newline at end of file
+ErrorResponseEncrypted: Um keine sensiblen Daten preiszugeben wurden nähere Details verschlüsselt. Wenn Sie eine Anfrage an den Support schicken fügen Sie bitte die unten aufgeführten verschlüsselten Daten mit an.
+ErrMsgCiphertext: Verschlüsselte Fehlermeldung
+ErrMsgCiphertextTooShort: Verschlüsselte Daten zu kurz um valide zu sein
+ErrMsgInvalidBase64 base64Err@String: Verschlüsselte Daten nicht korrekt base64url-kodiert: #{base64Err}
+ErrMsgCouldNotDecodeNonce: Konnte secretbox-nonce nicht dekodieren
+ErrMsgCouldNotOpenSecretbox: Konnte libsodium-secretbox nicht öffnen (Verschlüsselte Daten sind nicht authentisch)
+ErrMsgCouldNotDecodePlaintext utf8Err@Text: Konnte Klartext nicht UTF8-dekodieren: #{utf8Err}
+ErrMsgHeading: Fehlermeldung entschlüsseln
\ No newline at end of file
diff --git a/routes b/routes
index 991318c6a..17a653125 100644
--- a/routes
+++ b/routes
@@ -36,6 +36,7 @@
 /admin/test                 AdminTestR        GET POST
 /admin/user/#CryptoUUIDUser AdminUserR        GET
 /admin/user/#CryptoUUIDUser/hijack AdminHijackUserR POST
+/admin/errMsg               AdminErrMsgR      GET POST
 /info                       VersionR          GET             !free
 /help                       HelpR             GET POST        !free
 
diff --git a/src/Application.hs b/src/Application.hs
index f52c180e9..0e7c7e211 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -155,9 +155,7 @@ makeFoundation appSettings@(AppSettings{..}) = do
       migrateAll `runSqlPool` sqlPool
       appCryptoIDKey <- clusterSetting (Proxy :: Proxy 'ClusterCryptoIDKey) `runSqlPool` sqlPool
       appSessionKey <- clusterSetting (Proxy :: Proxy 'ClusterClientSessionKey) `runSqlPool` sqlPool
-      appErrorMsgKey <- if
-        | appEncryptErrors -> Just <$> clusterSetting (Proxy :: Proxy 'ClusterErrorMessageKey) `runSqlPool` sqlPool
-        | otherwise -> return Nothing
+      appErrorMsgKey <- clusterSetting (Proxy :: Proxy 'ClusterErrorMessageKey) `runSqlPool` sqlPool
 
       let foundation = mkFoundation sqlPool smtpPool appCryptoIDKey appSessionKey appErrorMsgKey
 
@@ -178,7 +176,7 @@ clusterSetting proxy@(knownClusterSetting -> key) = do
   case Aeson.fromJSON . clusterConfigValue <$> current' of
     Just (Aeson.Success c) -> return c
     Just (Aeson.Error str) -> do
-      $logErrorS "clusterSetting" $ "Could not parse JSON-Value for " <> toPathPiece key
+      $logErrorS "clusterSetting" $ "Could not parse JSON-Value for " <> toPathPiece key <> ": " <> pack str
       liftIO exitFailure
     Nothing -> do
       new <- initClusterSetting proxy
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 2634974fb..78ff9dc21 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -100,7 +100,6 @@ import qualified Data.Conduit.List as C
 
 import qualified Crypto.Saltine.Core.SecretBox as SecretBox
 import qualified Crypto.Saltine.Class as Saltine
-import qualified Data.Binary as Binary
 
 
 instance DisplayAble b => DisplayAble (E.CryptoID a b) where
@@ -133,7 +132,7 @@ data UniWorX = UniWorX
     , appCryptoIDKey :: CryptoIDKey
     , appInstanceID  :: InstanceId
     , appJobCtl      :: [TMChan JobCtl]
-    , appErrorMsgKey :: Maybe SecretBox.Key
+    , appErrorMsgKey :: SecretBox.Key
     , appSessionKey  :: ClientSession.Key
     }
 
@@ -610,19 +609,22 @@ instance Yesod UniWorX where
       let
         encrypted :: ToJSON a => a -> Widget -> Widget
         encrypted plaintextJson plaintext = do
+          canDecrypt <- (== Authorized) <$> evalAccess AdminErrMsgR True
+          shouldEncrypt <- getsYesod $ appEncryptErrors . appSettings
           errKey <- getsYesod appErrorMsgKey
-          case errKey of
-            Nothing -> plaintext
-            Just key -> do
-              nonce <- liftIO SecretBox.newNonce
-              let ciphertext = SecretBox.secretbox key nonce . Lazy.ByteString.toStrict $ encode plaintextJson
-                  encoded = decodeUtf8 . Base64.encode . Lazy.ByteString.toStrict $ Binary.encode (Saltine.encode nonce, ciphertext)
-                  formatted = Text.intercalate "\n" . map (Text.intercalate " " . Text.chunksOf 4) $ Text.chunksOf 72 encoded
-              [whamlet|
-                <p>_{MsgErrorResponseEncrypted}
-                <pre .errMsg>
-                  #{formatted}
-              |]
+          if
+            | shouldEncrypt
+            , not canDecrypt -> do
+                nonce <- liftIO SecretBox.newNonce
+                let ciphertext = SecretBox.secretbox errKey nonce . Lazy.ByteString.toStrict $ encode plaintextJson
+                    encoded = decodeUtf8 . Base64.encode $ Saltine.encode nonce <> ciphertext
+                    formatted = Text.intercalate "\n" $ Text.chunksOf 76 encoded
+                [whamlet|
+                  <p>_{MsgErrorResponseEncrypted}
+                  <pre .errMsg>
+                    #{formatted}
+                |]
+            | otherwise -> plaintext
         
         errPage = case err of
           NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
@@ -971,8 +973,8 @@ pageActions (HomeR) =
 --       , menuItemAccessCallback' = return True
 --       }
 --   ,
-    NavbarAside $ MenuItem
-      { menuItemLabel = "AdminDemo"
+    PageActionPrime $ MenuItem
+      { menuItemLabel = "Admin-Demo"
       , menuItemIcon  = Just "screwdriver"
       , menuItemRoute = AdminTestR
       , menuItemModal = False
@@ -985,6 +987,13 @@ pageActions (HomeR) =
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
+  , PageActionPrime $ MenuItem
+      { menuItemLabel = "Fehlermeldung entschlüsseln"
+      , menuItemIcon = Nothing
+      , menuItemRoute = AdminErrMsgR
+      , menuItemModal = False
+      , menuItemAccessCallback' = return True
+      }
   ]
 pageActions (ProfileR) =
   [ PageActionPrime $ MenuItem
@@ -1232,6 +1241,8 @@ pageHeading (AdminTestR)
   = Just $ [whamlet|Internal Code Demonstration Page|]
 pageHeading (AdminUserR _)
   = Just $ [whamlet|User Display for Admin|]
+pageHeading (AdminErrMsgR)
+  = Just $ i18nHeading MsgErrMsgHeading
 pageHeading (VersionR)
   = Just $ i18nHeading MsgImpressumHeading
 pageHeading (HelpR)
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 1b5c3ae9d..46d65d29f 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -15,6 +15,19 @@ import Import
 import Handler.Utils
 import Jobs
 
+import qualified Data.ByteString as BS
+
+import qualified Crypto.Saltine.Internal.ByteSizes as Saltine
+import qualified Data.ByteString.Base64.URL as Base64
+import Crypto.Saltine.Core.SecretBox (secretboxOpen)
+import qualified Crypto.Saltine.Class as Saltine
+
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+import Data.Char (isSpace)
+
+import Control.Monad.Trans.Except
+
 -- import Data.Time
 -- import qualified Data.Text as T
 -- import Data.Function ((&))
@@ -105,3 +118,35 @@ getAdminUserR uuid = do
       <h2>Admin Page for User ^{nameWidget userDisplayName userSurname}
     |]
 
+getAdminErrMsgR, postAdminErrMsgR :: Handler Html
+getAdminErrMsgR = postAdminErrMsgR
+postAdminErrMsgR = do
+  errKey <- getsYesod appErrorMsgKey
+  
+  ((ctResult, ctView), ctEncoding) <- runFormPost . renderAForm FormStandard $
+        (unTextarea <$> areq textareaField (fslpI MsgErrMsgCiphertext "Ciphertext") Nothing)
+    <*  submitButton
+
+  plaintext <- formResultMaybe ctResult $ \(encodeUtf8 . Text.filter (not . isSpace) -> inputBS) ->
+    exceptT (\err -> Nothing <$ addMessageI Error err) (return . Just) $ do
+      ciphertext <- either (throwE . MsgErrMsgInvalidBase64) return $ Base64.decode inputBS
+
+      unless (BS.length ciphertext >= Saltine.secretBoxNonce + Saltine.secretBoxMac) $
+        throwE MsgErrMsgCiphertextTooShort
+      let (nonceBS, secretbox) = BS.splitAt Saltine.secretBoxNonce ciphertext
+
+      nonce <- maybe (throwE MsgErrMsgCouldNotDecodeNonce) return $ Saltine.decode nonceBS
+
+      plainBS <- maybe (throwE MsgErrMsgCouldNotOpenSecretbox) return $ secretboxOpen errKey nonce secretbox
+
+      either (throwE . MsgErrMsgCouldNotDecodePlaintext . tshow) return $ Text.decodeUtf8' plainBS
+
+  defaultLayout $
+    [whamlet|
+      $maybe t <- plaintext
+        <pre style="white-space:pre-wrap; font-family:monospace">
+          #{t}
+
+      <form action=@{AdminErrMsgR} method=post enctype=#{ctEncoding}>
+        ^{ctView}
+    |]
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 12b92f430..6859eccea 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -284,6 +284,9 @@ reorderField optList = Field{..}
 ---------------------
 
 formResult :: MonadHandler m => FormResult a -> (a -> m ()) -> m ()
-formResult (FormFailure errs) _ = forM_ errs $ addMessage Error . toHtml
-formResult  FormMissing       _ = return ()
-formResult (FormSuccess res)  f = f res
+formResult res f = void . formResultMaybe res $ \x -> Nothing <$ f x
+
+formResultMaybe :: MonadHandler m => FormResult a -> (a -> m (Maybe b)) -> m (Maybe b)
+formResultMaybe (FormFailure errs) _ = Nothing <$ forM_ errs (addMessage Error . toHtml)
+formResultMaybe  FormMissing       _ = return Nothing
+formResultMaybe (FormSuccess res)  f = f res

From eff7875c1c0cb2226283c14aac6f9cf85e915672 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 28 Oct 2018 19:11:40 +0100
Subject: [PATCH 6/6] Cleanup language extensions

---
 package.yaml                                  | 48 ++++++++++++++
 src/Application.hs                            | 14 +----
 src/Auth/Dummy.hs                             |  8 ---
 src/Auth/LDAP.hs                              | 11 ----
 src/Auth/PWHash.hs                            | 10 ---
 src/Cron.hs                                   |  9 ---
 src/Cron/Types.hs                             |  5 --
 src/CryptoID.hs                               |  8 ---
 src/CryptoID/TH.hs                            |  4 --
 src/Data/CaseInsensitive/Instances.hs         |  7 +--
 .../Universe/Instances/Reverse/Hashable.hs    |  3 -
 src/Data/Universe/Instances/Reverse/JSON.hs   |  3 -
 src/Foundation.hs                             | 15 +----
 src/Handler/Admin.hs                          | 11 ----
 src/Handler/Common.hs                         |  5 --
 src/Handler/Corrections.hs                    | 17 -----
 src/Handler/Course.hs                         | 15 -----
 src/Handler/CryptoIDDispatch.hs               | 16 +----
 src/Handler/Home.hs                           | 13 ----
 src/Handler/Profile.hs                        | 14 -----
 src/Handler/School.hs                         | 15 -----
 src/Handler/Sheet.hs                          | 17 -----
 src/Handler/Submission.hs                     | 35 +++--------
 src/Handler/SystemMessage.hs                  | 14 -----
 src/Handler/Term.hs                           | 63 ++++++++-----------
 src/Handler/Users.hs                          |  8 ---
 src/Handler/Utils.hs                          |  7 ---
 src/Handler/Utils/DateTime.hs                 |  7 ---
 src/Handler/Utils/Form.hs                     | 14 -----
 src/Handler/Utils/Form/Types.hs               |  2 -
 src/Handler/Utils/Mail.hs                     |  8 ---
 src/Handler/Utils/Rating.hs                   | 12 ----
 src/Handler/Utils/Sheet.hs                    | 10 ---
 src/Handler/Utils/StudyFeatures.hs            |  4 --
 src/Handler/Utils/Submission.hs               | 16 -----
 src/Handler/Utils/Submission/TH.hs            |  7 ---
 src/Handler/Utils/Table.hs                    |  5 --
 src/Handler/Utils/Table/Cells.hs              |  7 ---
 src/Handler/Utils/Table/Pagination.hs         | 22 +------
 src/Handler/Utils/Table/Pagination/Types.hs   |  6 --
 src/Handler/Utils/Templates.hs                |  2 -
 src/Handler/Utils/Zip.hs                      |  4 --
 src/Import/NoFoundation.hs                    |  3 +-
 src/Jobs.hs                                   | 17 +----
 src/Jobs/Crontab.hs                           |  8 ---
 src/Jobs/Handler/HelpRequest.hs               |  6 --
 src/Jobs/Handler/QueueNotification.hs         |  5 --
 src/Jobs/Handler/SendNotification.hs          |  5 --
 .../SendNotification/CorrectionsAssigned.hs   |  7 ---
 .../Handler/SendNotification/SheetActive.hs   |  7 ---
 .../Handler/SendNotification/SheetInactive.hs |  9 +--
 .../SendNotification/SubmissionRated.hs       |  7 ---
 src/Jobs/Handler/SendTestEmail.hs             |  6 --
 src/Jobs/Handler/SetLogSettings.hs            |  3 -
 src/Jobs/Queue.hs                             |  4 --
 src/Jobs/TH.hs                                | 29 ---------
 src/Jobs/Types.hs                             |  6 --
 src/Mail.hs                                   | 19 +-----
 src/Model.hs                                  | 19 ------
 src/Model/Migration.hs                        |  8 ---
 src/Model/Migration/Version.hs                |  7 ---
 src/Model/Types.hs                            | 16 +----
 src/Model/Types/JSON.hs                       |  4 --
 src/Model/Types/Wordlist.hs                   |  6 --
 src/Settings.hs                               | 16 +----
 src/Settings/Cluster.hs                       |  8 ---
 src/Settings/StaticFiles.hs                   |  3 -
 src/Utils.hs                                  |  9 ---
 src/Utils/DB.hs                               |  5 --
 src/Utils/DateTime.hs                         | 13 +---
 src/Utils/Form.hs                             | 15 -----
 src/Utils/Lang.hs                             |  4 --
 src/Utils/Lens.hs                             |  5 --
 src/Utils/Message.hs                          |  7 ---
 src/Utils/PathPiece.hs                        |  3 -
 src/Utils/Sql.hs                              |  8 ---
 src/Utils/SystemMessage.hs                    |  4 --
 src/Utils/TH.hs                               | 19 ++++--
 78 files changed, 114 insertions(+), 727 deletions(-)
 delete mode 100644 src/Jobs/TH.hs

diff --git a/package.yaml b/package.yaml
index 44695edb0..246f6bcf3 100644
--- a/package.yaml
+++ b/package.yaml
@@ -111,6 +111,54 @@ dependencies:
 - mmorph
 - clientsession
 
+other-extensions:
+  - GeneralizedNewtypeDeriving
+  - IncoherentInstances
+  - OverloadedLists
+  - UndecidableInstances
+
+default-extensions:
+  - OverloadedStrings
+  - PartialTypeSignatures
+  - ScopedTypeVariables
+  - TemplateHaskell
+  - QuasiQuotes
+  - CPP
+  - TypeSynonymInstances
+  - KindSignatures
+  - ConstraintKinds
+  - ViewPatterns
+  - TypeOperators
+  - TupleSections
+  - TypeFamilies
+  - GADTs
+  - StandaloneDeriving
+  - RecordWildCards
+  - RankNTypes
+  - PatternGuards
+  - PatternSynonyms
+  - ParallelListComp
+  - NumDecimals
+  - MultiWayIf
+  - NamedFieldPuns
+  - NoImplicitPrelude
+  - LambdaCase
+  - MultiParamTypeClasses
+  - FlexibleContexts
+  - FlexibleInstances
+  - FunctionalDependencies
+  - EmptyDataDecls
+  - ExistentialQuantification
+  - DefaultSignatures
+  - DeriveDataTypeable
+  - DeriveGeneric
+  - DeriveLift
+  - DeriveFunctor
+  - DerivingStrategies
+  - DataKinds
+  - BinaryLiterals
+  - PolyKinds
+
 # The library contains all of our application code. The executable
 # defined below is just a thin wrapper.
 library:
diff --git a/src/Application.hs b/src/Application.hs
index 0e7c7e211..3757d98f7 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -1,15 +1,5 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Application
     ( getApplicationDev, getAppDevSettings
     , appMain
@@ -29,7 +19,7 @@ module Application
 import Control.Monad.Logger                 (liftLoc, LoggingT(..), MonadLoggerIO(..))
 import Database.Persist.Postgresql          (createPostgresqlPool, pgConnStr,
                                              pgPoolSize, runSqlPool)
-import Import hiding (Proxy)
+import Import
 import Language.Haskell.TH.Syntax           (qLocation)
 import Network.Wai (Middleware)
 import Network.Wai.Handler.Warp             (Settings, defaultSettings,
diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs
index 809db8647..df4ab5e40 100644
--- a/src/Auth/Dummy.hs
+++ b/src/Auth/Dummy.hs
@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , TemplateHaskell
-           , FlexibleContexts
-           , TypeFamilies
-           , OverloadedStrings
-  #-}
-
 module Auth.Dummy
   ( dummyLogin
   , DummyMessage(..)
diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs
index 32c185519..2b053ce05 100644
--- a/src/Auth/LDAP.hs
+++ b/src/Auth/LDAP.hs
@@ -1,14 +1,3 @@
-{-# LANGUAGE RecordWildCards
-           , OverloadedStrings
-           , TemplateHaskell
-           , ViewPatterns
-           , TypeFamilies
-           , FlexibleContexts
-           , FlexibleInstances
-           , NoImplicitPrelude
-           , ScopedTypeVariables
-  #-}
-
 module Auth.LDAP
   ( campusLogin
   , CampusUserException(..)
diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs
index ba7198710..3efad0d32 100644
--- a/src/Auth/PWHash.hs
+++ b/src/Auth/PWHash.hs
@@ -1,13 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , QuasiQuotes
-           , TemplateHaskell
-           , ViewPatterns
-           , RecordWildCards
-           , OverloadedStrings
-           , FlexibleContexts
-           , TypeFamilies
-  #-}
-
 module Auth.PWHash
   ( hashLogin
   , PWHashMessage(..)
diff --git a/src/Cron.hs b/src/Cron.hs
index 2620aec12..cb2d9a338 100644
--- a/src/Cron.hs
+++ b/src/Cron.hs
@@ -1,12 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , PatternGuards
-           , ViewPatterns
-           , DeriveFunctor
-           , TemplateHaskell
-           , NamedFieldPuns
-  #-}
-
 module Cron
   ( CronNextMatch(..)
   , nextCronMatch
diff --git a/src/Cron/Types.hs b/src/Cron/Types.hs
index fa95477f0..ab3e92972 100644
--- a/src/Cron/Types.hs
+++ b/src/Cron/Types.hs
@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , DuplicateRecordFields
-  #-}
-
 module Cron.Types
   ( Cron(..), Crontab
   , CronMatch(..)
diff --git a/src/CryptoID.hs b/src/CryptoID.hs
index 58f68171e..6d4163982 100644
--- a/src/CryptoID.hs
+++ b/src/CryptoID.hs
@@ -1,11 +1,3 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
-{-# LANGUAGE RecordWildCards, ViewPatterns, PatternGuards #-}
-{-# LANGUAGE PatternSynonyms #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module CryptoID
diff --git a/src/CryptoID/TH.hs b/src/CryptoID/TH.hs
index 23122dadf..589c30637 100644
--- a/src/CryptoID/TH.hs
+++ b/src/CryptoID/TH.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ViewPatterns #-}
-
 module CryptoID.TH where
 
 import ClassyPrelude
diff --git a/src/Data/CaseInsensitive/Instances.hs b/src/Data/CaseInsensitive/Instances.hs
index ea5253f44..214283124 100644
--- a/src/Data/CaseInsensitive/Instances.hs
+++ b/src/Data/CaseInsensitive/Instances.hs
@@ -1,11 +1,8 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Data.CaseInsensitive.Instances
-  () where
+  (
+  ) where
 
 import ClassyPrelude.Yesod
 
diff --git a/src/Data/Universe/Instances/Reverse/Hashable.hs b/src/Data/Universe/Instances/Reverse/Hashable.hs
index e7459f613..d264fa41f 100644
--- a/src/Data/Universe/Instances/Reverse/Hashable.hs
+++ b/src/Data/Universe/Instances/Reverse/Hashable.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , ScopedTypeVariables
-  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Data.Universe.Instances.Reverse.Hashable
diff --git a/src/Data/Universe/Instances/Reverse/JSON.hs b/src/Data/Universe/Instances/Reverse/JSON.hs
index 60b7ba6ae..14c7d04fa 100644
--- a/src/Data/Universe/Instances/Reverse/JSON.hs
+++ b/src/Data/Universe/Instances/Reverse/JSON.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , ScopedTypeVariables
-  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Data.Universe.Instances.Reverse.JSON
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 78ff9dc21..10de66a02 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -1,17 +1,4 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE PatternGuards, MultiWayIf #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE FlexibleInstances, UndecidableInstances, FlexibleContexts #-}
+{-# LANGUAGE UndecidableInstances #-}
 
 module Foundation where
 
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index 46d65d29f..50b1963e7 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -1,14 +1,3 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
-
 module Handler.Admin where
 
 import Import
diff --git a/src/Handler/Common.hs b/src/Handler/Common.hs
index 2119bfb06..390b041e1 100644
--- a/src/Handler/Common.hs
+++ b/src/Handler/Common.hs
@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
 -- | Common handler functions.
 module Handler.Common where
 
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 9814f6d75..c1961857e 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -1,20 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE MultiWayIf, LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE MultiWayIf #-}
-
 module Handler.Corrections where
 
 import Import
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 044f9b391..c9262a2b6 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -1,18 +1,3 @@
-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleContexts #-}
-
 module Handler.Course where
 
 import Import hiding (catMaybes)
diff --git a/src/Handler/CryptoIDDispatch.hs b/src/Handler/CryptoIDDispatch.hs
index 9a744f208..54c2ec760 100644
--- a/src/Handler/CryptoIDDispatch.hs
+++ b/src/Handler/CryptoIDDispatch.hs
@@ -1,23 +1,9 @@
-{-# LANGUAGE NoImplicitPrelude
-           , DataKinds
-           , KindSignatures
-           , TypeFamilies
-           , FlexibleInstances
-           , TypeOperators
-           , RankNTypes
-           , PolyKinds
-           , RecordWildCards
-           , MultiParamTypeClasses
-           , ScopedTypeVariables
-           , ViewPatterns
-  #-}
-
 module Handler.CryptoIDDispatch
   ( getCryptoUUIDDispatchR
   , getCryptoFileNameDispatchR
   ) where
 
-import Import hiding (Proxy)
+import Import
 
 import Data.Proxy
 
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index 458e3d766..8c93c4a17 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -1,16 +1,3 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE IncoherentInstances #-} -- why is this needed? Instance for "display deadline" ought to be clear
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-
 module Handler.Home where
 
 import Import
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index 86e03d26e..3b16c186d 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -1,17 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE MultiWayIf, LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleInstances #-}
-
 module Handler.Profile where
 
 import Import
diff --git a/src/Handler/School.hs b/src/Handler/School.hs
index 9952a682d..92f0d2ec0 100644
--- a/src/Handler/School.hs
+++ b/src/Handler/School.hs
@@ -1,18 +1,3 @@
-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiWayIf #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleContexts #-}
-
 module Handler.School where
 
 import Import
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index e001b3a84..6150a1d54 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -1,20 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE MultiWayIf, LambdaCase #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE NamedFieldPuns #-}
-
 module Handler.Sheet where
 
 import Import
diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs
index 5055f6f26..25cac807d 100644
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@@ -1,21 +1,3 @@
-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE ParallelListComp #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE MultiWayIf #-}
-
 module Handler.Submission where
 
 import Import hiding (joinPath)
@@ -314,14 +296,15 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
         , dbtProj = return . dbrOutput
         , dbtStyle = def
         , dbtIdent = "files" :: Text
-        , dbtSorting =  [ ( "path"
-                          , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> E.coalesce [f1 E.?. FileTitle, f2 E.?. FileTitle]
-                          )
-                        , ( "time"
-                          , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> (E.unsafeSqlFunction "GREATEST" ([f1 E.?. FileModified, f2 E.?. FileModified] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
-                          )
-                        ]
-        , dbtFilter = []
+        , dbtSorting = Map.fromList
+          [ ( "path"
+            , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> E.coalesce [f1 E.?. FileTitle, f2 E.?. FileTitle]
+            )
+          , ( "time"
+            , SortColumn $ \((sf1 `E.InnerJoin` f1) `E.FullOuterJoin` (sf2 `E.InnerJoin` f2)) -> (E.unsafeSqlFunction "GREATEST" ([f1 E.?. FileModified, f2 E.?. FileModified] :: [E.SqlExpr (E.Value (Maybe UTCTime))]) :: E.SqlExpr (E.Value (Maybe UTCTime)))
+            )
+          ]
+        , dbtFilter = Map.empty
         }
   mFileTable <- traverse (fmap snd . dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
 
diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs
index 801b0b194..487b79331 100644
--- a/src/Handler/SystemMessage.hs
+++ b/src/Handler/SystemMessage.hs
@@ -1,17 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , TemplateHaskell
-           , NamedFieldPuns
-           , RecordWildCards
-           , OverloadedStrings
-           , TypeFamilies
-           , ViewPatterns
-           , FlexibleContexts
-           , LambdaCase
-           , MultiParamTypeClasses
-           , QuasiQuotes
-  #-}
-
 module Handler.SystemMessage where
 
 import Import
diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
index 1720eec1f..611a4cc9a 100644
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@@ -1,19 +1,8 @@
-{-# LANGUAGE NoImplicitPrelude
-           , OverloadedStrings
-           , OverloadedLists
-           , RecordWildCards
-           , TemplateHaskell
-           , QuasiQuotes
-           , MultiParamTypeClasses
-           , TypeFamilies
-           , FlexibleContexts
-           , PartialTypeSignatures
-  #-}
-
 module Handler.Term where
 
 import Import
 import Handler.Utils
+import qualified Data.Map as Map
 
 -- import qualified Data.Text as T
 import Yesod.Form.Bootstrap3
@@ -111,30 +100,32 @@ getTermShowR = do
         { dbtSQLQuery = termData
         , dbtColonnade = colonnadeTerms
         , dbtProj = return . dbrOutput
-        , dbtSorting = [ ( "start"
-                         , SortColumn $ \term -> term E.^. TermStart
-                         )
-                       , ( "end"
-                         , SortColumn $ \term -> term E.^. TermEnd
-                         )
-                       , ( "lecture-start"
-                         , SortColumn $ \term -> term E.^. TermLectureStart
-                         )
-                       , ( "lecture-end"
-                         , SortColumn $ \term -> term E.^. TermLectureEnd
-                         )
-                       ]
-        , dbtFilter = [ ( "active"
-                        , FilterColumn $ \term -> (term E.^. TermActive :: E.SqlExpr (E.Value Bool))
-                        )
-                      , ( "course"
-                        , FilterColumn $ \term csh -> case csh of -- FilterColumn-Lambdas are 
-                            []   -> E.val True :: E.SqlExpr (E.Value Bool)
-                            cshs -> E.exists . E.from $ \course -> do
-                              E.where_ $ course E.^. CourseTerm E.==. term E.^. TermId
-                                   E.&&. course E.^. CourseShorthand `E.in_` E.valList cshs
-                        )
-                      ]
+        , dbtSorting = Map.fromList
+            [ ( "start"
+              , SortColumn $ \term -> term E.^. TermStart
+              )
+            , ( "end"
+              , SortColumn $ \term -> term E.^. TermEnd
+              )
+            , ( "lecture-start"
+              , SortColumn $ \term -> term E.^. TermLectureStart
+              )
+            , ( "lecture-end"
+              , SortColumn $ \term -> term E.^. TermLectureEnd
+              )
+            ]
+        , dbtFilter = Map.fromList
+            [ ( "active"
+              , FilterColumn $ \term -> (term E.^. TermActive :: E.SqlExpr (E.Value Bool))
+              )
+            , ( "course"
+              , FilterColumn $ \term csh -> case csh of -- FilterColumn-Lambdas are 
+                  []   -> E.val True :: E.SqlExpr (E.Value Bool)
+                  cshs -> E.exists . E.from $ \course -> do
+                    E.where_ $ course E.^. CourseTerm E.==. term E.^. TermId
+                         E.&&. course E.^. CourseShorthand `E.in_` E.valList cshs
+              )
+            ]
         , dbtStyle = def
         , dbtIdent = "terms" :: Text
         }
diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs
index 8208d1a1f..0b6fb1c87 100644
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
-
 module Handler.Users where
 
 import Import
diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs
index 2a5c6a160..da07f0477 100644
--- a/src/Handler/Utils.hs
+++ b/src/Handler/Utils.hs
@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-
-
 module Handler.Utils
   ( module Handler.Utils
   ) where
diff --git a/src/Handler/Utils/DateTime.hs b/src/Handler/Utils/DateTime.hs
index 67acd6a32..dcacedadb 100644
--- a/src/Handler/Utils/DateTime.hs
+++ b/src/Handler/Utils/DateTime.hs
@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , OverloadedStrings
-           , RecordWildCards
-           , TypeFamilies
-  #-}
-
 module Handler.Utils.DateTime
   ( utcToLocalTime
   , localTimeToUTC, TZ.LocalToUTCResult(..)
diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index c7b7aee21..fbfd9f8dc 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -1,17 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE LambdaCase #-}
-
 module Handler.Utils.Form
   ( module Handler.Utils.Form
   , module Utils.Form
diff --git a/src/Handler/Utils/Form/Types.hs b/src/Handler/Utils/Form/Types.hs
index 386f029a0..16c8f0af6 100644
--- a/src/Handler/Utils/Form/Types.hs
+++ b/src/Handler/Utils/Form/Types.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-
 module Handler.Utils.Form.Types where
 
 import Import
diff --git a/src/Handler/Utils/Mail.hs b/src/Handler/Utils/Mail.hs
index 96ef448e0..4ade0952d 100644
--- a/src/Handler/Utils/Mail.hs
+++ b/src/Handler/Utils/Mail.hs
@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , NamedFieldPuns
-           , TypeFamilies
-           , FlexibleContexts
-           , ViewPatterns
-           , LambdaCase
-  #-}
-
 module Handler.Utils.Mail
   ( addRecipientsDB
   , userMailT
diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs
index 7702a7d52..b2b0d8a1e 100644
--- a/src/Handler/Utils/Rating.hs
+++ b/src/Handler/Utils/Rating.hs
@@ -1,16 +1,4 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
-
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
 
 module Handler.Utils.Rating
   ( Rating(..), Rating'(..)
diff --git a/src/Handler/Utils/Sheet.hs b/src/Handler/Utils/Sheet.hs
index d38d2e10a..e535eab8b 100644
--- a/src/Handler/Utils/Sheet.hs
+++ b/src/Handler/Utils/Sheet.hs
@@ -1,13 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-
 module Handler.Utils.Sheet where
 
 import Import
diff --git a/src/Handler/Utils/StudyFeatures.hs b/src/Handler/Utils/StudyFeatures.hs
index e4e8b38c7..75a82053b 100644
--- a/src/Handler/Utils/StudyFeatures.hs
+++ b/src/Handler/Utils/StudyFeatures.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-  #-}
-
 module Handler.Utils.StudyFeatures
   ( parseStudyFeatures
   ) where
diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs
index 9f67bf0e0..78f836f46 100644
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@@ -1,19 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE MultiWayIf #-}
-
-
 module Handler.Utils.Submission
   ( AssignSubmissionException(..)
   , assignSubmissions
diff --git a/src/Handler/Utils/Submission/TH.hs b/src/Handler/Utils/Submission/TH.hs
index 99de8a01f..0b24a4da1 100644
--- a/src/Handler/Utils/Submission/TH.hs
+++ b/src/Handler/Utils/Submission/TH.hs
@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , ViewPatterns
-           , OverloadedStrings
-           , StandaloneDeriving
-           , DeriveLift
-  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Handler.Utils.Submission.TH
diff --git a/src/Handler/Utils/Table.hs b/src/Handler/Utils/Table.hs
index 478bd58ff..d784d1cdc 100644
--- a/src/Handler/Utils/Table.hs
+++ b/src/Handler/Utils/Table.hs
@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TypeFamilies #-}
-
 module Handler.Utils.Table where
 -- General Utilities for Tables
 
diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs
index 65bc11452..8b7da8308 100644
--- a/src/Handler/Utils/Table/Cells.hs
+++ b/src/Handler/Utils/Table/Cells.hs
@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE FlexibleContexts #-}
-
 module Handler.Utils.Table.Cells where
 
 import Import
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index ff2e81f64..f36fba523 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -1,23 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , ExistentialQuantification
-           , RecordWildCards
-           , NamedFieldPuns
-           , OverloadedStrings
-           , TemplateHaskell
-           , QuasiQuotes
-           , LambdaCase
-           , ViewPatterns
-           , FlexibleContexts
-           , FlexibleInstances
-           , MultiParamTypeClasses
-           , TypeFamilies
-           , ScopedTypeVariables
-           , TupleSections
-           , RankNTypes
-           , MultiWayIf
-           , FunctionalDependencies
-  #-}
-
 module Handler.Utils.Table.Pagination
   ( SortColumn(..), SortDirection(..)
   , FilterColumn(..), IsFilterColumn
@@ -47,7 +27,7 @@ module Handler.Utils.Table.Pagination
 import Handler.Utils.Table.Pagination.Types
 import Utils.Lens.TH
 
-import Import hiding (Proxy(..))
+import Import
 import qualified Database.Esqueleto as E
 import qualified Database.Esqueleto.Internal.Sql as E (SqlSelect,unsafeSqlValue)
 import qualified Database.Esqueleto.Internal.Language as E (From)
diff --git a/src/Handler/Utils/Table/Pagination/Types.hs b/src/Handler/Utils/Table/Pagination/Types.hs
index 0a0b6c1c2..6bc9e1286 100644
--- a/src/Handler/Utils/Table/Pagination/Types.hs
+++ b/src/Handler/Utils/Table/Pagination/Types.hs
@@ -1,9 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , ExistentialQuantification
-           , RankNTypes
-           , RecordWildCards
-  #-}
-
 module Handler.Utils.Table.Pagination.Types where
 
 import Import hiding (singleton)
diff --git a/src/Handler/Utils/Templates.hs b/src/Handler/Utils/Templates.hs
index 57ab0f1d6..bdd82db86 100644
--- a/src/Handler/Utils/Templates.hs
+++ b/src/Handler/Utils/Templates.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude, TemplateHaskell, QuasiQuotes #-}
-
 module Handler.Utils.Templates where
 
 import Data.Either (isLeft)
diff --git a/src/Handler/Utils/Zip.hs b/src/Handler/Utils/Zip.hs
index fb196c933..f1e5f5d7e 100644
--- a/src/Handler/Utils/Zip.hs
+++ b/src/Handler/Utils/Zip.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}
 {-# OPTIONS_GHC -fno-warn-missing-fields #-} -- This concerns zipEntrySize in produceZip
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs
index 45c6c2d6a..51f05a9cb 100644
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@@ -1,10 +1,9 @@
-{-# LANGUAGE CPP #-}
 module Import.NoFoundation
     ( module Import
     , MForm
     ) where
 
-import ClassyPrelude.Yesod    as Import hiding (formatTime, derivePersistFieldJSON, addMessage, addMessageI, (.=), MForm)
+import ClassyPrelude.Yesod    as Import hiding (formatTime, derivePersistFieldJSON, addMessage, addMessageI, (.=), MForm, Proxy)
 import Model                  as Import
 import Model.Types.JSON       as Import
 import Model.Migration        as Import
diff --git a/src/Jobs.hs b/src/Jobs.hs
index f89265009..112a1376f 100644
--- a/src/Jobs.hs
+++ b/src/Jobs.hs
@@ -1,29 +1,14 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , TemplateHaskell
-           , OverloadedStrings
-           , FlexibleContexts
-           , ViewPatterns
-           , TypeFamilies
-           , DeriveGeneric
-           , DeriveDataTypeable
-           , QuasiQuotes
-           , NamedFieldPuns
-           , MultiWayIf
-  #-}
-
 module Jobs
   ( module Types
   , module Jobs.Queue
   , handleJobs
   ) where
 
-import Import hiding (Proxy)
+import Import
 
 import Jobs.Types as Types hiding (JobCtl(JobCtlQueue))
 import Jobs.Types (JobCtl(JobCtlQueue))
 import Jobs.Queue
-import Jobs.TH
 import Jobs.Crontab
 
 import Data.Conduit.TMChan
diff --git a/src/Jobs/Crontab.hs b/src/Jobs/Crontab.hs
index ad0fecc21..abee018f4 100644
--- a/src/Jobs/Crontab.hs
+++ b/src/Jobs/Crontab.hs
@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , FlexibleContexts
-           , MultiWayIf
-           , NamedFieldPuns
-           , TypeFamilies
-  #-}
-
 module Jobs.Crontab
   ( determineCrontab
   ) where
diff --git a/src/Jobs/Handler/HelpRequest.hs b/src/Jobs/Handler/HelpRequest.hs
index 0e03587a2..73642e90b 100644
--- a/src/Jobs/Handler/HelpRequest.hs
+++ b/src/Jobs/Handler/HelpRequest.hs
@@ -1,9 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , RecordWildCards
-           , OverloadedStrings
-  #-}
-
 module Jobs.Handler.HelpRequest
   ( dispatchJobHelpRequest
   ) where
diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs
index 024d57682..444ffe935 100644
--- a/src/Jobs/Handler/QueueNotification.hs
+++ b/src/Jobs/Handler/QueueNotification.hs
@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-  #-}
-
 module Jobs.Handler.QueueNotification
   ( dispatchJobQueueNotification
   ) where
diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs
index a554bcfa8..529042a46 100644
--- a/src/Jobs/Handler/SendNotification.hs
+++ b/src/Jobs/Handler/SendNotification.hs
@@ -1,14 +1,9 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-  #-}
-
 module Jobs.Handler.SendNotification
   ( dispatchJobSendNotification
   ) where
 
 import Import
 
-import Jobs.TH
 import Jobs.Types
 
 
diff --git a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs
index 6b7ed47d8..15f7a0289 100644
--- a/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs
+++ b/src/Jobs/Handler/SendNotification/CorrectionsAssigned.hs
@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-           , TemplateHaskell
-           , OverloadedStrings
-  #-}
-
 module Jobs.Handler.SendNotification.CorrectionsAssigned
   ( dispatchNotificationCorrectionsAssigned
   ) where
diff --git a/src/Jobs/Handler/SendNotification/SheetActive.hs b/src/Jobs/Handler/SendNotification/SheetActive.hs
index aaedcb7a6..0de2ff787 100644
--- a/src/Jobs/Handler/SendNotification/SheetActive.hs
+++ b/src/Jobs/Handler/SendNotification/SheetActive.hs
@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-           , TemplateHaskell
-           , OverloadedStrings
-  #-}
-
 module Jobs.Handler.SendNotification.SheetActive
   ( dispatchNotificationSheetActive
   ) where
diff --git a/src/Jobs/Handler/SendNotification/SheetInactive.hs b/src/Jobs/Handler/SendNotification/SheetInactive.hs
index 6873d2b28..99248e777 100644
--- a/src/Jobs/Handler/SendNotification/SheetInactive.hs
+++ b/src/Jobs/Handler/SendNotification/SheetInactive.hs
@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-           , TemplateHaskell
-           , OverloadedStrings
-  #-}
-
 module Jobs.Handler.SendNotification.SheetInactive
   ( dispatchNotificationSheetSoonInactive
   , dispatchNotificationSheetInactive
@@ -55,4 +48,4 @@ dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do
   addAlternatives $ do
     let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet")
     providePreferredAlternative ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
-    
\ No newline at end of file
+    
diff --git a/src/Jobs/Handler/SendNotification/SubmissionRated.hs b/src/Jobs/Handler/SendNotification/SubmissionRated.hs
index 885dc8bfe..fd7543f47 100644
--- a/src/Jobs/Handler/SendNotification/SubmissionRated.hs
+++ b/src/Jobs/Handler/SendNotification/SubmissionRated.hs
@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-           , TemplateHaskell
-           , OverloadedStrings
-  #-}
-
 module Jobs.Handler.SendNotification.SubmissionRated
   ( dispatchNotificationSubmissionRated
   ) where
diff --git a/src/Jobs/Handler/SendTestEmail.hs b/src/Jobs/Handler/SendTestEmail.hs
index 4b2865fdd..b66bbb471 100644
--- a/src/Jobs/Handler/SendTestEmail.hs
+++ b/src/Jobs/Handler/SendTestEmail.hs
@@ -1,9 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-           , NamedFieldPuns
-           , QuasiQuotes
-  #-}
-
 module Jobs.Handler.SendTestEmail
   ( dispatchJobSendTestEmail
   ) where
diff --git a/src/Jobs/Handler/SetLogSettings.hs b/src/Jobs/Handler/SetLogSettings.hs
index 01c8d618f..a7bf40f6c 100644
--- a/src/Jobs/Handler/SetLogSettings.hs
+++ b/src/Jobs/Handler/SetLogSettings.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-  #-}
-
 module Jobs.Handler.SetLogSettings
   ( dispatchJobSetLogSettings
   ) where
diff --git a/src/Jobs/Queue.hs b/src/Jobs/Queue.hs
index d72734aeb..db5f2d8e5 100644
--- a/src/Jobs/Queue.hs
+++ b/src/Jobs/Queue.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TypeFamilies
-  #-}
-
 module Jobs.Queue
   ( writeJobCtl, writeJobCtlBlock
   , queueJob, queueJob'
diff --git a/src/Jobs/TH.hs b/src/Jobs/TH.hs
deleted file mode 100644
index 47e69f62d..000000000
--- a/src/Jobs/TH.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , QuasiQuotes
-           , RecordWildCards
-  #-}
-
-module Jobs.TH
-  ( dispatchTH
-  ) where
-
-import ClassyPrelude
-
-import Language.Haskell.TH
-import Language.Haskell.TH.Datatype
-
-import Data.List (foldl)
-
-
-dispatchTH :: Name -- ^ Datatype to pattern match
-           -> ExpQ
-dispatchTH dType = do
-  DatatypeInfo{..} <- reifyDatatype dType
-  let
-    matches = map mkMatch datatypeCons
-    mkMatch ConstructorInfo{..} = do
-      pats <- forM constructorFields $ \_ -> newName "x"
-      let fName = mkName $ "dispatch" <> nameBase constructorName
-      match (conP constructorName $ map varP pats) (normalB $ foldl (\e pat -> e `appE` varE pat) (varE fName) pats) []
-  lamCaseE matches
diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs
index 63b947a69..20af81933 100644
--- a/src/Jobs/Types.hs
+++ b/src/Jobs/Types.hs
@@ -1,9 +1,3 @@
-{-# LANGUAGE TemplateHaskell
-           , NoImplicitPrelude
-           , DeriveGeneric
-           , DeriveDataTypeable
-  #-}
-
 module Jobs.Types
   ( Job(..), Notification(..)
   , JobCtl(..)
diff --git a/src/Mail.hs b/src/Mail.hs
index c812bc583..cbbc1c933 100644
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -1,22 +1,5 @@
-{-# LANGUAGE NoImplicitPrelude
-           , GeneralizedNewtypeDeriving
-           , DerivingStrategies
-           , FlexibleInstances
-           , MultiParamTypeClasses
+{-# LANGUAGE GeneralizedNewtypeDeriving
            , UndecidableInstances
-           , DeriveGeneric
-           , TemplateHaskell
-           , OverloadedStrings
-           , RecordWildCards
-           , FlexibleContexts
-           , TypeFamilies
-           , ViewPatterns
-           , NamedFieldPuns
-           , MultiWayIf
-           , QuasiQuotes
-           , RankNTypes
-           , ScopedTypeVariables
-           , DeriveDataTypeable
   #-}
 
 module Mail
diff --git a/src/Model.hs b/src/Model.hs
index bd56ab5a2..15da993f1 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -1,17 +1,4 @@
-{-# LANGUAGE EmptyDataDecls             #-}
-{-# LANGUAGE FlexibleInstances          #-}
-{-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses      #-}
-{-# LANGUAGE NoImplicitPrelude          #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE TemplateHaskell            #-}
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE RecordWildCards            #-}
-{-# LANGUAGE StandaloneDeriving         #-}
-
 
 module Model
   ( module Model
@@ -44,12 +31,6 @@ share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll
 
 -- (Eq Course) is impossible so we derive it for the Uniqueness Constraint only
 deriving instance Eq (Unique Course)
-  
-data PWEntry = PWEntry
-  { pwUser :: User
-  , pwHash :: Text
-  } deriving (Show)
-$(deriveJSON defaultOptions ''PWEntry)
 
 submissionRatingDone :: Submission -> Bool
 submissionRatingDone Submission{..} = isJust submissionRatingTime
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index bd6be6098..bdc362560 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-{-# LANGUAGE TypeFamilies, FlexibleInstances #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
 module Model.Migration
   ( migrateAll
   ) where
diff --git a/src/Model/Migration/Version.hs b/src/Model/Migration/Version.hs
index 37bbd8f3f..2bc5579c9 100644
--- a/src/Model/Migration/Version.hs
+++ b/src/Model/Migration/Version.hs
@@ -1,10 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-{-# LANGUAGE PatternSynonyms #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveLift, DeriveGeneric, DeriveDataTypeable #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Model.Migration.Version
diff --git a/src/Model/Types.hs b/src/Model/Types.hs
index b4d3a41c5..0b10e1fb0 100644
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@@ -1,16 +1,6 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE PatternGuards #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE BinaryLiterals #-}
-{-# LANGUAGE MultiWayIf #-}
-{-- # LANGUAGE ExistentialQuantification #-} -- for DA type
+{-# LANGUAGE GeneralizedNewtypeDeriving
+           , UndecidableInstances
+  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- for instance PathPiece (CI Text)
 
 module Model.Types
diff --git a/src/Model/Types/JSON.hs b/src/Model/Types/JSON.hs
index dc5a5eec6..4e2927edb 100644
--- a/src/Model/Types/JSON.hs
+++ b/src/Model/Types/JSON.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-
 module Model.Types.JSON
   ( derivePersistFieldJSON
   ) where
diff --git a/src/Model/Types/Wordlist.hs b/src/Model/Types/Wordlist.hs
index d4bab9e8c..5e35d7f25 100644
--- a/src/Model/Types/Wordlist.hs
+++ b/src/Model/Types/Wordlist.hs
@@ -1,9 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , ViewPatterns
-           , OverloadedStrings
-  #-}
-
 module Model.Types.Wordlist (wordlist) where
 
 import ClassyPrelude hiding (lift)
diff --git a/src/Settings.hs b/src/Settings.hs
index da5fc9336..82b7f7ec0 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -1,17 +1,5 @@
-{-# LANGUAGE CPP                #-}
-{-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE OverloadedStrings  #-}
-{-# LANGUAGE RecordWildCards    #-}
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE MultiWayIf         #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 -- | Settings are centralized, as much as possible, into this file. This
 -- includes database connection settings, static file locations, etc.
 -- In addition, you can configure a number of different aspects of Yesod
@@ -22,7 +10,7 @@ module Settings
   , module Settings.Cluster
   ) where
 
-import           ClassyPrelude.Yesod hiding (Proxy)
+import           ClassyPrelude.Yesod
 import Data.UUID (UUID)
 import qualified Control.Exception           as Exception
 import           Data.Aeson                  (Result (..), fromJSON, withObject
diff --git a/src/Settings/Cluster.hs b/src/Settings/Cluster.hs
index 94bce92e0..25552d4a6 100644
--- a/src/Settings/Cluster.hs
+++ b/src/Settings/Cluster.hs
@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , DataKinds
-           , TypeFamilies
-           , ScopedTypeVariables
-           , TemplateHaskell
-           , OverloadedStrings
-           , FlexibleContexts
-  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Settings.Cluster
diff --git a/src/Settings/StaticFiles.hs b/src/Settings/StaticFiles.hs
index 0cefeaa1d..c8021d3a5 100644
--- a/src/Settings/StaticFiles.hs
+++ b/src/Settings/StaticFiles.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
 module Settings.StaticFiles where
 
 import Settings     (appStaticDir, compileTimeAppSettings)
diff --git a/src/Utils.hs b/src/Utils.hs
index 17795138c..a95c79722 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -1,12 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
-{-# LANGUAGE QuasiQuotes, TemplateHaskell #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- Monad FormResult
 
 module Utils
diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs
index 69d230275..4e6c83a1c 100644
--- a/src/Utils/DB.hs
+++ b/src/Utils/DB.hs
@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies, FlexibleContexts, ConstraintKinds #-}
-{-# LANGUAGE QuasiQuotes #-}
-
 module Utils.DB where
 
 import ClassyPrelude.Yesod
diff --git a/src/Utils/DateTime.hs b/src/Utils/DateTime.hs
index 2d58788e3..0b5855566 100644
--- a/src/Utils/DateTime.hs
+++ b/src/Utils/DateTime.hs
@@ -1,15 +1,4 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , QuasiQuotes
-           , StandaloneDeriving
-           , DerivingStrategies
-           , DeriveLift
-           , DeriveDataTypeable
-           , DeriveGeneric
-           , GeneralizedNewtypeDeriving
-           , OverloadedStrings
-           , FlexibleInstances
-  #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Utils.DateTime
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 6859eccea..e17678d06 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -1,18 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , TemplateHaskell
-           , ViewPatterns
-           , OverloadedStrings
-           , QuasiQuotes
-           , TemplateHaskell
-           , MultiParamTypeClasses
-           , TypeFamilies
-           , FlexibleContexts
-           , NamedFieldPuns
-           , ScopedTypeVariables
-           , MultiWayIf
-           , RecordWildCards
-#-}
-
 module Utils.Form where
 
 import ClassyPrelude.Yesod hiding (addMessage)
diff --git a/src/Utils/Lang.hs b/src/Utils/Lang.hs
index 6556cede3..ab62d1baf 100644
--- a/src/Utils/Lang.hs
+++ b/src/Utils/Lang.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
 module Utils.Lang where
 
 import ClassyPrelude.Yesod
diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs
index 55f8d406c..d99d3c4a4 100644
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@@ -1,8 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FunctionalDependencies #-}
 module Utils.Lens ( module Utils.Lens ) where
 
 import Import.NoFoundation
diff --git a/src/Utils/Message.hs b/src/Utils/Message.hs
index d0d61e68a..62e337328 100644
--- a/src/Utils/Message.hs
+++ b/src/Utils/Message.hs
@@ -1,10 +1,3 @@
-{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE DeriveLift #-}
-
-
 module Utils.Message
   ( MessageClass(..)
   , addMessage, addMessageI, addMessageIHamlet, addMessageFile
diff --git a/src/Utils/PathPiece.hs b/src/Utils/PathPiece.hs
index 0aa1a364c..f093ce22f 100644
--- a/src/Utils/PathPiece.hs
+++ b/src/Utils/PathPiece.hs
@@ -1,6 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-  #-}
-
 module Utils.PathPiece
   ( finiteFromPathPiece
   , nullaryToPathPiece
diff --git a/src/Utils/Sql.hs b/src/Utils/Sql.hs
index ef2d2c6ea..f56ac38a2 100644
--- a/src/Utils/Sql.hs
+++ b/src/Utils/Sql.hs
@@ -1,11 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NumDecimals #-}
-{-# LANGUAGE FlexibleContexts #-}
-
 module Utils.Sql
   ( setSerializable
   ) where
diff --git a/src/Utils/SystemMessage.hs b/src/Utils/SystemMessage.hs
index 80a7b7e00..e5cff0496 100644
--- a/src/Utils/SystemMessage.hs
+++ b/src/Utils/SystemMessage.hs
@@ -1,7 +1,3 @@
-{-# LANGUAGE NoImplicitPrelude
-           , RecordWildCards
-  #-}
-
 module Utils.SystemMessage where
 
 import Import.NoFoundation
diff --git a/src/Utils/TH.hs b/src/Utils/TH.hs
index c2d050bde..501cfee12 100644
--- a/src/Utils/TH.hs
+++ b/src/Utils/TH.hs
@@ -1,9 +1,3 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
 module Utils.TH where
 -- Common Utility Functions that require TemplateHaskell
 
@@ -142,3 +136,16 @@ embedRenderMessageVariant f newT mangle = do
       ]
     ]
   
+
+dispatchTH :: Name -- ^ Datatype to pattern match
+           -> ExpQ
+-- ^ Produces a lambda-case-expression matching all constructors of the named datatype and calling a function (named after the constructor prefixed with @dispatch@) on the fields of each constructor
+dispatchTH dType = do
+  DatatypeInfo{..} <- reifyDatatype dType
+  let
+    matches = map mkMatch datatypeCons
+    mkMatch ConstructorInfo{..} = do
+      pats <- forM constructorFields $ \_ -> newName "x"
+      let fName = mkName $ "dispatch" <> nameBase constructorName
+      match (conP constructorName $ map varP pats) (normalB $ foldl (\e pat -> e `appE` varE pat) (varE fName) pats) []
+  lamCaseE matches