chore(firm): implement fix #67 Maske Firmen
This commit is contained in:
parent
b9f2d3bda4
commit
83bab6b86b
@ -16,7 +16,7 @@ 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
|
||||
FirmSuperActRMSuperDef: Standard Firmenansprechpartner entfernen
|
||||
FirmSuperActRMSuperAll: Als aktiven Ansprechpartner komplett entfernen
|
||||
FirmSuperActRMSuperActive: Auch aktive Ansprechpartnerbeziehungen innerhalb dieser Firma beenden
|
||||
FirmsNotification: Firmen Benachrichtigung versenden
|
||||
FirmNotification fsh@CompanyShorthand: Benachrichtigung an #{fsh} versenden
|
||||
FirmsNotificationTitle: Firmen benachrichtigen
|
||||
@ -32,8 +32,9 @@ FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}
|
||||
NoCompanySelected: Bitte wählen Sie mindestens eine Firm aus.
|
||||
TableIsDefaultSupervisor: Standardansprechpartner
|
||||
TableIsDefaultReroute: Standardumleitung
|
||||
ASReqPostal: Benachrichtigungseinstellung
|
||||
ASReqPostalTip: Gilt für alle Benachrichtigungen an diese Person, nicht nur für Umleitungen an diesen Ansprechpartner
|
||||
FormReqPostal: Benachrichtigungseinstellung
|
||||
FormReqPostalTip: 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.
|
||||
RemoveSupervisors ndef@Int64 nact@Int64: #{ndef} Standard Ansprechpartner entfernt#{bool ", aber noch nicht deaktiviert" (", " <> tshow nact <> " aktive Ansprechpartnerbeziehungen gelöscht") (nact > 0)}
|
||||
FirmUserChanges n@Int64: Benachrichtigungseinstellung für #{n} Firmenangehörige wurden geändert
|
||||
@ -16,7 +16,7 @@ FirmResetSupervision rem set: #{tshow set} supervisors set#{bool mempty (", " <>
|
||||
FirmUserActMkSuper: Mark as company supervisor
|
||||
FirmSuperActNotify: Send message
|
||||
FirmSuperActRMSuperDef: Remove as default supervisor
|
||||
FirmSuperActRMSuperAll: Remove all active supervisions for this company
|
||||
FirmSuperActRMSuperActive: Also remove active supervisions within this company
|
||||
FirmsNotification: Send company notification
|
||||
FirmNotification fsh: Send notification to company #{fsh}
|
||||
FirmsNotificationTitle: Company notification
|
||||
@ -32,8 +32,9 @@ FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users
|
||||
NoCompanySelected: Select at least one company, please.
|
||||
TableIsDefaultSupervisor: Default supervisor
|
||||
TableIsDefaultReroute: Default reroute
|
||||
ASReqPostal: Notification type
|
||||
ASReqPostalTip: Affects all notifications to this person, not just reroutes to this supervisor
|
||||
FormReqPostal: Notification type
|
||||
FormReqPostalTip: 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.
|
||||
RemoveSupervisors ndef nact: #{ndef} default supervisors removed#{bool ", but not yet deactivated" (" and " <> tshow nact <> " active supervisons terminated") (nact > 0)}
|
||||
FirmUserChanges n: Notification settings changed for #{n} company associates
|
||||
@ -104,4 +104,5 @@ TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} Jobs entfernt
|
||||
TableFilterComma: Es können mehrere alternative Suchkriterien mit Komma getrennt angegeben werden, wovon mindestens eines erfüllt werden muss.
|
||||
TableFilterCommaPlus: Mehrere alternative Suchkriterien mit Komma trennen. Mindestens ein Suchkriterium muss erfüllt werden, zusätzlich zu allen Suchkriterien mit vorangestelltem Plus-Symbol.
|
||||
TableFilterCommaName: Mehrere Namen mit Komma trennen.
|
||||
TableFilterCommaNameNr: Mehrere Namen oder Nummern mit Komma trennen. Nummern werden nur exakt gesucht.
|
||||
TableFilterCommaNameNr: Mehrere Namen oder Nummern mit Komma trennen. Nummern werden nur exakt gesucht.
|
||||
TableUserEdit: Benutzer bearbeiten
|
||||
@ -104,4 +104,5 @@ TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} queued jobs deleted
|
||||
TableFilterComma: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled.
|
||||
TableFilterCommaPlus: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled in addition to all criteria preceded by a plus symbol.
|
||||
TableFilterCommaName: Separate names by comma.
|
||||
TableFilterCommaNameNr: Separate names and numbers by comma. Numbers have to match exact.
|
||||
TableFilterCommaNameNr: Separate names and numbers by comma. Numbers have to match exact.
|
||||
TableUserEdit: Edit user
|
||||
@ -50,7 +50,10 @@ encryptUser = encrypt
|
||||
|
||||
---------------------------
|
||||
-- Firm specific utilities
|
||||
-- for filters and counts see before FirmAllR Handlers
|
||||
-- for filters and counts also see before FirmAllR Handlers
|
||||
|
||||
postalEmailField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m Bool
|
||||
postalEmailField = boolFieldCustom (SomeMessage MsgUtilPostal) (SomeMessage MsgUtilEMail) $ Just $ SomeMessage MsgUtilUnchanged
|
||||
|
||||
-- remove supervisors:
|
||||
deleteSupervisors :: NonEmpty UserId -> DB Int64
|
||||
@ -501,6 +504,25 @@ postFirmAllR = do
|
||||
-----------------------
|
||||
-- Firm Users Table
|
||||
|
||||
data FirmUserChangeRequest = FirmUserChangeRequest
|
||||
{ fucrPostalPref :: Maybe Bool
|
||||
, fucrPostalAddr :: Maybe StoredMarkup
|
||||
}
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
instance Default FirmUserChangeRequest where
|
||||
def = FirmUserChangeRequest
|
||||
{ fucrPostalPref = Nothing
|
||||
, fucrPostalAddr = Nothing
|
||||
}
|
||||
|
||||
makeFirmUserChangeRequestForm :: Maybe FirmUserChangeRequest -> Form FirmUserChangeRequest
|
||||
makeFirmUserChangeRequestForm template html = do
|
||||
flip (renderAForm FormStandard) html $ FirmUserChangeRequest
|
||||
<$> aopt postalEmailField (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip) (fucrPostalPref <$> template)
|
||||
<*> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) (fucrPostalAddr <$> template)
|
||||
|
||||
|
||||
data FirmUserAction = FirmUserActNotify
|
||||
| FirmUserActResetSupervision
|
||||
| FirmUserActMkSuper
|
||||
@ -518,7 +540,7 @@ data FirmUserActionData = FirmUserActNotifyData
|
||||
| FirmUserActMkSuperData
|
||||
{ firmUserActMkSuperReroute :: Maybe Bool }
|
||||
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
type UserCompanyTableExpr = E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity UserCompany)
|
||||
|
||||
@ -584,6 +606,7 @@ mkFirmUserTable isAdmin cid = do
|
||||
, sortable (Just "reroutes") (i18nCell MsgTableCompanyNrRerouteActive) $ \(view resultUserCompanyReroutes -> nr) -> wgtCell $ word2widget nr
|
||||
, sortable (Just "postal-pref") (i18nCell MsgPrefersPostal) $ \(view $ resultUserUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
|
||||
, colUserEmail
|
||||
, sortable Nothing (i18nCell MsgTableUserEdit) $ \(view resultUserUser -> entUsr) -> cellEditUserModal entUsr
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ single $ sortUserNameLink queryUserUser
|
||||
@ -750,6 +773,29 @@ postFirmUsersR fsh = do
|
||||
newSupers <- addDefaultSupervisors cid uids
|
||||
addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
|
||||
((fucrRes, fucrWgt), fucrEnctype) <- runFormPost . identifyForm FIDFirmUserChangeRequest $ makeFirmUserChangeRequestForm (Just def)
|
||||
let addFormAnchor = "firm-user-change-form" :: Text
|
||||
routeForm = FirmUsersR fsh :#: addFormAnchor
|
||||
fucrForm = wrapForm fucrWgt FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ routeForm
|
||||
, formEncoding = fucrEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Just addFormAnchor
|
||||
}
|
||||
formResult fucrRes $ \FirmUserChangeRequest{..} -> when (isJust fucrPostalAddr || isJust fucrPostalAddr) $ do
|
||||
let changes = foldMap (\pp -> [UserPrefersPostal E.=. E.val pp]) fucrPostalPref <>
|
||||
foldMap (\pa -> [UserPostAddress E.=. E.justVal pa]) fucrPostalAddr -- seems weird, but: Nothing means no change, and not delete address!
|
||||
nrChanged <- runDB $ E.updateCount $ \usr -> do
|
||||
E.set usr changes
|
||||
E.where_ $ E.exists $ do
|
||||
usrCmpy <- E.from $ E.table @UserCompany
|
||||
E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. E.val cid
|
||||
E.&&. usrCmpy E.^. UserCompanyUser E.==. usr E.^. UserId
|
||||
addMessageI Info $ MsgFirmUserChanges nrChanged
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
|
||||
siteLayout (citext2widget companyName) $ do
|
||||
setTitle $ toHtml $ CI.original companyShorthand <> "-" <> tshow companyAvsId
|
||||
@ -761,7 +807,7 @@ postFirmUsersR fsh = do
|
||||
|
||||
data FirmSuperAction = FirmSuperActNotify
|
||||
| FirmSuperActRMSuperDef
|
||||
| FirmSuperActRMSuperAll
|
||||
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
@ -770,8 +816,9 @@ embedRenderMessage ''UniWorX ''FirmSuperAction id
|
||||
|
||||
data FirmSuperActionData = FirmSuperActNotifyData
|
||||
| FirmSuperActRMSuperDefData
|
||||
| FirmSuperActRMSuperAllData
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
{ firmSuperActRMSuperActive :: Maybe Bool }
|
||||
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
|
||||
data AddSupervisorRequest = AddSupervisorRequest
|
||||
@ -787,16 +834,13 @@ instance Default AddSupervisorRequest where
|
||||
, 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)
|
||||
<*> aopt postalEmailField (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip) (asReqPostal <$> template)
|
||||
|
||||
|
||||
type SuperCompanyTableExpr = E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity UserCompany))
|
||||
@ -874,6 +918,7 @@ mkFirmSuperTable isAdmin cid = do
|
||||
, sortable (Just "rerouted") (i18nCell MsgTableCompanyNrEmpRerouted ) $ \(view resultSuperCompanyReroutes -> nr) -> wgtCell $ word2widget nr
|
||||
, sortable (Just "def-super") (i18nCell MsgTableIsDefaultSupervisor) $ \(view resultSuperCompanyDefaultSuper -> mb) -> case mb of { Nothing -> iconCell IconSupervisorForeign; Just True -> iconCell IconSupervisor; Just False -> iconSpacerCell }
|
||||
, sortable (Just "def-reroute") (i18nCell MsgTableIsDefaultReroute) $ \(view resultSuperCompanyDefaultReroute -> mb) -> tickmarkCell (mb == Just True)
|
||||
, sortable Nothing (i18nCell MsgTableUserEdit) $ \(view resultSuperUser -> entUsr) -> cellEditUserModal entUsr
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ single $ sortUserNameLink querySuperUser
|
||||
@ -902,8 +947,8 @@ mkFirmSuperTable isAdmin cid = do
|
||||
acts :: Map FirmSuperAction (AForm Handler FirmSuperActionData)
|
||||
acts = mconcat
|
||||
[ singletonMap FirmSuperActNotify $ pure FirmSuperActNotifyData
|
||||
, singletonMap FirmSuperActRMSuperDef $ pure FirmSuperActRMSuperDefData
|
||||
, singletonMap FirmSuperActRMSuperAll $ pure FirmSuperActRMSuperAllData
|
||||
, singletonMap FirmSuperActRMSuperDef $ FirmSuperActRMSuperDefData
|
||||
<$> aopt checkBoxField (fslI MsgFirmSuperActRMSuperActive) (Just $ Just True)
|
||||
]
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
@ -946,11 +991,22 @@ postFirmSupersR fsh = do
|
||||
|
||||
formResult fsprRes $ \case
|
||||
(_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice
|
||||
(FirmSuperActRMSuperDefData, Set.toList -> uids) -> do
|
||||
nrRmSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False]
|
||||
addMessageI Info $ MsgRemoveDefaultSupervisors nrRmSuper
|
||||
(FirmSuperActRMSuperDefData{..}, Set.toList -> uids) -> do
|
||||
(nrRmSuper,nrRmActual) <- runDB $ (,)
|
||||
<$> updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False]
|
||||
<*> if firmSuperActRMSuperActive /= Just True
|
||||
then return 0
|
||||
else E.deleteCount $ do
|
||||
spr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ spr E.^. UserSupervisorSupervisor `E.in_` E.vals uids
|
||||
E.&&. E.exists (do
|
||||
usr <- E.from $ E.table @UserCompany
|
||||
E.where_ $ usr E.^. UserCompanyCompany E.==. E.val cid
|
||||
E.&&. usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
|
||||
)
|
||||
addMessageI Info $ MsgRemoveSupervisors nrRmSuper nrRmActual
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
(FirmSuperActRMSuperAllData, uids) -> addMessage Warning $ text2Html $ "TODO 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])
|
||||
|
||||
@ -229,6 +229,16 @@ cellHasUserModal toLink user =
|
||||
modal nWdgt (Left $ SomeRoute $ toLink uuid)
|
||||
in cell lWdgt
|
||||
|
||||
-- | like `cellHasUserModal` but with fixed route and showing an edit icon instead
|
||||
cellEditUserModal :: (IsDBTable m c, HasEntity u User) => u -> DBCell m c
|
||||
cellEditUserModal user =
|
||||
let userEntity = user ^. hasEntityUser
|
||||
uid = userEntity ^. _entityKey
|
||||
nWdgt = toWidget $ icon IconUserEdit
|
||||
lWdgt = do
|
||||
uuid <- liftHandler $ encrypt uid
|
||||
modal nWdgt (Left $ SomeRoute $ ForProfileR uuid)
|
||||
in cell lWdgt
|
||||
cellHasMatrikelnummer :: (IsDBTable m a, HasUser u) => u -> DBCell m a
|
||||
cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer
|
||||
|
||||
|
||||
@ -317,6 +317,7 @@ data FormIdentifier
|
||||
| FIDBtnAvsRevokeUnknown
|
||||
| FIDHijackUser
|
||||
| FIDAddSupervisor
|
||||
| FIDFirmUserChangeRequest
|
||||
deriving (Eq, Ord, Read, Show)
|
||||
|
||||
instance PathPiece FormIdentifier where
|
||||
|
||||
@ -116,6 +116,7 @@ data Icon
|
||||
| IconUnlocked
|
||||
| IconResetTries -- also see IconReset
|
||||
| IconCompany
|
||||
| IconUserEdit
|
||||
|
||||
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic)
|
||||
deriving anyclass (Universe, Finite, NFData)
|
||||
@ -209,7 +210,8 @@ iconText = \case
|
||||
IconLocked -> "lock"
|
||||
IconUnlocked -> "lock-open-alt"
|
||||
IconResetTries -> "trash-undo"
|
||||
IconCompany -> "building"
|
||||
IconCompany -> "building"
|
||||
IconUserEdit -> "user-edit"
|
||||
|
||||
nullaryPathPiece ''Icon $ camelToPathPiece' 1
|
||||
deriveLift ''Icon
|
||||
|
||||
@ -65,4 +65,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
<h2>
|
||||
_{MsgFirmAssociates}
|
||||
<p>
|
||||
^{fusrTable}
|
||||
^{fusrTable}
|
||||
|
||||
<section>
|
||||
^{fucrForm}
|
||||
Loading…
Reference in New Issue
Block a user