Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

ChangeLog.md

@@ -1,3 +1,9 @@
+  * Version 19.10.2018
+
+    Benutzer können sich in der Testphase komplett selbst löschen
+
+    Hilfe Widget
+
   * Version 18.09.2018
 
     Tooltips funktionieren auch ohne JavaScript

config/settings.yml

@@ -15,6 +15,9 @@ mail-object-domain: "_env:MAILOBJECT_DOMAIN:localhost"
 mail-verp:
   separator:    "+"
   at-replacement: "="
+mail-support:
+  name:         null
+  email:        "uni2work@ifi.lmu.de"
 
 job-workers:        "_env:JOB_WORKERS:10"
 job-flush-interval: "_env:JOB_FLUSH:30"

db.hs

@@ -118,7 +118,7 @@ fillDb = do
     , userMailLanguages = MailLanguages ["de"]
     , userNotificationSettings = def
     }
-  void . insert $ User
+  maxMuster <- insert User
     { userIdent  = "max@campus.lmu.de"
     , userAuthentication = AuthLDAP
     , userMatrikelnummer = Nothing
@@ -319,6 +319,12 @@ fillDb = do
   void . insert $ SheetFile sh1 h102 SheetHint
   void . insert $ SheetFile sh1 h103 SheetSolution
   void . insert $ SheetFile sh1 pdf10 SheetExercise
+  --
+  sub1 <- insert $ Submission sh1 Nothing Nothing Nothing Nothing Nothing
+  void . insert $ SubmissionEdit maxMuster (nominalDay `addUTCTime` now) sub1
+  void . insert $ SubmissionUser maxMuster sub1
+  sub1fid1 <- insertFile "AbgabeH10-1.hs"
+  void . insert $ SubmissionFile sub1 sub1fid1 False False
   -- datenbanksysteme
   dbs <- insert' Course
     { courseName = "Datenbanksysteme"

messages/uniworx/de.msg

@@ -343,6 +343,8 @@ MailSheetActiveIntro courseName@Text termDesc@Text sheetName@SheetName: Sie kön
 MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden
 MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Dia Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) endet in Kürze.
 
+MailSubjectSupport: Supportanfrage
+
 SheetTypeBonus: Bonus
 SheetTypeNormal: Normal
 SheetTypePass: Bestehen
@@ -381,4 +383,9 @@ SheetNoRegisteredGroup sheetGroupDesc@Text: "#{sheetGroupDesc}" sind nicht als G
 SheetAmbiguousRegisteredGroup sheetGroupDesc@Text: "#{sheetGroupDesc}" enthält Mitglieder aus verschiedenen registrierten Gruppen
 SheetNoGroupSubmission sheetGroupDesc@Text: Gruppenabgabe ist für dieses Blatt nicht vorgesehen (#{sheetGroupDesc})
 SheetDuplicatePseudonym: Folgende Pseudonyme kamen mehrfach vor; alle Vorkommen außer dem Ersten wurden ignoriert:
-SheetCreateExisting: Folgende Pseudonyme haben bereits abgegeben:
+SheetCreateExisting: Folgende Pseudonyme haben bereits abgegeben:
+
+
+UserAccountDeleted name@Text: Konto für #{name} wurde gelöscht!
+
+Dummy: TODO Message not defined!

routes

@@ -37,6 +37,7 @@
 /admin/user/#CryptoUUIDUser AdminUserR        GET
 /admin/user/#CryptoUUIDUser/hijack AdminHijackUserR POST
 /info                       VersionR          GET             !free
+/help                       HelpR             GET POST        !free
 
 /profile                    ProfileR          GET POST        !free                             !free
 /profile/data               ProfileDataR      GET POST        !free                             !free

src/Foundation.hs

@@ -160,7 +160,7 @@ pattern CSubmissionR tid ssh csh shn cid ptn
 -- Menus and Favourites
 data MenuItem = MenuItem
     { menuItemLabel :: Text
-    , menuItemIcon  :: Maybe Text
+    , menuItemIcon  :: Maybe Text     -- currently from: https://fontawesome.com/icons?d=gallery
     , menuItemRoute :: Route UniWorX
     , menuItemAccessCallback' :: Handler Bool -- Check whether action is shown in ADDITION to authorization (which is always checked)
     , menuItemModal :: Bool
@@ -856,6 +856,13 @@ defaultLinks = -- Define the menu items of the header.
       , menuItemModal = False
       , menuItemAccessCallback' = return True
       }
+  , NavbarRight $ MenuItem
+      { menuItemLabel = "Hilfe"
+      , menuItemIcon  = Just "question"
+      , menuItemRoute = HelpR
+      , menuItemModal = True
+      , menuItemAccessCallback' = return True
+      }
   , NavbarRight $ MenuItem
       { menuItemLabel = "Profil"
       , menuItemIcon = Just "cogs"

src/Handler/Home.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE IncoherentInstances #-} -- why is this needed? Instance for "display deadline" ought to be clear
@@ -16,7 +17,14 @@ import Handler.Utils
 
 import qualified Data.Map as Map
 
+import qualified Data.Text as Text
+import Data.Text.Encoding (decodeUtf8')
 import Data.Time hiding (formatTime)
+import Data.Universe
+import Data.Universe.Helpers
+
+import Network.Wai (requestHeaderReferer)
+
 -- import qualified Data.Text as T
 -- import Yesod.Form.Bootstrap3
 
@@ -27,6 +35,8 @@ import Data.Time hiding (formatTime)
 -- import Yesod.Colonnade
 import qualified Database.Esqueleto as E
 
+import Jobs
+
 -- import Text.Shakespeare.Text
 
 import Development.GitRev
@@ -117,10 +127,10 @@ homeUser uid = do
   cTime <- liftIO getCurrentTime
   let fTime = addUTCTime (offSheetDeadlines * nominalDay) cTime
 
-      tableData :: -- E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant))
-                   --                         (E.SqlExpr (Entity Course           )))
-                   --                         (E.SqlExpr (Entity Sheet            ))
-                _ -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term))
+      tableData :: E.LeftOuterJoin
+                        (E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity CourseParticipant)) (E.SqlExpr (Entity Course))) (E.SqlExpr (Entity Sheet)))
+                        (E.InnerJoin (E.SqlExpr (Maybe (Entity Submission))) (E.SqlExpr (Maybe (Entity SubmissionUser))))
+                  -> E.SqlQuery ( E.SqlExpr (E.Value (Key Term))
                                 , E.SqlExpr (E.Value SchoolId)
                                 , E.SqlExpr (E.Value CourseShorthand)
                                 , E.SqlExpr (E.Value SheetName)
@@ -224,3 +234,71 @@ getVersionR = selectRep $ do
       $(widgetFile "versionHistory")
     provideRep $
       return ($gitDescribe :: Text)
+
+
+
+
+data HelpIdentOptions = HIAnonymous | HIUser | HIEmail
+  deriving (Eq, Ord, Bounded, Enum, Show, Read)
+
+$( return [] ) -- forces order of splices, error otherwise, see https://ghc.haskell.org/trac/ghc/ticket/9813
+instance Universe HelpIdentOptions where universe = universeDef
+instance Finite HelpIdentOptions
+
+instance PathPiece HelpIdentOptions where
+  toPathPiece   = $(nullaryToPathPiece ''HelpIdentOptions [Text.intercalate "-" . map Text.toLower . unsafeTail . splitCamel])
+  fromPathPiece = finiteFromPathPiece
+
+instance RenderMessage UniWorX HelpIdentOptions where
+  renderMessage _ _ opt = tshow opt -- TODO
+
+data HelpForm = HelpForm
+  { hfReferer:: Maybe Text
+  , hfUserId :: Either (Maybe Email) UserId
+  , hfRequest:: Text
+  }
+
+helpForm :: Maybe Text -> Maybe UserId -> AForm _ HelpForm
+helpForm mReferer mUid = HelpForm
+    <$> maybe (pure Nothing) (fmap Just . aforced textField  (fslI MsgDummy)) mReferer
+    <*> multiActionA (fslI MsgDummy) identActions (HIUser <$ mUid)
+    <*> (unTextarea <$> areq textareaField (fslI MsgDummy) Nothing)
+    <*  submitButton
+  where
+    identActions :: Map _ (AForm _ (Either (Maybe Email) UserId))
+    identActions = Map.fromList . catMaybes $
+      [ ( HIUser,) . pure . Right <$> mUid
+      , Just (HIAnonymous, pure (Left Nothing))
+      , Just (HIEmail, Left . Just <$> apreq emailField (fslI MsgDummy) Nothing)
+      ]
+
+getHelpR :: Handler Html
+getHelpR = postHelpR
+
+postHelpR :: Handler Html
+postHelpR = do
+  mUid <- maybeAuthId
+  mRefererBS <- requestHeaderReferer <$> waiRequest
+  let mReferer = maybeRight . decodeUtf8' =<< mRefererBS
+
+  ((res,formWidget),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mReferer mUid
+
+  case res of
+    FormSuccess (HelpForm{..}) -> do
+      now <- liftIO getCurrentTime
+      queueJob' $ JobHelpRequest { jSender      = hfUserId
+                                  , jHelpRequest = hfRequest
+                                  , jRequestTime = now
+                                  , jReferer     = hfReferer }
+      redirect $ HelpR
+      {-selectRep $ do
+          provideJson ()
+          provideRep (redirect $ HelpR :: Handler Html) -}
+    FormMissing -> return ()
+    FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
+
+  defaultLayout $ do
+    setTitle "Hilfe" -- TODO: International
+    $(widgetFile "help")
+
+

src/Handler/Profile.hs

@@ -163,17 +163,69 @@ postProfileDataR = do
   case btnResult of
     (FormSuccess BtnDelete) -> do
       (uid, User{..}) <- requireAuthPair
-      addMessage Warning "Delete-Knopf gedrückt"
-      addMessage Error "Löschen der Daten wurde noch nicht implementiert."
-      -- first determine all submission that solely depend on this user:
-      -- SubmissionGroup / SubmissionGroupUser
-      -- Submission / SubmissionUser
-      -- runDB $ deleteCascade uid
+      clearCreds False -- Logout-User
+      ((deletedSubmissions,groupSubmissions),deletedSubmissionGroups) <- runDB $ deleteUser uid
+      -- addMessageIHamlet
+      $(addMessageFile Success "templates/deletedUser.hamlet") -- USE THIS ONE
+      -- addMessageI Success $ MsgDeleteUser deletedSubmissions
+      -- when (groupSubmissions > 0) $ addMessageI Info $ MsgDeleteUserGroupSubmissions groupSubmissions
+      defaultLayout $ do
+        $(widgetFile "deletedUser")
+
     (FormSuccess BtnAbort ) -> do
       addMessageI Info MsgAborted
       redirect ProfileDataR
-    _other -> return ()
-  getProfileDataR
+    _other -> getProfileDataR
+
+
+
+deleteUser :: UserId -> DB ((Int,Int),Int64) -- TODO: Restrict deletions for lecturers, tutors and students in course that won't allow deregistration
+deleteUser duid = do
+    -- E.deleteCount for submissions is not cascading, hence we first select and then delete manually
+    -- We delete all files tied to submissions where the user is the lone submissionUser
+
+    -- Do not deleteCascade submissions where duid is the corrector:
+    updateWhere [SubmissionRatingBy ==. Just duid] [SubmissionRatingBy =. Nothing]
+
+    groupSubmissions  <- selectSubmissionsWhere (\numBuddies -> numBuddies E.>.  E.val (0::Int64))
+    singleSubmissions <- selectSubmissionsWhere (\numBuddies -> numBuddies E.==. E.val (0::Int64))
+    deleteCascade duid
+    forM_ singleSubmissions $ \(E.Value submissionId) -> do
+      deleteFileIds  <- map E.unValue <$> getSubmissionFiles submissionId
+      deleteCascade submissionId
+      deleteCascadeWhere [FileId <-. deleteFileIds] -- TODO: throws exception for de-duplicated files
+
+    deletedSubmissionGroups <- deleteSingleSubmissionGroups
+    return ((length singleSubmissions, length groupSubmissions),deletedSubmissionGroups)
+  where
+    selectSubmissionsWhere :: (E.SqlExpr (E.Value Int64) -> E.SqlExpr (E.Value Bool)) -> DB [E.Value (Key Submission)]
+    selectSubmissionsWhere whereBuddies = E.select $ E.from $ \(submission `E.InnerJoin` suser) -> do
+        E.on $ submission E.^. SubmissionId E.==. suser E.^. SubmissionUserSubmission
+        let numBuddies = E.sub_select $ E.from $ \subUsers -> do
+                E.where_ $ subUsers E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
+                    E.&&.  subUsers E.^. SubmissionUserUser E.!=. E.val duid
+                return E.countRows
+        E.where_ $ suser E.^. SubmissionUserUser E.==. E.val duid
+          E.&&.  (whereBuddies numBuddies)
+        return $ submission E.^. SubmissionId
+
+    getSubmissionFiles :: SubmissionId ->  DB [E.Value (Key File)]
+    getSubmissionFiles subId = E.select $ E.from $ \file -> do
+      E.where_ $ E.exists $ E.from $ \submissionFile -> do
+          E.where_ $ submissionFile E.^. SubmissionFileSubmission E.==. E.val subId
+              E.&&.  submissionFile E.^. SubmissionFileFile E.==. file E.^. FileId
+      return $ file E.^. FileId
+
+    deleteSingleSubmissionGroups = E.deleteCount $ E.from $ \submissionGroup -> do
+      E.where_ $ E.exists $ E.from $ \subGroupUser -> do
+          E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
+              E.&&.  subGroupUser E.^. SubmissionGroupUserUser E.==. E.val duid
+      E.where_ $ E.notExists $ E.from $ \subGroupUser -> do
+          E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
+              E.&&.  subGroupUser E.^. SubmissionGroupUserUser E.!=. E.val duid
+
+
+
 
 
 

src/Handler/Utils/Form.hs

@@ -566,3 +566,30 @@ multiAction acts defAction = do
       accWidget act (Just w) = cons $(widgetFile "widgets/multiAction")
       actionResults = Map.map fst results
   return ((actionResults Map.!) =<< actionRes, $(widgetFile "widgets/multiActionCollect"))
+
+multiActionA :: (RenderMessage UniWorX action, PathPiece action, Ord action, Eq action)
+            => FieldSettings UniWorX
+            -> Map action (AForm (HandlerT UniWorX IO) a)
+            -> Maybe action
+            -> AForm (HandlerT UniWorX IO) a
+multiActionA FieldSettings{..} acts defAction = formToAForm $ do
+  (res, selView) <- multiAction acts defAction
+
+  fvId <- maybe newIdent return fsId
+  MsgRenderer mr <- getMsgRenderer
+
+  return (res,
+    [ FieldView
+      { fvLabel = toHtml $ mr fsLabel
+      , fvTooltip = toHtml . mr <$> fsTooltip
+      , fvId
+      , fvInput = selView
+      , fvErrors = case res of
+          FormFailure [e] -> Just $ toHtml e
+          _ -> Nothing
+      , fvRequired = True
+      }
+    ])
+
+
+

src/Jobs.hs

@@ -40,6 +40,7 @@ import Database.Persist.Sql (executeQQ, fromSqlKey, transactionSave)
 
 import Data.Monoid (Last(..))
 import Data.Semigroup (Max(..))
+import Data.Bitraversable
 
 import Utils.Lens
 import Utils.Sql
@@ -515,3 +516,17 @@ performJob JobSendTestEmail{..} = mailT jMailContext $ do
       * #{nD}
       * #{nT}
     |] :: TextUrl (Route UniWorX))
+performJob JobHelpRequest{..} = do
+  supportAddress <- getsYesod $ appMailSupport . appSettings
+  userInfo <- bitraverse return (runDB . getEntity) jSender
+  let userAddress = either (fmap $ Address Nothing)
+                           (fmap $ \(Entity _ User{..}) -> Address (Just userDisplayName) (CI.original userEmail))
+                           userInfo
+  mailT def $ do
+    _mailTo .= [supportAddress]
+    whenIsJust userAddress $ addMailHeader "Reply-To" . renderAddress
+    setSubjectI MsgMailSubjectSupport
+    setDate jRequestTime
+    rtime <- formatTimeMail SelFormatDateTime jRequestTime
+    addPart ($(ihamletFile "templates/mail/support.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+

src/Jobs/Types.hs

@@ -19,8 +19,11 @@ import Data.List.NonEmpty (NonEmpty)
 
 
 data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notification }
-         | JobSendTestEmail { jEmail :: Text, jMailContext :: MailContext }
+         | JobSendTestEmail { jEmail :: Email, jMailContext :: MailContext }
          | JobQueueNotification { jNotification :: Notification }
+         | JobHelpRequest { jSender :: Either (Maybe Email) UserId
+                          , jRequestTime :: UTCTime
+                          , jHelpRequest :: Text, jReferer :: Maybe Text }
   deriving (Eq, Ord, Show, Read, Generic, Typeable)
 data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId }
                   | NotificationSheetActive { nSheet :: SheetId }

src/Mail.hs

@@ -42,7 +42,7 @@ module Mail
   , replaceMailHeader, addMailHeader, removeMailHeader
   , replaceMailHeaderI, addMailHeaderI
   , setSubjectI, setMailObjectId, setMailObjectId'
-  , setDateCurrent
+  , setDate, setDateCurrent
   , setMailSmtpData
   , _mailFrom, _mailTo, _mailCc, _mailBcc, _mailHeaders, _mailParts
   , _partType, _partEncoding, _partFilename, _partHeaders, _partContent
@@ -163,6 +163,10 @@ deriveJSON defaultOptions
   } ''MailContext
 
 instance Hashable MailContext
+instance Default MailContext where
+  def = MailContext { mcLanguages = def
+                    , mcDateTimeFormat = def
+          }
 
 makeLenses_ ''MailContext
 
@@ -450,10 +454,12 @@ setMailObjectId' oid = setMailObjectUUID . ciphertext =<< encrypt oid
 
 
 setDateCurrent :: (MonadHandler m, YesodMail (HandlerSite m)) => MailT m ()
-setDateCurrent = do
-  now <- liftIO getCurrentTime
+setDateCurrent = setDate =<< liftIO getCurrentTime
+
+setDate :: (MonadHandler m, YesodMail (HandlerSite m)) => UTCTime -> MailT m ()
+setDate time = do
   tz <- mailDateTZ
-  let timeStr = formatTime defaultTimeLocale "%a, %d %b %Y %T %z" $ ZonedTime (utcToLocalTimeTZ tz now) (timeZoneForUTCTime tz now)
+  let timeStr = formatTime defaultTimeLocale "%a, %d %b %Y %T %z" $ ZonedTime (utcToLocalTimeTZ tz time) (timeZoneForUTCTime tz time)
   replaceMailHeader "Date" . Just $ pack timeStr
 
 

src/Model/Types.hs

@@ -124,8 +124,9 @@ fromPoints = round
 instance DisplayAble Points
 
 data SheetType
-  = Bonus  { maxPoints :: Points }
-  | Normal { maxPoints :: Points }
+  = Bonus  { maxPoints :: Points } -- Erhöht nicht das Maximum, wird gutgeschrieben
+  | Normal { maxPoints :: Points } -- Erhöht das Maximum, wird gutgeschrieben
+--  | Informational { maxPoints :: Points } -- Erhöht nicht das Maximum Keine Gutschrift
   | Pass   { maxPoints, passingPoints :: Points }
   | NotGraded
   deriving (Show, Read, Eq)

src/Settings.hs

@@ -82,6 +82,7 @@ data AppSettings = AppSettings
     , appMailFrom               :: Address
     , appMailObjectDomain       :: Text
     , appMailVerp               :: VerpMode
+    , appMailSupport            :: Address
     , appJobWorkers             :: Int
     , appJobFlushInterval       :: Maybe NominalDiffTime
     , appJobCronInterval        :: NominalDiffTime
@@ -274,6 +275,7 @@ instance FromJSON AppSettings where
         appMailFrom               <- o .: "mail-from"
         appMailObjectDomain       <- o .: "mail-object-domain"
         appMailVerp               <- o .: "mail-verp"
+        appMailSupport            <- o .: "mail-support"
 
         appJobWorkers             <- o .:  "job-workers"
         appJobFlushInterval       <- o .:? "job-flush-interval"

src/Utils/DB.hs

@@ -15,7 +15,7 @@ import qualified Data.Set as Set
 import qualified Database.Esqueleto as E
 -- import Database.Persist -- currently not needed here
 
-
+-- ezero = E.val (0 :: Int64)
 
 emptyOrIn :: PersistField typ =>
   E.SqlExpr (E.Value typ) -> Set typ -> E.SqlExpr (E.Value Bool)

src/Utils/DateTime.hs

@@ -8,6 +8,7 @@
            , DeriveGeneric
            , GeneralizedNewtypeDeriving
            , OverloadedStrings
+           , FlexibleInstances
   #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
@@ -27,6 +28,7 @@ import System.Locale.Read
 import Data.Time (TimeZone(..), TimeLocale(..))
 import Data.Time.Zones (TZ)
 import Data.Time.Zones.TH (includeSystemTZ)
+import Data.Time.Clock.POSIX
 
 import Language.Haskell.TH
 import Language.Haskell.TH.Syntax (Lift(..))
@@ -47,6 +49,8 @@ import Utils.PathPiece
 deriving instance Lift TimeZone
 deriving instance Lift TimeLocale
 
+instance Hashable UTCTime where
+  hashWithSalt s = hashWithSalt s . toRational . utcTimeToPOSIXSeconds
 
 -- $(timeLocaleMap _) :: [Lang] -> TimeLocale
 timeLocaleMap :: [(Lang, String)] -- ^ Languages and matching locales, first is taken as default
@@ -105,3 +109,8 @@ instance ToJSONKey SelDateTimeFormat where
   toJSONKey = toJSONKeyText $ \v -> let String txt = toJSON v in txt
 instance FromJSONKey SelDateTimeFormat where
   fromJSONKey = FromJSONKeyTextParser $ parseJSON . String
+
+instance {-# OVERLAPPING #-} Default (SelDateTimeFormat -> DateTimeFormat) where
+  def SelFormatDateTime = "%c"
+  def SelFormatDate     = "%F"
+  def SelFormatTime     = "%T"

templates/deletedUser.hamlet

@@ -0,0 +1,16 @@
+<div .container>
+  <h1>
+    _{MsgUserAccountDeleted userDisplayName}
+  <div .container>
+    #{display deletedSubmissions} Abgaben wurden unwiederruflich gelöscht.
+  $if groupSubmissions > 0
+    <div .container>
+      #{display groupSubmissions} Gruppenabgaben verbleiben in der Datenbank,
+      aber die Zuordnung zum Benutzer wurden gelöscht.
+      Gruppenabgaben können dadurch zu Einzelabgaben werden,
+      welche dann vom letzten Benutzer gelöscht werden können.
+  $if deletedSubmissionGroups > 0
+    <div .container>
+      #{display deletedSubmissionGroups} benannte Abgabengruppen wurden gelöscht, da diese dadurch leer wurden.
+  <div .container>
+    Good Bye!

templates/help.hamlet

@@ -0,0 +1,5 @@
+
+Bitte beschreiben Sie Ihr Problem:
+
+<form method=post action=@{HelpR} enctype=#{formEnctype}>
+   ^{formWidget}

templates/mail/support.hamlet

@@ -0,0 +1,29 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+  <body>
+    <dl>
+      $case userInfo
+        $of Left (Just email)
+          <dt> E-Mail
+          <dd> #{email}
+        $of Left  Nothing
+        $of Right Nothing
+          <dt> Ungültige UserId erhalten!
+        $of Right (Just (Entity _ User{..}))
+          <dt> Name
+          <dd> #{userDisplayName}
+          <dt> E-Mail
+          <dd> #{userEmail}
+          $maybe matrnr <- userMatrikelnummer
+            <dt> Matrikelnummer
+            <dd> #{matrnr}
+          <dt> E-Mail Sprachen
+          $forall lang <- mailLanguages userMailLanguages
+            <dd> #{lang}
+      <dt> Zeit
+      <dd> #{rtime}
+    <p>
+      #{jHelpRequest}

testdata/AbgabeH10-1.hs

@@ -0,0 +1,3 @@
+Abgabe zu H10-1:
+
+ Ich habe keine Ahnung wie ich die H10-1 lösen soll, sorry!