Merge branch 'master' into 'live'

Master Closes #251 and #247 See merge request !120
2018-12-05 22:10:17 +01:00 · 2018-12-05 22:10:17 +01:00 · eb4ff3ada6
commit eb4ff3ada6
parent 7cae1485c4 aea7837c49
36 changed files with 577 additions and 288 deletions
--- a/.vscode/tasks.json
+++ b/.vscode/tasks.json
@ -1,4 +1,4 @@
-{  
+{
  "version": "2.0.0",
  "tasks": [
    {
@ -11,7 +11,7 @@
      },
      "presentation": {
        "echo": true,
-        "reveal": "silent",
+        "reveal": "always",
        "focus": false,
        "panel": "dedicated",
        "showReuseMessage": false
--- a/config/keter_testworx.yml
+++ b/config/keter_testworx.yml
@ -47,6 +47,12 @@ stanzas:
      - SMTPTIMEOUT
      - SMTPLIMIT
      - INSTANCE_ID
+      - MEMCACHEDHOST
+      - MEMCACHEDPORT
+      - MEMCACHEDLIMIT
+      - MEMCACHEDTIMEOUT
+      - MEMCACHEDROOT
+      - MEMCACHEDEXPIRATION

 # Use the following to automatically copy your bundle upon creation via `yesod
 # keter`. Uses `scp` internally, so you can set it to a remote destination
--- a/config/keter_uni2work.yml
+++ b/config/keter_uni2work.yml
@ -46,6 +46,12 @@ stanzas:
      - SMTPTIMEOUT
      - SMTPLIMIT
      - INSTANCE_ID
+      - MEMCACHEDHOST
+      - MEMCACHEDPORT
+      - MEMCACHEDLIMIT
+      - MEMCACHEDTIMEOUT
+      - MEMCACHEDROOT
+      - MEMCACHEDEXPIRATION


 # Use the following to automatically copy your bundle upon creation via `yesod
--- a/config/settings.yml
+++ b/config/settings.yml
@ -34,7 +34,6 @@ log-settings:
  minimum-level: "_env:LOGLEVEL:warn"
  destination:   "_env:LOGDEST:stderr"

-
 # Debugging
 auth-dummy-login:  "_env:DUMMY_LOGIN:false"
 allow-deprecated:  "_env:ALLOW_DEPRECATED:false"
@ -80,7 +79,16 @@ smtp:
  pool:
    stripes: "_env:SMTPSTRIPES:1"
    timeout: "_env:SMTPTIMEOUT:20"
-    limit: "_env:SMTPLIMIT:10"
+    limit:   "_env:SMTPLIMIT:10"
+
+widget-memcached:
+  host:       "_env:MEMCACHEDHOST:"
+  port:       "_env:MEMCACHEDPORT:11211"
+  auth:       []
+  limit:      "_env:MEMCACHEDLIMIT:10"
+  timeout:    "_env:MEMCACHEDTIMEOUT:20"
+  base-url:   "_env:MEMCACHEDROOT:"
+  expiration: "_env:MEMCACHEDEXPIRATION:3600"

 user-defaults:
  max-favourites:   12
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@ -171,7 +171,7 @@ MaterialFree: Kursmaterialien ohne Anmeldung zugänglich
 UnauthorizedWrite: Sie haben hierfür keine Schreibberechtigung
 UnauthorizedSystemMessageTime: Diese Systemnachricht ist noch nicht oder nicht mehr einsehbar.
 UnauthorizedSystemMessageAuth: Diese Systemnachricht ist nur für angemeldete Benutzer einsehbar.
-UnsupportedAuthPredicate tag@String shownRoute@String: "#{tag}" wurde auf eine Route angewandt, die dies nicht unterstützt: #{shownRoute}
+UnsupportedAuthPredicate authTagT@Text shownRoute@String: "#{authTagT}" wurde auf eine Route angewandt, die dies nicht unterstützt: #{shownRoute}
 UnauthorizedDisabledTag authTag@AuthTag: Authorisierungsprädikat "#{toPathPiece authTag}" ist für Ihre Sitzung nicht aktiv
 UnknownAuthPredicate tag@String: Authorisierungsprädikat "#{tag}" ist dem System nicht bekannt

@ -380,7 +380,9 @@ SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{tsh
 SheetGradingPassBinary:  Bestanden/Nicht Bestanden
 SheetGradingInfo: "Bestanden nach Punkten" zählt sowohl zur maximal erreichbaren Gesamtpunktzahl also auch zur Anzahl der zu bestehenden Blätter.

+SheetGradingCount': Anzahl
 SheetGradingPoints': Punkte
+SheetGradingPassing': Bestehen
 SheetGradingPassPoints': Bestehen nach Punkten
 SheetGradingPassBinary': Bestanden/Nicht bestanden

@ -388,7 +390,11 @@ SheetTypeBonus grading@SheetGrading: Bonus
 SheetTypeNormal grading@SheetGrading: Normal
 SheetTypeInformational grading@SheetGrading: Keine Wertung
 SheetTypeNotGraded: Unbewertet
-SheetTypeInfo: Bonus Blätter zählen, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter. Blätter ohne Wertung werden nirgends angerechnet, die Bewertung durch den Korrektor dient lediglich zur Information an die Teilnehmer.
+SheetTypeInfoBonus: Bonus Blätter zählen normal, erhöhen aber nicht die maximal erreichbare Punktzahl bzw. Anzahl zu bestehender Blätter.
+SheetTypeInfoNotGraded: Blätter ohne Wertung werden nirgends angerechnet, die Bewertung durch den Korrektor dient lediglich zur Information an die Teilnehmer.
+SheetGradingBonusIncluded: Erzielte Bonuspunkte wurden hier bereits zu den erreichten normalen Punkten hinzugezählt.
+SheetGradingSummaryTitle n@Int: Zusammenfassung über alle #{display n} Blätter
+SubmissionGradingSummaryTitle n@Int: Zusammenfassung über alle #{display n} Abgaben

 SheetTypeBonus': Bonus
 SheetTypeNormal': Normal
--- a/package.yaml
+++ b/package.yaml
@ -111,6 +111,7 @@ dependencies:
  - xss-sanitize
  - text-metrics
  - pkcs7
+  - memcached-binary

 other-extensions:
  - GeneralizedNewtypeDeriving
--- a/2
+++ b/2
@ -26,7 +26,7 @@
 --    !deprecated  -- like free, but logs and gives a warning; entirely disabled in production
 --    !development -- like free, but only for development builds

-/static StaticR Static appStatic                              !free
+/static StaticR EmbeddedStatic appStatic                      !free
 /auth   AuthR   Auth   getAuth                                !free

 /favicon.ico FaviconR GET                                     !free
--- a/src/Application.hs
+++ b/src/Application.hs
@ -69,6 +69,8 @@ import Data.Proxy
 import qualified Data.Aeson as Aeson

 import System.Exit (exitFailure)
+
+import qualified Database.Memcached.Binary.IO as Memcached
  
 -- Import all relevant handler modules here.
 -- (HPack takes care to add new modules to our cabal file nowadays.)
@ -125,7 +127,7 @@ makeFoundation appSettings@AppSettings{..} = do
        (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
+    let appStatic = embeddedStatic

    appInstanceID <- liftIO $ maybe UUID.nextRandom (either readInstanceIDFile return) appInitialInstanceID

@ -137,7 +139,7 @@ makeFoundation appSettings@AppSettings{..} = do
    -- logging function. To get out of this loop, we initially create a
    -- temporary foundation without a real connection pool, get a log function
    -- from there, and then create the real foundation.
-    let mkFoundation appConnPool appSmtpPool appCryptoIDKey appSessionKey appSecretBoxKey = UniWorX {..}
+    let mkFoundation appConnPool appSmtpPool appCryptoIDKey appSessionKey appSecretBoxKey appWidgetMemcached = 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
@ -147,6 +149,7 @@ makeFoundation appSettings@AppSettings{..} = do
          (error "cryptoIDKey forced in tempFoundation")
          (error "sessionKey forced in tempFoundation")
          (error "secretBoxKey forced in tempFoundation")
+          (error "widgetMemcached forced in tempFoundation")
        logFunc loc src lvl str = do
          f <- messageLoggerSource tempFoundation <$> readTVarIO (snd appLogger)
          f loc src lvl str
@ -157,6 +160,8 @@ makeFoundation appSettings@AppSettings{..} = do

      smtpPool <- traverse createSmtpPool appSmtpConf

+      appWidgetMemcached <- traverse createWidgetMemcached appWidgetMemcachedConf
+
      -- Create the database connection pool
      sqlPool <- createPostgresqlPool
        (pgConnStr  appDatabaseConf)
@ -168,7 +173,7 @@ makeFoundation appSettings@AppSettings{..} = do
      appSessionKey <- clusterSetting (Proxy :: Proxy 'ClusterClientSessionKey) `runSqlPool` sqlPool
      appSecretBoxKey <- clusterSetting (Proxy :: Proxy 'ClusterSecretBoxKey) `runSqlPool` sqlPool

-      let foundation = mkFoundation sqlPool smtpPool appCryptoIDKey appSessionKey appSecretBoxKey
+      let foundation = mkFoundation sqlPool smtpPool appCryptoIDKey appSessionKey appSecretBoxKey appWidgetMemcached

      handleJobs foundation

@ -234,6 +239,9 @@ createSmtpPool SmtpConf{ smtpPool = ResourcePoolConf{..}, .. } = do
      return conn
  liftIO $ createPool (mkConnection >>= maybe return applyAuth smtpAuth) reapConnection poolStripes poolTimeout poolLimit

+createWidgetMemcached :: (MonadLogger m, MonadResource m) => WidgetMemcachedConf -> m Memcached.Connection
+createWidgetMemcached WidgetMemcachedConf{widgetMemcachedConnectInfo} = snd <$> allocate (Memcached.connect widgetMemcachedConnectInfo) Memcached.close
+
 -- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
 -- applying some additional middlewares.
 makeApplication :: MonadIO m => UniWorX -> m Application
@ -348,6 +356,10 @@ getApplicationRepl = do
 shutdownApp :: MonadIO m => UniWorX -> m ()
 shutdownApp app = do
  stopJobCtl app
+  liftIO $ do
+    for_ (appWidgetMemcached app) Memcached.close
+    for_ (appSmtpPool app) destroyAllResources
+    destroyAllResources $ appConnPool app
  release . fst $ appLogger app


--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@ -1,4 +1,5 @@
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-} -- MonadCrypto

 module Foundation where
@ -6,7 +7,6 @@ module Foundation where
 import Import.NoFoundation
 import Database.Persist.Sql (ConnectionPool, runSqlPool)
 import Text.Hamlet          (hamletFile)
-import Text.Jasmine         (minifym)

 import qualified Web.ClientSession as ClientSession

@ -18,7 +18,6 @@ import Jobs.Types

 import qualified Network.Wai as W (pathInfo)

-import Yesod.Default.Util   (addStaticContentExternal)
 import Yesod.Core.Types     (Logger)
 import qualified Yesod.Core.Unsafe as Unsafe
 import Data.CaseInsensitive (CI)
@ -75,6 +74,9 @@ import qualified Data.Conduit.List as C

 import qualified Crypto.Saltine.Core.SecretBox as SecretBox

+import qualified Database.Memcached.Binary.IO as Memcached
+import Data.Bits (Bits(zeroBits))
+

 instance DisplayAble b => DisplayAble (E.CryptoID a b) where
  display = display . ciphertext
@ -96,19 +98,20 @@ instance DisplayAble SchoolId where
 -- starts running, such as database connections. Every handler will have
 -- access to the data present here.
 data UniWorX = UniWorX
-    { appSettings     :: AppSettings
-    , appStatic       :: Static -- ^ Settings for static file serving.
-    , appConnPool     :: ConnectionPool -- ^ Database connection pool.
-    , appSmtpPool     :: Maybe SMTPPool
-    , appHttpManager  :: Manager
-    , appLogger       :: (ReleaseKey, TVar Logger)
-    , appLogSettings  :: TVar LogSettings
-    , appCryptoIDKey  :: CryptoIDKey
-    , appInstanceID   :: InstanceId
-    , appJobCtl       :: TVar (Map ThreadId (TMChan JobCtl))
-    , appCronThread   :: TMVar (ReleaseKey, ThreadId)
-    , appSessionKey   :: ClientSession.Key
-    , appSecretBoxKey :: SecretBox.Key
+    { appSettings        :: AppSettings
+    , appStatic          :: EmbeddedStatic -- ^ Settings for static file serving.
+    , appConnPool        :: ConnectionPool -- ^ Database connection pool.
+    , appSmtpPool        :: Maybe SMTPPool
+    , appWidgetMemcached :: Maybe Memcached.Connection
+    , 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
@ -142,7 +145,7 @@ pattern CSubmissionR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Cr
 pattern CSubmissionR tid ssh csh shn cid ptn
  = CSheetR tid ssh csh shn (SubmissionR cid ptn)

-- Messages
+-- Messages creates type UniWorXMessage and RenderMessage UniWorX instance
 mkMessage "UniWorX" "messages/uniworx" "de"
 mkMessageVariant "UniWorX" "Campus" "messages/campus" "de"
 mkMessageVariant "UniWorX" "Dummy" "messages/dummy" "de"
@ -222,6 +225,16 @@ instance RenderMessage UniWorX SheetType where
 newtype ErrorResponseTitle = ErrorResponseTitle ErrorResponse
 embedRenderMessageVariant ''UniWorX ''ErrorResponseTitle ("ErrorResponseTitle" <>)

+newtype UniWorXMessages = UniWorXMessages [SomeMessage UniWorX]
+  deriving (Generic, Typeable)
+  deriving newtype (Semigroup, Monoid, IsList)
+
+instance RenderMessage UniWorX UniWorXMessages where
+  renderMessage foundation ls (UniWorXMessages msgs) =
+    intercalate " " $ map (renderMessage foundation ls) msgs
+
+uniworxMessages :: [UniWorXMessage] -> UniWorXMessages
+uniworxMessages = UniWorXMessages . map SomeMessage

 -- Menus and Favourites
 data MenuType = NavbarAside | NavbarRight | NavbarSecondary | PageActionPrime | PageActionSecondary
@ -441,7 +454,7 @@ tagAccessPredicate AuthTime = APDB $ \route _ -> case route of
         && NTop systemMessageTo   >= cTime
    return Authorized

-  r -> $unsupportedAuthPredicate "time" r
+  r -> $unsupportedAuthPredicate AuthTime r
 tagAccessPredicate AuthRegistered = APDB $ \route _ -> case route of
  CourseR tid ssh csh _ -> exceptT return return $ do
    authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
@ -454,14 +467,14 @@ tagAccessPredicate AuthRegistered = APDB $ \route _ -> case route of
      return (E.countRows :: E.SqlExpr (E.Value Int64))
    guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedParticipant)
    return Authorized
-  r -> $unsupportedAuthPredicate "registered" r
+  r -> $unsupportedAuthPredicate AuthRegistered r
 tagAccessPredicate AuthCapacity = APDB $ \route _ -> case route of
  CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do
    Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
    registered <- lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ]
    guard $ NTop courseCapacity > NTop (Just registered)
    return Authorized
-  r -> $unsupportedAuthPredicate "capacity" r
+  r -> $unsupportedAuthPredicate AuthCapacity r
 tagAccessPredicate AuthEmpty = APDB $ \route _ -> case route of
  CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNotEmpty) $ do
    -- Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
@ -469,41 +482,41 @@ tagAccessPredicate AuthEmpty = APDB $ \route _ -> case route of
    registered <- lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ]
    guard $ registered <= 0
    return Authorized
-  r -> $unsupportedAuthPredicate "empty" r
+  r -> $unsupportedAuthPredicate AuthEmpty r
 tagAccessPredicate AuthMaterials = APDB $ \route _ -> case route of
  CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnfreeMaterials) $ do
    Entity _ Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
    guard courseMaterialFree
    return Authorized
-  r -> $unsupportedAuthPredicate "materials" r
+  r -> $unsupportedAuthPredicate AuthMaterials r
 tagAccessPredicate AuthOwner = APDB $ \route _ -> case route of
  CSubmissionR _ _ _ _ cID _ -> exceptT return return $ do
    sid <- catchIfMExceptT (const $ unauthorizedI MsgUnauthorizedSubmissionOwner) (const True :: CryptoIDError -> Bool) $ decrypt cID
    authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
    void . maybeMExceptT (unauthorizedI MsgUnauthorizedSubmissionOwner) . getBy $ UniqueSubmissionUser authId sid
    return Authorized
-  r -> $unsupportedAuthPredicate "owner" r
+  r -> $unsupportedAuthPredicate AuthOwner r
 tagAccessPredicate AuthRated = APDB $ \route _ -> case route of
  CSubmissionR _ _ _ _ cID _ -> maybeT (unauthorizedI MsgUnauthorizedSubmissionRated) $ do
    sid <- catchIfMaybeT (const True :: CryptoIDError -> Bool) $ decrypt cID
    sub <- MaybeT $ get sid
    guard $ submissionRatingDone sub
    return Authorized
-  r -> $unsupportedAuthPredicate "rated" r
+  r -> $unsupportedAuthPredicate AuthRated r
 tagAccessPredicate AuthUserSubmissions = APDB $ \route _ -> case route of
  CSheetR tid ssh csh shn _ -> maybeT (unauthorizedI MsgUnauthorizedUserSubmission) $ do
    Entity cid _ <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
    Entity _ Sheet{sheetSubmissionMode} <- MaybeT . getBy $ CourseSheet cid shn
    guard $ sheetSubmissionMode == UserSubmissions
    return Authorized
-  r -> $unsupportedAuthPredicate "user-submissions" r
+  r -> $unsupportedAuthPredicate AuthUserSubmissions r
 tagAccessPredicate AuthCorrectorSubmissions = APDB $ \route _ -> case route of
  CSheetR tid ssh csh shn _ -> maybeT (unauthorizedI MsgUnauthorizedCorrectorSubmission) $ do
    Entity cid _ <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
    Entity _ Sheet{sheetSubmissionMode} <- MaybeT . getBy $ CourseSheet cid shn
    guard $ sheetSubmissionMode == CorrectorSubmissions
    return Authorized
-  r -> $unsupportedAuthPredicate "corrector-submissions" r
+  r -> $unsupportedAuthPredicate AuthCorrectorSubmissions r
 tagAccessPredicate AuthAuthentication = APDB $ \route _ -> case route of
  MessageR cID -> maybeT (unauthorizedI MsgUnauthorizedSystemMessageAuth) $ do
    smId <- decrypt cID
@ -511,7 +524,7 @@ tagAccessPredicate AuthAuthentication = APDB $ \route _ -> case route of
    isAuthenticated <- isJust <$> liftHandlerT maybeAuthId
    guard $ not systemMessageAuthenticatedOnly || isAuthenticated
    return Authorized
-  r -> $unsupportedAuthPredicate "authentication" r
+  r -> $unsupportedAuthPredicate AuthAuthentication r
 tagAccessPredicate AuthRead = APHandler . const $ bool (return Authorized) (unauthorizedI MsgUnauthorizedWrite)
 tagAccessPredicate AuthWrite = APHandler . const $ bool (unauthorizedI MsgUnauthorized) (return Authorized)

@ -704,21 +717,16 @@ instance Yesod UniWorX where

    isAuthorized = evalAccess

-    -- This function creates static content files in the static folder
-    -- and names them based on a hash of their content. This allows
-    -- expiration dates to be set far in the future without worry of
-    -- users receiving stale content.
-    addStaticContent ext mime content = do
-        master <- getYesod
-        let staticDir = appStaticDir $ appSettings master
-        addStaticContentExternal
-            minifym
-            genFileName
-            staticDir
-            (StaticR . flip StaticRoute [])
-            ext
-            mime
-            content
+    addStaticContent ext _mime content = do
+      UniWorX{appWidgetMemcached, appSettings} <- getYesod
+      for ((,) <$> appWidgetMemcached <*> appWidgetMemcachedConf appSettings) $ \(mConn, WidgetMemcachedConf{ widgetMemcachedConnectInfo = _, .. }) -> do
+        let expiry = (maybe 0 ceiling widgetMemcachedExpiry)
+            touch = liftIO $ Memcached.touch expiry (encodeUtf8 $ pack fileName) mConn
+            add = liftIO $ Memcached.add zeroBits expiry (encodeUtf8 $ pack fileName) content mConn
+            absoluteLink = unpack widgetMemcachedBaseUrl </> fileName
+        C.catchIf Memcached.isKeyNotFound touch $ \_ ->
+          C.handleIf Memcached.isKeyExists (\_ -> return ()) add
+        return . Left $ pack absoluteLink
      where
        -- Generate a unique filename based on the content itself, this is used
        -- for deduplication so a collision resistant hash function is required
@ -727,12 +735,13 @@ instance Yesod UniWorX where
        --
        -- Length of hash is 144 bits instead of MD5's 128, so as to avoid
        -- padding after base64-conversion
-        genFileName lbs = Text.unpack
-                        . Text.decodeUtf8
-                        . Base64.encode
-                        . (convert :: Digest (SHAKE256 144) -> ByteString)
-                        . runIdentity
-                        $ sourceList (Lazy.ByteString.toChunks lbs) $$ sinkHash
+        fileName = (<.> unpack ext)
+                 . unpack
+                 . decodeUtf8
+                 . Base64.encode
+                 . (convert :: Digest (SHAKE256 144) -> ByteString)
+                 . runIdentity
+                 $ sourceList (Lazy.ByteString.toChunks content) $$ sinkHash

    -- What messages should be logged. The following includes all messages when
    -- in development, and warnings and errors in production.
--- a/src/Handler/Common.hs
+++ b/src/Handler/Common.hs
@ -2,7 +2,7 @@
 module Handler.Common where

 import Data.FileEmbed (embedFile)
-import Import
+import Import hiding (embedFile)

 -- These handlers embed files in the executable at compile time to avoid a
 -- runtime dependency, and for efficiency.
@ -10,8 +10,8 @@ import Import
 getFaviconR :: Handler TypedContent
 getFaviconR = do cacheSeconds $ 60 * 60 * 24 * 30 -- cache for a month
                 return $ TypedContent "image/x-icon"
-                        $ toContent $(embedFile "embedded/favicon.ico")
+                        $ toContent $(embedFile "static/favicon.ico")

 getRobotsR :: Handler TypedContent
 getRobotsR = return $ TypedContent typePlain
-                    $ toContent $(embedFile "embedded/robots.txt")
+                    $ toContent $(embedFile "static/robots.txt")
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@ -7,18 +7,20 @@ import Jobs
 import Handler.Utils
 import Handler.Utils.Submission
 import Handler.Utils.Table.Cells
+import Handler.Utils.SheetType
 -- import Handler.Utils.Zip

 import Utils.Lens

 import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Map (Map)
+import Data.Map (Map, (!))
 import qualified Data.Map as Map

 import qualified Data.Text as Text

 import Data.Semigroup (Sum(..))
+import Data.Monoid (All(..))

 -- import Data.Time
 -- import qualified Data.Text as T
@ -45,7 +47,8 @@ import Database.Persist.Sql (updateWhereCount)

 import Data.List (genericLength)

-import Control.Monad.Trans.Writer (WriterT(..), runWriter)
+import Control.Monad.Trans.Writer (WriterT(..), runWriter, execWriterT)
+import Control.Monad.Trans.Reader (mapReaderT)

 import Control.Monad.Trans.RWS (RWST)

@ -56,25 +59,33 @@ import Data.Foldable (foldrM)



-type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) =>
-            (expr (Entity Course), expr (Entity Sheet), expr (Entity Submission))
-            -> expr (E.Value Bool)
-
-ratedBy :: Key User -> CorrectionsWhere
-ratedBy uid (_course,_sheet,submission) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
-
-courseIs :: Key Course -> CorrectionsWhere
-courseIs cid (course,_sheet,_submission) = course E.^. CourseId E.==. E.val cid
-
-sheetIs :: Key Sheet -> CorrectionsWhere
-sheetIs shid (_course,sheet,_submission) = sheet E.^. SheetId E.==. E.val shid
-
-submissionModeIs :: SheetSubmissionMode -> CorrectionsWhere
-submissionModeIs sMode (_course, sheet, _submission) = sheet E.^. SheetSubmissionMode E.==. E.val sMode
-
-
+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))
+type CorrectionTableWhere = CorrectionTableExpr -> E.SqlExpr (E.Value Bool)
 type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Map UserId (User, Maybe Pseudonym))

+correctionsTableQuery :: CorrectionTableWhere -> (CorrectionTableExpr -> v) -> CorrectionTableExpr -> E.SqlQuery v
+correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
+    E.on $ corrector E.?. UserId   E.==. submission E.^. SubmissionRatingBy
+    E.on $ sheet     E.^. SheetId  E.==. submission E.^. SubmissionSheet
+    E.on $ course    E.^. CourseId E.==. sheet      E.^. SheetCourse
+    E.where_ $ whereClause t
+    return $ returnStatement t
+
+-- Where Clauses
+ratedBy :: UserId -> CorrectionTableWhere
+ratedBy uid   ((_course `E.InnerJoin` _sheet `E.InnerJoin`  submission) `E.LeftOuterJoin` _corrector) = submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
+
+courseIs :: CourseId -> CorrectionTableWhere
+courseIs cid  (( course `E.InnerJoin` _sheet `E.InnerJoin` _submission) `E.LeftOuterJoin` _corrector) = course E.^. CourseId E.==. E.val cid
+
+sheetIs :: Key Sheet -> CorrectionTableWhere
+sheetIs shid  ((_course `E.InnerJoin`  sheet `E.InnerJoin` _submission) `E.LeftOuterJoin` _corrector) = sheet E.^. SheetId E.==. E.val shid
+
+submissionModeIs :: SheetSubmissionMode -> CorrectionTableWhere
+submissionModeIs sMode ((_course `E.InnerJoin` sheet `E.InnerJoin` _submission) `E.LeftOuterJoin` _corrector) = sheet E.^. SheetSubmissionMode E.==. E.val sMode
+
+
+-- Columns
 colTerm :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
 colTerm = sortable (Just "term") (i18nCell MsgTerm)
        $ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
@ -94,6 +105,10 @@ colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
              shn   = sheetName $ entityVal sheet
          in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|#{display shn}|]

+colSheetType :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
+colSheetType = sortable (toNothing "sheetType") (i18nCell MsgSheetType)
+        $ \DBRow{ dbrOutput=(_, sheet, _, _, _) } -> i18nCell . sheetType $ entityVal sheet
+
 colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
 colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
  DBRow{ dbrOutput = (_, _, _, Nothing  , _) } -> cell mempty
@ -116,7 +131,7 @@ colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult
 colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId

 colSubmittors :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
-colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let
+colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, users) } -> let
  csh = course ^. _2
  tid = course ^. _3
  ssh = course ^. _4
@ -138,6 +153,7 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $  \DBRow{ dbrOutput=(
      tid = course ^. _3
      ssh = course ^. _4
      -- shn = sheetName
+
      mkRoute = do
        cid <- encrypt subId
        return $ CSubmissionR tid ssh csh sheetName cid CorrectionR
@ -176,23 +192,19 @@ colCommentField = sortable Nothing (i18nCell MsgRatingComment) $ formCell
  (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _) } _ -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField "" (Just $ Textarea <$> submissionRatingComment))


-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 -> _ -> DB (DBResult m x)
+                     => CorrectionTableWhere -> 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
-        E.on $ corrector E.?. UserId E.==. submission E.^. SubmissionRatingBy
-        E.on $ sheet  E.^. SheetId  E.==. submission E.^. SubmissionSheet
-        E.on $ course E.^. CourseId E.==. sheet      E.^. SheetCourse
-        E.where_ $ whereClause (course,sheet,submission)
-        let crse =  ( course E.^. CourseName      :: E.SqlExpr (E.Value CourseName)
-                    , course E.^. CourseShorthand
-                    , course E.^. CourseTerm
-                    , course E.^. CourseSchool    :: E.SqlExpr (E.Value SchoolId)
-                    )
-        return (submission, sheet, crse, corrector)
+      dbtSQLQuery = correctionsTableQuery whereClause
+          (\((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) ->
+            let crse =  ( course E.^. CourseName      :: E.SqlExpr (E.Value CourseName)
+                        , course E.^. CourseShorthand
+                        , course E.^. CourseTerm
+                        , course E.^. CourseSchool    :: E.SqlExpr (E.Value SchoolId)
+                        )
+            in (submission, sheet, crse, corrector)
+          )
      dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CorrectionTableData
      dbtProj = traverse $ \(submission@(Entity sId _), sheet@(Entity shId _), (E.Value courseName, E.Value courseShorthand, E.Value courseTerm, E.Value courseSchool), mCorrector) -> do
        submittors <- lift . E.select . E.from $ \((submissionUser `E.InnerJoin` user) `E.LeftOuterJoin` pseudonym) -> do
@ -200,7 +212,7 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
           E.&&. pseudonym E.?. SheetPseudonymSheet E.==. E.just (E.val shId)
          E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
          E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val sId
-          E.orderBy [E.asc $ user E.^. UserId]
+          E.orderBy [E.asc $ user E.^. UserDisplayName]
          return (user, pseudonym E.?. SheetPseudonymPseudonym)
        let
          submittorMap = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
@ -231,6 +243,16 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
      , ( "assignedtime"
        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingAssigned
        )
+      , ( "submittors"
+        , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) ->
+            E.sub_select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
+              E.on $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId
+              E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
+              E.orderBy [E.asc $ user E.^. UserDisplayName]
+              E.limit 1
+              return (user E.^. UserDisplayName)
+
+        )
      ]
    , dbtFilter    = Map.fromList
      [ ( "term"
@ -356,9 +378,16 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
            addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
      redirect currentRoute

+  gradingSummary <- runDB $ do
+      let getTypePoints ((_course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) = (sheet E.^. SheetType, submission E.^. SubmissionRatingPoints, submission E.^. SubmissionRatingTime)
+      points <- E.select . E.from $ correctionsTableQuery whereClause getTypePoints
+      -- points <- E.select . E.from $ t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> (correctionsTableQuery whereClause getTypePoints t) <* E.distinctOn []
+      return $ foldMap (\(E.Value stype, E.Value srpoints, E.Value srtime) -> sheetTypeSum stype (srpoints <* srtime)) points
+  let statistics = gradeSummaryWidget MsgSubmissionGradingSummaryTitle gradingSummary
  fmap toTypedContent . defaultLayout $ do
    setTitleI MsgCourseCorrectionsTitle
    $(widgetFile "corrections")
+
  where
    authorizedToAssign :: SubmissionId -> DB Bool
    authorizedToAssign sId = do
@ -641,81 +670,96 @@ postCorrectionsCreateR = do
    FormMissing -> return ()
    FormFailure errs -> forM_ errs $ addMessage Error . toHtml
    FormSuccess (sid, (pss, invalids)) -> do
-      forM_ (Map.toList invalids) $ \((oPseudonyms, iPseudonym), alts) -> $(addMessageFile Warning "templates/messages/ignoredInvalidPseudonym.hamlet")
-      
-      runDB $ do
-        Sheet{..} <- get404 sid
-        (sps, unknown) <- fmap partitionEithers' . forM pss . mapM $ \p -> maybe (Left p) Right <$> getBy (UniqueSheetPseudonym sid p)
-        forM_ unknown $ addMessageI Error . MsgUnknownPseudonym . review _PseudonymText
-        now <- liftIO getCurrentTime
-        let
-          sps' :: [[SheetPseudonym]]
-          duplicate :: Set Pseudonym
-          ( sps'
-            , Map.keysSet . Map.filter (\(getSum -> n) -> n > 1) -> duplicate
-            ) = flip runState Map.empty . forM sps . flip (foldrM :: (Entity SheetPseudonym -> [SheetPseudonym] -> State (Map Pseudonym (Sum Integer)) [SheetPseudonym]) -> [SheetPseudonym] -> [Entity SheetPseudonym] -> State (Map Pseudonym (Sum Integer)) [SheetPseudonym]) [] $ \(Entity _ p@SheetPseudonym{sheetPseudonymPseudonym}) ps -> do
-                  known <- State.gets $ Map.member sheetPseudonymPseudonym
-                  State.modify $ Map.insertWith (<>) sheetPseudonymPseudonym (Sum 1)
-                  return $ bool (p :) id known ps
-          submissionPrototype = Submission
-            { submissionSheet = sid
-            , submissionRatingPoints = Nothing
-            , submissionRatingComment = Nothing
-            , submissionRatingBy = Just uid
-            , submissionRatingAssigned = Just now
-            , submissionRatingTime = Nothing
-            }
-        unless (null duplicate)
-          $(addMessageFile Warning "templates/messages/submissionCreateDuplicates.hamlet")
-        existingSubUsers <- E.select . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
-          E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
-          E.where_ $ submissionUser E.^. SubmissionUserUser `E.in_` E.valList (sheetPseudonymUser <$> concat sps')
-               E.&&. submission E.^. SubmissionSheet E.==. E.val sid
-          return submissionUser
-        unless (null existingSubUsers) $ do
-          (Map.toList -> subs) <- foldrM (\(Entity _ SubmissionUser{..}) mp -> Map.insertWith (<>) <$> (encrypt submissionUserSubmission :: DB CryptoFileNameSubmission) <*> pure (Set.fromList . map sheetPseudonymPseudonym . filter (\SheetPseudonym{..} -> sheetPseudonymUser == submissionUserUser) $ concat sps') <*> pure mp) Map.empty existingSubUsers
-          $(addMessageFile Warning "templates/messages/submissionCreateExisting.hamlet")
-        let sps'' = filter (not . null) $ filter (\spGroup -> not . flip any spGroup $ \SheetPseudonym{sheetPseudonymUser} -> sheetPseudonymUser `elem` map (submissionUserUser . entityVal) existingSubUsers) sps'
-        forM_ sps'' $ \spGroup
-          -> let
-               sheetGroupDesc = Text.intercalate ", " $ map (review _PseudonymText . sheetPseudonymPseudonym) spGroup
-              in case sheetGrouping of
-          Arbitrary maxSize -> do
-            subId <- insert submissionPrototype
-            void . insert $ SubmissionEdit uid now subId
-            insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
-              { submissionUserUser = sheetPseudonymUser
-              , submissionUserSubmission = subId
+      allDone <- fmap getAll . execWriterT $ do 
+        forM_ (Map.toList invalids) $ \((oPseudonyms, iPseudonym), alts) -> $(addMessageFile Error "templates/messages/ignoredInvalidPseudonym.hamlet")
+        tell . All $ null invalids
+
+        WriterT . runDB . mapReaderT runWriterT $ do
+          Sheet{..} <- get404 sid
+          (sps, unknown) <- fmap partitionEithers' . forM pss . mapM $ \p -> maybe (Left p) Right <$> getBy (UniqueSheetPseudonym sid p)
+          forM_ unknown $ addMessageI Error . MsgUnknownPseudonym . review _PseudonymText
+          tell . All $ null unknown
+          now <- liftIO getCurrentTime
+          let
+            sps' :: [[SheetPseudonym]]
+            duplicate :: Set Pseudonym
+            ( sps'
+              , Map.keysSet . Map.filter (\(getSum -> n) -> n > 1) -> duplicate
+              ) = flip runState Map.empty . forM sps . flip (foldrM :: (Entity SheetPseudonym -> [SheetPseudonym] -> State (Map Pseudonym (Sum Integer)) [SheetPseudonym]) -> [SheetPseudonym] -> [Entity SheetPseudonym] -> State (Map Pseudonym (Sum Integer)) [SheetPseudonym]) [] $ \(Entity _ p@SheetPseudonym{sheetPseudonymPseudonym}) ps -> do
+                    known <- State.gets $ Map.member sheetPseudonymPseudonym
+                    State.modify $ Map.insertWith (<>) sheetPseudonymPseudonym (Sum 1)
+                    return $ bool (p :) id known ps
+            submissionPrototype = Submission
+              { submissionSheet = sid
+              , submissionRatingPoints = Nothing
+              , submissionRatingComment = Nothing
+              , submissionRatingBy = Just uid
+              , submissionRatingAssigned = Just now
+              , submissionRatingTime = Nothing
              }
-            when (genericLength spGroup > maxSize) $
-              addMessageI Warning $ MsgSheetGroupTooLarge sheetGroupDesc
-          RegisteredGroups -> do
-            groups <- E.select . E.from $ \submissionGroup -> do
-              E.where_ . E.exists . E.from $ \submissionGroupUser ->
-                E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser `E.in_` E.valList (map sheetPseudonymUser spGroup)
-              return $ submissionGroup E.^. SubmissionGroupId
-            if
-              | length (groups :: [E.Value SubmissionGroupId]) < 2
-                -> do
-                  subId <- insert submissionPrototype
-                  void . insert $ SubmissionEdit uid now subId
-                  insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
-                    { submissionUserUser = sheetPseudonymUser
-                    , submissionUserSubmission = subId
-                    }
-                  when (null groups) $
-                    addMessageI Warning $ MsgSheetNoRegisteredGroup sheetGroupDesc
-              | otherwise -> addMessageI Error $ MsgSheetAmbiguousRegisteredGroup sheetGroupDesc
-          NoGroups -> do
-            subId <- insert submissionPrototype
-            void . insert $ SubmissionEdit uid now subId
-            insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
-              { submissionUserUser = sheetPseudonymUser
-              , submissionUserSubmission = subId
-              }
-            when (length spGroup > 1) $
-              addMessageI Warning $ MsgSheetNoGroupSubmission sheetGroupDesc
-      redirect CorrectionsGradeR
+          unless (null duplicate)
+            $(addMessageFile Warning "templates/messages/submissionCreateDuplicates.hamlet")
+          existingSubUsers <- E.select . E.from $ \(submissionUser `E.InnerJoin` submission) -> do
+            E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission
+            E.where_ $ submissionUser E.^. SubmissionUserUser `E.in_` E.valList (sheetPseudonymUser <$> concat sps')
+                 E.&&. submission E.^. SubmissionSheet E.==. E.val sid
+            return submissionUser
+          unless (null existingSubUsers) . mapReaderT lift $ do
+            (Map.toList -> subs) <- foldrM (\(Entity _ SubmissionUser{..}) mp -> Map.insertWith (<>) <$> (encrypt submissionUserSubmission :: DB CryptoFileNameSubmission) <*> pure (Set.fromList . map sheetPseudonymPseudonym . filter (\SheetPseudonym{..} -> sheetPseudonymUser == submissionUserUser) $ concat sps') <*> pure mp) Map.empty existingSubUsers
+            $(addMessageFile Warning "templates/messages/submissionCreateExisting.hamlet")
+          let sps'' = filter (not . null) $ filter (\spGroup -> not . flip any spGroup $ \SheetPseudonym{sheetPseudonymUser} -> sheetPseudonymUser `elem` map (submissionUserUser . entityVal) existingSubUsers) sps'
+          forM_ sps'' $ \spGroup
+            -> let
+                 sheetGroupDesc = Text.intercalate ", " $ map (review _PseudonymText . sheetPseudonymPseudonym) spGroup
+                in case sheetGrouping of
+            Arbitrary maxSize -> do
+              subId <- insert submissionPrototype
+              void . insert $ SubmissionEdit uid now subId
+              insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
+                { submissionUserUser = sheetPseudonymUser
+                , submissionUserSubmission = subId
+                }
+              when (genericLength spGroup > maxSize) $
+                addMessageI Warning $ MsgSheetGroupTooLarge sheetGroupDesc
+            RegisteredGroups -> do
+              let spGroup' = Map.fromList $ map (sheetPseudonymUser &&& id) spGroup
+              groups <- E.select . E.from $ \submissionGroup -> do
+                E.where_ . E.exists . E.from $ \submissionGroupUser ->
+                  E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser `E.in_` E.valList (map sheetPseudonymUser spGroup)
+                return $ submissionGroup E.^. SubmissionGroupId
+              groupUsers <- fmap (Set.fromList . map E.unValue) . E.select . E.from $ \submissionGroupUser -> do
+                E.where_ $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup `E.in_` E.valList (map E.unValue groups)
+                return $ submissionGroupUser E.^. SubmissionGroupUserUser
+              if
+                | [_] <- groups
+                , Map.keysSet spGroup' `Set.isSubsetOf` groupUsers
+                  -> do
+                    subId <- insert submissionPrototype
+                    void . insert $ SubmissionEdit uid now subId
+                    insertMany_ . flip map (Set.toList groupUsers) $ \sheetUser -> SubmissionUser
+                      { submissionUserUser = sheetUser
+                      , submissionUserSubmission = subId
+                      }
+                    when (null groups) $
+                      addMessageI Warning $ MsgSheetNoRegisteredGroup sheetGroupDesc
+                | length groups < 2
+                  -> do
+                    forM_ (Set.toList (Map.keysSet spGroup' `Set.difference` groupUsers)) $ \((spGroup' !) -> SheetPseudonym{sheetPseudonymPseudonym}) -> do
+                      addMessageI Error $ MsgSheetNoRegisteredGroup (review _PseudonymText sheetPseudonymPseudonym)
+                      tell $ All False
+                | otherwise ->
+                    addMessageI Error $ MsgSheetAmbiguousRegisteredGroup sheetGroupDesc
+            NoGroups -> do
+              subId <- insert submissionPrototype
+              void . insert $ SubmissionEdit uid now subId
+              insertMany_ . flip map spGroup $ \SheetPseudonym{sheetPseudonymUser} -> SubmissionUser
+                { submissionUserUser = sheetPseudonymUser
+                , submissionUserSubmission = subId
+                }
+              when (length spGroup > 1) $
+                addMessageI Warning $ MsgSheetNoGroupSubmission sheetGroupDesc
+      when allDone $
+        redirect CorrectionsGradeR


  defaultLayout $
--- a/src/Handler/Sheet.hs
+++ b/src/Handler/Sheet.hs
@ -6,6 +6,7 @@ import System.FilePath (takeFileName)
 import Handler.Utils
 -- import Handler.Utils.Zip
 import Handler.Utils.Table.Cells
+import Handler.Utils.SheetType

 -- import Data.Time
 -- import qualified Data.Text as T
@ -41,7 +42,7 @@ import qualified Data.Map as Map

 import Data.Map (Map, (!?))

-import Data.Monoid (Sum(..), Any(..))
+import Data.Monoid (Any(..))

 -- import Control.Lens
 import Utils.Lens
@ -62,7 +63,7 @@ data SheetForm = SheetForm
      { sfName         :: SheetName
      , sfDescription  :: Maybe Html
      , sfType         :: SheetType
-      , sfGrouping     :: SheetGroup      
+      , sfGrouping     :: SheetGroup
      , sfVisibleFrom  :: Maybe UTCTime
      , sfActiveFrom   :: UTCTime
      , sfActiveTo     :: UTCTime
@ -97,8 +98,9 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
      <$> areq ciField        (fslI MsgSheetName)         (sfName        <$> template)
      <*> aopt htmlField      (fslI MsgSheetDescription)  (sfDescription <$> template)
      <*> sheetTypeAFormReq   (fslI MsgSheetType
-            & setTooltip MsgSheetTypeInfo)                  (sfType        <$> template)
-      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        (sfGrouping    <$> template)      
+            & setTooltip (uniworxMessages [MsgSheetTypeInfoBonus,MsgSheetTypeInfoNotGraded]))
+                                                          (sfType        <$> template)
+      <*> sheetGroupAFormReq  (fslI MsgSheetGroup)        (sfGrouping    <$> template)
      <*> aopt utcTimeField   (fslI MsgSheetVisibleFrom
            & setTooltip MsgSheetVisibleFromTip)
                                                              ((sfVisibleFrom  <$> template) <|> pure (Just ctime))
@ -118,7 +120,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
      <*> aopt (multiFileField $ oldFileIds SheetSolution) (fslI MsgSheetSolution) (sfSolutionF <$> template)
      <*> aopt (multiFileField $ oldFileIds SheetMarking)  (fslI MsgSheetMarking
            & setTooltip MsgSheetMarkingTip)   (sfMarkingF <$> template)
-      <*> aopt htmlField      (fslI MsgSheetMarking)      (sfMarkingText <$> template)            
+      <*> aopt htmlField      (fslI MsgSheetMarking)      (sfMarkingText <$> template)
      <*  submitButton
    return $ case result of
      FormSuccess sheetResult
@ -137,7 +139,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
      ] ]

 getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
-getSheetListR tid ssh csh = do 
+getSheetListR tid ssh csh = do
  muid <- maybeAuthId
  Entity cid _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh
  let
@ -152,18 +154,19 @@ getSheetListR tid ssh csh = do
      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
      return (sheet, lastSheetEdit sheet, submission)
    sheetCol = widgetColonnade . mconcat $
-      [ sortable (Just "name") (i18nCell MsgSheet)
-          $ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName)
+      [ dbRow
+      , sortable (Just "name") (i18nCell MsgSheet)
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> anchorCell (CSheetR tid ssh csh sheetName SShowR) (toWidget sheetName)
      , sortable (Just "last-edit") (i18nCell MsgLastEdit)
-          $ \(_, E.Value mEditTime, _) -> maybe mempty timeCell mEditTime
+          $ \DBRow{dbrOutput=(_, E.Value mEditTime, _)} -> maybe mempty timeCell mEditTime
      , sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
-          $ \(Entity _ Sheet{..}, _, _) -> timeCell sheetActiveFrom
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> timeCell sheetActiveFrom
      , sortable (Just "submission-until") (i18nCell MsgSheetActiveTo)
-          $ \(Entity _ Sheet{..}, _, _) -> timeCell sheetActiveTo
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> timeCell sheetActiveTo
      , sortable Nothing (i18nCell MsgSheetType)
-          $ \(Entity _ Sheet{..}, _, _) -> i18nCell sheetType
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, _)} -> i18nCell sheetType
      , sortable Nothing (i18nCell MsgSubmission)
-          $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub)} -> case mbSub of
              Nothing -> mempty
              (Just (Entity sid Submission{..})) ->
                let mkCid = encrypt sid -- TODO: executed twice
@ -172,7 +175,7 @@ getSheetListR tid ssh csh = do
                      return $ CSubmissionR tid ssh csh sheetName cid' SubShowR
                in anchorCellM mkRoute (mkCid >>= \cid2 -> [whamlet|#{display cid2}|])
      , sortable (Just "rating") (i18nCell MsgRating)
-          $ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
+          $ \DBRow{dbrOutput=(Entity _ Sheet{..}, _, mbSub)} -> case mbSub of
              Nothing -> mempty
              (Just (Entity sid Submission{..})) ->
                let mkCid = encrypt sid
@ -180,15 +183,15 @@ getSheetListR tid ssh csh = do
                      cid' <- mkCid
                      return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR
                in anchorCellM mkRoute $(widgetFile "widgets/rating")
-      , sortable Nothing -- (Just "percent") 
+      , sortable Nothing -- (Just "percent")
                        (i18nCell MsgRatingPercent)
-          $ \(Entity _ Sheet{sheetType=sType}, _, mbSub) -> case mbSub of
+          $ \DBRow{dbrOutput=(Entity _ Sheet{sheetType=sType}, _, mbSub)} -> case mbSub of
              (Just (Entity _ Submission{submissionRatingPoints=Just sPoints})) ->
                case preview (_grading . _maxPoints) sType of
                  Just maxPoints
                    | maxPoints /= 0 ->
                        let percent = sPoints / maxPoints
-                        in textCell $ textPercent $ realToFrac percent    
+                        in textCell $ textPercent $ realToFrac percent
                  _other -> mempty
              _other -> mempty
      ]
@ -197,8 +200,8 @@ getSheetListR tid ssh csh = do
  table <- runDB $ dbTableWidget' psValidator DBTable
    { dbtSQLQuery  = sheetData
    , dbtColonnade = sheetCol
-    , dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) }
-                   -> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False)
+    , dbtProj = \dbr@DBRow{ dbrOutput=(Entity _ Sheet{..}, _, _) }
+                   -> dbr <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid ssh csh sheetName SShowR) False)
    , dbtSorting   = Map.fromList
      [ ( "name"
        , SortColumn $ \(sheet `E.LeftOuterJoin` _) -> sheet E.^. SheetName
@ -228,7 +231,7 @@ getSheetListR tid ssh csh = do
    , dbtIdent     = "sheets" :: Text
    }
  -- Collect summary over all Sheets, not just the ones shown due to pagination:
-  SheetTypeSummary{..} <- do
+  statistics <- gradeSummaryWidget MsgSheetGradingSummaryTitle <$> do
    rows <- runDB $ E.select $ E.from $ \(sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) -> do
      E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
      E.on $  (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
@ -238,7 +241,6 @@ getSheetListR tid ssh csh = do
    return $ foldMap (\(E.Value sheetType, E.Value mbPts) -> sheetTypeSum sheetType (join mbPts)) rows
  defaultLayout $ do
    $(widgetFile "sheetList")
-    $(widgetFile "widgets/sheetTypeSummary")

 data ButtonGeneratePseudonym = BtnGenerate
  deriving (Enum, Eq, Ord, Bounded, Read, Show)
@ -398,7 +400,7 @@ getSheetNewR tid ssh csh = do
          { sfName         = stepTextCounterCI sheetName
          , sfDescription  = sheetDescription
          , sfType         = sheetType
-          , sfGrouping     = sheetGrouping          
+          , sfGrouping     = sheetGrouping
          , sfVisibleFrom  = addOneWeek <$> sheetVisibleFrom
          , sfActiveFrom   = addOneWeek     sheetActiveFrom
          , sfActiveTo     = addOneWeek     sheetActiveTo
@ -431,7 +433,7 @@ getSEditR tid ssh csh shn = do
        { sfName         = sheetName
        , sfDescription  = sheetDescription
        , sfType         = sheetType
-        , sfGrouping     = sheetGrouping        
+        , sfGrouping     = sheetGrouping
        , sfVisibleFrom  = sheetVisibleFrom
        , sfActiveFrom   = sheetActiveFrom
        , sfActiveTo     = sheetActiveTo
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@ -263,7 +263,7 @@ multiFileField permittedFiles' = Field{..}
      pVals <- lift permittedFiles'
      let
        decrypt' :: CryptoUUIDFile -> Handler (Maybe FileId)
-        decrypt' = fmap (either (\(_ :: CryptoIDError) -> Nothing) Just) . try . decrypt 
+        decrypt' = fmap (either (\(_ :: CryptoIDError) -> Nothing) Just) . try . decrypt
      yieldMany vals
        .| C.filter (/= unpackZips)
        .| C.map fromPathPiece .| C.catMaybes
@ -288,7 +288,7 @@ multiFileField permittedFiles' = Field{..}
          let fuiChecked
                | Right sentVals' <- sentVals = fuiId' `elem` sentVals'
                | otherwise = True
-          return FileUploadInfo{..}     
+          return FileUploadInfo{..}
      fileInfos <- mapM toFUI <=< handlerToWidget . runDB . E.select . E.from $ \file -> do
          E.where_ $ file E.^. FileId `E.in_` E.valList (setToList pVals)
          E.orderBy [E.asc $ file E.^. FileTitle]
@ -303,13 +303,13 @@ multiFileField permittedFiles' = Field{..}


 data SheetGrading' = Points' | PassPoints' | PassBinary'
-  deriving (Eq, Ord, Read, Show, Enum, Bounded)      
+  deriving (Eq, Ord, Read, Show, Enum, Bounded)

 instance Universe SheetGrading'
 instance Finite SheetGrading'

 nullaryPathPiece ''SheetGrading' (camelToPathPiece . dropSuffix "'")
-embedRenderMessage ''UniWorX ''SheetGrading' ("SheetGrading" <>)  
+embedRenderMessage ''UniWorX ''SheetGrading' ("SheetGrading" <>)


 data SheetType' = Bonus' | Normal' | Informational' | NotGraded'
@ -319,7 +319,7 @@ instance Universe SheetType'
 instance Finite SheetType'

 nullaryPathPiece ''SheetType' (camelToPathPiece . dropSuffix "'")
-embedRenderMessage ''UniWorX ''SheetType' ("SheetType" <>)  
+embedRenderMessage ''UniWorX ''SheetType' ("SheetType" <>)


 data SheetGroup' = Arbitrary' | RegisteredGroups' | NoGroups'
@ -333,31 +333,31 @@ embedRenderMessage ''UniWorX ''SheetGroup' (("SheetGroup" <>) . dropSuffix "'")

 sheetGradingAFormReq :: FieldSettings UniWorX -> Maybe SheetGrading -> AForm Handler SheetGrading
 sheetGradingAFormReq fs template = multiActionA fs selOptions (classify' <$> template)
-  where 
-    selOptions = Map.fromList 
-      [ ( Points', Points <$> maxPointsReq )
+  where
+    selOptions = Map.fromList
+      [ ( Points',     Points     <$> maxPointsReq )
      , ( PassPoints', PassPoints <$> maxPointsReq <*> passPointsReq )
      , ( PassBinary', pure PassBinary)
      ]
-    classify' :: SheetGrading -> SheetGrading' 
-    classify' = \case 
-      Points {} -> Points'
+    classify' :: SheetGrading -> SheetGrading'
+    classify' = \case
+      Points     {} -> Points'
      PassPoints {} -> PassPoints'
      PassBinary {} -> PassBinary'
-    
-    maxPointsReq  = apreq pointsField (fslI MsgSheetGradingMaxPoints) (template >>= preview _maxPoints)
+
+    maxPointsReq  = apreq pointsField (fslI MsgSheetGradingMaxPoints)     (template >>= preview _maxPoints)
    passPointsReq = apreq pointsField (fslI MsgSheetGradingPassingPoints) (template >>= preview _passingPoints)


 sheetTypeAFormReq :: FieldSettings UniWorX -> Maybe SheetType -> AForm Handler SheetType
 sheetTypeAFormReq fs template = multiActionA fs selOptions (classify' <$> template)
-  where 
+  where
    selOptions = Map.fromList
      [ ( Bonus' , Bonus  <$> gradingReq )
      , ( Normal', Normal <$> gradingReq )
      , ( Informational', Informational <$> gradingReq  )
      , ( NotGraded', pure NotGraded )
-      ]    
+      ]
    gradingReq = sheetGradingAFormReq (fslI MsgSheetGrading
        & setTooltip MsgSheetGradingInfo) (template >>= preview _grading)

@ -440,8 +440,8 @@ utcTimeField = Field
    fieldTimeFormat :: String
    --fieldTimeFormat = "%e.%m.%y %k:%M"
    fieldTimeFormat = "%Y-%m-%dT%H:%M"
-    
-    -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any 
+
+    -- `defaultTimeLocale` is okay here, since `fieldTimeFormat` does not contain any
    readTime :: Text -> Either UniWorXMessage UTCTime
    readTime t =
      case localTimeToUTC <$> parseTimeM True defaultTimeLocale fieldTimeFormat (T.unpack t) of
@ -595,7 +595,7 @@ formResultModal res finalDest handler = maybeT_ $ do
    FormMissing -> mzero
    FormFailure errs -> mapM_ (addMessage Error . toHtml) errs >> mzero
    FormSuccess val -> lift . execWriterT $ handler val
-  
+
  isModal <- hasCustomHeader HeaderIsModal
  if
    | isModal   -> sendResponse $ toJSON messages
--- a/src/Handler/Utils/Rating.hs
+++ b/src/Handler/Utils/Rating.hs
@ -41,7 +41,7 @@ import qualified Database.Esqueleto as E

 import qualified Data.Conduit.List as Conduit

-import Utils.Lens hiding ((<.>))
+import Utils.Lens


 instance HasResolution prec => Pretty (Fixed prec) where
@ -51,7 +51,7 @@ instance Pretty x => Pretty (CI x) where
  pretty = pretty . CI.original


-instance Pretty SheetGrading where   
+instance Pretty SheetGrading where
  pretty Points{..}     = pretty ( show maxPoints <> " Punkte" :: String)
  pretty PassPoints{..} = pretty ( show maxPoints <> " Punkte, bestanden ab " <> show passingPoints <> " Punkte" :: String )
  pretty PassBinary     = pretty ( "Bestanden (1) /  Nicht bestanden (0)" :: String )
@ -59,12 +59,12 @@ instance Pretty SheetGrading where

 validateRating :: SheetType -> Rating' -> [RatingException]
 validateRating ratingSheetType Rating'{ratingPoints=Just rp, ..}
-  | rp < 0 
-    = [RatingNegative] 
-  | NotGraded <- ratingSheetType 
+  | rp < 0
+    = [RatingNegative]
+  | NotGraded <- ratingSheetType
    = [RatingNotExpected]
  | (Just maxPoints ) <- ratingSheetType ^?  _grading . _maxPoints
-  , rp > maxPoints 
+  , rp > maxPoints
    = [RatingExceedsMax]
  | (Just PassBinary) <- ratingSheetType ^? _grading
  , not (rp == 0 || rp == 1)
@ -98,7 +98,7 @@ getRating submissionId = runMaybeT $ do
    , E.unValue -> ratingComment
    , E.unValue -> ratingTime
    ) ] <- lift query
-  
+
  return Rating{ ratingValues = Rating'{..}, .. }

 formatRating :: CryptoFileNameSubmission -> Rating -> Lazy.ByteString
--- a/src/Handler/Utils/SheetType.hs
+++ b/src/Handler/Utils/SheetType.hs
@ -0,0 +1,39 @@
+module Handler.Utils.SheetType
+  (
+    gradeSummaryWidget
+  ) where
+
+import Import
+import Data.Monoid (Sum(..))
+import Utils.Lens
+
+addBonusToPoints :: SheetTypeSummary -> SheetTypeSummary
+addBonusToPoints sts =
+    sts & _normalSummary . _achievedPoints %~ maxBonusPts  . addBonusPts
+        & _normalSummary . _achievedPasses %~ maxBonusPass . addBonusPass
+  where
+    bonusPoints  = sts ^. _bonusSummary  . _achievedPoints
+    maxPoints    = sts ^. _normalSummary . _sumGradePoints
+    maxBonusPts  = fmap $ min maxPoints
+    addBonusPts  = maybeAdd bonusPoints
+
+    bonusPasses  = sts ^. _bonusSummary  . _achievedPasses
+    maxPasses    = sts ^. _normalSummary . _numGradePasses
+    maxBonusPass = fmap $ min maxPasses
+    addBonusPass = maybeAdd bonusPasses
+
+gradeSummaryWidget ::  RenderMessage UniWorX msg => (Int -> msg) -> SheetTypeSummary -> Widget
+gradeSummaryWidget title sts =
+  let SheetTypeSummary{..} = addBonusToPoints sts
+      sumSummaries = normalSummary <> bonusSummary <> informationalSummary & _numSheets %~ (<> numNotGraded)
+      hasPassings  = positiveSum $ numGradePasses sumSummaries
+      hasPoints    = positiveSum $ sumGradePoints sumSummaries
+      rowWdgts =  [ $(widgetFile "widgets/gradingSummaryRow")
+                  | (sumHeader,summary) <-
+                    [ (MsgSheetTypeNormal'        ,normalSummary)
+                    , (MsgSheetTypeBonus'         ,bonusSummary)
+                    , (MsgSheetTypeInformational' ,informationalSummary)
+                  ] ]
+  in if 0 == numSheets sumSummaries
+        then mempty
+        else $(widgetFile "widgets/gradingSummary")
--- a/src/Handler/Utils/Table/Pagination.hs
+++ b/src/Handler/Utils/Table/Pagination.hs
@ -183,7 +183,7 @@ instance Default (PSValidator m x) where
    Just pi -> swap . (\act -> execRWS act pi def) $ do
      asks piSorting >>= maybe (return ()) (\s -> modify $ \ps -> ps { psSorting = s })
      asks piFilter >>= maybe (return ()) (\f -> modify $ \ps -> ps { psFilter = f })
-      
+
      l <- asks piLimit
      case l of
        Just l'
@ -258,7 +258,7 @@ class (MonadHandler m, Monoid x, Monoid (DBCell m x)) => IsDBTable (m :: * -> *)

  data DBCell m x :: *
  dbCell :: Iso' (DBCell m x) ([(Text, Text)], WriterT x m Widget)
-    
+
  -- dbWidget :: Proxy m -> Proxy x -> Iso' (DBResult m x) (Widget, DBResult' m x)
  -- | Format @DBTable@ when sort-circuiting
  dbWidget   :: forall m'. (MonadHandler m', HandlerSite m' ~ UniWorX) => DBTable m x -> PaginationInput -> DBResult m x -> m' Widget
@ -284,7 +284,7 @@ instance Monoid x => IsDBTable (HandlerT UniWorX IO) x where
  dbCell = iso
    (\WidgetCell{..} -> (wgtCellAttrs, wgtCellContents))
    (uncurry WidgetCell)
-  
+
  -- dbWidget Proxy Proxy = iso (, ()) $ view _1
  dbWidget _ _ = return . snd
  dbHandler _ _ f = return . over _2 f
@ -331,7 +331,7 @@ instance Monoid a => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) Enc
  dbCell = iso
    (\FormCell{..} -> (formCellAttrs, WriterT $ fmap swap formCellContents))
    (\(attrs, mkWidget) -> FormCell attrs . fmap swap $ runWriterT mkWidget)
-  
+
  -- dbWidget Proxy Proxy = iso ((,) <$> view (_1._2) <*> ((,) <$> view (_1._1) <*> view _2))
  --                            ((,) <$> ((,) <$> view (_2._1) <*> view _1) <*> view (_2._2))
  dbWidget dbtable pi = liftHandlerT . fmap (view $ _1 . _2) . runFormPost . addPIHiddenField dbtable pi
@ -353,10 +353,10 @@ addPIHiddenField DBTable{ dbtIdent = (toPathPiece -> dbtIdent) } pi form fragmen
 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')
-  
+
 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 -> DB (DBResult m x)
 dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> dbtIdent), dbtStyle = DBStyle{..}, .. } = do
@ -378,7 +378,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
      , fieldView = error "multiTextField: should not be rendered"
      , fieldEnctype = UrlEncoded
      }
-    
+
  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)
@ -571,6 +571,7 @@ formCell genIndex genForm input = FormCell

 -- Predefined colonnades

+--Number column?
 dbRow :: forall h r m a. (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a)
 dbRow = Colonnade.singleton (headednessPure $ i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex

--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@ -3,7 +3,7 @@ module Import.NoFoundation
    , MForm
    ) where

-import ClassyPrelude.Yesod    as Import hiding (formatTime, derivePersistFieldJSON, addMessage, addMessageI, (.=), MForm, Proxy, foldlM)
+import ClassyPrelude.Yesod    as Import hiding (formatTime, derivePersistFieldJSON, addMessage, addMessageI, (.=), MForm, Proxy, foldlM, static)
 import Model                  as Import
 import Model.Types.JSON       as Import
 import Model.Migration        as Import
@ -35,10 +35,12 @@ import Mail                   as Import
 import Data.Data              as Import (Data)
 import Data.Typeable          as Import (Typeable)
 import GHC.Generics           as Import (Generic)
+import GHC.Exts               as Import (IsList)

 import Data.Hashable          as Import
 import Data.List.NonEmpty     as Import (NonEmpty(..))
 import Data.Text.Encoding.Error    as Import(UnicodeException(..))
+import Data.Semigroup         as Import (Semigroup)

 import Control.Monad.Morph    as Import (MFunctor(..))

--- a/src/Jobs.hs
+++ b/src/Jobs.hs
@ -134,6 +134,7 @@ execCrontab = evalStateT go HashMap.empty
        runConduit $ transPipe lift (selectSource [] []) .| C.mapM_ merge

      refT <- liftIO getCurrentTime
+      settings <- getsYesod appSettings
      currentState <- mapStateT (mapReaderT $ liftIO . atomically) $ do
        crontab' <- liftBase . tryReadTMVar =<< asks jobCrontab
        case crontab' of
@ -141,7 +142,7 @@ execCrontab = evalStateT go HashMap.empty
          Just crontab -> Just <$> do
            State.modify . HashMap.filterWithKey $ \k _ -> HashMap.member k crontab
            prevExec <- State.get
-            case earliestJob prevExec crontab refT of
+            case earliestJob settings prevExec crontab refT of
              Nothing -> liftBase retry
              Just (_, MatchNone) -> liftBase retry
              Just x -> return (crontab, x)
@ -189,6 +190,11 @@ execCrontab = evalStateT go HashMap.empty
        acc :: NominalDiffTime
        acc = 1e-3

+        debouncingAcc :: AppSettings -> JobCtl -> NominalDiffTime
+        debouncingAcc AppSettings{appNotificationRateLimit} = \case
+          JobCtlQueue (JobQueueNotification _) -> appNotificationRateLimit
+          _ -> acc
+
        applyJitter :: (MonadHandler m, HandlerSite m ~ UniWorX, Hashable seed) => seed -> UTCTime -> m UTCTime
        applyJitter seed t = do
          appInstance <- getsYesod appInstanceID
@ -197,8 +203,8 @@ execCrontab = evalStateT go HashMap.empty
            diff = evalRand ( (* acc) . fromInteger <$> getRandomR (- halfRange, halfRange)) $ mkStdGen (hash appInstance `hashWithSalt` seed)
          return $ addUTCTime diff t

-        earliestJob :: HashMap JobCtl (Max UTCTime) -> Crontab JobCtl -> UTCTime -> Maybe (JobCtl, CronNextMatch UTCTime)
-        earliestJob lastTimes crontab now = foldr go' Nothing $ HashMap.toList crontab
+        earliestJob :: AppSettings -> HashMap JobCtl (Max UTCTime) -> Crontab JobCtl -> UTCTime -> Maybe (JobCtl, CronNextMatch UTCTime)
+        earliestJob settings lastTimes crontab now = foldr go' Nothing $ HashMap.toList crontab
          where
            go' (jobCtl, cron) mbPrev
              | Just (_, t') <- mbPrev
@ -207,7 +213,7 @@ execCrontab = evalStateT go HashMap.empty
              | otherwise
              = Just (jobCtl, t)
              where
-                t = nextCronMatch appTZ (getMax <$> HashMap.lookup jobCtl lastTimes) acc now cron
+                t = nextCronMatch appTZ (getMax <$> HashMap.lookup jobCtl lastTimes) (debouncingAcc settings jobCtl) now cron

        waitUntil :: (Eq a, MonadResourceBase m, MonadLogger m) => TMVar a -> a -> UTCTime -> m Bool
        waitUntil crontabTV crontab nextTime = runResourceT $ do
--- a/src/Model/Rating.hs
+++ b/src/Model/Rating.hs
@ -2,7 +2,6 @@ module Model.Rating where

 import ClassyPrelude.Yesod
 import Model
-
 -- import Data.Text (Text)
 import Data.Text.Encoding.Error (UnicodeException(..))
 import GHC.Generics (Generic)
--- a/src/Model/Types.hs
+++ b/src/Model/Types.hs
@ -135,10 +135,11 @@ gradingPassed (PassPoints {..}) pts = Just $ pts >= passingPoints
 gradingPassed (PassBinary {}) pts = Just $ pts /= 0

 data SheetGradeSummary = SheetGradeSummary
-  { sumGradePoints :: Sum Points
+  { numSheets      :: Sum Int
  , numGradePasses :: Sum Int
-  , achievedPoints :: Maybe (Sum Points)
+  , sumGradePoints :: Sum Points
  , achievedPasses :: Maybe (Sum Int)
+  , achievedPoints :: Maybe (Sum Points)
  } deriving (Generic, Read, Show, Eq)

 instance Monoid SheetGradeSummary where
@ -146,18 +147,25 @@ instance Monoid SheetGradeSummary where
  mappend = mappenddefault

 instance Semigroup SheetGradeSummary where
-  (<>) = mappend -- remove for GHC > 8.4.x
+  (<>) = mappend -- TODO: remove for GHC > 8.4.x
+
+makeLenses_ ''SheetGradeSummary

 sheetGradeSum :: SheetGrading -> Maybe Points -> SheetGradeSummary
 sheetGradeSum gr (Just p) =
  let baseSum = (sheetGradeSum gr Nothing) { achievedPasses = Sum . bool 0 1 <$> gradingPassed gr p }
  in case gr of PassBinary -> baseSum
                _other     -> baseSum { achievedPoints = Just $ Sum $ p }
-sheetGradeSum (Points {..})    Nothing = mempty { sumGradePoints = Sum maxPoints }
-sheetGradeSum (PassPoints{..}) Nothing = mempty { sumGradePoints = Sum maxPoints
-                                                , numGradePasses = Sum 1 }
-sheetGradeSum (PassBinary)     Nothing = mempty { numGradePasses = Sum 1 }
-
+sheetGradeSum (Points {..})    Nothing = mempty { numSheets      = Sum 1
+                                                , sumGradePoints = Sum maxPoints
+                                                }
+sheetGradeSum (PassPoints{..}) Nothing = mempty { numSheets      = Sum 1
+                                                , numGradePasses = Sum 1
+                                                , sumGradePoints = Sum maxPoints
+                                                }
+sheetGradeSum (PassBinary)     Nothing = mempty { numSheets      = Sum 1
+                                                , numGradePasses = Sum 1
+                                                }

 data SheetType
  = Normal        { grading :: SheetGrading }
@ -174,19 +182,26 @@ deriveJSON defaultOptions
 derivePersistFieldJSON ''SheetType

 data SheetTypeSummary = SheetTypeSummary
-  { normalSummary, bonusSummary, informationalSummary :: SheetGradeSummary
-  , numNotGraded  :: Sum Int
+  { normalSummary
+  , bonusSummary
+  , informationalSummary :: SheetGradeSummary
+  , numNotGraded :: Sum Int
  } deriving (Generic, Read, Show, Eq)

 instance Monoid SheetTypeSummary where
  mempty  = memptydefault
  mappend = mappenddefault

+instance Semigroup SheetTypeSummary where
+  (<>) = mappend -- TODO: remove for GHC > 8.4.x
+
+makeLenses_ ''SheetTypeSummary
+
 sheetTypeSum :: SheetType -> Maybe Points -> SheetTypeSummary
 sheetTypeSum Bonus{..}         mps = mempty { bonusSummary         = sheetGradeSum grading mps }
 sheetTypeSum Normal{..}        mps = mempty { normalSummary        = sheetGradeSum grading mps }
 sheetTypeSum Informational{..} mps = mempty { informationalSummary = sheetGradeSum grading mps }
-sheetTypeSum NotGraded _           = mempty { numNotGraded = Sum 1 }
+sheetTypeSum NotGraded _           = mempty { numNotGraded         = Sum 1 }

 data SheetGroup
  = Arbitrary { maxParticipants :: Natural }
--- a/src/Settings.hs
+++ b/src/Settings.hs
@ -29,7 +29,7 @@ import           Yesod.Default.Util          (WidgetFileSettings,
                                              widgetFileReload)
 import qualified Yesod.Auth.Util.PasswordStore as PWStore

-import Data.Time (NominalDiffTime)
+import Data.Time (NominalDiffTime, nominalDay)

 import Data.Scientific (toBoundedInteger)
 import Data.Word (Word16)
@ -47,12 +47,15 @@ import qualified Data.Char as Char

 import qualified Network.HaskellNet.Auth as HaskellNet (UserName, Password, AuthType(..))
 import qualified Network.Socket as HaskellNet (PortNumber(..), HostName)
+import qualified Network

 import Network.Mail.Mime (Address)
 import Network.Mail.Mime.Instances ()

 import Mail (VerpMode)

+import qualified Database.Memcached.Binary.Types as Memcached
+
 import Model
 import Settings.Cluster

@ -68,6 +71,8 @@ data AppSettings = AppSettings
    -- ^ Configuration settings for accessing the LDAP-directory
    , appSmtpConf               :: Maybe SmtpConf
    -- ^ Configuration settings for accessing a SMTP Mailserver
+    , appWidgetMemcachedConf    :: Maybe WidgetMemcachedConf
+    -- ^ Configuration settings for accessing a Memcached instance for use with `addStaticContent`
    , appRoot                   :: Maybe Text
    -- ^ Base for all generated URLs. If @Nothing@, determined
    -- from the request headers.
@ -167,6 +172,34 @@ data SmtpConf = SmtpConf
  , smtpPool :: ResourcePoolConf
  } deriving (Show)

+data WidgetMemcachedConf = WidgetMemcachedConf
+  { widgetMemcachedConnectInfo :: Memcached.ConnectInfo
+  , widgetMemcachedBaseUrl     :: Text
+  , widgetMemcachedExpiry      :: Maybe NominalDiffTime
+  } deriving (Show)
+
+instance FromJSON Memcached.Auth where
+  parseJSON = Aeson.withText "Auth" $ \(Text.breakOn "@" -> (encodeUtf8 -> user, encodeUtf8 -> pw)) -> return $ Memcached.Plain user pw
+
+instance FromJSON Network.PortID where
+  parseJSON v = Network.UnixSocket <$> pSocket v <|> Network.PortNumber <$> pNumber v <|> Network.Service <$> pService v
+    where
+      pSocket = Aeson.withText "UnixSocket" $ fmap unpack . assertM' ("/" `Text.isPrefixOf`)
+      pNumber = Aeson.withScientific "PortNumber" $ maybe (fail "PortNumber ") (return . (fromIntegral :: Word16 -> Network.PortNumber)) . toBoundedInteger
+      pService = Aeson.withText "Service" $ return . unpack
+
+instance FromJSON WidgetMemcachedConf where
+  parseJSON = withObject "WidgetMemcachedConf" $ \o -> do
+    connectHost <- o .: "host"
+    connectPort <- o .: "port"
+    connectAuth <- o .: "auth"
+    numConnection <- o .: "limit"
+    connectionIdleTime <- o .: "timeout"
+    widgetMemcachedBaseUrl <- o .: "base-url"
+    widgetMemcachedExpiry <- assertM (maybe True $ \t -> 0 < t && t <= 30 * nominalDay) $ o .:? "expiration"
+    
+    return WidgetMemcachedConf{ widgetMemcachedConnectInfo = Memcached.ConnectInfo{..}, .. }
+
 data ResourcePoolConf = ResourcePoolConf
  { poolStripes :: Int
  , poolTimeout :: NominalDiffTime
@ -284,6 +317,15 @@ instance FromJSON AppSettings where
              Ldap.Plain host -> not $ null host
        appLdapConf               <- assertM nonEmptyHost <$> o .:? "ldap"
        appSmtpConf               <- assertM (not . null . smtpHost) <$> o .:? "smtp"
+        let validWidgetMemcachedConf WidgetMemcachedConf{ widgetMemcachedConnectInfo = Memcached.ConnectInfo{..}, ..} = and
+              [ not (null connectHost) || isUnixSocket connectPort
+              , not $ null widgetMemcachedBaseUrl
+              , numConnection > 0
+              , connectionIdleTime >= 0
+              ]
+            isUnixSocket (Network.UnixSocket _) = True
+            isUnixSocket _ = False
+        appWidgetMemcachedConf    <- assertM validWidgetMemcachedConf <$> o .:? "widget-memcached"
        appRoot                   <- o .:? "approot"
        appHost                   <- fromString <$> o .: "host"
        appPort                   <- o .: "port"
--- a/src/Settings/StaticFiles.hs
+++ b/src/Settings/StaticFiles.hs
@ -1,18 +1,26 @@
-module Settings.StaticFiles where
+module Settings.StaticFiles
+  ( module Settings.StaticFiles
+  , module Yesod.EmbeddedStatic
+  ) where
+
+import ClassyPrelude

 import Settings     (appStaticDir, compileTimeAppSettings)
-import Yesod.Static (staticFiles)
+import Yesod.EmbeddedStatic

 -- This generates easy references to files in the static directory at compile time,
 -- giving you compile-time verification that referenced files exist.
 -- Warning: any files added to your static directory during run-time can't be
-- accessed this way. You'll have to use their FilePath or URL to access them.
+-- accessed this way.
 --
 -- For example, to refer to @static/js/script.js@ via an identifier, you'd use:
 --
 --     js_script_js
--
-- If the identifier is not available, you may use:
--
--     StaticFile ["js", "script.js"] []
-staticFiles (appStaticDir compileTimeAppSettings)
+
+#ifdef DEVELOPMENT
+#define DEV_BOOL True
+#else
+#define DEV_BOOL False
+#endif
+
+mkEmbeddedStatic DEV_BOOL "embeddedStatic" [embedDir $ appStaticDir compileTimeAppSettings]
--- a/src/Utils.hs
+++ b/src/Utils.hs
@ -63,6 +63,9 @@ import qualified Crypto.Saltine.Core.SecretBox as SecretBox
 import qualified Crypto.Saltine.Class as Saltine
 import qualified Crypto.Data.PKCS7 as PKCS7

+import Data.Fixed (Centi)
+import Data.Ratio ((%))
+


 -----------
@ -87,7 +90,7 @@ guardAuthResult AuthenticationRequired = notAuthenticated
 guardAuthResult (Unauthorized t) = permissionDenied t
 guardAuthResult Authorized = return ()

-data UnsupportedAuthPredicate route = UnsupportedAuthPredicate String route
+data UnsupportedAuthPredicate route = UnsupportedAuthPredicate Text route
  deriving (Eq, Ord, Typeable, Show)
 instance (Show route, Typeable route) => Exception (UnsupportedAuthPredicate route)

@ -95,8 +98,8 @@ unsupportedAuthPredicate :: ExpQ
 unsupportedAuthPredicate = do
  logFunc <- logErrorS
  [e| \tag route -> do
-        $(return logFunc) "AccessControl" [st|"!#{tag}" used on route that doesn't support it: #{tshow route}|]
-        unauthorizedI (UnsupportedAuthPredicate tag route)
+        $(return logFunc) "AccessControl" [st|"!#{toPathPiece tag}" used on route that doesn't support it: #{tshow route}|]
+        unauthorizedI (UnsupportedAuthPredicate (toPathPiece tag) route)
    |]


@ -204,15 +207,16 @@ instance {-# OVERLAPPABLE #-} Show a => DisplayAble a where -- The easy way out
  display = pack . show
 -}

-textPercent :: Double -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
+textPercent :: Real a => a -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
 textPercent x = lz <> pack (show rx) <> "%"
 where
-   round' :: Double -> Int -- avoids annoying warning
-   round' = round
-   rx :: Double
-   rx = fromIntegral (round' $ 1000.0*x) / 10.0
+   rx :: Centi
+   rx = realToFrac (x * 100)
   lz = if rx < 10.0 then "0" else ""

+textPercentInt :: Integral a => a -> a -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
+textPercentInt part whole = textPercent $ fromIntegral part % fromIntegral whole
+
 stepTextCounterCI :: CI Text -> CI Text -- find and increment rightmost-number, preserving leading zeroes
 stepTextCounterCI = CI.map stepTextCounter

@ -317,14 +321,13 @@ toNothing = const Nothing
 toNothingS :: String -> Maybe b
 toNothingS = const Nothing

-maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap
+maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap/ap
 maybeAdd (Just x) (Just y) = Just (x + y)
 maybeAdd Nothing y  = y
 maybeAdd x Nothing  = x

 maybeEmpty :: Monoid m => Maybe a -> (a -> m) -> m
-maybeEmpty (Just x) f = f x
-maybeEmpty Nothing  _ = mempty
+maybeEmpty = flip foldMap

 whenIsJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
 whenIsJust (Just x) f = f x
@ -339,7 +342,7 @@ maybePositive a | a > 0     = Just a
                | otherwise = Nothing

 positiveSum :: (Num a, Ord a) => Sum a -> Maybe a -- like maybePositive
-positiveSum (Sum x) = maybePositive x
+positiveSum = maybePositive . getSum

 maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b
 maybeM dft act mb = mb >>= maybe dft act
@ -369,7 +372,6 @@ instance Ord a => Ord (NTop (Maybe a)) where
  compare (NTop (Just x)) (NTop (Just y)) = compare x y


-
 ------------
 -- Either --
 ------------
--- a/src/Utils/Lens.hs
+++ b/src/Utils/Lens.hs
@ -1,7 +1,7 @@
 module Utils.Lens ( module Utils.Lens ) where

 import Import.NoFoundation
-import Control.Lens as Utils.Lens
+import Control.Lens as Utils.Lens hiding ((<.>))
 import Control.Lens.Extras as Utils.Lens (is)
 import Utils.Lens.TH as Utils.Lens (makeLenses_)

--- a/stack.yaml
+++ b/stack.yaml
@ -45,4 +45,8 @@ extra-deps:
  - quickcheck-classes-0.4.14
  - semirings-0.2.1.1

+  - memcached-binary-0.2.0
+
+allow-newer: true
+
 resolver: lts-10.5
--- a/embedded/favicon.ico
+++ b/embedded/favicon.ico
--- a/embedded/robots.txt
+++ b/embedded/robots.txt
--- a/templates/corrections.hamlet
+++ b/templates/corrections.hamlet
@ -1,5 +1,7 @@
-<div .container>
+<section>
  <form method=POST enctype=#{tableEncoding} action=@{currentRoute}>
    ^{table}
    <button type=submit>
      _{MsgBtnSubmit}
+<section>
+  ^{statistics}
--- a/templates/sheetList.hamlet
+++ b/templates/sheetList.hamlet
@ -1 +1,4 @@
-^{table}
+<section>
+  ^{table}
+<section>
+  ^{statistics}
--- a/templates/standalone/alerts.julius
+++ b/templates/standalone/alerts.julius
@ -29,7 +29,7 @@
      var iconEl = document.createElement('DIV');
      var closeEl = document.createElement('DIV');
      var dataDecay = alertEl.dataset.decay;
-      var autoDecay = 30;
+      var autoDecay = 10;
      if (dataDecay) {
        autoDecay = parseInt(dataDecay, 10);
      }
--- a/templates/standalone/modal.julius
+++ b/templates/standalone/modal.julius
@ -76,7 +76,7 @@

                var scriptClone = document.createElement('script');
                if (scriptTag.text)
-                  scriptClone.text = striptTag.text;
+                  scriptClone.text = scriptTag.text;
                if (scriptTag.hasAttributes()) {
                  var attrs = scriptTag.attributes;
                  for (var i = attrs.length - 1; i >= 0; i--) {
--- a/templates/widgets/gradingSummary.hamlet
+++ b/templates/widgets/gradingSummary.hamlet
@ -0,0 +1,30 @@
+$# Displays gradings Summary for various purposes
+$# --
+<div>
+  <h3>_{title $ getSum $ numSheets $ sumSummaries}
+  <table .table .table--striped>
+    <tr .table__row .table__row--head>
+      <th>
+      $# empty cell for row headers
+      $maybe _ <- hasPassings
+        <th .table__th colspan=2>_{MsgSheetGradingPassing'}
+      $maybe _ <- hasPoints
+        <th .table__th colspan=2>_{MsgSheetGradingPoints'}
+      <th .table__th>_{MsgSheetGradingCount'}
+        $# Number of Sheet/Submissions used for calculating maximum passes/points
+    $forall row <- rowWdgts
+      ^{row}
+    $maybe nrNoGrade <- positiveSum $ numNotGraded
+      <tr .table__row>
+        <th .table__th>_{MsgSheetTypeNotGraded}
+        $maybe _ <- hasPassings
+          <td colspan=2>
+        $maybe _ <- hasPoints
+          <td .table__td colspan=2>
+        <td .table__td>#{display nrNoGrade}
+  $maybe _ <- positiveSum $ bonusSummary ^. _numSheets
+    <p>_{MsgSheetTypeInfoBonus}
+      $maybe _ <- positiveSum =<< (bonusSummary ^. _achievedPoints)
+        _{MsgSheetGradingBonusIncluded}
+  $maybe _ <- positiveSum $ informationalSummary ^. _numSheets
+    <p>_{MsgSheetTypeInfoNotGraded}
--- a/templates/widgets/gradingSummaryRow.hamlet
+++ b/templates/widgets/gradingSummaryRow.hamlet
@ -0,0 +1,33 @@
+$# Displays one row of the grading summary
+$# Expects several variables:
+$#  hasPassing :: Maybe Int    -- Should Passing be displayed?
+$#  hasPoints  :: Maybe Poibts -- Should Points  be displayed?
+$#  summary    :: SheetGradeSummary -- summary to display
+$#  sumHeader  :: UniWorXMessage    -- row header
+$#
+  $maybe nrSheets <- positiveSum $ summary ^. _numSheets
+    <tr .table__row >
+      <th .table__th>_{sumHeader}
+      $maybe _ <- hasPassings
+        $with Sum pmax <- summary ^. _numGradePasses
+          $maybe Sum pacv <- summary ^. _achievedPasses
+              <td .table__td>
+                $if pmax /= 0
+                  #{textPercentInt pacv pmax}
+              <td .table__td>
+                #{display pacv} / #{display pmax}
+          $nothing
+            <td .table__td colspan=2>
+              #{display pmax }
+      $maybe _ <- hasPoints
+        $with Sum pmax <- summary ^. _sumGradePoints
+          $maybe Sum pacv <- summary ^. _achievedPoints
+              <td .table__td>
+                $if pmax /= 0
+                  #{textPercent $ realToFrac $ pacv / pmax}
+              <td .table__td>
+                #{display pacv} / #{display pmax}
+          $nothing
+            <td .table__td colspan=2>
+              #{display pmax }
+      <td .table__td>#{display nrSheets}
--- a/templates/widgets/rating.hamlet
+++ b/templates/widgets/rating.hamlet
@ -3,18 +3,19 @@ $#  submissionRatingPoints :: Maybe points

 $maybe points <- submissionRatingPoints
  $maybe grading <- preview _grading sheetType
-    $case grading	
+    $case grading
      $of Points{..}
-        _{MsgAchievedOf points maxPoints}          
-      $of PassPoints{}
-        $if fromMaybe False (gradingPassed grading points)
-          _{MsgPassed}
-        $else
-          _{MsgNotPassed}
-      $of PassBinary 
+        _{MsgAchievedOf points maxPoints}
+      $of PassPoints{maxPoints}
+        $if fromMaybe False (gradingPassed grading points)
+          _{MsgPassed}, _{MsgAchievedOf points maxPoints}
+        $else
+          _{MsgNotPassed}, _{MsgAchievedOf points maxPoints}
+      $of PassBinary
        $if fromMaybe False (gradingPassed grading points)
          _{MsgPassed}
        $else
          _{MsgNotPassed}
+    , _{SheetTypeHeader sheetType}
  $nothing
    #{tickmarkS}
--- a/templates/widgets/sheetTypeSummary.hamlet
+++ b/templates/widgets/sheetTypeSummary.hamlet
@ -1,9 +1,9 @@
-$with realGrades <- normalSummary <> bonusSummary 
+$# DEPRECATED IN FAVOUR OF widgets/gradingSummary.hamlet DO NOT USE !!!
+$with realGrades <- normalSummary <> bonusSummary
  $# $with allGrades <- realGrades <> informationalSummary
  <div>
-    <ul>    
-      $maybe realPoints <- positiveSum (sumGradePoints realGrades) 
-        <li>     
+      $maybe realPoints <- positiveSum (sumGradePoints realGrades)
+        <p>
          Gesamtpunktzahl #{display realPoints}
          $maybe nPts <- getSum <$> achievedPoints realGrades
            \ davon #{display nPts} erreicht
@ -13,21 +13,21 @@ $with realGrades <- normalSummary <> bonusSummary
                von #{display achievedBonus} erreichbaren #
              Bonuspunkten)
            $if realPoints /= 0
-              \ #{textPercent $ realToFrac $ nPts / realPoints}    
+              \ #{textPercent $ realToFrac $ nPts / realPoints}
            \.
      $maybe fakePoints <- positiveSum (sumGradePoints informationalSummary)
-        <li>
-          <em>Hinweis: 
+        <p>
+          <em>Hinweis:
          \ #{display fakePoints} Punkte gab es für Aufgabenblätter, #
          welche nicht gewertet wurden, sondern nur informativen Charakter besitzen
          $maybe achievedFakes <- getSum <$> achievedPoints informationalSummary
            , davon wurden #{display achievedFakes} erreicht
            $if fakePoints /= 0
-              \ #{textPercent $ realToFrac $ achievedFakes / fakePoints}    
+              \ #{textPercent $ realToFrac $ achievedFakes / fakePoints}
          \.

-      $maybe reqPasses <- positiveSum (numGradePasses normalSummary)      
-        <li>
+      $maybe reqPasses <- positiveSum (numGradePasses normalSummary)
+        <p>
          Aufgaben zum Bestehen: #{display reqPasses}
          $maybe passed <- getSum <$> achievedPasses realGrades
            \ davon #{display passed} bestanden
@ -36,6 +36,6 @@ $with realGrades <- normalSummary <> bonusSummary
            \.

      $maybe noGradeSheets <- positiveSum numNotGraded
-        <li>
+        <p>
          #{display noGradeSheets} unbewertete Aufgabenblätter.

--- a/test/Database.hs
+++ b/test/Database.hs
@ -24,6 +24,9 @@ import qualified Data.ByteString as BS

 import Data.Time

+import Utils.Lens (review)
+import Control.Monad.Random.Class (MonadRandom(..))
+

 data DBAction = DBClear
              | DBTruncate
@ -151,7 +154,7 @@ fillDb = do
    , userMailLanguages = MailLanguages ["de"]
    , userNotificationSettings = def
    }
-  void . insert $ User
+  tinaTester <- insert $ User
    { userIdent  = "tester@campus.lmu.de"
    , userAuthentication = AuthLDAP
    , userMatrikelnummer = Just "999"
@ -312,6 +315,7 @@ fillDb = do
  insert_ $ CourseEdit jost now pmo
  void . insert $ DegreeCourse pmo sdBsc sdInf
  void . insert $ Lecturer jost pmo
+  void . insertMany $ map (\u -> CourseParticipant pmo u now) [fhamann, maxMuster, tinaTester]
  sh1 <- insert Sheet
    { sheetCourse = pmo
    , sheetName = "Blatt 1"
@ -328,6 +332,10 @@ fillDb = do
    , sheetSolutionFrom = Nothing
    }
  void . insert $ SheetEdit jost now sh1
+  forM_ [fhamann, maxMuster, tinaTester] $ \u -> do
+    p <- liftIO getRandom
+    $logDebug (review _PseudonymText p)
+    void . insert $ SheetPseudonym sh1 p u
  void . insert $ SheetCorrector jost sh1 (Load (Just True) 0) CorrectorNormal
  void . insert $ SheetCorrector gkleen sh1 (Load (Just True) 1) CorrectorNormal
  h102 <- insertFile "H10-2.hs"