diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index 71c910999..49fc0d066 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -11,6 +11,7 @@ FirmAllActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurück FirmAllActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten? FirmAllActResetMutualSupervision: Ansprechpartner beaufsichtigen sich gegenseitig FirmUserActNotify: Mitteilung versenden +FirmUserActResetSupervision: Ansprechpartner auf Firmenstandard zurücksetzen FirmUserActMkSuper: Zum Firmenansprechpartner ernennen FirmResetSupervision rem@Int64 set@Int64: #{tshow set} Ansprechpartner gesetzt#{bool mempty (", " <> tshow rem <> " zuvor gelöscht") (rem > 0)} FirmSuperActNotify: Mitteilung versenden @@ -30,4 +31,9 @@ FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh} NoCompanySelected: Bitte wählen Sie mindestens eine Firm aus. TableIsDefaultSupervisor: Standardansprechpartner -TableIsDefaultReroute: Standardumleitung \ No newline at end of file +TableIsDefaultReroute: Standardumleitung +ASReqPostal: Benachrichtigungseinstellung +ASReqPostalTip: Gilt für alle Benachrichtigungen an diese Person, nicht nur für Umleitungen an diesen Ansprechpartner +ASReqEmpty: Es konnten keine Ansprechpartner hinzugefügt werden +ASReqSetSupers n@Int64 postal@(Maybe Bool): #{n} Standardansprechpartner eingetragen #{maybeBoolMessage postal "" "und auf Briefversand geschaltet" "und Benachrichtigungen per Email gesetzt"}, aber nicht nicht aktiviert. +RemoveDefaultSupervisors n@Int64: #{n} Standard Ansprechpartner entfernt, aber noch nicht deaktiviert. \ No newline at end of file diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index 7491437fe..39e46d552 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -11,6 +11,7 @@ FirmAllActResetSupervision: Reset supervisors for all company associates FirmUserActNotify: Send message FirmAllActResetSuperKeep: Additionally keep existing supervisors of company associates? FirmAllActResetMutualSupervision: Supervisors supervise each other +FirmUserActResetSupervision: Reset supervisors to company default FirmResetSupervision rem set: #{tshow set} supervisors set#{bool mempty (", " <> tshow rem <> " deleted before") (rem > 0)} FirmUserActMkSuper: Mark as company supervisor FirmSuperActNotify: Send message @@ -30,4 +31,9 @@ FirmSupervisorIndependent: Independent supervisors FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users NoCompanySelected: Select at least one company, please. TableIsDefaultSupervisor: Default supervisor -TableIsDefaultReroute: Default reroute \ No newline at end of file +TableIsDefaultReroute: Default reroute +ASReqPostal: Notification type +ASReqPostalTip: Affects all notifications to this person, not just reroutes to this supervisor +ASReqEmpty: No supervisors added +ASReqSetSupers n postal: #{n} default company supervisors set #{maybeBoolMessage postal "" "and switched to postal notifications" "and switched to email notifications"}, but not yet activated. +RemoveDefaultSupervisors n: #{n} default supervisors removed, but not yet deactivated. \ No newline at end of file diff --git a/messages/uniworx/utils/utils/de-de-formal.msg b/messages/uniworx/utils/utils/de-de-formal.msg index c02cbe1fb..f25770b33 100644 --- a/messages/uniworx/utils/utils/de-de-formal.msg +++ b/messages/uniworx/utils/utils/de-de-formal.msg @@ -18,6 +18,8 @@ CommRecipients: Empfänger:innen CommRecipientsTip: Sie selbst erhalten immer eine Kopie der Nachricht CommRecipientsList: Die an Sie selbst verschickte Kopie der Nachricht wird, zu Archivierungszwecken, eine vollständige Liste aller Empfänger:innen enthalten. Die Empfängerliste wird im CSV-Format an die E-Mail angehängt. Andere Empfänger:innen erhalten die Liste nicht. Bitte entfernen Sie dementsprechend den Anhang bevor Sie die E-Mail weiterleiten oder anderweitig mit Dritten teilen. UtilEMail: E-Mail +UtilPostal: Brief +UtilUnchanged: Nicht verändern UtilMultiEmailFieldTip: Es sind mehrere, Komma-separierte, E-Mail-Adressen möglich RGTutorialParticipants tutn@TutorialName: Kursteilnehmer:innen (#{tutn}) RGExamRegistered examn@ExamName: Angemeldet zur Prüfung „#{examn}“ @@ -94,6 +96,7 @@ RoomReferenceLinkLink !ident-ok: Link RoomReferenceLinkLinkPlaceholder !ident-ok: URL RoomReferenceLinkInstructions: Anweisungen RoomReferenceLinkInstructionsPlaceholder: Anweisungen +UtilEmptyChoice: Auswahl war leer #invitation.hs InvitationAction: Aktion diff --git a/messages/uniworx/utils/utils/en-eu.msg b/messages/uniworx/utils/utils/en-eu.msg index 1135dbade..97f5daa22 100644 --- a/messages/uniworx/utils/utils/en-eu.msg +++ b/messages/uniworx/utils/utils/en-eu.msg @@ -18,6 +18,8 @@ CommRecipients: Recipients CommRecipientsTip: You always receive a copy of the message CommRecipientsList: For archival purposes the copy of the message sent to you will contain a complete list of all recipients. The list of recipients will be attached to the email in CSV-format. Other recipients do not receive the list. Thus, please remove the attachment before you forward the email or otherwise share it with third parties. UtilEMail: Email +UtilPostal: Postal +UtilUnchanged: No change UtilMultiEmailFieldTip: Multiple emails addresses may be specified (comma-separated) RGTutorialParticipants tutn: Course participants (#{tutn}) RGExamRegistered examn: Registered for exam “#{examn}” @@ -94,6 +96,7 @@ RoomReferenceLinkLink: Link RoomReferenceLinkLinkPlaceholder: URL RoomReferenceLinkInstructions: Instructions RoomReferenceLinkInstructionsPlaceholder: Instructions +UtilEmptyChoice: Empty selection #invitation.hs InvitationAction: Action diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index a7fd0ac1d..8c8a0137b 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -203,6 +203,11 @@ maybeToMessage :: ToMessage m => Text -> Maybe m -> Text -> Text maybeToMessage _ Nothing _ = mempty maybeToMessage before (Just x) after = before <> toMessage x <> after +maybeBoolMessage :: Maybe Bool -> Text -> Text -> Text -> Text +maybeBoolMessage Nothing n _ _ = n +maybeBoolMessage (Just True) _ t _ = t +maybeBoolMessage (Just False) _ _ f = f + newtype ShortTermIdentifier = ShortTermIdentifier TermIdentifier deriving stock (Eq, Ord, Read, Show) diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 17990295c..c55eee0fb 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -21,6 +21,7 @@ import Import -- import Jobs import Handler.Utils import Handler.Utils.Communication +import Handler.Utils.Avs (guessAvsUser) import qualified Data.Set as Set import qualified Data.Map as Map @@ -28,7 +29,7 @@ import qualified Data.Map as Map -- import qualified Data.Text as T import qualified Data.CaseInsensitive as CI -- import qualified Data.Conduit.List as C -import Database.Persist.Sql (deleteWhereCount) +import Database.Persist.Sql (deleteWhereCount, updateWhereCount) import Database.Esqueleto.Experimental ((:&)(..)) import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma import qualified Database.Esqueleto.Legacy as EL (from, on) @@ -77,16 +78,18 @@ addDefaultSupervisors cid employees = do ) (\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications]) --- like `addDefaultSupervisors`, but selects all employees from database -addDefaultSupervisorsAll :: (MonoFoldable mono, CompanyId ~ Element mono) => Bool -> mono -> DB Int64 +-- like `addDefaultSupervisors`, but selects all employees of given companies from database +addDefaultSupervisorsAll :: (CompanyId ~ Element mono, MonoFoldable mono) => Bool -> mono -> DB Int64 addDefaultSupervisorsAll mutualSupervision cids = do E.insertSelectWithConflictCount UniqueUserSupervisor (do (spr :& usr) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @UserCompany `E.on` (\(spr :& usr) -> spr E.^. UserCompanyCompany E.==. usr E.^. UserCompanyCompany) - E.where_ $ E.and $ guardMonoid (not mutualSupervision) [ E.not_ $ usr E.^. UserCompanySupervisor ] - <> [ spr E.^. UserCompanyCompany `E.in_` E.vals cids - , spr E.^. UserCompanySupervisor - ] + E.where_ $ E.and $ guardMonoid (not mutualSupervision) + [ E.not_ $ usr E.^. UserCompanySupervisor ] + <> [ spr E.^. UserCompanySupervisor + , spr E.^. UserCompanyCompany `E.in_` E.vals cids + , usr E.^. UserCompanyCompany `E.in_` E.vals cids + ] return $ UserSupervisor E.<# (spr E.^. UserCompanyUser) E.<&> (usr E.^. UserCompanyUser) @@ -216,12 +219,12 @@ firmCountUserSupervisorsReroute usrCmp = E.subSelectCount $ do getFirmR, postFirmR :: CompanyShorthand -> Handler Html getFirmR = postFirmR postFirmR fsh = do - let fshId = CompanyKey fsh + let cid = CompanyKey fsh cusers <- runDB $ do - cusers <- selectList [UserCompanyCompany ==. fshId] [] + cusers <- selectList [UserCompanyCompany ==. cid] [] selectList [UserId <-. fmap (userCompanyUser . entityVal) cusers] [Asc UserDisplayName] csuper <- runDB $ do - csuper <- selectList [UserCompanyCompany ==. fshId, UserCompanySupervisor ==. True] [] + csuper <- selectList [UserCompanyCompany ==. cid, UserCompanySupervisor ==. True] [] selectList [UserId <-. fmap (userCompanyUser . entityVal) csuper] [Asc UserDisplayName] cactSuper <- runDB $ E.select $ do (usr :& spr :& scmpy) <- E.from $ @@ -253,7 +256,7 @@ postFirmR fsh = do
  • #{nr} Employees supervised by ^{nameWidget dn sn} # #{iconLetterOrEmail prefPost} # $maybe csh <- mbCsh - $if csh /= fshId + $if csh /= cid from foreign company #{unCompanyKey csh} $else from this company @@ -478,8 +481,8 @@ postFirmAllR = do E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids E.&&. usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser else return 0 - newSupers <- addDefaultSupervisorsAll (firmAllActResetMutualSupervision /= Just False) fids - addMessageI Info $ MsgFirmResetSupervision newSupers delSupers + newSupers <- addDefaultSupervisorsAll (firmAllActResetMutualSupervision /= Just False) fids + addMessageI Info $ MsgFirmResetSupervision delSupers newSupers reloadKeepGetParams FirmAllR -- reload to reflect changes (FirmAllActNotifyData , Set.toList -> fids) -> do @@ -499,6 +502,7 @@ postFirmAllR = do -- Firm Users Table data FirmUserAction = FirmUserActNotify + | FirmUserActResetSupervision | FirmUserActMkSuper deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) deriving anyclass (Universe, Finite) @@ -507,8 +511,14 @@ nullaryPathPiece ''FirmUserAction $ camelToPathPiece' 3 embedRenderMessage ''UniWorX ''FirmUserAction id data FirmUserActionData = FirmUserActNotifyData + | FirmUserActResetSupervisionData + { firmUserActResetKeepOldSupers :: Maybe Bool + -- , firmUserActResetMutualSupervision :: Maybe Bool + } | FirmUserActMkSuperData - deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + { firmUserActMkSuperReroute :: Maybe Bool } + + deriving (Eq, Ord, Read, Show, Generic) type UserCompanyTableExpr = E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity UserCompany) @@ -651,8 +661,12 @@ mkFirmUserTable isAdmin cid = do dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } acts :: Map FirmUserAction (AForm Handler FirmUserActionData) acts = mconcat - [ singletonMap FirmUserActNotify $ pure FirmUserActNotifyData - , singletonMap FirmUserActMkSuper $ pure FirmUserActMkSuperData + [ singletonMap FirmUserActNotify $ pure FirmUserActNotifyData + , singletonMap FirmUserActResetSupervision $ FirmUserActResetSupervisionData + <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmAllActResetSuperKeep) (Just $ Just False) + -- <*> aopt checkBoxField (fslI MsgFirmAllActResetMutualSupervision) (Just $ Just True ) + , singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData + <$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True) ] dbtParams = DBParamsForm { dbParamsFormMethod = POST @@ -720,10 +734,23 @@ postFirmUsersR fsh = do <*> mkFirmUserTable isAdmin cid formResult fusrRes $ \case - (FirmUserActMkSuperData, fids) -> addMessage Info $ text2Html $ "Make " <> tshow (length fids) <> " employees to supervisors. TODO" - (FirmUserActNotifyData , fids) -> do - cuids <- traverse encrypt $ Set.toList fids :: Handler [CryptoUUIDUser] + (_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice + (FirmUserActMkSuperData{..}, uids) -> do + nrMkSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. firmUserActMkSuperReroute] + addMessageI Info $ MsgASReqSetSupers nrMkSuper Nothing + reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes + (FirmUserActNotifyData , uids) -> do + cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser] redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids]) + (FirmUserActResetSupervisionData{..}, Set.toList -> uids') -> do + let uids = fromList uids' -- guaranteed to be non-empty due to first case clause + runDB $ do + delSupers <- if firmUserActResetKeepOldSupers == Just False + then deleteSupervisors uids + else return 0 + newSupers <- addDefaultSupervisors cid uids + addMessageI Info $ MsgFirmResetSupervision delSupers newSupers + reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes siteLayout (citext2widget companyName) $ do setTitle $ toHtml $ CI.original companyShorthand <> "-" <> tshow companyAvsId @@ -745,7 +772,33 @@ embedRenderMessage ''UniWorX ''FirmSuperAction id data FirmSuperActionData = FirmSuperActNotifyData | FirmSuperActRMSuperDefData | FirmSuperActRMSuperAllData - deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + deriving (Eq, Ord, Read, Show, Generic) + + +data AddSupervisorRequest = AddSupervisorRequest + { asReqSupers :: Set Text + , asReqReroute :: Bool + , asReqPostal :: Maybe Bool + } deriving (Eq, Ord, Show, Generic) + +instance Default AddSupervisorRequest where + def = AddSupervisorRequest + { asReqSupers = mempty + , asReqReroute = True + , asReqPostal = Nothing + } + +postalEmailField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m Bool +postalEmailField = boolFieldCustom (SomeMessage MsgUtilPostal) (SomeMessage MsgUtilEMail) $ Just $ SomeMessage MsgUtilUnchanged + +makeAddSupervisorForm :: Maybe AddSupervisorRequest -> Form AddSupervisorRequest +makeAddSupervisorForm template html = do + flip (renderAForm FormStandard) html $ AddSupervisorRequest + <$> areq (textField & cfAnySeparatedSet) + (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) (asReqSupers <$> template) + <*> areq checkBoxField (fslI MsgTableIsDefaultReroute ) (asReqReroute <$> template) + <*> aopt postalEmailField (fslI MsgASReqPostal & setTooltip MsgASReqPostalTip) (asReqPostal <$> template) + type SuperCompanyTableExpr = E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity UserCompany)) @@ -886,41 +939,59 @@ getFirmSupersR, postFirmSupersR :: CompanyShorthand -> Handler Html getFirmSupersR = postFirmSupersR postFirmSupersR fsh = do isAdmin <- hasReadAccessTo AdminR - let fshId = CompanyKey fsh + let cid = CompanyKey fsh (Company{..},(fsprRes,fsprTable)) <- runDB $ (,) - <$> get404 fshId - <*> mkFirmSuperTable isAdmin fshId + <$> get404 cid + <*> mkFirmSuperTable isAdmin cid formResult fsprRes $ \case - (FirmSuperActRMSuperDefData, fids) -> addMessage Info $ text2Html $ "Remove " <> tshow (length fids) <> " default supervisors. TODO" - (FirmSuperActRMSuperAllData, fids) -> addMessage Info $ text2Html $ "Make " <> tshow (length fids) <> " default and active supervisors. TODO" - (FirmSuperActNotifyData , fids) -> do - cuids <- traverse encrypt $ Set.toList fids :: Handler [CryptoUUIDUser] + (_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice + (FirmSuperActRMSuperDefData, uids) -> do + nrRmSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False] + addMessageI Info $ MsgRemoveDefaultSupervisors nrRmSuper + reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes + (FirmSuperActRMSuperAllData, uids) -> addMessage Info $ text2Html $ "Make " <> tshow (length uids) <> " default and active supervisors. TODO" + (FirmSuperActNotifyData , uids) -> do + cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser] redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids]) + ((asReqRes, asReqWgt), asReqEnctype) <- runFormPost . identifyForm FIDAddSupervisor $ makeAddSupervisorForm (Just def) + let addSuperAnchor = "add-supervisors-form" :: Text + routeAddSuperForm = FirmSupersR fsh :#: addSuperAnchor + addSuperForm = wrapForm asReqWgt FormSettings + { formMethod = POST + , formAction = Just . SomeRoute $ routeAddSuperForm + , formEncoding = asReqEnctype + , formAttrs = [] + , formSubmit = FormSubmit + , formAnchor = Just addSuperAnchor + } + formResult asReqRes $ \AddSupervisorRequest{..} -> do + avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser asReqSupers + let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers + usersFound = mapMaybe snd usersFound' + unless (null usersNotFound) $ + let msgContent = [whamlet| + $newline never +