fix(firm): restrict firm access to company supervisors only
This commit is contained in:
parent
640a2e61d1
commit
0a06efd76c
@ -9,7 +9,7 @@ FirmEmail: Allgemeine Email
|
||||
FirmAddress: Postanschrift
|
||||
FirmDefaultPreferenceInfo: Diese Voreinstellungen gelten nur für neue Firmenangehörige
|
||||
FirmAction: Firmenweite Aktion
|
||||
FirmActionInfo: Betrifft alle Firmenangehörigen.
|
||||
FirmActionInfo: Betrifft alle Firmenangehörigen unter Ihrer Aufsicht.
|
||||
FirmActNotify: Mitteilung versenden
|
||||
FirmActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen
|
||||
FirmActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten?
|
||||
@ -18,7 +18,7 @@ FirmActAddSupersvisors: Ansprechpartner hinzufügen
|
||||
FirmActAddSupersEmpty: Es konnten keine Ansprechpartner hinzugefügt werden
|
||||
FirmActAddSupersSet n@Int64 postal@(Maybe Bool): #{n} Standardansprechpartner eingetragen #{maybeBoolMessage postal "" "und auf Briefversand geschaltet" "und Benachrichtigungen per Email gesetzt"}, aber nicht nicht aktiviert.
|
||||
RemoveSupervisors ndef@Int64 nact@Int64: #{ndef} Standard Ansprechpartner entfernt#{bool ", aber noch nicht deaktiviert" (", " <> tshow nact <> " aktive Ansprechpartnerbeziehungen gelöscht") (nact > 0)}
|
||||
FirmActChangeContactUser: Kontaktinformationen von Firmenangehörigen ändern
|
||||
FirmActChangeContactUser: Kontaktinformationen von allen Firmenangehörigen ändern
|
||||
FirmActChangeContactFirm: Kontaktinformationen der Firma ändern
|
||||
FirmActChangeContactFirmInfo: Firmenkontaktinformationen werden nur für neue Firmenangehörige verwendet, für die sonst keine Kontaktinformationen vorliegen.
|
||||
FirmActChangeContactFirmResult: Firmenkontaktinformationen geändert. Betrifft nur neue Firmenangehörige ohne eigene Kontaktinformationen
|
||||
|
||||
@ -9,7 +9,7 @@ FirmEmail: General company email
|
||||
FirmAddress: Postal address
|
||||
FirmDefaultPreferenceInfo: Default setting for new company associates only
|
||||
FirmAction: Companywide action
|
||||
FirmActionInfo: Affects alle company associates.
|
||||
FirmActionInfo: Affects alle company associates under your supervision.
|
||||
FirmActNotify: Send message
|
||||
FirmActResetSupervision: Reset supervisors for all company associates
|
||||
FirmActResetSuperKeep: Additionally keep existing supervisors of company associates?
|
||||
@ -17,8 +17,8 @@ FirmActResetMutualSupervision: Supervisors supervise each other
|
||||
FirmActAddSupersvisors: Add supervisors
|
||||
FirmActAddSupersEmpty: No supervisors added
|
||||
FirmActAddSupersSet n postal: #{n} default company supervisors set #{maybeBoolMessage postal "" "and switched to postal notifications" "and switched to email notifications"}, but not yet activated.
|
||||
RemoveSupervisors ndef nact: #{ndef} default supervisors removed#{bool ", but not yet deactivated" (" and " <> tshow nact <> " active supervisons terminated") (nact > 0)}
|
||||
FirmActChangeContactUser: Change contact data for company associates
|
||||
RemoveSupervisors ndef nact: #{ndef} default supervisors removed#{bool ", but not yet deactivated" (" and " <> tshow nact <> " active supervisions terminated") (nact > 0)}
|
||||
FirmActChangeContactUser: Change contact data for all company associates
|
||||
FirmActChangeContactFirm: Change company contact data
|
||||
FirmActChangeContactFirmInfo: The company contact data is only used for new company associates that would habe no contact information of their own otherwise.
|
||||
FirmActChangeContactFirmResult: Company contact data changed, affecting future company associates without contact information only
|
||||
|
||||
@ -554,7 +554,8 @@ tagAccessPredicate AuthSupervisor = APDB $ \_ _ mAuthId route _ -> case route of
|
||||
return Authorized
|
||||
checkCompanySupervisor sup@(mAuthId, fsh) = $cachedHereBinary sup . exceptT return return $ do
|
||||
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
|
||||
isSupervisor <- lift . existsBy $ UniqueUserCompany authId $ CompanyKey fsh
|
||||
-- isSupervisor <- lift . existsBy $ UniqueUserCompany authId $ CompanyKey fsh
|
||||
isSupervisor <- lift $ exists [UserCompanyUser ==. authId, UserCompanyCompany ==. CompanyKey fsh, UserCompanySupervisor ==. True]
|
||||
guardMExceptT isSupervisor (unauthorizedI $ MsgUnauthorizedCompanySupervisor fsh)
|
||||
return Authorized
|
||||
checkAnySupervisor mAuthId = $cachedHereBinary mAuthId . exceptT return return $ do
|
||||
|
||||
@ -273,7 +273,7 @@ newtype SomeMessages master = SomeMessages [SomeMessage master]
|
||||
deriving newtype (Semigroup, Monoid)
|
||||
|
||||
instance master ~ master' => RenderMessage master (SomeMessages master') where
|
||||
renderMessage a b (SomeMessages msgs) = Text.intercalate " " $ renderMessage a b <$> msgs
|
||||
renderMessage a b (SomeMessages msgs) = Text.intercalate "\n " $ renderMessage a b <$> msgs
|
||||
|
||||
-- | convenienience function if all messages happen to belong to the exact same type
|
||||
someMessages :: RenderMessage master msg => [msg] -> SomeMessages master
|
||||
|
||||
@ -113,23 +113,10 @@ firmActionForm mr isAdmin acts = multiActionA (firmActionMap mr isAdmin acts) (f
|
||||
makeFirmActionForm :: CompanyId -> _ -> Bool -> [FirmAction] -> Form (FirmActionData, Set CompanyId)
|
||||
makeFirmActionForm cid mr isAdmin acts html = flip (renderAForm FormStandard) html $ (,Set.singleton cid) <$> firmActionForm mr isAdmin acts
|
||||
|
||||
firmActionHandler :: Route UniWorX -> FormResult (FirmActionData, Set CompanyId) -> Handler ()
|
||||
firmActionHandler route = flip formResult faHandler
|
||||
firmActionHandler :: Route UniWorX -> Bool -> FormResult (FirmActionData, Set CompanyId) -> Handler ()
|
||||
firmActionHandler route isAdmin = flip formResult faHandler
|
||||
where
|
||||
faHandler (_,fids) | null fids = addMessageI Error MsgNoCompanySelected
|
||||
faHandler (FirmActResetSupervisionData{..}, fids) = do
|
||||
runDB $ do
|
||||
delSupers <- if firmActResetKeepOldSupers == Just False
|
||||
then E.deleteCount $ do
|
||||
spr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ E.exists $ do
|
||||
usr <- E.from $ E.table @UserCompany
|
||||
E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
|
||||
E.&&. usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
|
||||
else return 0
|
||||
newSupers <- addDefaultSupervisorsAll (firmActResetMutualSupervision /= Just False) fids
|
||||
addMessageI Success $ MsgFirmResetSupervision delSupers newSupers
|
||||
reloadKeepGetParams route -- reload to reflect changes
|
||||
|
||||
faHandler (FirmActNotifyData, Set.toList -> fids) = do
|
||||
usrs <- runDB $ E.select $ E.distinct $ do
|
||||
@ -139,6 +126,26 @@ firmActionHandler route = flip formResult faHandler
|
||||
cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
|
||||
redirect (FirmsCommR $ fmap unCompanyKey fids, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
|
||||
|
||||
faHandler (FirmActResetSupervisionData{..}, fids) = do
|
||||
madId <- bool maybeAuthId (return Nothing) isAdmin
|
||||
let suprFltr = if
|
||||
| isAdmin -> const E.true
|
||||
| (Just suprId) <- madId -> \spr -> spr E.^. UserSupervisorSupervisor E.==. E.val suprId
|
||||
| otherwise -> const E.false
|
||||
runDB $ do
|
||||
delSupers <- if firmActResetKeepOldSupers == Just False
|
||||
then E.deleteCount $ do
|
||||
spr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ suprFltr spr E.&&. E.exists (do
|
||||
usr <- E.from $ E.table @UserCompany
|
||||
E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
|
||||
E.&&. usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
|
||||
)
|
||||
else return 0
|
||||
newSupers <- addDefaultSupervisorsFor madId (firmActResetMutualSupervision /= Just False) fids
|
||||
addMessageI Success $ MsgFirmResetSupervision delSupers newSupers
|
||||
reloadKeepGetParams route -- reload to reflect changes
|
||||
|
||||
faHandler (FirmActAddSupersvisorsData{..}, Set.toList -> [cid]) = do
|
||||
avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmActAddSupervisorIds
|
||||
let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
|
||||
@ -204,11 +211,12 @@ runFirmActionFormPost cid route isAdmin acts = do
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Just faAnchor
|
||||
}
|
||||
firmActionHandler route faRes
|
||||
firmActionHandler route isAdmin faRes
|
||||
return [whamlet|
|
||||
<section>
|
||||
<h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
|
||||
_{MsgFirmAction}
|
||||
$
|
||||
<div>
|
||||
<p>
|
||||
_{MsgFirmActionInfo}
|
||||
@ -249,6 +257,30 @@ addDefaultSupervisors cid employees = do
|
||||
)
|
||||
(\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications])
|
||||
|
||||
-- like `addDefaultSupervisors`, but selects all employees of given companies from database, optionally filtered by being under supervision of a given individual
|
||||
addDefaultSupervisorsFor :: (CompanyId ~ Element mono, MonoFoldable mono) => Maybe UserId -> Bool -> mono -> DB Int64
|
||||
addDefaultSupervisorsFor mbSuperId 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 ]
|
||||
<> maybeEmpty mbSuperId (\sprId -> [E.exists $ do
|
||||
superv <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ superv E.^. UserSupervisorSupervisor E.==. E.val sprId
|
||||
E.&&. superv E.^. UserSupervisorUser E.==. usr E.^. UserCompanyUser
|
||||
])
|
||||
<> [ 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)
|
||||
E.<&> (spr E.^. UserCompanySupervisorReroute)
|
||||
)
|
||||
(\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications] )
|
||||
|
||||
-- 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
|
||||
@ -621,7 +653,7 @@ postFirmAllR = do
|
||||
uid <- requireAuthId
|
||||
isAdmin <- checkAdmin
|
||||
(firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
|
||||
firmActionHandler FirmAllR firmRes
|
||||
firmActionHandler FirmAllR isAdmin firmRes
|
||||
siteLayoutMsg MsgMenuFirms $ do
|
||||
setTitleI MsgMenuFirms
|
||||
$(i18nWidgetFile "firm-all")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user