Allow setting name when sending help request without account

src/Handler/Home.hs

@@ -245,7 +245,7 @@ instance RenderMessage UniWorX HelpIdentOptions where
 
 data HelpForm = HelpForm
   { hfReferer:: Maybe Text
-  , hfUserId :: Either (Maybe Email) UserId
+  , hfUserId :: Either (Maybe Address) UserId
   , hfRequest:: Text
   }
 
@@ -256,13 +256,13 @@ helpForm mReferer mUid = HelpForm
     <*> (unTextarea <$> areq textareaField (fslI MsgHelpRequest) Nothing)
     <*  submitButton
   where
-    identActions :: Map _ (AForm _ (Either (Maybe Email) UserId))
+    identActions :: Map _ (AForm _ (Either (Maybe Address) UserId))
     identActions = Map.fromList $ case mUid of 
       (Just uid) -> (HIUser, pure $ Right uid):defaultActions
       Nothing    -> defaultActions 
     
     defaultActions =
-      [ (HIEmail, Left . Just <$> apreq emailField (fslI MsgEMail) Nothing)
+      [ (HIEmail, Left . Just <$> (Address <$> aopt textField (fslI MsgName) Nothing <*> apreq emailField (fslI MsgEMail) Nothing))
       , (HIAnonymous, pure $ Left Nothing)
       ]
 

src/Import/NoFoundation.hs

@@ -42,6 +42,8 @@ import Control.Monad.Morph    as Import (MFunctor(..))
 
 import Control.Monad.Trans.Resource as Import (ReleaseKey)
 
+import Network.Mail.Mime.Instances as Import ()
+
 
 import Control.Monad.Trans.RWS (RWST)
 

src/Jobs/Handler/HelpRequest.hs

@@ -14,7 +14,7 @@ import Utils.Lens
 import Data.Bitraversable
   
 
-dispatchJobHelpRequest :: Either (Maybe Email) UserId
+dispatchJobHelpRequest :: Either (Maybe Address) UserId
                        -> UTCTime
                        -> Text -- ^ Help Request
                        -> Maybe Text -- ^ Referer
@@ -22,9 +22,10 @@ dispatchJobHelpRequest :: Either (Maybe Email) UserId
 dispatchJobHelpRequest jSender jRequestTime jHelpRequest jReferer = do
   supportAddress <- getsYesod $ appMailSupport . appSettings
   userInfo <- bitraverse return (runDB . getEntity) jSender
-  let userAddress = either (fmap $ Address Nothing)
+  let userAddress = either
-                           (fmap $ \(Entity _ User{..}) -> Address (Just userDisplayName) (CI.original userEmail))
+        id
-                           userInfo
+        (fmap $ \(Entity _ User{..}) -> Address (Just userDisplayName) (CI.original userEmail))
+        userInfo
   mailT def $ do
     _mailTo .= [supportAddress]
     whenIsJust userAddress $ addMailHeader "Reply-To" . renderAddress

src/Jobs/Types.hs

@@ -15,7 +15,7 @@ import Data.List.NonEmpty (NonEmpty)
 data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notification }
          | JobSendTestEmail { jEmail :: Email, jMailContext :: MailContext }
          | JobQueueNotification { jNotification :: Notification }
-         | JobHelpRequest { jSender :: Either (Maybe Email) UserId
+         | JobHelpRequest { jSender :: Either (Maybe Address) UserId
                           , jRequestTime :: UTCTime
                           , jHelpRequest :: Text, jReferer :: Maybe Text }
          | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings }         

src/Network/Mail/Mime/Instances.hs

@@ -0,0 +1,25 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Network.Mail.Mime.Instances
+  (
+  ) where
+
+import ClassyPrelude
+import Network.Mail.Mime
+import Data.Hashable (Hashable)
+
+import Data.Aeson
+import Data.Aeson.TH
+
+import Utils.PathPiece
+  
+
+deriving instance Read Address
+deriving instance Ord Address
+deriving instance Generic Address
+
+instance Hashable Address
+
+deriveJSON defaultOptions
+  { fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel
+  } ''Address

src/Settings.hs

@@ -49,6 +49,7 @@ import qualified Network.HaskellNet.Auth as HaskellNet (UserName, Password, Auth
 import qualified Network.Socket as HaskellNet (PortNumber(..), HostName)
 
 import Network.Mail.Mime (Address)
+import Network.Mail.Mime.Instances ()
 
 import Mail (VerpMode)
 
@@ -255,12 +256,6 @@ deriveFromJSON
     }
   ''SmtpAuthConf
 
-deriveFromJSON
-  defaultOptions
-    { fieldLabelModifier = intercalate "-" . map toLower . drop 1 . splitCamel
-    }
-  ''Address
-
 
 instance FromJSON AppSettings where
     parseJSON = withObject "AppSettings" $ \o -> do

templates/mail/support.hamlet

@@ -6,9 +6,12 @@ $newline never
   <body>
     <dl>
       $case userInfo
-        $of Left (Just email)
+        $of Left (Just Address{..})
+          $maybe name <- addressName
+            <dt>Name
+            <dd>#{name}
           <dt>E-Mail
-          <dd>#{email}
+          <dd>#{addressEmail}
         $of Left  Nothing
         $of Right Nothing
           <dt>Ungültige UserId erhalten!

templates/standalone/inputs.lucius

@@ -30,6 +30,12 @@
   }
 }
 
+.form-group--optional {
+  .form-group__label::after {
+    content: '';
+  }
+}
+
 .form-group--submit .form-group__input {
   grid-column: 2;
 }