feat(multi-user-field): multi-user-invitation-field

frontend/src/app.sass

@@ -1358,3 +1358,6 @@ a.breadcrumbs__home
 
   &:hover
     opacity: 1
+
+.multi-user-invitation-field__wrapper
+  max-width: 25rem

messages/uniworx/de-de-formal.msg

@@ -256,7 +256,7 @@ CourseFormSectionAdministration: Verwaltung
 CourseLecturers: Kursverwalter
 CourseLecturer: Dozent
 CourseAssistant: Assistent
-CourseLecturerAlreadyAdded email@UserEmail: Es gibt bereits einen Kursverwalter mit E-Mail #{email}
+CourseLecturerAlreadyAdded: Dieser Nutzer ist bereits als Kursverwalter eingetragen
 CourseRegistrationEndMustBeAfterStart: Ende des Anmeldezeitraums muss nach dem Anfang liegen
 CourseDeregistrationEndMustBeAfterStart: Ende des Abmeldezeitraums muss nach dem Anfang des Anmeldezeitraums liegen
 CourseUserMustBeLecturer: Aktueller Benutzer muss als Kursverwalter eingetragen sein
@@ -1434,7 +1434,17 @@ RGTutorialParticipants: Tutorium-Teilnehmer
 
 MultiSelectFieldTip: Mehrfach-Auswahl ist möglich (Umschalt bzw. Strg)
 MultiEmailFieldTip: Es sind mehrere, Komma-separierte, E-Mail-Addressen möglich
-EmailInvitationWarning: Diese Adresse konnte mit Ihren aktuellen Rechten keinem Uni2work-Benutzer zugeordnet werden (ggf. unter gewissen Einschränkungen). Es wird eine Einladung per E-Mail versandt.
+
+EmailInvitationWarning: Diese Adresse konnte keinem Uni2work-Benutzer zugeordnet werden. Es wird eine Einladung per E-Mail versandt.
+EmailInvitationWarningPrevCoSubmittors: Diese Adresse konnte keinem Kursteilnehmer, mit dem Sie schon einmal für diesen Kurs abgegeben haben, zugeordnet werden. Es wird eine Einladung per E-Mail versandt.
+EmailInvitationWarningCourseParticipants: Diese Adresse konnte keinem Kursteilnehmer zugeordnet werden. Es wird eine Einladung per E-Mail versandt.
+
+MultiUserFieldExplanationAnyUser: Dieses Eingabefeld sucht in den Addressen aller Uni2work-Benutzer.
+MultiUserFieldExplanationPrevCoSubmittors: Dieses Eingabefeld sucht in den Addressen von Kursteilnehmern, für die gesichert werden kann, dass Sie zusammen mit den dahinter stehenden Personen schon einmal für diesen Kurs abgegeben haben.
+MultiUserFieldExplanationCourseParticipants: Dieses Eingabefeld sucht in den Addressen von Kursteilnehmern.
+
+MultiUserFieldInvitationExplanation: An Addressen, die so keinem Uni2work-Benutzer zugeordnet werden können, wird eine Einladung per E-Mail versandt.
+MultiUserFieldInvitationExplanationAlways: Es wird an alle Addressen, die Sie hier angeben, eine Einladung per E-Mail versandt.
 
 LecturerInvitationAccepted lType@Text csh@CourseShorthand: Sie wurden als #{lType} für #{csh} eingetragen
 LecturerInvitationDeclined csh@CourseShorthand: Sie haben die Einladung, Kursverwalter für #{csh} zu werden, abgelehnt

messages/uniworx/en-eu.msg

@@ -255,7 +255,7 @@ CourseFormSectionAdministration: Administration
 CourseLecturers: Course administrators
 CourseLecturer: Lecturer
 CourseAssistant: Assistant
-CourseLecturerAlreadyAdded email: There already is a course administrator with email #{email}
+CourseLecturerAlreadyAdded: This user is already configured as a course administrator
 CourseRegistrationEndMustBeAfterStart: The end of the registration period must be before its start
 CourseDeregistrationEndMustBeAfterStart: The end of the deregistration period must be after the start of the registration period
 CourseUserMustBeLecturer: The current user needs to be a course administrator
@@ -1433,7 +1433,16 @@ RGTutorialParticipants: Tutorial participants
 
 MultiSelectFieldTip: Multiple selections are possible (Shift or Ctrl)
 MultiEmailFieldTip: Multiple emails addresses may be specified (comma-separated)
-EmailInvitationWarning: This address could not be matched to any Uni2work-user under your current permissions (may be subject to some restrictions). An invitation will be sent via email.
+EmailInvitationWarning: This address could not be matched to any Uni2work user. An invitation will be sent via email.
+EmailInvitationWarningPrevCoSubmittors: This address could not be matched to any course participant with whom you have submitted for this course before. An Invitation will be sent via email.
+EmailInvitationWarningCourseParticipants: This address coulde not be matched to any course participant. An Invitation will be sent via email.
+
+MultiUserFieldExplanationAnyUser: This input searches through the addresses of all Uni2work users.
+MultiUserFieldExplanationPrevCoSubmittors: This input searches through the addresses of all course participants for whom it could be determined, that you have already submitted with that person for this course.
+MultiUserFieldExplanationCourseParticipants: This input searches through the addresses of all course participants.
+
+MultiUserFieldInvitationExplanation: For addresses, which are not found in this way, an invitation will be sent via email.
+MultiUserFieldInvitationExplanationAlways: An invitation will be sent via email to all addresses you enter here.
 
 LecturerInvitationAccepted lType csh: You were registered as #{lType} for #{csh}
 LecturerInvitationDeclined csh: You have declined the invitation to become course administrator for #{csh}

src/Handler/Course/Edit.hs

@@ -128,16 +128,13 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
 
     let miAdd :: ListPosition -> Natural -> (Text -> Text) -> FieldView UniWorX -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
         miAdd _ _ nudge btn = Just $ \csrf -> do
-          (addRes, addView) <- mpreq emailField ("" & addName (nudge "user")) Nothing
+          (addRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
-          addRes'  <- for addRes $ liftHandler . runDB . getKeyBy . UniqueEmail . CI.mk
+          let addRes'' = addRes <&> \newDat oldDat -> if
-          let addRes'' = case (,) <$> addRes <*> addRes' of
+                | existing <- newDat `Set.intersection` Set.fromList (Map.elems oldDat)
-                FormSuccess (CI.mk -> email, mLid) ->
+                , not $ Set.null existing
-                  let new = maybe (Left email) Right mLid
+                  -> FormFailure [mr MsgCourseLecturerAlreadyAdded]
-                  in  FormSuccess $ \prev -> if
+                | otherwise
-                        | new `elem` Map.elems prev -> FormFailure [ mr $ MsgCourseLecturerAlreadyAdded email ] -- Since there is only ever one email address associated with any user, the case where a @Left email@ corresponds to a @Right lid@ can never occur (at least logically; might still be the same person, of course)
+                  -> FormSuccess . Map.fromList . zip [maybe 0 succ . fmap fst $ Map.lookupMax oldDat ..] $ Set.toList newDat
-                        | otherwise -> FormSuccess $ Map.singleton (maybe 0 succ . fmap fst $ Map.lookupMax prev) new
-                FormFailure errs -> FormFailure errs
-                FormMissing -> FormMissing
               addView' = $(widgetFile "course/lecturerMassInput/add")
           return (addRes'', addView')
 
@@ -149,7 +146,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
           return (Just <$> lrwRes,lrwView')
         miCell _ (Left lEmail) defType nudge = \csrf -> do
           (lrwRes,lrwView) <- mopt (selectField optionsFinite) ("" & addName (nudge "lecturer-type")) defType
-          invWarnMsg <- messageI Warning MsgEmailInvitationWarning
+          invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
           let lrwView' = $(widgetFile "course/lecturerMassInput/cellInvitation")
           return (lrwRes,lrwView')
 

src/Handler/Course/ParticipantInvite.hs

@@ -131,7 +131,7 @@ postCAddUserR tid ssh csh = do
       mbGrp <- wopt (textField & cfStrip & cfCI & addDatalist submissionGroupOpts) (fslI MsgSubmissionGroup & setTooltip MsgSubmissionGroupEmptyIsUnsetTip) Nothing
 
       mr <- getMessageRender
-      users <- wreq (multiUserField (maybe True not $ formResultToMaybe enlist) Nothing)
+      users <- wreq (multiUserInvitationField . maybe MUIAlwaysInvite (const $ MUILookupAnyUser Nothing) $ formResultToMaybe enlist)
                  (fslpI MsgCourseParticipantInviteField (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip) Nothing
 
       return $ Map.fromSet . const <$> mbGrp <*> users

src/Handler/Exam/AddUser.hs

@@ -71,7 +71,7 @@ postEAddUserR tid ssh csh examn = do
       registerCourse <- wpopt checkBoxField (fslI MsgExamRegistrationRegisterCourse & setTooltip MsgExamRegistrationRegisterCourseTip) (Just False)
       occurrence <- wopt (examOccurrenceField eid) (fslI MsgExamOccurrence) Nothing
       mr <- getMessageRender
-      users <- wreq (multiUserField (maybe True not $ formResultToMaybe enlist) Nothing)
+      users <- wreq (multiUserInvitationField . maybe MUIAlwaysInvite (const $ MUILookupAnyUser Nothing) $ formResultToMaybe enlist)
         (fslpI MsgExamRegistrationInviteField (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip) Nothing
       return $ (,,,) <$> deadline <*> registerCourse <*> occurrence <*> users
 

src/Handler/Exam/Form.hs

@@ -114,7 +114,7 @@ examCorrectorsForm mPrev = wFormToAForm $ do
 
     miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
     miAdd' nudge submitView csrf = do
-      (addRes, addView) <- mpreq (multiUserField False $ Just corrUserSuggestions) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
+      (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser $ Just corrUserSuggestions) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
       let
         addRes'
           | otherwise
@@ -138,7 +138,7 @@ examCorrectorsForm mPrev = wFormToAForm $ do
 
     miCell' :: Either UserEmail UserId -> Widget
     miCell' (Left email) = do
-      invWarnMsg <- messageI Warning MsgEmailInvitationWarning
+      invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
       $(widgetFile "widgets/massinput/examCorrectors/cellInvitation")
     miCell' (Right userId) = do
       User{..} <- liftHandler . runDB $ get404 userId

src/Handler/ExamOffice/Users.hs

@@ -95,7 +95,7 @@ makeExamOfficeUsersForm template = renderWForm FormStandard $ do
            -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
     miAdd' nudge btn csrf = do
       MsgRenderer mr <- getMsgRenderer
-      (addRes, addView) <- mpreq (multiUserField False Nothing) ("" & addName (nudge "users") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
+      (addRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) ("" & addName (nudge "users") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
       let
         res' :: FormResult ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
         res' = addRes <&> \newUsers oldUsers -> if
@@ -106,7 +106,7 @@ makeExamOfficeUsersForm template = renderWForm FormStandard $ do
       return (res', $(widgetFile "widgets/massinput/examOfficeUsers/add"))
     miCell' :: Either UserEmail UserId -> Widget
     miCell' (Left email) = do
-      invWarnMsg <- messageI Warning MsgEmailInvitationWarning
+      invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
       $(widgetFile "widgets/massinput/examOfficeUsers/cellInvitation")
     miCell' (Right uid) = do
       User{..} <- liftHandler . runDB $ getJust uid

src/Handler/ExternalExam/Form.hs

@@ -76,7 +76,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
       where
         miAdd mkUnique submitView csrf = do
           MsgRenderer mr <- getMsgRenderer
-          (usersRes, addView) <- mpreq (multiUserField False Nothing) ("" & addName (mkUnique "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
+          (usersRes, addView) <- mpreq (multiUserInvitationField $ MUILookupAnyUser Nothing) ("" & addName (mkUnique "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
           let
             usersRes' = usersRes <&> \newDat oldDat -> if
               | existing <- newDat `Set.intersection` Set.fromList oldDat
@@ -86,7 +86,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
                 -> FormSuccess $ Set.toList newDat
           return (usersRes', $(widgetFile "external-exam/staffMassInput/add"))
         miCell (Left email) = do
-          invWarnMsg <- messageI Warning MsgEmailInvitationWarning
+          invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
           $(widgetFile "external-exam/staffMassInput/cellInvitation")
         miCell (Right userId) = do
           User{..} <- liftHandler . runDB $ getJust userId

src/Handler/Sheet.hs

@@ -745,7 +745,7 @@ correctorForm loads' = wFormToAForm $ do
           -> FieldView UniWorX
           -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId))))
     miAdd _ _ nudge submitView = Just $ \csrf -> do
-      (addRes, addView) <- mpreq (multiUserField False $ Just previousCorrectors) (fslpI MsgCorrector (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "corrector")) Nothing
+      (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser $ Just previousCorrectors) (fslpI MsgCorrector (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "corrector")) Nothing
       let addRes' = addRes <&> \nCorrs oldData@(maybe 0 (succ . fst) . Map.lookupMax -> kStart) -> if
             | existing <- Set.intersection nCorrs . Set.fromList $ Map.elems oldData
             , not $ null existing
@@ -774,7 +774,7 @@ correctorForm loads' = wFormToAForm $ do
         Right uid -> do
           User{userEmail, userDisplayName, userSurname} <- liftHandler . runDB $ getJust uid
           return $ nameEmailWidget userEmail userDisplayName userSurname
-      invWarnMsg <- messageI Warning MsgEmailInvitationWarning
+      invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
       return (res, $(widgetFile "sheetCorrectors/cell"))
 
 

src/Handler/Submission.hs

@@ -131,7 +131,9 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
   where
     miCell' :: Markup -> Either UserEmail UserId -> Widget
     miCell' csrf (Left email) = do
-      invWarnMsg <- messageI Warning MsgEmailInvitationWarning
+      invWarnMsg <- messageIconI Info IconEmail $ if
+        | isLecturer -> MsgEmailInvitationWarningCourseParticipants
+        | otherwise  -> MsgEmailInvitationWarningPrevCoSubmittors
       $(widgetFile "widgets/massinput/submissionUsers/cellInvitation")
     miCell' csrf (Right uid) = do
       User{..} <- liftHandler . runDB $ getJust uid
@@ -174,9 +176,9 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
     addField, addFieldLecturer :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> Field m (Set (Either UserEmail UserId))
     addField = addField' False
     addFieldLecturer = addField' True
-    addField' isAdmin uid = multiUserField True . Just $ if
+    addField' isAdmin uid
-      | isAdmin   -> courseUsers
+      | isAdmin   = multiUserInvitationField $ MUILookupSuggested (SomeMessage MsgMultiUserFieldExplanationCourseParticipants) courseUsers
-      | otherwise -> previousCoSubmittors uid
+      | otherwise = multiUserInvitationField . MUILookupSuggested (SomeMessage MsgMultiUserFieldExplanationPrevCoSubmittors) $ previousCoSubmittors uid
 
     addFieldSettings :: (forall msg. RenderMessage UniWorX msg => msg -> Text) -> FieldSettings UniWorX
     addFieldSettings mr = fslpI MsgSubmissionMembers $ mr MsgLdapIdentificationOrEmail
@@ -282,8 +284,8 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident
                      | otherwise -> Set.insert (Right uid) $ Set.take (pred $ fromIntegral maxSize') resultUsers'
             | otherwise = Set.singleton $ Right uid
             where resultUsers = setOf (folded . _1) valMap
-        when (maxSize > Just 1) $
+        -- when (maxSize > Just 1) $
-          wformMessage =<< messageI Info MsgCosubmittorTip
+        --   wformMessage =<< messageI Info MsgCosubmittorTip
         fmap postProcess <$> massInputW MassInput{..} submittorSettings' True (Just . Map.fromList . zip [0..] . map (, ()) $ Set.toList prefillUsers)
 
 

src/Handler/Tutorial/Form.hs

@@ -40,7 +40,7 @@ tutorialForm cid template html = do
       where
         miAdd' :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId])
         miAdd' nudge submitView csrf = do
-          (addRes, addView) <- mpreq (multiUserField False . Just $ tutUserSuggestions uid) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
+          (addRes, addView) <- mpreq (multiUserInvitationField . MUILookupAnyUser . Just $ tutUserSuggestions uid) ("" & addName (nudge "email") & addPlaceholder (mr MsgLdapIdentificationOrEmail)) Nothing
           let
             addRes'
               | otherwise
@@ -55,7 +55,7 @@ tutorialForm cid template html = do
 
         miCell' :: Either UserEmail UserId -> Widget
         miCell' (Left email) = do
-          invWarnMsg <- messageI Warning MsgEmailInvitationWarning
+          invWarnMsg <- messageIconI Info IconEmail MsgEmailInvitationWarning
           $(widgetFile "tutorial/tutorMassInput/cellInvitation")
         miCell' (Right userId) = do
           User{..} <- liftHandler . runDB $ get404 userId

src/Handler/Utils/Communication.hs

@@ -127,7 +127,7 @@ commR CommunicationRoute{..} =  do
       recipientAForm = postProcess <$> massInputA MassInput{..} (fslI MsgCommRecipients & setTooltip MsgCommRecipientsTip) True (Just chosenRecipients')
         where
           miAdd (EnumPosition RecipientCustom, 0) 1 nudge submitView = Just $ \csrf -> do
-            (addRes, addView) <- mpreq (multiUserField True Nothing) (fslpI MsgEMail (mr MsgLdapIdentificationOrEmail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "email")) Nothing
+            (addRes, addView) <- mpreq (multiUserField True Nothing) (fslpI MsgEMail (mr MsgEMail) & setTooltip MsgMultiEmailFieldTip & addName (nudge "email")) Nothing
             let
               addRes' = addRes <&> \(Set.toList -> nEmails) (maybe 0 (succ . snd . fst) . Map.lookupMax . Map.filterWithKey (\(EnumPosition c, _) _ -> c == RecipientCustom) -> kStart) -> FormSuccess . Map.fromList $ zip (map (EnumPosition RecipientCustom, ) [kStart..]) nEmails
             return (addRes', $(widgetFile "widgets/communication/recipientAdd"))

src/Handler/Utils/Form.hs

@@ -1461,35 +1461,54 @@ formResultModal res finalDest handler = maybeT_ $ do
         forM_ messages $ \Message{..} -> addMessage messageStatus messageContent
         redirect finalDest
 
-userMatriculationField :: forall m.
-                          ( MonadHandler m
-                          , HandlerSite m ~ UniWorX
-                          )
-                       => Field m [Entity User]
-userMatriculationField = Field{..}
-  where
-    fieldEnctype = UrlEncoded
-    fieldView theId name attrs val isReq = do
-      let val' = val <&> Text.intercalate ", " . mapMaybe (userMatrikelnummer . entityVal)
-      [whamlet|
-        $newline never
-        <input id="#{theId}" name="#{name}" *{attrs} type="text" :isReq:required="" value="#{either id id val'}">
-      |]
-    fieldParse (all Text.null -> True) _ = return $ Right Nothing
-    fieldParse ts _ = runExceptT . fmap Just $ do
-      let ts' = concatMap (Text.splitOn ",") ts
-      forM ts' $ \matr -> do
-        dbRes <- liftHandler . runDB . E.select . E.from $ \user -> do
-          E.where_ $ E.strip (user E.^. UserMatrikelnummer) `E.ciEq` E.just (E.val $ Text.strip matr)
-          return user
-        case dbRes of
-          [user]
-            -> return user
-          []
-            -> throwE . SomeMessage $ MsgUserMatriculationNotFound matr
-          _other
-            -> throwE . SomeMessage $ MsgUserMatriculationAmbiguous matr
 
+data MultiUserInvitationMode
+  = MUIAlwaysInvite
+  | MUILookupAnyUser (Maybe (E.SqlQuery (E.SqlExpr (Entity User))))
+  | MUILookupSuggested (SomeMessage UniWorX) (E.SqlQuery (E.SqlExpr (Entity User)))
+
+  
+multiUserInvitationField :: forall m.
+                            ( MonadHandler m
+                            , HandlerSite m ~ UniWorX
+                            )
+                         => MultiUserInvitationMode
+                         -> Field m (Set (Either UserEmail UserId))
+multiUserInvitationField mode
+  = baseField
+      { fieldView = \theId name attrs val isReq ->
+          [whamlet|
+            $newline never
+            <div .multi-user-invitation-field__wrapper>
+              ^{fieldView baseField theId name attrs val isReq}
+              <p .multi-user-invitation-field__explanation .explanation>
+                ^{explanation}
+          |]
+      }
+  where
+    (onlySuggested, suggestions) = case mode of
+      MUIAlwaysInvite         -> (True , Nothing)
+      MUILookupAnyUser     ms -> (False, ms     )
+      MUILookupSuggested _ s  -> (True , Just s )
+    baseField = multiUserField onlySuggested suggestions
+
+    explanation
+      | MUILookupSuggested suggestExplain _ <- mode
+      = [whamlet|
+          $newline never
+          _{suggestExplain}
+          <br />
+          _{MsgMultiUserFieldInvitationExplanation}
+        |]
+      | onlySuggested
+      = i18n MsgMultiUserFieldInvitationExplanationAlways
+      | otherwise
+      = [whamlet|
+          $newline never
+          _{MsgMultiUserFieldExplanationAnyUser}
+          <br />
+          _{MsgMultiUserFieldInvitationExplanation}
+        |]
 
 multiUserField :: forall m.
                   ( MonadHandler m