From fdd6b1a194fd2d4a1deb399cd3914e63e167d30a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Fri, 24 Apr 2020 13:30:20 +0200
Subject: [PATCH] feat(help): attach last error message

---
 config/settings.yml                        |  2 +-
 messages/uniworx/de-de-formal.msg          |  4 +
 src/Foundation.hs                          | 99 ++++++++++++++--------
 src/Handler/Help.hs                        | 76 +++++++++++++----
 src/Jobs/Handler/HelpRequest.hs            | 16 +++-
 src/Jobs/Types.hs                          |  3 +-
 src/Mail.hs                                | 23 +++--
 src/Network/HTTP/Types/Method/Instances.hs | 11 +++
 src/Utils.hs                               | 33 ++++++++
 src/Utils/Session.hs                       |  1 +
 src/Yesod/Core/Instances.hs                | 15 ++++
 start.sh                                   |  1 +
 templates/mail/support.hamlet              | 10 ++-
 13 files changed, 228 insertions(+), 66 deletions(-)

diff --git a/config/settings.yml b/config/settings.yml
index a810f4c83..85cd909e6 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -67,6 +67,7 @@ ip-retention-time: 1209600
 # Debugging
 auth-dummy-login:  "_env:DUMMY_LOGIN:false"
 allow-deprecated:  "_env:ALLOW_DEPRECATED:false"
+encrypt-errors:    "_env:ENCRYPT_ERRORS:true"
 server-session-acid-fallback: "_env:SERVER_SESSION_ACID_FALLBACK:false"
 
 auth-pw-hash:
@@ -78,7 +79,6 @@ auth-pw-hash:
 # reload-templates: false
 # mutable-static: false
 # skip-combining: false
-# encrypt-errors: true
 
 database:
   user:     "_env:PGUSER:uniworx"
diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index f7548e2af..11772317c 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@@ -1075,6 +1075,10 @@ HelpRequest: Supportanfrage / Verbesserungsvorschlag
 HelpProblemPage: Problematische Seite
 HelpIntroduction: Wenn Ihnen die Benutzung dieser Webseite Schwierigkeiten bereitet oder Sie einen verbesserbaren Umstand entdecken bitten wir Sie uns das zu melden, auch wenn Sie Ihr Problem bereits selbst lösen konnten. Wir passen die Seite ständig an und versuchen sie auch für zukünftige Benutzer so einsichtig wie möglich zu halten.
 HelpSent: Ihre Supportanfrage wurde weitergeleitet.
+HelpSendLastError: Letzte Fehlermeldung anhängen
+HelpError: Letzte Fehlermeldung
+HelpErrorYamlFilename mailId@MailObjectId: fehlermeldung-#{toPathPiece mailId}.yaml
+HelpErrorOrRequestRequired: Bitte geben Sie entweder eine Supportanfrage bzw. einen Verbesserungsvorschlag an oder hängen Sie die letzte Fehlermeldung an
 
 InfoLecturerTitle: Hinweise für Veranstalter
 
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 12d149392..77f0828d8 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -1624,43 +1624,70 @@ instance Yesod UniWorX where
     defaultMessageWidget _title _body = error "defaultMessageWidget: undefined"
 
     errorHandler err = do
-      mr <- getMessageRender
-      let
-        encrypted :: ToJSON a => a -> Widget -> Widget
-        encrypted plaintextJson plaintext = do
-          canDecrypt <- (== Authorized) <$> evalAccess AdminErrMsgR True
-          shouldEncrypt <- getsYesod $ view _appEncryptErrors
-          if
-            | shouldEncrypt
-            , not canDecrypt -> do
-                ciphertext <- encodedSecretBox SecretBoxPretty plaintextJson
+      shouldEncrypt <- do
+        canDecrypt <- (== Authorized) <$> evalAccess AdminErrMsgR True
+        shouldEncrypt <- getsYesod $ view _appEncryptErrors
+        return $ shouldEncrypt && not canDecrypt
 
-                [whamlet|
-                  <p>_{MsgErrorResponseEncrypted}
-                  <pre .errMsg>
-                    #{ciphertext}
-                |]
-            | otherwise -> plaintext
+      sessErr <- bool return (_InternalError $ encodedSecretBox SecretBoxShort) shouldEncrypt err
+      setSessionJson SessionError sessErr
 
-        errPage = case err of
-          NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
-          InternalError err' -> encrypted err' [whamlet|<p .errMsg>#{err'}|]
-          InvalidArgs errs -> [whamlet|
-              <ul>
-                $forall err' <- errs
-                  <li .errMsg>#{err'}
-            |]
-          NotAuthenticated -> [whamlet|<p>_{MsgErrorResponseNotAuthenticated}|]
-          PermissionDenied err' -> [whamlet|<p .errMsg>#{err'}|]
-          BadMethod method -> [whamlet|<p>_{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
-      fmap toTypedContent . siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do
-        toWidget
-          [cassius|
-            .errMsg
-              white-space: pre-wrap
-              font-family: monospace
-          |]
-        errPage
+      selectRep $ do
+        provideRep $ do
+          mr <- getMessageRender
+          let
+            encrypted :: ToJSON a => a -> Widget -> Widget
+            encrypted plaintextJson plaintext = do
+              if
+                | shouldEncrypt -> do
+                    ciphertext <- encodedSecretBox SecretBoxPretty plaintextJson
+
+                    [whamlet|
+                      <p>_{MsgErrorResponseEncrypted}
+                      <pre .errMsg>
+                        #{ciphertext}
+                    |]
+                | otherwise -> plaintext
+
+            errPage = case err of
+              NotFound -> [whamlet|<p>_{MsgErrorResponseNotFound}|]
+              InternalError err' -> encrypted err' [whamlet|<p .errMsg>#{err'}|]
+              InvalidArgs errs -> [whamlet|
+                  <ul>
+                    $forall err' <- errs
+                      <li .errMsg>#{err'}
+                 |]
+              NotAuthenticated -> [whamlet|<p>_{MsgErrorResponseNotAuthenticated}|]
+              PermissionDenied err' -> [whamlet|<p .errMsg>#{err'}|]
+              BadMethod method -> [whamlet|<p>_{MsgErrorResponseBadMethod (decodeUtf8 method)}|]
+          siteLayout (toWgt . mr $ ErrorResponseTitle err) $ do
+            toWidget
+              [cassius|
+                .errMsg
+                  white-space: pre-wrap
+                  font-family: monospace
+              |]
+            errPage
+        provideRep . fmap PrettyValue $ case err of
+          PermissionDenied err' -> return $ object [ "message" JSON..= err' ]
+          InternalError err'
+            | shouldEncrypt -> do
+                ciphertext <- encodedSecretBox SecretBoxShort err'
+                return $ object [ "message" JSON..= ciphertext
+                                , "encrypted" JSON..= True
+                                ]
+            | otherwise -> return $ object [ "message" JSON..= err' ]
+          InvalidArgs errs -> return $ object [ "messages" JSON..= errs ]
+          _other -> return $ object []
+        provideRep $ case err of
+          PermissionDenied err' -> return err'
+          InternalError err'
+            | shouldEncrypt -> do
+                addHeader "Encrypted-Error-Message" "True"
+                encodedSecretBox SecretBoxPretty err'
+            | otherwise -> return err'
+          InvalidArgs errs -> return . Text.unlines . map (Text.replace "\n" "\n\t") $ errs
+          _other -> return Text.empty
 
     defaultLayout = siteLayout' Nothing
 
@@ -1887,7 +1914,7 @@ siteLayout' headingOverride widget = do
   nav <- forM nav' $ \n -> (n,,,) <$> newIdent <*> traverse toTextUrl (n ^? _navLink) <*> traverse (\nc -> (nc,, ) <$> newIdent <*> toTextUrl nc) (n ^. _navChildren)
 
   mmsgs <- if
-    | isModal -> getMessages
+    | isModal -> return mempty
     | otherwise -> do
         applySystemMessages
         authTagPivots <- fromMaybe Set.empty <$> takeSessionJson SessionInactiveAuthTags
diff --git a/src/Handler/Help.hs b/src/Handler/Help.hs
index 098695563..28bf3e804 100644
--- a/src/Handler/Help.hs
+++ b/src/Handler/Help.hs
@@ -7,6 +7,11 @@ import Jobs
 
 import qualified Data.Map as Map
 
+import qualified Data.Yaml as Yaml
+
+import qualified Control.Monad.State.Class as State
+  
+
 data HelpIdentOptions = HIUser | HIEmail | HIAnonymous
   deriving (Eq, Ord, Bounded, Enum, Show, Read)
 
@@ -20,25 +25,56 @@ data HelpForm = HelpForm
   { hfReferer :: Maybe (Route UniWorX)
   , hfUserId  :: Either (Maybe Address) UserId
   , hfSubject :: Maybe Text
-  , hfRequest :: Html
+  , hfRequest :: Maybe Html
+  , hfError   :: Maybe ErrorResponse
   }
 
-helpForm :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> Maybe (Route UniWorX) -> Maybe UserId -> AForm _ HelpForm
-helpForm mr mReferer mUid = HelpForm
-    <$> aopt routeField (fslI MsgHelpProblemPage & inputReadonly) (Just <$> mReferer)
-    <*> multiActionA identActions (fslI MsgHelpAnswer) (HIUser <$ mUid)
-    <*> aopt textField (fslpI MsgHelpSubject $ mr MsgHelpSubject) Nothing
-    <*> areq htmlField (fslpI MsgHelpRequest $ mr MsgHelpRequest) Nothing
-  where
-    identActions :: Map _ (AForm _ (Either (Maybe Address) UserId))
-    identActions = Map.fromList $ case mUid of
-      (Just uid) -> (HIUser, pure $ Right uid):defaultActions
-      Nothing    -> defaultActions
+helpForm :: Maybe (Route UniWorX) -> Maybe UserId -> Form HelpForm
+helpForm mReferer mUid = renderWForm FormStandard $ do
+  MsgRenderer mr <- getMsgRenderer
 
-    defaultActions =
-      [ (HIEmail, Left . Just <$> (Address <$> aopt textField (fslpI MsgName $ mr MsgName) Nothing <*> apreq emailField (fslpI MsgEMail $ mr MsgEMail) Nothing))
-      , (HIAnonymous, pure $ Left Nothing)
-      ]
+  let defaultActions =
+        [ ( HIEmail
+          , Left . Just <$> (Address <$> aopt textField (fslpI MsgName $ mr MsgName) Nothing <*> apreq emailField (fslpI MsgEMail $ mr MsgEMail) Nothing)
+          )
+        , ( HIAnonymous
+          , pure $ Left Nothing
+          )
+        ]
+      identActions :: Map _ (AForm _ (Either (Maybe Address) UserId))
+      identActions = Map.fromList $ case mUid of
+        (Just uid) -> (HIUser, pure $ Right uid):defaultActions
+        Nothing    -> defaultActions
+
+  sessErr <- lookupSessionJson SessionError
+
+  hfReferer' <- wopt routeField (fslI MsgHelpProblemPage & inputReadonly) (Just <$> mReferer)
+  hfUserId'  <- multiActionW identActions (fslI MsgHelpAnswer) (HIUser <$ mUid)
+  hfSubject' <- wopt textField (fslpI MsgHelpSubject $ mr MsgHelpSubject) Nothing
+  hfRequest' <- case sessErr of
+    Nothing -> fmap Just <$> wreq htmlField (fslpI MsgHelpRequest $ mr MsgHelpRequest) Nothing
+    Just _  -> wopt htmlField (fslpI MsgHelpRequest $ mr MsgHelpRequest) Nothing
+  hfError'   <- case sessErr of
+    Nothing -> return $ pure Nothing
+    Just err ->
+      let prettyErr = decodeUtf8 $ Yaml.encode err
+       in optionalActionW 
+            (err <$ aforced textareaField (fslI MsgHelpError) (Textarea prettyErr))
+            (fslI MsgHelpSendLastError)
+            (Just True)
+
+  return $ HelpForm
+    <$> hfReferer'
+    <*> hfUserId'
+    <*> hfSubject'
+    <*> hfRequest'
+    <*> hfError'
+    
+validateHelpForm :: FormValidator HelpForm Handler ()
+validateHelpForm = do
+  HelpForm{..} <- State.get
+
+  guardValidation MsgHelpErrorOrRequestRequired $ is _Just hfRequest || is _Just hfError
 
 getHelpR, postHelpR :: Handler Html
 getHelpR = postHelpR
@@ -46,9 +82,8 @@ postHelpR = do
   mUid <- maybeAuthId
   mReferer <- flip formResultMaybe return <=< runInputGetResult $ iopt routeField (toPathPiece GetReferer)
   isModal <- hasCustomHeader HeaderIsModal
-  MsgRenderer mr <- getMsgRenderer
 
-  ((res,formWidget'),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mr mReferer mUid
+  ((res,formWidget'),formEnctype) <- runFormPost . validateForm validateHelpForm $ helpForm mReferer mUid
 
   formResultModal res HelpR $ \HelpForm{..} -> do
     now <- liftIO getCurrentTime
@@ -59,7 +94,12 @@ postHelpR = do
       , jHelpRequest = hfRequest
       , jRequestTime = now
       , jReferer     = hfReferer'
+      , jError       = hfError
       }
+
+    whenIsJust hfError $ \error' ->
+      modifySessionJson SessionError $ assertM (/= error')
+    
     tell . pure =<< messageI Success MsgHelpSent
 
   defaultLayout $ do
diff --git a/src/Jobs/Handler/HelpRequest.hs b/src/Jobs/Handler/HelpRequest.hs
index b4e9c5b69..10b4e310e 100644
--- a/src/Jobs/Handler/HelpRequest.hs
+++ b/src/Jobs/Handler/HelpRequest.hs
@@ -15,10 +15,11 @@ import Data.Bitraversable
 dispatchJobHelpRequest :: Either (Maybe Address) UserId
                        -> UTCTime
                        -> Maybe Text -- ^ Help Subject
-                       -> Html -- ^ Help Request
+                       -> Maybe Html -- ^ Help Request
                        -> Maybe Text -- ^ Referer
+                       -> Maybe ErrorResponse
                        -> Handler ()
-dispatchJobHelpRequest jSender jRequestTime jHelpSubject jHelpRequest jReferer = do
+dispatchJobHelpRequest jSender jRequestTime jHelpSubject jHelpRequest jReferer jError = do
   supportAddress <- getsYesod $ view _appMailSupport
   userInfo <- bitraverse return (runDB . getEntity) jSender
   let senderAddress = either
@@ -32,4 +33,15 @@ dispatchJobHelpRequest jSender jRequestTime jHelpSubject jHelpRequest jReferer =
     setSubjectI $ maybe MsgMailSubjectSupport MsgMailSubjectSupportCustom jHelpSubject
     setDate jRequestTime
     rtime <- formatTimeMail SelFormatDateTime jRequestTime
+
+    errPartName <- for jError $ \_ -> do
+      objId <- setMailObjectIdRandom
+      mr <- getMailMessageRender
+      return . mr $ MsgHelpErrorYamlFilename objId
+    
     addHtmlMarkdownAlternatives ($(ihamletFile "templates/mail/support.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX))
+
+    whenIsJust ((,) <$> jError <*> errPartName) $ \(err, partName) -> addPart' $ do
+        toMailPart $ toYAML err
+        _partDisposition .= InlineDisposition partName
+    
diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs
index 5d1eb8be5..79acc5c7c 100644
--- a/src/Jobs/Types.hs
+++ b/src/Jobs/Types.hs
@@ -42,8 +42,9 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica
          | JobHelpRequest { jHelpSender :: Either (Maybe Address) UserId
                           , jRequestTime :: UTCTime
                           , jSubject :: Maybe Text
-                          , jHelpRequest :: Html
+                          , jHelpRequest :: Maybe Html
                           , jReferer :: Maybe Text
+                          , jError :: Maybe ErrorResponse
                           }
          | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings }
          | JobDistributeCorrections { jSheet :: SheetId }
diff --git a/src/Mail.hs b/src/Mail.hs
index c472a75f2..36ae4146d 100644
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -67,8 +67,9 @@ import qualified Data.Foldable as Foldable
 import qualified Data.Text.Lazy as LT
 import qualified Data.Text.Lazy.Builder as LTB
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString as BS
 
-import Utils (MsgRendererS(..), MonadSecretBox(..), maybeT)
+import Utils (MsgRendererS(..), MonadSecretBox(..), maybeT, YamlValue)
 import Utils.Lens.TH
 
 import Control.Lens hiding (from)
@@ -97,6 +98,7 @@ import qualified Text.Shakespeare as Shakespeare (RenderUrl)
 
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Encode.Pretty as Aeson
+import qualified Data.Yaml as Yaml
 import Data.Aeson.TH
 import Utils.PathPiece (splitCamel)
 import Utils.DateTime
@@ -110,12 +112,15 @@ import Control.Monad.Trans.Maybe (MaybeT(..))
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
   
-import Control.Monad.Random (MonadRandom(..), evalRand, mkStdGen)
+import Control.Monad.Random (MonadRandom(..))
 import qualified Crypto.Saltine.Class as Saltine (IsEncoding(..))
 import qualified Data.ByteArray as ByteArray (convert)
-import Crypto.MAC.HMAC (hmac, HMAC)
+import Crypto.MAC.KMAC (KMAC)
+import qualified Crypto.MAC.KMAC as KMAC
 import Crypto.Hash.Algorithms (SHAKE128)
 
+import Language.Haskell.TH (nameBase)
+
 
 makeLenses_ ''Address
 makeLenses_ ''Mail
@@ -370,6 +375,12 @@ instance YesodMail site => ToMailPart site Aeson.Value where
     _partEncoding .= QuotedPrintableText
     _partContent .= PartContent (Aeson.encodePretty val)
 
+instance YesodMail site => ToMailPart site YamlValue where
+  toMailPart val = do
+    _partType .= "text/vnd.yaml"
+    _partEncoding .= QuotedPrintableText
+    _partContent .= PartContent (fromStrict $ Yaml.encode val)
+
 
 addAlternatives :: (MonadMail m)
                 => Writer (PrioritisedAlternatives m) ()
@@ -495,9 +506,9 @@ setMailObjectIdPseudorandom :: ( MonadHeader m
 setMailObjectIdPseudorandom obj = do
   sbKey <- secretBoxKey
   let
-    seed :: HMAC (SHAKE128 64)
-    seed = hmac (Saltine.encode sbKey) . toStrict $ Binary.encode obj
-  setMailObjectUUID . evalRand getRandom . mkStdGen $ hash (ByteArray.convert seed :: ByteString)
+    seed :: KMAC (SHAKE128 128)
+    seed = KMAC.finalize . KMAC.updates (KMAC.initialize (BS.pack . encodeUtf8 $ nameBase 'setMailObjectIdPseudorandom) $ Saltine.encode sbKey) . LBS.toChunks $ Binary.encode obj
+  setMailObjectUUID . fromMaybe (error "Could not convert hash to UUID") . UUID.fromByteString $ fromStrict (ByteArray.convert seed :: ByteString)
 
 
 setDateCurrent :: (MonadHandler m, YesodMail (HandlerSite m)) => MailT m ()
diff --git a/src/Network/HTTP/Types/Method/Instances.hs b/src/Network/HTTP/Types/Method/Instances.hs
index 144f901a3..b71b009ea 100644
--- a/src/Network/HTTP/Types/Method/Instances.hs
+++ b/src/Network/HTTP/Types/Method/Instances.hs
@@ -9,6 +9,17 @@ import Data.Binary (Binary)
 
 import Network.HTTP.Types.Method
 
+import Utils.PathPiece (pathPieceJSON, pathPieceJSONKey)
+
+import Web.PathPieces
+
 
 deriving instance Generic StdMethod
 instance Binary StdMethod
+
+instance PathPiece Method where
+  toPathPiece = decodeUtf8
+  fromPathPiece = Just . encodeUtf8
+
+pathPieceJSON ''Method
+pathPieceJSONKey ''Method
diff --git a/src/Utils.hs b/src/Utils.hs
index 3addd9116..ffc77197e 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -68,6 +68,8 @@ import Text.Shakespeare.Text (st)
 import Data.Aeson (FromJSONKey)
 import qualified Data.Aeson as Aeson
 import qualified Data.Aeson.Types as Aeson
+import qualified Data.Aeson.Encode.Pretty as Aeson
+import qualified Data.Yaml as Yaml
 
 import Data.Universe
 
@@ -97,6 +99,7 @@ import Control.Monad.Random.Class (MonadRandom)
 import qualified System.Random.Shuffle as Rand (shuffleM)
 
 import Data.Data (Data)
+import qualified Data.Text.Lazy.Builder as Builder
 
 import Unsafe.Coerce
 
@@ -140,6 +143,36 @@ maybeAttribute :: Text -> (a -> Text) -> Maybe a -> [(Text,Text)]
 maybeAttribute _ _ Nothing  = []
 maybeAttribute a c (Just v) = [(a,c v)]
 
+  
+newtype PrettyValue = PrettyValue { unPrettyValue :: Value }
+  deriving (Eq, Read, Show, Generic, Typeable, Data)
+  deriving newtype (Hashable, IsString, TH.Lift, FromJSON, ToJSON, NFData)
+
+instance ToContent PrettyValue where
+  toContent = toContent . Builder.toLazyText . Aeson.encodePrettyToTextBuilder
+instance ToTypedContent PrettyValue where
+  toTypedContent = TypedContent <$> getContentType . (return @Proxy) <*> toContent
+instance HasContentType PrettyValue where
+  getContentType _ = typeJson
+
+toPrettyJSON :: ToJSON a => a -> PrettyValue
+toPrettyJSON = PrettyValue . toJSON
+
+
+newtype YamlValue = YamlValue { unYamlValue :: Value }
+  deriving (Eq, Read, Show, Generic, Typeable, Data)
+  deriving newtype (Hashable, IsString, TH.Lift, FromJSON, ToJSON, NFData)
+
+instance ToContent YamlValue where
+  toContent = toContent . Yaml.encode
+instance ToTypedContent YamlValue where
+  toTypedContent = TypedContent <$> getContentType . (return @Proxy) <*> toContent
+instance HasContentType YamlValue where
+  getContentType _ = "text/vnd.yaml"
+
+toYAML :: ToJSON a => a -> YamlValue
+toYAML = YamlValue . toJSON
+
 
 ---------------------
 -- Text and String --
diff --git a/src/Utils/Session.hs b/src/Utils/Session.hs
index c4418d0ae..51f66105c 100644
--- a/src/Utils/Session.hs
+++ b/src/Utils/Session.hs
@@ -15,6 +15,7 @@ data SessionKey = SessionActiveAuthTags | SessionInactiveAuthTags
                 | SessionBearer
                 | SessionAllocationResults
                 | SessionLang
+                | SessionError
   deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
   deriving anyclass (Universe, Finite)
 
diff --git a/src/Yesod/Core/Instances.hs b/src/Yesod/Core/Instances.hs
index e145d6575..17838c4b8 100644
--- a/src/Yesod/Core/Instances.hs
+++ b/src/Yesod/Core/Instances.hs
@@ -13,6 +13,7 @@ import Control.Lens
 import Data.ByteString.Builder (toLazyByteString)
 
 import Data.Aeson
+import Data.Aeson.TH
 import Data.Aeson.Types
 
 import Control.Monad.Fix
@@ -24,6 +25,10 @@ import qualified Data.Binary as Binary
 
 import Control.Monad.Fail
 
+import Utils.PathPiece (camelToPathPiece)
+
+import Network.HTTP.Types.Method.Instances ()
+
 
 routeFromPathPiece :: ParseRoute site => Text -> Maybe (Route site)
 routeFromPathPiece
@@ -97,3 +102,13 @@ instance Extend FormResult where
   duplicated (FormSuccess x)    = FormSuccess $ FormSuccess x
   duplicated  FormMissing       = FormMissing
   duplicated (FormFailure errs) = FormFailure errs
+
+
+deriveJSON defaultOptions
+  { constructorTagModifier = camelToPathPiece
+  , sumEncoding = ObjectWithSingleField
+  } ''ErrorResponse
+
+deriving instance Ord ErrorResponse
+deriving instance Read ErrorResponse
+instance Hashable ErrorResponse
diff --git a/start.sh b/start.sh
index 51ffc6340..329fdad02 100755
--- a/start.sh
+++ b/start.sh
@@ -14,6 +14,7 @@ export SERVER_SESSION_ACID_FALLBACK=${SERVER_SESSION_ACID_FALLBACK:-true}
 export SERVER_SESSION_COOKIES_SECURE=${SERVER_SESSION_COOKIES_SECURE:-false}
 export COOKIES_SECURE=${COOKIES_SECURE:-false}
 export ALLOW_DEPRECATED=${ALLOW_DEPRECATED:-true}
+export ENCRYPT_ERRORS=${ENCRYPT_ERRORS:-false}
 export RIBBON=${RIBBON:-${__HOST:-localhost}}
 unset HOST
 
diff --git a/templates/mail/support.hamlet b/templates/mail/support.hamlet
index de412b7d3..623ba907f 100644
--- a/templates/mail/support.hamlet
+++ b/templates/mail/support.hamlet
@@ -38,5 +38,11 @@ $newline never
           <dd>
             <a href=#{referer} style="font-family: monospace">
               #{referer}
-    <section>
-      #{jHelpRequest}
+        $maybe errName <- errPartName
+          <dt>Fehlermeldung
+          <dd>
+            <a href="cid:#{errName}">
+              #{errName}
+    $maybe request <- jHelpRequest
+      <section>
+        #{request}