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
@ -31,3 +31,4 @@ src/Handler/Course.SnapCustom.hs
 .stack-work-*
 .directory
 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
@ -421,6 +421,7 @@ sinkSubmission userId mExists isUpdate = do
        when anyChanges $ do

          Sheet{..} <- lift $ getJust submissionSheet
+          --TODO: should display errorMessages
          mapM_ throwM $ validateRating sheetType r'

          touchSubmission
--- 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)
+  let mapMaybeM f = fmap catMaybes . mapM (runMaybeT . f)

-    rows <- mapMaybeM dbtProj . map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'
+  rows <- mapMaybeM dbtProj . map (\(dbrIndex, (E.Value dbrCount, dbrOutput)) -> DBRow{..}) $ zip [succ (psPage * psLimit)..] rows'

-    let
-      rowCount
-        | (E.Value n, _):_ <- rows' = n
-        | otherwise = 0
+  let
+    rowCount
+      | (E.Value n, _):_ <- rows' = n
+      | otherwise = 0

-      table' :: WriterT x m Widget
-      table' = do
-        getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
+    table' :: WriterT x m Widget
+    table' = do
+      getParams <- liftHandlerT $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest

-        let
-          tblLink f = decodeUtf8 . Builder.toLazyByteString . renderQueryText True $ f getParams
+      let
+        tblLink f = decodeUtf8 . Builder.toLazyByteString . renderQueryText True $ f getParams

-          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")
+        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")

-          columnCount :: Int64
-          columnCount = olength64 $ getColonnade dbtColonnade
+        columnCount :: Int64
+        columnCount = olength64 $ getColonnade dbtColonnade

-        wHeaders <- maybe (return Nothing) (fmap Just . genHeaders) pSortable
+      wHeaders <- maybe (return Nothing) (fmap Just . genHeaders) pSortable

-        wRows <- forM rows $ \row' -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row') -> cell') -> do
-          widget <- cell' ^. cellContents
-          let attrs = cell' ^. cellAttrs
-          return $(widgetFile "table/cell/body")
+      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]
+      let table = $(widgetFile "table/colonnade")
+          pageCount = max 1 . ceiling $ rowCount % psLimit
+          pageNumbers = [0..pred pageCount]

-        return $(widgetFile "table/layout")
+      return $(widgetFile "table/layout")

-    bool (dbHandler dbtable $ \table -> $(widgetFile "table/layout-wrapper")) (sendResponse <=< tblLayout <=< dbWidget dbtable) psShortcircuit <=< runDBTable . fmap swap $ runWriterT table'
+  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
@ -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;

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