Merge branch 'master' into 'live'

Master See merge request !112
2018-11-29 12:57:06 +01:00 · 2018-11-29 12:57:06 +01:00 · 4cccf42727
commit 4cccf42727
parent dbb69e1817 f126246a23
39 changed files with 510 additions and 267 deletions
--- a/.gitignore
+++ b/.gitignore
@ -30,4 +30,5 @@ src/Handler/Course.SnapCustom.hs
 /instance
 .stack-work-*
 .directory
-tags
+tags
+test.log
--- 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"
--- 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
--- 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

--- a/package.yaml
+++ b/package.yaml
@ -110,6 +110,7 @@ dependencies:
  - monad-memo
  - xss-sanitize
  - text-metrics
+  - pkcs7

 other-extensions:
  - GeneralizedNewtypeDeriving
--- 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,14 +132,12 @@ 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
    -- 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
@ -127,8 +146,10 @@ makeFoundation appSettings@AppSettings{..} = do
          (error "smtpPool forced in tempFoundation")
          (error "cryptoIDKey forced in tempFoundation")
          (error "sessionKey forced in tempFoundation")
-          (error "errorMsgKey forced in tempFoundation")
-        logFunc = messageLoggerSource tempFoundation appLogger
+          (error "secretBoxKey forced in tempFoundation")
+        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
@ -145,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

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


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

--- 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      :: 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" <>)
@ -678,18 +676,15 @@ 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
-                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

@ -757,7 +752,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 +1689,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
@ -1720,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:
--- 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}
--- 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
@ -551,8 +551,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
@ -760,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
--- 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
+  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")
--- 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, _, _) }
--- 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
--- 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) }
--- 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
--- 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
--- 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
--- 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
--- 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
-
--- 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
--- 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
@ -240,8 +266,10 @@ 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)
-  dbWidget   :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> DBResult m x -> m' Widget
-  dbHandler  :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> (Widget -> Widget) -> DBResult m x -> m' (DBResult m x)
+  -- | Format @DBTable@ when sort-circuiting
+  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 -> 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)]
@ -264,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
@ -284,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

@ -312,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')
@ -327,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
@ -348,79 +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
-    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)
-  
-    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
@ -431,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)
--- 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
--- 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
--- 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:
@ -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';
+        |]
+    )
  ]


--- 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
--- 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
--- 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
--- 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
--- 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 {
--- 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");
  });
 });

--- 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 }));
+});
--- 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 _
--- 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);
 }
--- 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 -> []
--- 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 ()
--- 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
  
--- 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
--- a/test/UtilsSpec.hs
+++ 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