From b0732ae6c6665ea60f0c61302ba3c55ccc7074e1 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Tue, 20 Nov 2018 15:48:29 +0300
Subject: [PATCH 1/9] Mino

---
 src/Handler/Corrections.hs      |  5 +++-
 src/Handler/Utils/Submission.hs | 45 +++++++++++++++++----------------
 src/Jobs/Queue.hs               |  5 ++--
 3 files changed, 30 insertions(+), 25 deletions(-)

diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 73f0df665..48d9c5e48 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -550,8 +550,11 @@ postCorrectionR tid ssh csh shn cid = do
           uid <- requireAuthId
 
           void . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| extractRatingsMsg .| sinkSubmission uid (Right sub) True
+          {-case res of
+            (Left _) -> addMessageI Success MsgRatingFilesUpdated
+            (Right RatingNotExpected) -> addMessageI Error MsgRatingNotExpected
+            (Right other) -> throw other-}
 
-          addMessageI Success MsgRatingFilesUpdated
           redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
 
       mr <- getMessageRender
diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs
index c1e2648c5..3d405fff8 100644
--- a/src/Handler/Utils/Submission.hs
+++ b/src/Handler/Utils/Submission.hs
@@ -3,7 +3,7 @@ module Handler.Utils.Submission
   , assignSubmissions
   , submissionBlacklist, filterSubmission, extractRatings, extractRatingsMsg
   , submissionFileSource, submissionFileQuery
-  , submissionMultiArchive 
+  , submissionMultiArchive
   , SubmissionSinkException(..)
   , sinkSubmission, sinkMultiSubmission
   , submissionMatchesSheet
@@ -142,9 +142,9 @@ assignSubmissions sid restriction = do
       wholeProps = Map.fromList [ ( sheetCorrectorUser, round $ byProportion * fromInteger lcd ) | Entity _ SheetCorrector{ sheetCorrectorLoad = Load{..}, .. } <- corrsProp ]
       detQueueLength = fromIntegral (Map.size $ Map.filter (\tuts -> all countsToLoad' tuts) subTutor') - sum deficit
       detQueue = concat . List.genericReplicate (detQueueLength `div` sum wholeProps) . concatMap (uncurry $ flip List.genericReplicate) $ Map.toList wholeProps
-    
+
     $logDebugS "assignSubmissions" $ "Deterministic Queue: " <> tshow detQueue
-    
+
     queue <- liftIO . Rand.evalRandIO . execWriterT $ do
       tell $ map Just detQueue
       forever $
@@ -162,11 +162,11 @@ assignSubmissions sid restriction = do
 
       maximumDeficit :: (MonadState (_a, _b, Map UserId Integer) m, MonadIO m) => m (Maybe UserId)
       maximumDeficit = do
-        transposed <- uses _3 invertMap 
+        transposed <- uses _3 invertMap
         traverse (liftIO . Rand.evalRandIO . Rand.uniform . snd) (Map.lookupMax transposed)
 
     subTutor'' <- liftIO . Rand.evalRandIO . Rand.shuffleM $ Map.toList subTutor'
-          
+
     subTutor <- fmap (view _1) . flip execStateT (Map.empty, queue, deficit) . forM_ subTutor'' $ \(smid, tuts) -> do
       let
         restrictTuts
@@ -177,7 +177,7 @@ assignSubmissions sid restriction = do
         Just q' -> do
           $logDebugS "assignSubmissions" $ tshow smid <> " -> " <> tshow q' <> " (byDeficit)"
           assignSubmission False smid q'
-        Nothing 
+        Nothing
           | Set.null tuts -> do
               q <- preuse $ _2 . _head . _Just
               case q of
@@ -194,7 +194,7 @@ assignSubmissions sid restriction = do
     forM_ (Map.toList subTutor) $
         \(smid, tutid) -> update smid [ SubmissionRatingBy       =. Just tutid
                                       , SubmissionRatingAssigned =. Just now  ]
-        
+
     let assignedSubmissions   = Map.keysSet subTutor
         unassigendSubmissions = Map.keysSet subTutor' \\ assignedSubmissions
     return (assignedSubmissions, unassigendSubmissions)
@@ -222,7 +222,7 @@ submissionMultiArchive (Set.toList -> ids) = do
   ratedSubmissions <- runDBRunner dbrunner $ do
     submissions <- selectList [ SubmissionId <-. ids ] []
     forM submissions $ \s@(Entity submissionId _) -> maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s)) =<< getRating submissionId
-  
+
   (<* cleanup) . respondSource "application/zip" . transPipe (runDBRunner dbrunner) $ do
     let
       fileEntitySource' :: (Rating, Entity Submission) -> Source (YesodDB UniWorX) File
@@ -231,7 +231,7 @@ submissionMultiArchive (Set.toList -> ids) = do
 
         let
           directoryName = Text.unpack $ toPathPiece (cID :: CryptoFileNameSubmission)
-              
+
           fileEntitySource = do
             submissionFileSource submissionID =$= Conduit.map entityVal
             yieldM (ratingFile cID rating)
@@ -249,7 +249,7 @@ submissionMultiArchive (Set.toList -> ids) = do
           }
 
         fileEntitySource =$= mapC withinDirectory
-          
+
     mapM_ fileEntitySource' ratedSubmissions =$= produceZip def =$= Conduit.map toFlushBuilder
 
 
@@ -374,7 +374,7 @@ sinkSubmission userId mExists isUpdate = do
               | not (null underlyingFiles) = all (~~ file) [ f | (Entity _ f, Entity _ _sf) <- underlyingFiles ]
               | otherwise                  = False
             undoneDeletion = any submissionFileIsDeletion [ sf | (_, Entity _ sf) <- collidingFiles ]
-  
+
         when anyChanges $ do
           touchSubmission
           when (not $ null collidingFiles) $
@@ -394,14 +394,14 @@ sinkSubmission userId mExists isUpdate = do
         when undoneDeletion $ do
           touchSubmission
           lift $ deleteWhere [ SubmissionFileId <-. [ sfId | (_, Entity sfId sf) <- collidingFiles, submissionFileIsDeletion sf ] ]
-  
+
       Right (submissionId', r'@Rating'{..}) -> do
         $logDebugS "sinkSubmission" $ tshow submissionId'
 
         unless (submissionId' == submissionId) $ do
           cID <- encrypt submissionId'
           throwM $ ForeignRating cID
-        
+
         alreadySeen <- gets $ getAny . sinkSeenRating
         when alreadySeen $ throwM DuplicateRating
         tellSt $ mempty{ sinkSeenRating = Any True }
@@ -410,19 +410,20 @@ sinkSubmission userId mExists isUpdate = do
 
         Submission{..} <- lift $ getJust submissionId
 
-        let anyChanges = or $ 
+        let anyChanges = or $
               [ submissionRatingPoints /= ratingPoints
               , submissionRatingComment /= ratingComment
               ]
         -- 'ratingTime' is ignored for consistency with 'File's:
-        -- 
+        --
         -- 'fileModified' is simply stored and never inspected while
-        -- 'submissionChanged' is always set to @now@.          
+        -- 'submissionChanged' is always set to @now@.
         when anyChanges $ do
 
           Sheet{..} <- lift $ getJust submissionSheet
-          mapM_ throwM $ validateRating sheetType r' 
-                  
+          --TODO: should display errorMessages
+          mapM_ throwM $ validateRating sheetType r'
+
           touchSubmission
           lift $ update submissionId
             [ SubmissionRatingPoints =. ratingPoints
@@ -514,7 +515,7 @@ data SubmissionMultiSinkException
     { _submissionSinkId :: CryptoFileNameSubmission
     , _submissionSinkFedFile :: Maybe FilePath
     , _submissionSinkException :: SubmissionSinkException
-    }                                   
+    }
   deriving (Typeable, Show)
 
 instance Exception SubmissionMultiSinkException
@@ -522,7 +523,7 @@ instance Exception SubmissionMultiSinkException
 sinkMultiSubmission :: UserId
                     -> Bool {-^ Are these corrections -}
                     -> Sink SubmissionContent (YesodJobDB UniWorX) (Set SubmissionId)
-               
+
 -- ^ Expects all supplied 'SubmissionContent' to contain an encrypted 'SubmissionId' and replaces the currently saved files for the respective submissions (either corrected files or original ones, depending on arguments) with the supplied 'SubmissionContent'.
 --
 -- Files that don't occur in the 'SubmissionContent' but are in the database are deleted (or marked as deleted in the case of this being a correction).
@@ -545,7 +546,7 @@ sinkMultiSubmission userId isUpdate = do
         Nothing -> do
           lift $ do
             cID <- encrypt sId
-            $(logDebugS) "sinkMultiSubmission" $ "Doing auth checks for " <> toPathPiece cID 
+            $(logDebugS) "sinkMultiSubmission" $ "Doing auth checks for " <> toPathPiece cID
             Submission{..} <- get404 sId
             Sheet{..} <- get404 submissionSheet
             Course{..} <- get404 sheetCourse
@@ -595,7 +596,7 @@ sinkMultiSubmission userId isUpdate = do
     handleHCError _ e = throwM e
     handleCryptoID :: CryptoIDError -> _ (Maybe a)
     handleCryptoID _ = return Nothing
-    
+
 
 submissionMatchesSheet :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> DB SubmissionId
 submissionMatchesSheet tid ssh csh shn cid = do
diff --git a/src/Jobs/Queue.hs b/src/Jobs/Queue.hs
index 001471544..851b2bf77 100644
--- a/src/Jobs/Queue.hs
+++ b/src/Jobs/Queue.hs
@@ -46,7 +46,7 @@ writeJobCtlBlock cmd = do
     return var
   lift $ writeJobCtl cmd
   let
-    removeResVar = HashMap.update (NonEmpty.nonEmpty . NonEmpty.filter (/= resVar)) cmd 
+    removeResVar = HashMap.update (NonEmpty.nonEmpty . NonEmpty.filter (/= resVar)) cmd
   mExc <- liftIO . atomically $ takeTMVar resVar <* modifyTVar' getResVar removeResVar
   maybe (return ()) throwM mExc
 
@@ -77,7 +77,8 @@ type YesodJobDB site = ReaderT (YesodPersistBackend site) (WriterT (Set QueuedJo
 queueDBJob :: Job -> ReaderT (YesodPersistBackend UniWorX) (WriterT (Set QueuedJobId) (HandlerT UniWorX IO)) ()
 queueDBJob job = mapReaderT lift (queueJobUnsafe job) >>= tell . Set.singleton
 
-runDBJobs :: (MonadHandler m, HandlerSite m ~ UniWorX) => ReaderT (YesodPersistBackend UniWorX) (WriterT (Set QueuedJobId) (HandlerT UniWorX IO)) a -> m a
+runDBJobs :: (MonadHandler m, HandlerSite m ~ UniWorX)
+ => ReaderT (YesodPersistBackend UniWorX) (WriterT (Set QueuedJobId) (HandlerT UniWorX IO)) a -> m a
 runDBJobs act = do
   (ret, jIds) <- liftHandlerT . runDB $ mapReaderT runWriterT act
   forM_ jIds $ writeJobCtl . JobCtlPerform

From 03fa874e05895294398e951febc06f9e0f7005aa Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 27 Nov 2018 15:38:07 +0100
Subject: [PATCH 2/9] Account for jitter in determining whether CronLastExec is
 acceptable

---
 src/Cron.hs | 10 ++++++----
 src/Jobs.hs |  2 +-
 2 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/src/Cron.hs b/src/Cron.hs
index 600eb873c..53a7a01b3 100644
--- a/src/Cron.hs
+++ b/src/Cron.hs
@@ -150,10 +150,11 @@ genMatch p m st (CronMatchUnion aGen bGen) = merge (genMatch p m st aGen) (genMa
 
 nextCronMatch :: TZ -- ^ Timezone of the `Cron`-Entry
               -> Maybe UTCTime -- ^ Time of last execution of the job
+              -> NominalDiffTime -- ^ Scheduling precision
               -> UTCTime -- ^ Current time, used only for `CronCalendar`
               -> Cron
               -> CronNextMatch UTCTime
-nextCronMatch tz mPrev now c@Cron{..} = case notAfter of
+nextCronMatch tz mPrev prec now c@Cron{..} = case notAfter of
   MatchAsap -> MatchNone
   MatchAt ts
     | MatchAt ts' <- nextMatch
@@ -183,7 +184,7 @@ nextCronMatch tz mPrev now c@Cron{..} = case notAfter of
       Just prevT
         -> case cronRepeat of
             CronRepeatOnChange
-              | not $ matchesCron tz Nothing prevT c
+              | not $ matchesCron tz Nothing prec prevT c
                 -> let
                      cutoffTime = addUTCTime cronRateLimit prevT
                    in case execRef now False cronInitial of
@@ -240,13 +241,14 @@ nextCronMatch tz mPrev now c@Cron{..} = case notAfter of
 
 matchesCron :: TZ -- ^ Timezone of the `Cron`-Entry
             -> Maybe UTCTime -- ^ Previous execution of the job
+            -> NominalDiffTime -- ^ Scheduling precision
             -> UTCTime -- ^ "Current" time
             -> Cron
             -> Bool
 -- ^ @matchesCron tz prev prec now c@ determines whether the given `Cron`
 --   specification @c@ should match @now@, under the assumption that the next
 --   check will occur no earlier than @now + prec@.
-matchesCron tz mPrev now cron = case nextCronMatch tz mPrev now cron of
+matchesCron tz mPrev prec now cron = case nextCronMatch tz mPrev prec now cron of
   MatchAsap -> True
   MatchNone -> False
-  MatchAt ts -> ts <= now
+  MatchAt ts -> ts <= addUTCTime prec now
diff --git a/src/Jobs.hs b/src/Jobs.hs
index 50bb56e5d..45a5f74f6 100644
--- a/src/Jobs.hs
+++ b/src/Jobs.hs
@@ -207,7 +207,7 @@ execCrontab = evalStateT go HashMap.empty
               | otherwise
               = Just (jobCtl, t)
               where
-                t = nextCronMatch appTZ (getMax <$> HashMap.lookup jobCtl lastTimes) now cron
+                t = nextCronMatch appTZ (getMax <$> HashMap.lookup jobCtl lastTimes) acc now cron
 
         waitUntil :: (Eq a, MonadResourceBase m, MonadLogger m) => TMVar a -> a -> UTCTime -> m Bool
         waitUntil crontabTV crontab nextTime = runResourceT $ do

From 77d03348e83e8cc1e377b466f315a9f83b9fa1e3 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 27 Nov 2018 16:03:48 +0100
Subject: [PATCH 3/9] Fix tests

---
 src/Foundation.hs | 2 +-
 test/CronSpec.hs  | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index 4960f292b..4289cdaad 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -678,10 +678,10 @@ instance Yesod UniWorX where
         encrypted plaintextJson plaintext = do
           canDecrypt <- (== Authorized) <$> evalAccess AdminErrMsgR True
           shouldEncrypt <- getsYesod $ appEncryptErrors . appSettings
-          errKey <- getsYesod appErrorMsgKey
           if
             | shouldEncrypt
             , not canDecrypt -> do
+                errKey <- getsYesod appErrorMsgKey
                 nonce <- liftIO SecretBox.newNonce
                 let ciphertext = SecretBox.secretbox errKey nonce . Lazy.ByteString.toStrict $ encode plaintextJson
                     encoded = decodeUtf8 . Base64.encode $ Saltine.encode nonce <> ciphertext
diff --git a/test/CronSpec.hs b/test/CronSpec.hs
index ee9abe812..79265811c 100644
--- a/test/CronSpec.hs
+++ b/test/CronSpec.hs
@@ -21,7 +21,7 @@ sampleCron :: Natural -> Cron -> [UTCTime]
 sampleCron n = go n baseTime Nothing
   where
     go 0 _ _ _ = []
-    go (pred -> n') t mPrev cron = case nextCronMatch utcTZ mPrev t cron of
+    go (pred -> n') t mPrev cron = case nextCronMatch utcTZ mPrev 0 t cron of
       MatchAsap -> t : go n' t (Just t) cron
       MatchAt t' -> t' : go n' t' (Just t') cron
       MatchNone -> []

From 431eb45a94b3b5beac101820e5b5a2c8564eaf89 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 27 Nov 2018 19:11:28 +0100
Subject: [PATCH 4/9] Log to file during tests

---
 .gitignore                  |  3 ++-
 config/settings.yml         |  8 +++---
 config/test-settings.yml    | 15 +++++------
 src/Application.hs          | 54 +++++++++++++++++++++++++++----------
 src/Foundation.hs           |  8 +++---
 src/Model/Migration.hs      |  6 ++---
 src/Settings.hs             | 16 +++++++++--
 test/Database.hs            |  2 ++
 test/Handler/ProfileSpec.hs |  4 +--
 test/TestImport.hs          |  3 ++-
 10 files changed, 81 insertions(+), 38 deletions(-)

diff --git a/.gitignore b/.gitignore
index bce03bdeb..b85a1c848 100644
--- a/.gitignore
+++ b/.gitignore
@@ -30,4 +30,5 @@ src/Handler/Course.SnapCustom.hs
 /instance
 .stack-work-*
 .directory
-tags
\ No newline at end of file
+tags
+test.log
\ No newline at end of file
diff --git a/config/settings.yml b/config/settings.yml
index 60c1f2c33..f3243a773 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -29,9 +29,11 @@ notification-expiration: 259201
 session-timeout: 7200
 
 log-settings:
-  log-detailed:      "_env:DETAILED_LOGGING:false"
-  log-all:           "_env:LOG_ALL:false"
-  log-minimum-level: "_env:LOGLEVEL:warn"
+  detailed:      "_env:DETAILED_LOGGING:false"
+  all:           "_env:LOG_ALL:false"
+  minimum-level: "_env:LOGLEVEL:warn"
+  destination:   "_env:LOGDEST:stderr"
+
 
 # Debugging
 auth-dummy-login:  "_env:DUMMY_LOGIN:false"
diff --git a/config/test-settings.yml b/config/test-settings.yml
index c6e5bf360..23f59aed5 100644
--- a/config/test-settings.yml
+++ b/config/test-settings.yml
@@ -1,11 +1,10 @@
 database:
-  # NOTE: By design, this setting prevents the PGDATABASE environment variable
-  # from affecting test runs, so that we don't accidentally affect the
-  # production database during testing. If you're not concerned about that and
-  # would like to have environment variable overrides, you could instead use
-  # something like:
-  #
-  #   database: "_env:PGDATABASE:uniworx_test"
-  database: uniworx_test
+  database: "_env:PGDATABASE_TEST:uniworx_test"
+
+log-settings:
+  detailed:      true
+  all:           true
+  minimum-level: "debug"
+  destination:   "test.log"
 
 auth-dummy-login: true
diff --git a/src/Application.hs b/src/Application.hs
index e1fbfa575..b1f17147b 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -30,8 +30,9 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger),
                                              IPAddrSource (..),
                                              OutputFormat (..), destination,
                                              mkRequestLogger, outputFormat)
-import System.Log.FastLogger                (defaultBufSize, newStderrLoggerSet,
-                                             toLogStr)
+import System.Log.FastLogger                ( defaultBufSize, newStderrLoggerSet, newStdoutLoggerSet, newFileLoggerSet
+                                            , toLogStr, rmLoggerSet
+                                            )
 
 import qualified Data.Map.Strict as Map
 
@@ -61,7 +62,7 @@ import qualified Yesod.Core.Types as Yesod (Logger(..))
 
 import qualified Data.HashMap.Strict as HashMap
 
-import Control.Lens ((&))
+import Control.Lens
 
 import Data.Proxy
 
@@ -100,10 +101,30 @@ makeFoundation appSettings@AppSettings{..} = do
     -- Some basic initializations: HTTP connection manager, logger, and static
     -- subsite.
     appHttpManager <- newManager
-    appLogger <- liftIO $ do
-      tgetter <- newTimeCache "%Y-%m-%d %T %z"
-      loggerSet <- newStderrLoggerSet defaultBufSize
-      return $ Yesod.Logger loggerSet tgetter
+    appLogSettings <- liftIO $ newTVarIO appInitialLogSettings
+
+    let
+      mkLogger LogSettings{..} = do
+        tgetter <- newTimeCache "%Y-%m-%d %T %z"
+        loggerSet <- case logDestination of
+          LogDestStderr -> newStderrLoggerSet defaultBufSize
+          LogDestStdout -> newStdoutLoggerSet defaultBufSize
+          LogDestFile{..} -> newFileLoggerSet defaultBufSize logDestFile
+        return $ Yesod.Logger loggerSet tgetter
+      mkLogger' = liftIO $ do
+        initialSettings <- readTVarIO appLogSettings
+        tVar <- newTVarIO =<< mkLogger initialSettings
+        let updateLogger prevSettings = do
+              newSettings <- atomically $ do
+                newSettings <- readTVar appLogSettings
+                guard $ newSettings /= prevSettings
+                return newSettings
+              oldLogger <- atomically . swapTVar tVar =<< mkLogger newSettings
+              rmLoggerSet $ loggerSet oldLogger
+              updateLogger newSettings
+        (tVar, ) <$> fork (updateLogger initialSettings)
+    appLogger <- over _2 fst <$> allocate mkLogger' (\(tVar, tId) -> killThread tId >> (readTVarIO tVar >>= rmLoggerSet . loggerSet))
+
     appStatic <- liftIO $ bool static staticDevel appMutableStatic appStaticDir
 
     appInstanceID <- liftIO $ maybe UUID.nextRandom (either readInstanceIDFile return) appInitialInstanceID
@@ -111,8 +132,6 @@ makeFoundation appSettings@AppSettings{..} = do
     appJobCtl <- liftIO $ newTVarIO Map.empty
     appCronThread <- liftIO newEmptyTMVarIO
 
-    appLogSettings <- liftIO $ newTVarIO appInitialLogSettings
-
     -- We need a log function to create a connection pool. We need a connection
     -- pool to create our foundation. And we need our foundation to get a
     -- logging function. To get out of this loop, we initially create a
@@ -128,7 +147,9 @@ makeFoundation appSettings@AppSettings{..} = do
           (error "cryptoIDKey forced in tempFoundation")
           (error "sessionKey forced in tempFoundation")
           (error "errorMsgKey forced in tempFoundation")
-        logFunc = messageLoggerSource tempFoundation appLogger
+        logFunc loc src lvl str = do
+          f <- messageLoggerSource tempFoundation <$> readTVarIO (snd appLogger)
+          f loc src lvl str
 
     flip runLoggingT logFunc $ do
       $logDebugS "InstanceID" $ UUID.toText appInstanceID
@@ -228,12 +249,13 @@ makeLogWare app = do
 
   let
     mkLogWare ls@LogSettings{..} = do
+      logger <- readTVarIO . snd $ appLogger app
       logWare <- mkRequestLogger def
         { outputFormat = bool
             (Apache . bool FromSocket FromHeader . appIpFromHeader $ appSettings app)
             (Detailed True)
             logDetailed
-        , destination = Logger . loggerSet $ appLogger app
+        , destination = Logger $ loggerSet logger
         }
       atomically . modifyTVar' logWareMap $ HashMap.insert ls logWare
       return logWare
@@ -255,9 +277,11 @@ warpSettings foundation = defaultSettings
     & setPort (appPort $ appSettings foundation)
     & setHost (appHost $ appSettings foundation)
     & setOnException (\_req e ->
-        when (defaultShouldDisplayException e) $ messageLoggerSource
+        when (defaultShouldDisplayException e) $ do
+          logger <- readTVarIO . snd $ appLogger foundation
+          messageLoggerSource
             foundation
-            (appLogger foundation)
+            logger
             $(qLocation >>= liftLoc)
             "yesod"
             LevelError
@@ -322,7 +346,9 @@ getApplicationRepl = do
     return (getPort wsettings, foundation, app1)
 
 shutdownApp :: MonadIO m => UniWorX -> m ()
-shutdownApp = stopJobCtl
+shutdownApp app = do
+  stopJobCtl app
+  release . fst $ appLogger app
 
 
 ---------------------------------------------
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 4289cdaad..9b899765f 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -104,7 +104,7 @@ data UniWorX = UniWorX
     , appConnPool    :: ConnectionPool -- ^ Database connection pool.
     , appSmtpPool    :: Maybe SMTPPool
     , appHttpManager :: Manager
-    , appLogger      :: Logger
+    , appLogger      :: (ReleaseKey, TVar Logger)
     , appLogSettings :: TVar LogSettings
     , appCryptoIDKey :: CryptoIDKey
     , appInstanceID  :: InstanceId
@@ -757,7 +757,7 @@ instance Yesod UniWorX where
       LogSettings{..} <- readTVarIO $ appLogSettings app
       return $ logAll || level >= logMinimumLevel
 
-    makeLogger = return . appLogger
+    makeLogger = readTVarIO . snd . appLogger
 
 
 siteLayout :: Maybe Html -- ^ Optionally override `pageHeading`
@@ -1694,7 +1694,9 @@ instance HasHttpManager UniWorX where
     getHttpManager = appHttpManager
 
 unsafeHandler :: UniWorX -> Handler a -> IO a
-unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
+unsafeHandler f h = do
+  logger <- makeLogger f
+  Unsafe.fakeHandlerGetLogger (const logger) f h
 
 
 instance YesodMail UniWorX where
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index e38e55bb5..e84be6b9c 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -50,9 +50,9 @@ share [mkPersist sqlSettings, mkMigrate "migrateDBVersioning"]
       deriving Show Eq Ord
   |]
 
-migrateAll :: MonadIO m => ReaderT SqlBackend m ()
+migrateAll :: (MonadLogger m, MonadBaseControl IO m, MonadIO m) => ReaderT SqlBackend m ()
 migrateAll = do
-  runMigration $ do
+  mapM_ ($logInfoS "Migration") <=< runMigrationSilent $ do
     -- Manual migrations to go to InitialVersion below:
     migrateEnableExtension "citext"
 
@@ -69,7 +69,7 @@ migrateAll = do
   -- Map.foldlWithKey traverses migrations in ascending order of AppliedMigrationKey
   Map.foldlWithKey doCustomMigration (return ()) missingMigrations 
   
-  runMigration migrateAll'
+  mapM_ ($logInfoS "Migration") =<< runMigrationSilent migrateAll'
 
 {-
   Confusion about quotes, from the PostgreSQL Manual:
diff --git a/src/Settings.hs b/src/Settings.hs
index b05ae3c5d..9b4e48541 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -114,11 +114,16 @@ data AppSettings = AppSettings
 data LogSettings = LogSettings
   { logAll, logDetailed :: Bool
   , logMinimumLevel :: LogLevel
+  , logDestination :: LogDestination
   } deriving (Show, Read, Generic, Eq, Ord)
 
+data LogDestination = LogDestStderr | LogDestStdout | LogDestFile { logDestFile :: !FilePath }
+  deriving (Show, Read, Generic, Eq, Ord)
+
 deriving instance Generic LogLevel
 instance Hashable LogLevel
 instance Hashable LogSettings
+instance Hashable LogDestination
 
 data UserDefaultConf = UserDefaultConf
   { userDefaultTheme :: Theme
@@ -178,12 +183,19 @@ data SmtpAuthConf = SmtpAuthConf
   } deriving (Show)
 
 deriveJSON defaultOptions
-  { fieldLabelModifier = intercalate "-" . map toLower . splitCamel
+  { constructorTagModifier = camelToPathPiece' 2
+  , fieldLabelModifier = camelToPathPiece' 2
+  , sumEncoding = UntaggedValue
+  , unwrapUnaryRecords = True
+  } ''LogDestination
+
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
   } ''LogSettings
   
 deriveFromJSON defaultOptions ''Ldap.Scope
 deriveFromJSON defaultOptions
-  { fieldLabelModifier = intercalate "-" . map toLower . drop 2 . splitCamel
+  { fieldLabelModifier = camelToPathPiece' 2
   } ''UserDefaultConf
 
 instance FromJSON LdapConf where
diff --git a/test/Database.hs b/test/Database.hs
index 8359210ce..0308a3dfa 100755
--- a/test/Database.hs
+++ b/test/Database.hs
@@ -12,6 +12,7 @@ import Data.Pool (destroyAllResources)
 
 import Database.Persist.Postgresql
 import Control.Monad.Logger
+import Control.Monad.Trans.Resource
 
 import System.Console.GetOpt
 import System.Exit (exitWith, ExitCode(..))
@@ -50,6 +51,7 @@ main = do
       DBTruncate -> db $ do
         foundation <- getYesod
         stopJobCtl foundation
+        release . fst $ appLogger foundation
         liftIO . destroyAllResources $ appConnPool foundation
         truncateDb
       DBMigrate -> db $ return ()
diff --git a/test/Handler/ProfileSpec.hs b/test/Handler/ProfileSpec.hs
index aaf7a0da5..5d34a831d 100644
--- a/test/Handler/ProfileSpec.hs
+++ b/test/Handler/ProfileSpec.hs
@@ -7,7 +7,6 @@ import TestImport
 import qualified Data.CaseInsensitive as CI
 
 import Yesod.Core.Handler (toTextUrl)
-import Yesod.Core.Unsafe (fakeHandlerGetLogger)
 
 spec :: Spec
 spec = withApp $ do
@@ -15,8 +14,7 @@ spec = withApp $ do
     it "asserts no access to my-account for anonymous users" $ do
       get ProfileR
 
-      app <- getTestYesod
-      loginText <- fakeHandlerGetLogger appLogger app (toTextUrl $ AuthR LoginR)
+      loginText <- runHandler . toTextUrl $ AuthR LoginR
 
       assertHeader "Location" $ encodeUtf8 loginText
   
diff --git a/test/TestImport.hs b/test/TestImport.hs
index 1ef954051..207a563fe 100644
--- a/test/TestImport.hs
+++ b/test/TestImport.hs
@@ -44,7 +44,8 @@ runDBWithApp app query = liftIO $ runSqlPersistMPool query (appConnPool app)
 runHandler :: Handler a -> YesodExample UniWorX a
 runHandler handler = do
   app <- getTestYesod
-  fakeHandlerGetLogger appLogger app handler
+  logger <- liftIO . readTVarIO . snd $ appLogger app
+  fakeHandlerGetLogger (const logger) app handler
 
 
 withApp :: YSpec UniWorX -> Spec

From 1085dc1df1159e6bc107887e793e9e0e024db492 Mon Sep 17 00:00:00 2001
From: Felix Hamann <felix.hamann@satellytes.com>
Date: Tue, 27 Nov 2018 22:04:40 +0100
Subject: [PATCH 5/9] page actions more prominent

---
 templates/default-layout.lucius          |  5 +++--
 templates/widgets/pageactionprime.hamlet | 27 ++++++++++++------------
 templates/widgets/pageactionprime.lucius | 17 ++++-----------
 3 files changed, 20 insertions(+), 29 deletions(-)

diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius
index 1cdd12452..8deb58679 100644
--- a/templates/default-layout.lucius
+++ b/templates/default-layout.lucius
@@ -5,8 +5,9 @@
   --color-success: #23d160;
   --color-info: #c4c4c4;
   --color-lightblack: #1A2A36;
-  --color-lightwhite: #FCFFFA;
+  --color-lightwhite: #fcfffa;
   --color-grey: #B1B5C0;
+  --color-grey-light: #f4f5f6;
   --color-font: #34303a;
   --color-fontsec: #5b5861;
 
@@ -515,7 +516,7 @@ section {
     padding: 0 0 12px;
     margin: 0 0 12px;
     border-bottom: 1px solid #d3d3d3;
-    
+
 }
 
 section:last-of-type {
diff --git a/templates/widgets/pageactionprime.hamlet b/templates/widgets/pageactionprime.hamlet
index 13aff9d10..624ec8e51 100644
--- a/templates/widgets/pageactionprime.hamlet
+++ b/templates/widgets/pageactionprime.hamlet
@@ -1,17 +1,16 @@
 $newline never
 $if hasPageActions
   <div .page-nav-prime>
-    <ul .pagenav__list>
-      $forall (MenuItem{menuItemLabel, menuItemType, menuItemModal}, menuIdent, route) <- menuTypes
-        $case menuItemType
-          $of PageActionPrime
-            <li .pagenav__list-item>
-              $if menuItemModal
-                <div .modal.js-modal #modal-#{menuIdent} data-trigger=#{menuIdent} data-closeable data-dynamic>
-              <a .pagenav__link-wrapper href=#{route} ##{menuIdent}>_{SomeMessage menuItemLabel}
-          $of PageActionSecondary
-            <li .pagenav__list-item>
-              $if menuItemModal
-                <div .modal.js-modal #modal-#{menuIdent} data-trigger=#{menuIdent} data-closeable data-dynamic>
-              <a .pagenav__link-wrapper href=#{route} ##{menuIdent}>_{SomeMessage menuItemLabel}
-          $of _
+    $forall (MenuItem{menuItemLabel, menuItemType, menuItemModal}, menuIdent, route) <- menuTypes
+      $case menuItemType
+        $of PageActionPrime
+          <div .pagenav__list-item>
+            $if menuItemModal
+              <div .modal.js-modal #modal-#{menuIdent} data-trigger=#{menuIdent} data-closeable data-dynamic>
+            <a .pagenav__link-wrapper href=#{route} ##{menuIdent}>_{SomeMessage menuItemLabel}
+        $of PageActionSecondary
+          <div .pagenav__list-item>
+            $if menuItemModal
+              <div .modal.js-modal #modal-#{menuIdent} data-trigger=#{menuIdent} data-closeable data-dynamic>
+            <a .pagenav__link-wrapper href=#{route} ##{menuIdent}>_{SomeMessage menuItemLabel}
+        $of _
diff --git a/templates/widgets/pageactionprime.lucius b/templates/widgets/pageactionprime.lucius
index 5dba2f4c4..9cd08c1db 100644
--- a/templates/widgets/pageactionprime.lucius
+++ b/templates/widgets/pageactionprime.lucius
@@ -1,19 +1,10 @@
 .page-nav-prime {
-  margin: 4px 0 13px;
-  border-left: 2px solid #c3c3c3;
-  padding-left: 10px;
-}
-
-.pagenav__list {
-  display: block;
-  margin-left: 0;
+  margin: 10px 0 20px;
+  background-color: var(--color-grey-light);
 }
 
 .pagenav__list-item {
   display: inline-block;
-
-  &:not(:last-child) {
-    margin-right: 7px;
-    padding-right: 7px;
-  }
+  padding: 15px;
+  box-shadow: 0 0 2px 0 rgba(0, 0, 0, 0.1);
 }

From 3ad8505489d59032cc01d8ecb5b19a24d713455d Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 29 Nov 2018 11:01:49 +0100
Subject: [PATCH 6/9] Generalize encrypted error messages to encoded
 SecretBoxes

---
 messages/uniworx/de.msg               |  11 +--
 package.yaml                          |   1 +
 src/Application.hs                    |   8 +-
 src/Foundation.hs                     |  42 +++++------
 src/Handler/Admin.hs                  |  29 +-------
 src/Handler/Utils.hs                  |   1 -
 src/Handler/Utils/Table/Pagination.hs |  15 ++--
 src/Model/Migration.hs                |   6 ++
 src/Settings/Cluster.hs               |   8 +-
 src/Utils.hs                          | 103 +++++++++++++++++++++++++-
 stack.yaml                            |   2 +
 test/UtilsSpec.hs                     |  39 ++++++++++
 12 files changed, 195 insertions(+), 70 deletions(-)
 create mode 100644 test/UtilsSpec.hs

diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg
index 86c1d0cd5..44209ffb9 100644
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@@ -491,11 +491,12 @@ ErrorResponseBadMethod requestMethodText@Text: Ihr Browser kann auf mehrere vers
 
 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}
+EncodedSecretBoxCiphertextTooShort: Verschlüsselte Daten zu kurz um valide zu sein
+EncodedSecretBoxInvalidBase64 base64Err@String: Verschlüsselte Daten nicht korrekt base64url-kodiert: #{base64Err}
+EncodedSecretBoxInvalidPadding: Verschlüsselte Daten sind nicht korrekt padded
+EncodedSecretBoxCouldNotDecodeNonce: Konnte secretbox-nonce nicht dekodieren
+EncodedSecretBoxCouldNotOpenSecretBox: Konnte libsodium-secretbox nicht öffnen (Verschlüsselte Daten sind nicht authentisch)
+EncodedSecretBoxCouldNotDecodePlaintext aesonErr@String: Konnte Klartext nicht JSON-dekodieren: #{aesonErr}
 ErrMsgHeading: Fehlermeldung entschlüsseln
 ErrorCryptoIdMismatch: Verschlüsselte Id der Abgabe passte nicht zu anderen Daten
 
diff --git a/package.yaml b/package.yaml
index 0853fdd38..4e09e10e4 100644
--- a/package.yaml
+++ b/package.yaml
@@ -110,6 +110,7 @@ dependencies:
   - monad-memo
   - xss-sanitize
   - text-metrics
+  - pkcs7
 
 other-extensions:
   - GeneralizedNewtypeDeriving
diff --git a/src/Application.hs b/src/Application.hs
index b1f17147b..90792b4f5 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -137,7 +137,7 @@ 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 appCryptoIDKey appSessionKey appErrorMsgKey = UniWorX {..}
+    let mkFoundation appConnPool appSmtpPool appCryptoIDKey appSessionKey appSecretBoxKey = 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
@@ -146,7 +146,7 @@ makeFoundation appSettings@AppSettings{..} = do
           (error "smtpPool forced in tempFoundation")
           (error "cryptoIDKey forced in tempFoundation")
           (error "sessionKey forced in tempFoundation")
-          (error "errorMsgKey forced in tempFoundation")
+          (error "secretBoxKey forced in tempFoundation")
         logFunc loc src lvl str = do
           f <- messageLoggerSource tempFoundation <$> readTVarIO (snd appLogger)
           f loc src lvl str
@@ -166,9 +166,9 @@ makeFoundation appSettings@AppSettings{..} = do
       migrateAll `runSqlPool` sqlPool
       appCryptoIDKey <- clusterSetting (Proxy :: Proxy 'ClusterCryptoIDKey) `runSqlPool` sqlPool
       appSessionKey <- clusterSetting (Proxy :: Proxy 'ClusterClientSessionKey) `runSqlPool` sqlPool
-      appErrorMsgKey <- clusterSetting (Proxy :: Proxy 'ClusterErrorMessageKey) `runSqlPool` sqlPool
+      appSecretBoxKey <- clusterSetting (Proxy :: Proxy 'ClusterSecretBoxKey) `runSqlPool` sqlPool
 
-      let foundation = mkFoundation sqlPool smtpPool appCryptoIDKey appSessionKey appErrorMsgKey
+      let foundation = mkFoundation sqlPool smtpPool appCryptoIDKey appSessionKey appSecretBoxKey
 
       handleJobs foundation
 
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 9b899765f..ea504444d 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -66,8 +66,6 @@ import Utils.Lens
 import Utils.Form
 import Utils.SystemMessage
 
-import Data.Aeson hiding (Error, Success)
-
 import Text.Shakespeare.Text (st)
 
 import Yesod.Form.I18n.German
@@ -76,7 +74,6 @@ 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
 
 
 instance DisplayAble b => DisplayAble (E.CryptoID a b) where
@@ -99,19 +96,19 @@ instance DisplayAble SchoolId where
 -- starts running, such as database connections. Every handler will have
 -- access to the data present here.
 data UniWorX = UniWorX
-    { appSettings    :: AppSettings
-    , appStatic      :: Static -- ^ Settings for static file serving.
-    , appConnPool    :: ConnectionPool -- ^ Database connection pool.
-    , appSmtpPool    :: Maybe SMTPPool
-    , appHttpManager :: Manager
-    , appLogger      :: (ReleaseKey, TVar Logger)
-    , appLogSettings :: TVar LogSettings
-    , appCryptoIDKey :: CryptoIDKey
-    , appInstanceID  :: InstanceId
-    , appJobCtl      :: TVar (Map ThreadId (TMChan JobCtl))
-    , appCronThread  :: TMVar (ReleaseKey, ThreadId)
-    , appErrorMsgKey :: SecretBox.Key
-    , appSessionKey  :: ClientSession.Key
+    { appSettings     :: AppSettings
+    , appStatic       :: Static -- ^ Settings for static file serving.
+    , appConnPool     :: ConnectionPool -- ^ Database connection pool.
+    , appSmtpPool     :: Maybe SMTPPool
+    , appHttpManager  :: Manager
+    , appLogger       :: (ReleaseKey, TVar Logger)
+    , appLogSettings  :: TVar LogSettings
+    , appCryptoIDKey  :: CryptoIDKey
+    , appInstanceID   :: InstanceId
+    , appJobCtl       :: TVar (Map ThreadId (TMChan JobCtl))
+    , appCronThread   :: TMVar (ReleaseKey, ThreadId)
+    , appSessionKey   :: ClientSession.Key
+    , appSecretBoxKey :: SecretBox.Key
     }
 
 type SMTPPool = Pool SMTPConnection
@@ -201,6 +198,7 @@ embedRenderMessage ''UniWorX ''RatingException id
 embedRenderMessage ''UniWorX ''SheetGrading ("SheetGrading" <>)
 embedRenderMessage ''UniWorX ''AuthTag $ ("AuthTag" <>) . concat . drop 1 . splitCamel
 embedRenderMessage ''UniWorX ''SheetSubmissionMode ("Sheet" <>)
+embedRenderMessage ''UniWorX ''EncodedSecretBoxException id
 
 newtype SheetTypeHeader = SheetTypeHeader SheetType
 embedRenderMessageVariant ''UniWorX ''SheetTypeHeader ("SheetType" <>)
@@ -681,15 +679,12 @@ instance Yesod UniWorX where
           if
             | shouldEncrypt
             , not canDecrypt -> do
-                errKey <- getsYesod appErrorMsgKey
-                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
+                ciphertext <- encodedSecretBox SecretBoxPretty plaintextJson
+
                 [whamlet|
                   <p>_{MsgErrorResponseEncrypted}
                   <pre .errMsg>
-                    #{formatted}
+                    #{ciphertext}
                 |]
             | otherwise -> plaintext
 
@@ -1722,6 +1717,9 @@ instance (MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX) => MonadCrypto
   type MonadCryptoKey m = CryptoIDKey
   cryptoIDKey f = getsYesod appCryptoIDKey >>= f
 
+instance {-# OVERLAPPING #-} (Monad m, MonadHandler m, HandlerSite m ~ UniWorX) => MonadSecretBox m where
+  secretBoxKey = getsYesod appSecretBoxKey
+
 -- Note: Some functionality previously present in the scaffolding has been
 -- moved to documentation in the Wiki. Following are some hopefully helpful
 -- links:
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index da8a8aed8..feea45783 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -4,16 +4,7 @@ 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 Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder)
 
 import Control.Monad.Trans.Except
 
@@ -110,31 +101,17 @@ getAdminUserR uuid = do
 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
+  plaintext <- formResultMaybe ctResult $ exceptT (\err -> Nothing <$ addMessageI Error err) (return . Just) . (encodedSecretBoxOpen :: Text -> ExceptT EncodedSecretBoxException Handler Value)
 
   defaultLayout
     [whamlet|
       $maybe t <- plaintext
         <pre style="white-space:pre-wrap; font-family:monospace">
-          #{t}
+          #{encodePrettyToTextBuilder t}
 
       <form action=@{AdminErrMsgR} method=post enctype=#{ctEncoding}>
         ^{ctView}
diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs
index 67beeabd1..7ccf0a731 100644
--- a/src/Handler/Utils.hs
+++ b/src/Handler/Utils.hs
@@ -69,4 +69,3 @@ warnTermDays tid times = do
   forM_ warnholidays  $ warnI MsgDayIsAHoliday
   forM_ outoflecture  $ warnI MsgDayIsOutOfLecture
   forM_ outoftermdays $ warnI MsgDayIsOutOfTerm
-
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index 82f177cde..df84f44fc 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -240,7 +240,9 @@ class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *)
   dbCell :: Iso' (DBCell m x) ([(Text, Text)], WriterT x m Widget)
     
   -- dbWidget :: Proxy m -> Proxy x -> Iso' (DBResult m x) (Widget, DBResult' m x)
+  -- | Format @DBTable@ when sort-circuiting
   dbWidget   :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> DBResult m x -> m' Widget
+  -- | Format @DBTable@ when not short-circuiting
   dbHandler  :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> (Widget -> Widget) -> DBResult m x -> m' (DBResult m x)
   runDBTable :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => m (x, Widget) -> ReaderT SqlBackend m' (DBResult m x)
 
@@ -368,16 +370,17 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = (toPathPiece -> dbtIdent), d
       FormFailure errs'      -> first (map SomeMessage errs' <>) $ runPSValidator dbtable Nothing
       _                      -> runPSValidator dbtable Nothing
     psSorting' = map (first (dbtSorting !)) psSorting
-    sqlQuery' = E.from $ \t -> dbtSQLQuery t
-      <* E.orderBy (map (sqlSortDirection t) psSorting')
-      <* E.limit psLimit
-      <* E.offset (psPage * psLimit)
-      <* Map.foldrWithKey (\key args expr -> E.where_ (filterColumn (dbtFilter ! key) args t) >> expr) (return ()) psFilter
 
   mapM_ (addMessageI Warning) errs
 
   runDB $ do
-    rows' <- E.select $ (,) <$> pure (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64)) <*> sqlQuery'
+    rows' <- E.select . E.from $ \t -> do
+      res <- dbtSQLQuery t
+      E.orderBy (map (sqlSortDirection t) psSorting')
+      E.limit psLimit
+      E.offset (psPage * psLimit)
+      Map.foldrWithKey (\key args expr -> E.where_ (filterColumn (dbtFilter ! key) args t) >> expr) (return ()) psFilter
+      return (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64), res)
 
     let mapMaybeM f = fmap catMaybes . mapM (runMaybeT . f)
   
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index e84be6b9c..1aa9fe36a 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -193,6 +193,12 @@ customMigrations = Map.fromListWith (>>)
         sheets <- [sqlQQ| SELECT "id", "type" FROM "sheet"; |]
         forM_ sheets $ \(sid, Single lsty) -> update sid [SheetType =. Legacy.sheetType lsty]                
     )
+  , ( AppliedMigrationKey [migrationVersion|6.0.0|] [version|7.0.0|]
+    , whenM (tableExists "cluster_config") $
+        [executeQQ|
+           UPDATE "cluster_config" SET "setting" = 'secret-box-key' WHERE "setting" = 'error-message-key';
+        |]
+    )
   ]
 
 
diff --git a/src/Settings/Cluster.hs b/src/Settings/Cluster.hs
index 65219f347..a6fb11799 100644
--- a/src/Settings/Cluster.hs
+++ b/src/Settings/Cluster.hs
@@ -36,7 +36,7 @@ import qualified Data.ByteString.Base64.URL as Base64
 data ClusterSettingsKey
   = ClusterCryptoIDKey
   | ClusterClientSessionKey
-  | ClusterErrorMessageKey
+  | ClusterSecretBoxKey
   deriving (Eq, Ord, Enum, Bounded, Show, Read)
 
 instance Universe ClusterSettingsKey
@@ -108,10 +108,10 @@ instance FromJSON ClientSession.Key where
     either fail return $ Serialize.decode bytes
 
 
-instance ClusterSetting 'ClusterErrorMessageKey where
-  type ClusterSettingValue 'ClusterErrorMessageKey = SecretBox.Key
+instance ClusterSetting 'ClusterSecretBoxKey where
+  type ClusterSettingValue 'ClusterSecretBoxKey = SecretBox.Key
   initClusterSetting _ = liftIO SecretBox.newKey
-  knownClusterSetting _ = ClusterErrorMessageKey
+  knownClusterSetting _ = ClusterSecretBoxKey
 
 instance ToJSON SecretBox.Key where
   toJSON = Aeson.String . decodeUtf8 . Base64.encode . Saltine.encode
diff --git a/src/Utils.hs b/src/Utils.hs
index a451eb70b..e7776ec5b 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -14,7 +14,9 @@ import Data.Monoid (Sum(..))
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
 
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text as Text
 
 import Utils.DB as Utils
 import Utils.TH as Utils
@@ -27,7 +29,7 @@ import Control.Lens as Utils (none)
 
 import Text.Blaze (Markup, ToMarkup)
 
-import Data.Char (isDigit)
+import Data.Char (isDigit, isSpace)
 import Data.Text (dropWhileEnd, takeWhileEnd, justifyRight)
 import Numeric (showFFloat)
 
@@ -39,8 +41,9 @@ import qualified Data.Map as Map
 -- import qualified Data.List as List
 
 import Control.Monad.Trans.Except (ExceptT(..), throwE, runExceptT)
+import Control.Monad.Except (MonadError(..))
 import Control.Monad.Trans.Maybe (MaybeT(..))
-import Control.Monad.Catch
+import Control.Monad.Catch hiding (throwM)
 
 
 import qualified Database.Esqueleto as E (Value, unValue)
@@ -54,6 +57,12 @@ import qualified Data.Aeson as Aeson
 
 import Data.Universe
 
+import qualified Crypto.Saltine.Internal.ByteSizes as Saltine
+import qualified Data.ByteString.Base64.URL as Base64
+import qualified Crypto.Saltine.Core.SecretBox as SecretBox
+import qualified Crypto.Saltine.Class as Saltine
+import qualified Crypto.Data.PKCS7 as PKCS7
+
 
 
 -----------
@@ -391,6 +400,10 @@ exceptT f g = either f g <=< runExceptT
 catchIfMExceptT :: (MonadCatch m, Exception e) => (e -> m e') -> (e -> Bool) -> m a -> ExceptT e' m a
 catchIfMExceptT err p act = catchIf p (lift act) (throwE <=< lift . err)
 
+throwExceptT :: ( Exception e, MonadThrow m )
+             => ExceptT e m a -> m a
+throwExceptT = exceptT throwM return
+
 
 
 ------------
@@ -512,3 +525,89 @@ lookupCustomHeader ident = (>>= fromPathPiece . decodeUtf8) <$> lookupHeader (CI
 
 hasCustomHeader :: MonadHandler m => CustomHeader -> m Bool
 hasCustomHeader ident = isJust <$> lookupHeader (CI.mk . encodeUtf8 $ toPathPiece ident)
+
+------------------
+-- Cryptography --
+------------------
+
+data SecretBoxEncoding = SecretBoxShort | SecretBoxPretty
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
+
+instance Universe SecretBoxEncoding
+instance Finite SecretBoxEncoding
+instance Default SecretBoxEncoding where
+  def = SecretBoxShort
+
+encodedSecretBoxBlocksize :: Word8
+-- | `encodedSecretBox'` tries to hide plaintext length by ensuring the message
+--   length (before addition of HMAC and nonce) is always a multiple of
+--   `encodedSecretBlocksize`.
+--   Bigger blocksizes hide exact message length better but lead to longer messages
+encodedSecretBoxBlocksize = maxBound
+
+
+encodedSecretBox' :: ( ToJSON a, MonadIO m )
+                  => SecretBox.Key
+                  -> SecretBoxEncoding
+                  -> a -> m Text
+encodedSecretBox' sKey pretty val = liftIO $ do
+  nonce <- SecretBox.newNonce
+  let
+    encrypt = SecretBox.secretbox sKey nonce
+    base64 = decodeUtf8 . Base64.encode
+    pad = PKCS7.padBytesN (fromIntegral encodedSecretBoxBlocksize)
+    attachNonce = mappend $ Saltine.encode nonce
+    chunk
+      | SecretBoxPretty <- pretty = Text.intercalate "\n" . Text.chunksOf 76
+      | otherwise                 = id
+
+  return . chunk . base64 . attachNonce . encrypt . pad . toStrict $ Aeson.encode val
+
+data EncodedSecretBoxException
+  = EncodedSecretBoxInvalidBase64 !String
+  | EncodedSecretBoxInvalidPadding
+  | EncodedSecretBoxCiphertextTooShort
+  | EncodedSecretBoxCouldNotDecodeNonce
+  | EncodedSecretBoxCouldNotOpenSecretBox
+  | EncodedSecretBoxCouldNotDecodePlaintext !String
+  deriving (Eq, Ord, Show, Read, Generic, Typeable)
+instance Exception EncodedSecretBoxException
+
+encodedSecretBoxOpen' :: (FromJSON a, MonadError EncodedSecretBoxException m)
+                      => SecretBox.Key
+                      -> Text -> m a
+encodedSecretBoxOpen' sKey chunked = do
+  let unchunked = Text.filter (not . isSpace) chunked
+  decoded <- either (throwError . EncodedSecretBoxInvalidBase64) return . Base64.decode $ encodeUtf8 unchunked
+
+  unless (BS.length decoded >= Saltine.secretBoxNonce + Saltine.secretBoxMac) $
+    throwError EncodedSecretBoxCiphertextTooShort
+  let (nonceBS, encrypted) = BS.splitAt Saltine.secretBoxNonce decoded
+  nonce <- maybe (throwError EncodedSecretBoxCouldNotDecodeNonce) return $ Saltine.decode nonceBS
+  padded <- maybe (throwError EncodedSecretBoxCouldNotOpenSecretBox) return $ SecretBox.secretboxOpen sKey nonce encrypted
+
+  unpadded <- maybe (throwError EncodedSecretBoxInvalidPadding) return $ PKCS7.unpadBytesN (fromIntegral encodedSecretBoxBlocksize) padded
+
+  either (throwError . EncodedSecretBoxCouldNotDecodePlaintext) return $ Aeson.eitherDecodeStrict' unpadded
+
+class Monad m => MonadSecretBox m where
+  secretBoxKey :: m SecretBox.Key
+
+instance MonadSecretBox ((->) SecretBox.Key) where
+  secretBoxKey = id
+
+instance Monad m => MonadSecretBox (ReaderT SecretBox.Key m) where
+  secretBoxKey = ask
+
+encodedSecretBox :: ( ToJSON a, MonadSecretBox m, MonadIO m )
+                 => SecretBoxEncoding
+                 -> a -> m Text
+encodedSecretBox pretty val = do
+  sKey <- secretBoxKey
+  encodedSecretBox' sKey pretty val
+
+encodedSecretBoxOpen :: ( FromJSON a, MonadError EncodedSecretBoxException m, MonadSecretBox m )
+                     => Text -> m a
+encodedSecretBoxOpen ciphertext = do
+  sKey <- secretBoxKey
+  encodedSecretBoxOpen' sKey ciphertext
diff --git a/stack.yaml b/stack.yaml
index 1e74d2310..083c073db 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -40,4 +40,6 @@ extra-deps:
 
   - hlint-test-0.1.0.0
 
+  - pkcs7-1.0.0.1
+
 resolver: lts-10.5
diff --git a/test/UtilsSpec.hs b/test/UtilsSpec.hs
new file mode 100644
index 000000000..dd50cf61e
--- /dev/null
+++ b/test/UtilsSpec.hs
@@ -0,0 +1,39 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module UtilsSpec where
+
+import TestImport
+import Utils
+
+import qualified Crypto.Saltine.Core.SecretBox as SecretBox
+import Data.Aeson
+
+instance Arbitrary Value where
+  arbitrary = sized $ \size -> if
+    | size <= 0 -> oneof [pure Null, bool', number, string]
+    | otherwise -> resize (size `div` 2) $ oneof [pure Null, bool', number, string, array, object']
+    where
+      bool' = Bool <$> arbitrary
+      number = Number <$> arbitrary
+      string = String <$> arbitrary
+      array = Array <$> arbitrary
+      object' = Object <$> arbitrary
+  shrink = genericShrink
+
+instance Arbitrary SecretBoxEncoding where
+  arbitrary = arbitraryBoundedEnum
+
+spec :: Spec
+spec = do
+  describe "encodedSecretBox" $ do
+    it "has comptabile encryption/decryption" . property $
+      \val pretty -> ioProperty $ do
+        sKey <- SecretBox.newKey
+        ciphertext <- encodedSecretBox' sKey pretty (val :: Value)
+        plaintext <- throwExceptT $ encodedSecretBoxOpen' sKey ciphertext
+        return $ plaintext == val
+    it "produces pretty ciphertext" . property $
+      \val -> ioProperty $ do
+        sKey <- SecretBox.newKey
+        ciphertext <- encodedSecretBox' sKey SecretBoxPretty (val :: Value)
+        return . all ((<= 76) . length) $ lines ciphertext

From 997403d6be5ad3250055958cd7a661aa13104e5a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 29 Nov 2018 12:30:42 +0100
Subject: [PATCH 7/9] Send pagination data in dbTable-Forms

---
 src/Data/CaseInsensitive/Instances.hs |  10 ++
 src/Handler/Corrections.hs            |   6 +-
 src/Handler/Course.hs                 |  14 +--
 src/Handler/Home.hs                   |   4 +-
 src/Handler/Profile.hs                |  38 +++---
 src/Handler/Sheet.hs                  |   4 +-
 src/Handler/Submission.hs             |   2 +-
 src/Handler/SystemMessage.hs          |   2 +-
 src/Handler/Term.hs                   |   2 +-
 src/Handler/Users.hs                  |   2 +-
 src/Handler/Utils/Table/Pagination.hs | 170 ++++++++++++++++----------
 11 files changed, 154 insertions(+), 100 deletions(-)

diff --git a/src/Data/CaseInsensitive/Instances.hs b/src/Data/CaseInsensitive/Instances.hs
index d7db622ff..7dc9123e8 100644
--- a/src/Data/CaseInsensitive/Instances.hs
+++ b/src/Data/CaseInsensitive/Instances.hs
@@ -18,6 +18,8 @@ import qualified Data.Text.Encoding as Text
 
 import Language.Haskell.TH.Syntax (Lift(..))
 
+import Data.Aeson (ToJSON(..), FromJSON(..), ToJSONKey(..), FromJSONKey(..), ToJSONKeyFunction(..))
+
 
 instance PersistField (CI Text) where
   toPersistValue ciText = PersistDbSpecific . Text.encodeUtf8 $ CI.original ciText
@@ -41,6 +43,14 @@ instance ToJSON a => ToJSON (CI a) where
 instance (FromJSON a, CI.FoldCase a) => FromJSON (CI a) where
   parseJSON = fmap CI.mk . parseJSON
 
+instance (ToJSONKey a, ToJSON a) => ToJSONKey (CI a) where
+  toJSONKey = case toJSONKey of
+    ToJSONKeyText  toVal toEnc -> ToJSONKeyText (toVal . CI.original) (toEnc . CI.original)
+    ToJSONKeyValue toVal toEnc -> ToJSONKeyValue (toVal . CI.original) (toEnc . CI.original)
+
+instance (FromJSON a, FromJSONKey a, CI.FoldCase a) => FromJSONKey (CI a) where
+  fromJSONKey = CI.mk <$> fromJSONKey
+
 instance ToMessage a => ToMessage (CI a) where
   toMessage = toMessage . CI.original
 
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index e574aca5a..aa16a97b5 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -179,7 +179,7 @@ colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ formCell
 type CorrectionTableExpr = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User))
 
 makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h )
-                     => _ -> Colonnade h CorrectionTableData (DBCell m x) -> PSValidator m x -> _ -> Handler (DBResult m x)
+                     => _ -> Colonnade h CorrectionTableData (DBCell m x) -> PSValidator m x -> _ -> DB (DBResult m x)
 makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
   let dbtSQLQuery :: CorrectionTableExpr -> E.SqlQuery _
       dbtSQLQuery ((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
@@ -278,7 +278,7 @@ data ActionCorrectionsData = CorrDownloadData
 
 correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent
 correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
-  tableForm <- makeCorrectionsTable whereClause displayColumns psValidator return
+  tableForm <- runDB $ makeCorrectionsTable whereClause displayColumns psValidator return
   ((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
     (fmap $ Map.keysSet . Map.filter id . getDBFormResult (const False) -> selectionRes, table) <- tableForm csrf
     (actionRes, action) <- multiAction actions Nothing
@@ -763,7 +763,7 @@ postCorrectionsGradeR = do
         & defaultSorting [("ratingtime", SortDesc)] :: PSValidator (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult (DBFormResult CorrectionTableData SubmissionId (Bool, Maybe Points, Maybe Text)))
       unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment)
 
-  tableForm <- makeCorrectionsTable whereClause displayColumns psValidator $ \i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _) -> do
+  tableForm <- runDB $ makeCorrectionsTable whereClause displayColumns psValidator $ \i@(Entity subId _, Entity _ Sheet{ sheetName = shn }, (_, csh, tid, ssh), _, _) -> do
     cID <- encrypt subId
     void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True
     return i
diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 161ebcd1d..03cbe03c5 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -109,10 +109,10 @@ course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \cou
     E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
       E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
 
-makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h )
-                     => _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> Handler (DBResult m x)
+makeCourseTable :: ( IsDBTable m x, ToSortable h, Functor h, DBResult m x ~ ((), Widget) )
+                     => _ -> Colonnade h CourseTableData (DBCell m x) -> PSValidator m x -> DB Widget
 makeCourseTable whereClause colChoices psValidator = do
-  muid <- maybeAuthId
+  muid <- lift maybeAuthId
   let dbtSQLQuery :: CourseTableExpr -> E.SqlQuery _
       dbtSQLQuery qin@(course `E.InnerJoin` school) = do
         E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
@@ -122,7 +122,7 @@ makeCourseTable whereClause colChoices psValidator = do
         return (course, participants, registered, school)
       dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData
       dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> return (course, participants, registered, school)
-  dbTable psValidator DBTable
+  fmap snd $ dbTable psValidator DBTable
     { dbtSQLQuery
     , dbtColonnade = colChoices
     , dbtProj
@@ -179,7 +179,7 @@ getCourseListR = do -- TODO: Suchfunktion für Kurse und Kürzel!!!
       whereClause = const $ E.val True
       validator = def
         & defaultSorting [("course", SortAsc), ("term", SortDesc)]
-  ((), coursesTable) <- makeCourseTable whereClause colonnade validator
+  coursesTable <- runDB $ makeCourseTable whereClause colonnade validator
   defaultLayout $ do
     setTitleI MsgCourseListTitle
     [whamlet|TODO: Such-/Filterfunktion hier einbauen|] -- TODO
@@ -211,7 +211,7 @@ getTermSchoolCourseListR tid ssh = do
         E.&&. course E.^. CourseSchool E.==. E.val ssh
       validator = def
         & defaultSorting [("cshort", SortAsc)]
-  ((), coursesTable) <- makeCourseTable whereClause colonnade validator
+  coursesTable <- runDB $ makeCourseTable whereClause colonnade validator
   defaultLayout $ do
     setTitleI $ MsgTermSchoolCourseListTitle tid school
     $(widgetFile "courses")
@@ -233,7 +233,7 @@ getTermCourseListR tid = do
       whereClause (course, _, _) = course E.^. CourseTerm E.==. E.val tid
       validator = def
         & defaultSorting [("cshort", SortAsc)]
-  ((), coursesTable) <- makeCourseTable whereClause colonnade validator
+  coursesTable <- runDB $ makeCourseTable whereClause colonnade validator
   defaultLayout $ do
     setTitleI . MsgTermCourseListTitle $ tid
     $(widgetFile "courses")
diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs
index f6f329951..2a87a09e8 100644
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@@ -72,7 +72,7 @@ homeAnonymous = do
         , sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
             cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
         ]
-  ((), courseTable) <- dbTable def DBTable
+  courseTable <- runDB $ dbTableWidget' def DBTable
     { dbtSQLQuery  = tableData
     , dbtColonnade = colonnade
     , dbtProj      = return
@@ -166,7 +166,7 @@ homeUser uid = do
                                         tickmark
         ]
   let validator = def & defaultSorting [("done",SortDesc), ("deadline",SortDesc)]
-  ((), sheetTable) <- dbTable validator DBTable
+  sheetTable <- runDB $ dbTableWidget' validator DBTable
     { dbtSQLQuery  = tableData
     , dbtColonnade = colonnade
     , dbtProj      = \row@DBRow{ dbrOutput = (E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) }
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index 4e1f7abe1..dab2a6b83 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -204,25 +204,25 @@ getProfileDataR = do
                   , studyfeat   E.^. StudyFeaturesType
                   , studyfeat   E.^. StudyFeaturesSemester)
       )
-  -- Tabelle mit eigenen Kursen
-  (hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid
-  -- Tabelle mit allen Teilnehmer: Kurs (link), Datum
-  enrolledCoursesTable <- mkEnrolledCoursesTable uid
-  -- Tabelle mit allen Klausuren und Noten
+  (   (hasRows, ownedCoursesTable)
+    , enrolledCoursesTable
+    , submissionTable
+    , submissionGroupTable
+    , correctionsTable
+    ) <- runDB $ (,,,,)
+           <$> mkOwnedCoursesTable uid -- Tabelle mit eigenen Kursen
+           <*> mkEnrolledCoursesTable uid -- Tabelle mit allen Teilnehmer: Kurs (link), Datum
+           <*> mkSubmissionTable uid -- Tabelle mit allen Abgaben und Abgabe-Gruppen
+           <*> mkSubmissionGroupTable uid -- Tabelle mit allen Abgabegruppen
+           <*> mkCorrectionsTable uid -- Tabelle mit allen Korrektor-Aufgaben
+  
+  
   let examTable = [whamlet| Klausuren werden momentan leider noch nicht unterstützt.|]
-  -- Tabelle mit allen Abgaben und Abgabe-Gruppen
-  submissionTable <- mkSubmissionTable uid
-  -- Tabelle mit allen Abgabegruppen
-  submissionGroupTable <- mkSubmissionGroupTable uid
-  -- Tabelle mit allen Korrektor-Aufgaben
-  correctionsTable <- mkCorrectionsTable uid
-  -- Tabelle mit allen eigenen Tutorials
   let ownTutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
-  -- Tabelle mit allen Tutorials
   let tutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
+
   -- Delete Button
   (btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form BtnDelete)
-  -- TODO: move this into a Message and/or Widget-File
   defaultLayout $ do
     let delWdgt = $(widgetFile "widgets/data-delete")
     $(widgetFile "profileData")
@@ -230,7 +230,7 @@ getProfileDataR = do
 
 
 
-mkOwnedCoursesTable :: UserId -> Handler (Bool, Widget)
+mkOwnedCoursesTable :: UserId -> DB (Bool, Widget)
 -- Table listing all courses that the given user is a lecturer for
 mkOwnedCoursesTable =
   let dbtIdent = "courseOwnership" :: Text
@@ -277,7 +277,7 @@ mkOwnedCoursesTable =
 
 
 
-mkEnrolledCoursesTable :: UserId -> Handler Widget
+mkEnrolledCoursesTable :: UserId -> DB Widget
 -- Table listing all courses that the given user is enrolled in
 mkEnrolledCoursesTable =
   let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
@@ -324,7 +324,7 @@ mkEnrolledCoursesTable =
 
 
 
-mkSubmissionTable :: UserId -> Handler Widget
+mkSubmissionTable :: UserId -> DB Widget
 -- Table listing all submissions for the given user
 mkSubmissionTable =
   let dbtIdent = "submissions" :: Text
@@ -405,7 +405,7 @@ mkSubmissionTable =
 
 
 
-mkSubmissionGroupTable :: UserId -> Handler Widget
+mkSubmissionGroupTable :: UserId -> DB Widget
 -- Table listing all submissions for the given user
 mkSubmissionGroupTable =
   let dbtIdent = "subGroups" :: Text
@@ -470,7 +470,7 @@ mkSubmissionGroupTable =
 
 
 
-mkCorrectionsTable :: UserId -> Handler Widget
+mkCorrectionsTable :: UserId -> DB Widget
 -- Table listing sum of corrections made by the given user per sheet
 mkCorrectionsTable =
   let dbtIdent = "corrections" :: Text
diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs
index 919dc3f53..18a4c473a 100644
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@@ -194,7 +194,7 @@ getSheetListR tid ssh csh = do
       ]
     psValidator = def
       & defaultSorting [("submission-since", SortAsc)]
-  ((), table) <- dbTable psValidator $ DBTable
+  table <- runDB $ dbTableWidget' psValidator DBTable
     { dbtSQLQuery  = sheetData
     , dbtColonnade = sheetCol
     , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) }
@@ -286,7 +286,7 @@ getSShowR tid ssh csh shn = do
         ]
   let psValidator = def
         & defaultSorting [("type", SortAsc), ("path", SortAsc)]
-  (Any hasFiles, fileTable) <- dbTable psValidator $ DBTable
+  (Any hasFiles, fileTable) <- runDB $ dbTable psValidator DBTable
     { dbtSQLQuery = fileData
     , dbtColonnade = colonnadeFiles
     , dbtProj = \DBRow{ dbrOutput = dbrOutput@(E.Value fName, _, E.Value fType) }
diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs
index 280fc3a48..cc645a929 100644
--- a/src/Handler/Submission.hs
+++ b/src/Handler/Submission.hs
@@ -312,7 +312,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
           ]
         , dbtFilter = Map.empty
         }
-  mFileTable <- traverse (fmap snd . dbTable def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
+  mFileTable <- traverse (runDB . dbTableWidget' def) . fmap smid2ArchiveTable $ (,) <$> msmid <*> mcid
 
   defaultLayout $ do
     setTitleI $ MsgSubmissionEditHead tid ssh csh shn
diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs
index 9ab849b41..0bde9b1c8 100644
--- a/src/Handler/SystemMessage.hs
+++ b/src/Handler/SystemMessage.hs
@@ -174,7 +174,7 @@ postMessageListR = do
         , ..
         }
     psValidator = def :: PSValidator (MForm (HandlerT UniWorX IO)) (FormResult (DBFormResult MessageListData CryptoUUIDSystemMessage Bool))
-  tableForm <- dbTable psValidator DBTable
+  tableForm <- runDB $ dbTable psValidator DBTable
     { dbtSQLQuery
     , dbtColonnade
     , dbtProj
diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs
index e5bb7641e..41262bd44 100644
--- a/src/Handler/Term.hs
+++ b/src/Handler/Term.hs
@@ -96,7 +96,7 @@ getTermShowR = do
 --                       #{termToText termName}
 --                 |]
 --           ]
-      ((), table) <- dbTable def DBTable
+      table <- runDB $ dbTableWidget' def DBTable
         { dbtSQLQuery = termData
         , dbtColonnade = colonnadeTerms
         , dbtProj = return . dbrOutput
diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs
index 178957385..ec3924508 100644
--- a/src/Handler/Users.hs
+++ b/src/Handler/Users.hs
@@ -69,7 +69,7 @@ getUsersR = do
     psValidator = def
       & defaultSorting [("name", SortAsc),("display-name", SortAsc)]
   
-  ((), userList) <- dbTable psValidator DBTable
+  ((), userList) <- runDB $ dbTable psValidator DBTable
     { dbtSQLQuery  = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User))
     , dbtColonnade
     , dbtProj      = return
diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs
index df84f44fc..f41a26689 100644
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@@ -25,6 +25,7 @@ module Handler.Utils.Table.Pagination
   ) where
 
 import Handler.Utils.Table.Pagination.Types
+import Utils
 import Utils.Lens.TH
 
 import Import hiding (pi)
@@ -59,6 +60,10 @@ import Data.Ratio ((%))
 
 import Control.Lens
 
+import Data.Aeson (Options(..), defaultOptions, decodeStrict')
+import Data.Aeson.Text
+import Data.Aeson.TH (deriveJSON)
+
 
 data SortColumn t = forall a. PersistField a => SortColumn { getSortColumn :: t -> E.SqlExpr (E.Value a) }
 
@@ -72,6 +77,10 @@ instance PathPiece SortDirection where
     | t == "desc" = Just SortDesc
     | otherwise   = Nothing
 
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece' 1
+  } ''SortDirection
+
 sqlSortDirection :: t -> (SortColumn t, SortDirection) -> E.SqlExpr E.OrderBy
 sqlSortDirection t (SortColumn e, SortAsc ) = E.asc  $ e t
 sqlSortDirection t (SortColumn e, SortDesc) = E.desc $ e t
@@ -119,15 +128,32 @@ instance Default PaginationSettings where
     , psShortcircuit = False
     }
 
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
+  } ''PaginationSettings
+
 data PaginationInput = PaginationInput
   { piSorting      :: Maybe [(CI Text, SortDirection)]
   , piFilter       :: Maybe (Map (CI Text) [Text])
   , piLimit        :: Maybe Int64
   , piPage         :: Maybe Int64
   , piShortcircuit :: Bool
-  }
+  } deriving (Eq, Ord, Show, Read, Generic)
+
+instance Default PaginationInput where
+  def = PaginationInput
+    { piSorting      = Nothing
+    , piFilter       = Nothing
+    , piLimit        = Nothing
+    , piPage         = Nothing
+    , piShortcircuit = False
+    }
 
 makeLenses_ ''PaginationInput
+deriveJSON defaultOptions
+  { fieldLabelModifier = camelToPathPiece' 1
+  , omitNothingFields = True
+  } ''PaginationInput
 
 piIsUnset :: PaginationInput -> Bool
 piIsUnset PaginationInput{..} = and
@@ -241,9 +267,9 @@ class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *)
     
   -- dbWidget :: Proxy m -> Proxy x -> Iso' (DBResult m x) (Widget, DBResult' m x)
   -- | Format @DBTable@ when sort-circuiting
-  dbWidget   :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> DBResult m x -> m' Widget
+  dbWidget   :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> PaginationInput -> DBResult m x -> m' Widget
   -- | Format @DBTable@ when not short-circuiting
-  dbHandler  :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> (Widget -> Widget) -> DBResult m x -> m' (DBResult m x)
+  dbHandler  :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> PaginationInput -> (Widget -> Widget) -> DBResult m x -> m' (DBResult m x)
   runDBTable :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => m (x, Widget) -> ReaderT SqlBackend m' (DBResult m x)
 
 cellAttrs :: IsDBTable m x => Lens' (DBCell m x) [(Text, Text)]
@@ -266,8 +292,8 @@ instance Monoid x => IsDBTable (HandlerT UniWorX IO) x where
     (uncurry WidgetCell)
   
   -- dbWidget Proxy Proxy = iso (, ()) $ view _1
-  dbWidget _ = return . snd
-  dbHandler _ f = return . over _2 f
+  dbWidget _ _ = return . snd
+  dbHandler _ _ f = return . over _2 f
   runDBTable = liftHandlerT
 
 instance Monoid x => Monoid (DBCell (HandlerT UniWorX IO) x) where
@@ -286,8 +312,8 @@ instance Monoid x => IsDBTable (ReaderT SqlBackend (HandlerT UniWorX IO)) x wher
     (\DBCell{..} -> (dbCellAttrs, dbCellContents))
     (uncurry DBCell)
 
-  dbWidget _ = return . snd
-  dbHandler _ f = return . over _2 f
+  dbWidget _ _ = return . snd
+  dbHandler _ _ f = return . over _2 f
   -- runDBTable :: forall m. (MonadHandler m, HandlerSite m ~ UniWorX) => ReaderT SqlBackend (HandlerT UniWorX IO) ((), Widget) -> m (Widget)
   runDBTable = mapReaderT liftHandlerT
 
@@ -314,13 +340,22 @@ instance Monoid a => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enc
   
   -- dbWidget Proxy Proxy = iso ((,) <$> view (_1._2) <*> ((,) <$> view (_1._1) <*> view _2))
   --                            ((,) <$> ((,) <$> view (_2._1) <*> view _1) <*> view (_2._2))
-  dbWidget _ = liftHandlerT . fmap (view $ _1 . _2) . runFormPost
-  dbHandler _ f form = return $ fmap (over _2 f) . form
+  dbWidget dbtable pi = liftHandlerT . fmap (view $ _1 . _2) . runFormPost . addPIHiddenField dbtable pi
+  dbHandler dbtable pi f form = return $ fmap (over _2 f) . addPIHiddenField dbtable pi form
   -- runDBTable :: MForm (HandlerT UniWorX IO) (FormResult a, Widget) -> m ((FormResult a, Widget), Enctype)
   -- runDBTable form = liftHandlerT . runFormPost $ \html -> over _2 (<> toWidget html) <$> form
   -- runDBTable :: MForm (HandlerT UniWorX IO) (FormResult a, Widget) -> m (Html -> MForm (HandleT UniWorX IO) (FormResult a, Widget))
   runDBTable = return . withFragment
 
+addPIHiddenField :: DBTable m x -> PaginationInput -> Form a -> Form a
+addPIHiddenField DBTable{ dbtIdent = (toPathPiece -> dbtIdent) } pi form fragment = form $ fragment <> [shamlet|
+    <input type=hidden name=#{wIdent "pagination"} value=#{encodeToTextBuilder pi}>
+  |]
+  where
+    wIdent n
+      | not $ null dbtIdent = dbtIdent <> "-" <> n
+      | otherwise           = n
+
 instance Monoid a => Monoid (DBCell (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enctype Ints (HandlerT UniWorX IO)) (FormResult a)) where
   mempty = FormCell mempty (return mempty)
   (FormCell a c) `mappend` (FormCell a' c') = FormCell (mappend a a') (mappend <$> c <*> c')
@@ -329,7 +364,7 @@ instance IsDBTable m a => IsString (DBCell m a) where
   fromString = cell . fromString
       
 
-dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> Handler (DBResult m x)
+dbTable :: forall m x. IsDBTable m x => PSValidator m x -> DBTable m x -> DB (DBResult m x)
 dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = (toPathPiece -> dbtIdent), dbtStyle = DBStyle{..}, .. } = do
   let
     sortingOptions = mkOptionList
@@ -350,80 +385,89 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = (toPathPiece -> dbtIdent), d
       , fieldEnctype = UrlEncoded
       }
     
-  psResult <- runInputGetResult $ PaginationInput
+  piResult <- lift . runInputGetResult $ PaginationInput
     <$> iopt (multiSelectField $ return sortingOptions) (wIdent "sorting")
     <*> (assertM' (not . Map.null) . Map.mapMaybe (assertM $ not . null) <$> Map.traverseWithKey (\k _ -> iopt multiTextField . wIdent $ CI.foldedCase k) dbtFilter)
     <*> iopt intField (wIdent "pagesize")
     <*> iopt intField (wIdent "page")
     <*> ireq checkBoxField (wIdent "table-only")
 
-  $(logDebug) . tshow $ (,,,,) <$> (piSorting <$> psResult)
-                               <*> (piFilter <$> psResult)
-                               <*> (piLimit <$> psResult)
-                               <*> (piPage <$> psResult)
-                               <*> (piShortcircuit <$> psResult)
+  piPrevious <- fmap (fmap (set _piShortcircuit False) . maybe FormMissing FormSuccess) . runMaybeT $ MaybeT . return . decodeStrict' . encodeUtf8 =<< MaybeT (lookupPostParam $ wIdent "pagination")
+
+  $(logDebug) . tshow $ (,,,,) <$> (piSorting <$> piResult)
+                               <*> (piFilter <$> piResult)
+                               <*> (piLimit <$> piResult)
+                               <*> (piPage <$> piResult)
+                               <*> (piShortcircuit <$> piResult)
 
   let
-    (errs, PaginationSettings{..}) = case psResult of
+    (errs, PaginationSettings{..}) = case piPrevious <|> piResult of
       FormSuccess pi
-        | not (piIsUnset pi) -> runPSValidator dbtable $ Just pi
-      FormFailure errs'      -> first (map SomeMessage errs' <>) $ runPSValidator dbtable Nothing
-      _                      -> runPSValidator dbtable Nothing
+        | not (piIsUnset pi)
+          -> runPSValidator dbtable $ Just pi
+      FormFailure errs'
+          -> first (map SomeMessage errs' <>) $ runPSValidator dbtable Nothing
+      _   -> runPSValidator dbtable Nothing
+    paginationInput
+      | FormSuccess pi <- piPrevious <|> piResult
+      , not $ piIsUnset pi
+      = pi
+      | otherwise
+      = def
     psSorting' = map (first (dbtSorting !)) psSorting
 
   mapM_ (addMessageI Warning) errs
 
-  runDB $ do
-    rows' <- E.select . E.from $ \t -> do
-      res <- dbtSQLQuery t
-      E.orderBy (map (sqlSortDirection t) psSorting')
-      E.limit psLimit
-      E.offset (psPage * psLimit)
-      Map.foldrWithKey (\key args expr -> E.where_ (filterColumn (dbtFilter ! key) args t) >> expr) (return ()) psFilter
-      return (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64), res)
+  rows' <- E.select . E.from $ \t -> do
+    res <- dbtSQLQuery t
+    E.orderBy (map (sqlSortDirection t) psSorting')
+    E.limit psLimit
+    E.offset (psPage * psLimit)
+    Map.foldrWithKey (\key args expr -> E.where_ (filterColumn (dbtFilter ! key) args t) >> expr) (return ()) psFilter
+    return (E.unsafeSqlValue "count(*) OVER ()" :: E.SqlExpr (E.Value Int64), res)
 
-    let mapMaybeM f = fmap catMaybes . mapM (runMaybeT . f)
-  
-    rows <- mapMaybeM dbtProj . map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'
+  let mapMaybeM f = fmap catMaybes . mapM (runMaybeT . f)
 
-    let
-      rowCount
-        | (E.Value n, _):_ <- rows' = n
-        | otherwise = 0
+  rows <- mapMaybeM dbtProj . map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'
 
-      table' :: WriterT x m Widget
-      table' = do
-        getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
+  let
+    rowCount
+      | (E.Value n, _):_ <- rows' = n
+      | otherwise = 0
 
-        let
-          tblLink f = decodeUtf8 . Builder.toLazyByteString . renderQueryText True $ f getParams
+    table' :: WriterT x m Widget
+    table' = do
+      getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
 
-          genHeaders SortableP{..} = forM (toSortable . oneColonnadeHead <$> getColonnade dbtColonnade) $ \Sortable{..} -> do
-            widget <- sortableContent ^. cellContents
-            let
-              directions = [dir | (k, dir) <- psSorting, Just k == sortableKey ]
-              isSortable = isJust sortableKey
-              isSorted = (`elem` directions)
-              attrs = sortableContent ^. cellAttrs
-            return $(widgetFile "table/cell/header")
+      let
+        tblLink f = decodeUtf8 . Builder.toLazyByteString . renderQueryText True $ f getParams
 
-          columnCount :: Int64
-          columnCount = olength64 $ getColonnade dbtColonnade
+        genHeaders SortableP{..} = forM (toSortable . oneColonnadeHead <$> getColonnade dbtColonnade) $ \Sortable{..} -> do
+          widget <- sortableContent ^. cellContents
+          let
+            directions = [dir | (k, dir) <- psSorting, Just k == sortableKey ]
+            isSortable = isJust sortableKey
+            isSorted = (`elem` directions)
+            attrs = sortableContent ^. cellAttrs
+          return $(widgetFile "table/cell/header")
 
-        wHeaders <- maybe (return Nothing) (fmap Just . genHeaders) pSortable
+        columnCount :: Int64
+        columnCount = olength64 $ getColonnade dbtColonnade
 
-        wRows <- forM rows $ \row' -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row') -> cell') -> do
-          widget <- cell' ^. cellContents
-          let attrs = cell' ^. cellAttrs
-          return $(widgetFile "table/cell/body")
-      
-        let table = $(widgetFile "table/colonnade")
-            pageCount = max 1 . ceiling $ rowCount % psLimit
-            pageNumbers = [0..pred pageCount]
+      wHeaders <- maybe (return Nothing) (fmap Just . genHeaders) pSortable
 
-        return $(widgetFile "table/layout")
+      wRows <- forM rows $ \row' -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row') -> cell') -> do
+        widget <- cell' ^. cellContents
+        let attrs = cell' ^. cellAttrs
+        return $(widgetFile "table/cell/body")
 
-    bool (dbHandler dbtable $ \table -> $(widgetFile "table/layout-wrapper")) (sendResponse <=< tblLayout <=< dbWidget dbtable) psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
+      let table = $(widgetFile "table/colonnade")
+          pageCount = max 1 . ceiling $ rowCount % psLimit
+          pageNumbers = [0..pred pageCount]
+
+      return $(widgetFile "table/layout")
+
+  bool (dbHandler dbtable paginationInput $ \table -> $(widgetFile "table/layout-wrapper")) (sendResponse <=< tblLayout <=< dbWidget dbtable paginationInput) psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
   where
     tblLayout :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => Widget -> m' Html
     tblLayout tbl' = do
@@ -434,10 +478,10 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = (toPathPiece -> dbtIdent), d
     setParam key v qt = (key, v) : [ i | i@(key', _) <- qt, key' /= key ]
 
 dbTableWidget :: Monoid x => PSValidator (HandlerT UniWorX IO) x -> DBTable (HandlerT UniWorX IO) x
-    -> Handler (DBResult (HandlerT UniWorX IO) x)
+    -> DB (DBResult (HandlerT UniWorX IO) x)
 dbTableWidget = dbTable
 
-dbTableWidget' :: PSValidator (HandlerT UniWorX IO) () -> DBTable (HandlerT UniWorX IO) () -> Handler Widget
+dbTableWidget' :: PSValidator (HandlerT UniWorX IO) () -> DBTable (HandlerT UniWorX IO) () -> DB Widget
 dbTableWidget' = fmap (fmap snd) . dbTable
 
 widgetColonnade :: (Headedness h, Monoid x)

From 910d7a90fef9f16ace2084631d5873a5bf5c7e68 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 29 Nov 2018 12:43:10 +0100
Subject: [PATCH 8/9] Fix multiple js-initialization issues

---
 templates/standalone/inputs.julius | 12 ++++++++----
 templates/table/layout.julius      | 25 ++++++++++++++++++++++---
 2 files changed, 30 insertions(+), 7 deletions(-)

diff --git a/templates/standalone/inputs.julius b/templates/standalone/inputs.julius
index 88b658851..f45a224c7 100644
--- a/templates/standalone/inputs.julius
+++ b/templates/standalone/inputs.julius
@@ -118,23 +118,27 @@ document.addEventListener('setup', function(e) {
     return;
 
   // initialize checkboxes
-  Array.from(e.detail.scope.querySelectorAll('input[type="checkbox"]')).forEach(function(inp) {
+  Array.from(e.detail.scope.querySelectorAll('input[type="checkbox"]:not(.js-initialized)')).forEach(function(inp) {
     window.utils.initializeCheckboxRadio(inp, 'checkbox');
+    inp.classList.add("js-initialized");
   });
 
   // initialize radios
-  Array.from(e.detail.scope.querySelectorAll('input[type="radio"]')).forEach(function(inp) {
+  Array.from(e.detail.scope.querySelectorAll('input[type="radio"]:not(.js-initialized)')).forEach(function(inp) {
     window.utils.initializeCheckboxRadio(inp, 'radio');
+    inp.classList.add("js-initialized");
   });
 
   // initialize file-upload-fields
-  Array.from(e.detail.scope.querySelectorAll('input[type="file"]')).forEach(function(inp) {
+  Array.from(e.detail.scope.querySelectorAll('input[type="file"]:not(.js-initialized)')).forEach(function(inp) {
     window.utils.initializeFileUpload(inp);
+    inp.classList.add("js-initialized");
   });
 
   // initialize file-checkbox-fields
-  Array.from(e.detail.scope.querySelectorAll('.js-file-checkbox')).forEach(function(inp) {
+  Array.from(e.detail.scope.querySelectorAll('.js-file-checkbox:not(.js-initialized)')).forEach(function(inp) {
     window.utils.reactiveFileCheckbox(inp);
+    inp.classList.add("js-initialized");
   });
 });
 
diff --git a/templates/table/layout.julius b/templates/table/layout.julius
index 25ded585f..d202b780f 100644
--- a/templates/table/layout.julius
+++ b/templates/table/layout.julius
@@ -3,6 +3,11 @@
 
   document.addEventListener('setup', function DOMContentLoaded(e) {
 
+    console.log('dbtable', e);
+
+    if (e.detail.module && e.detail.module !== 'dbtable')
+      return;
+
     function setupAsync(wrapper) {
 
       var table = wrapper.querySelector('#' + #{String $ dbtIdent});
@@ -66,16 +71,30 @@
           wrapper.innerHTML = data;
 
           // set up async functionality again
-          setupAsync(wrapper);
-          table.querySelector('tbody').innerHTML = data;
+          wrapper.classList.remove("js-initialized");
+          document.dispatchEvent(new CustomEvent('setup', {
+            detail: { scope: wrapper },
+            bubbles: true,
+            cancelable: true
+          }));
+          // table.querySelector('tbody').innerHTML = data;
         }).catch(function(err) {
           console.error(err);
         });
       }
+
+      wrapper.classList.add("js-initialized");
     }
 
-    var wrapperEl = e.detail.scope.querySelector('#' + #{String $ dbtIdent} + '-table-wrapper');
+    var selector = '#' + #{String $ dbtIdent} + '-table-wrapper:not(.js-initialized)';
+    var wrapperEl = e.detail.scope.querySelector(selector);
     if (wrapperEl)
       setupAsync(wrapperEl);
+    else if (e.detail.scope.matches(selector))
+      setupAsync(e.detail.scope);
   });
 })();
+
+document.addEventListener('DOMContentLoaded', function() {
+  document.dispatchEvent(new CustomEvent('setup', { detail: { scope: document.body, module: 'dbtable' }, bubbles: true, cancelable: true }));
+});

From f126246a23b08da94f910aaaab8da5bc0cb23218 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Thu, 29 Nov 2018 12:52:02 +0100
Subject: [PATCH 9/9] Fix build

---
 src/Handler/Course.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 03cbe03c5..e843ade32 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -122,7 +122,7 @@ makeCourseTable whereClause colChoices psValidator = do
         return (course, participants, registered, school)
       dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData
       dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> return (course, participants, registered, school)
-  fmap snd $ dbTable psValidator DBTable
+  snd <$> dbTable psValidator DBTable
     { dbtSQLQuery
     , dbtColonnade = colChoices
     , dbtProj