chore(firm): limit firm action access to admins
This commit is contained in:
parent
2636c9d41a
commit
212cb71807
4
routes
4
routes
@ -115,9 +115,9 @@
|
||||
|
||||
/firms FirmAllR GET POST !supervisor
|
||||
/firms/comm/+Companies FirmsCommR GET POST
|
||||
/firm/#CompanyShorthand FirmR GET POST
|
||||
/firm/#CompanyShorthand/debug FirmR GET POST
|
||||
/firm/#CompanyShorthand/comm FirmCommR GET POST
|
||||
/firm/#CompanyShorthand/users FirmUsersR GET POST !supervisor
|
||||
/firm/#CompanyShorthand FirmUsersR GET POST !supervisor
|
||||
/firm/#CompanyShorthand/supers FirmSupersR GET POST !supervisor
|
||||
|
||||
/exam-office ExamOfficeR !exam-office:
|
||||
|
||||
@ -62,7 +62,7 @@ data FirmAction = FirmActNotify
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
nullaryPathPiece ''FirmAction $ camelToPathPiece' 2
|
||||
nullaryPathPiece ''FirmAction $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''FirmAction id
|
||||
|
||||
data FirmActionData = FirmActNotifyData
|
||||
@ -86,28 +86,29 @@ data FirmActionData = FirmActNotifyData
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
firmActionMap :: _ -> [FirmAction] -> Map FirmAction (AForm Handler FirmActionData)
|
||||
firmActionMap mr acts = mconcat (mkAct <$> acts)
|
||||
firmActionMap :: _ -> Bool -> [FirmAction] -> Map FirmAction (AForm Handler FirmActionData)
|
||||
firmActionMap mr isAdmin acts = mconcat (mkAct isAdmin <$> acts)
|
||||
where
|
||||
mkAct FirmActNotify = singletonMap FirmActNotify $ pure FirmActNotifyData
|
||||
mkAct FirmActResetSupervision = singletonMap FirmActResetSupervision $ FirmActResetSupervisionData
|
||||
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just $ Just False)
|
||||
<*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
|
||||
mkAct FirmActAddSupersvisors = singletonMap FirmActAddSupersvisors $ FirmActAddSupersvisorsData
|
||||
<$> areq (textField & cfAnySeparatedSet) (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
|
||||
<*> areq checkBoxField (fslI MsgTableIsDefaultReroute ) (Just True)
|
||||
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
|
||||
mkAct FirmActChangeContactFirm = singletonMap FirmActChangeContactFirm $ FirmActChangeContactFirmData
|
||||
<$> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) Nothing
|
||||
<*> aopt (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail) Nothing
|
||||
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
|
||||
<* aformMessage (Message Info (toHtml $ mr MsgFirmActChangeContactFirmInfo) (Just IconNotificationNonactive))
|
||||
mkAct FirmActChangeContactUser = singletonMap FirmActChangeContactUser $ FirmActChangeContactUserData
|
||||
<$> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) Nothing
|
||||
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
|
||||
mkAct True FirmActNotify = singletonMap FirmActNotify $ pure FirmActNotifyData
|
||||
mkAct _ FirmActResetSupervision = singletonMap FirmActResetSupervision $ FirmActResetSupervisionData
|
||||
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just $ Just False)
|
||||
<*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
|
||||
mkAct _ FirmActAddSupersvisors = singletonMap FirmActAddSupersvisors $ FirmActAddSupersvisorsData
|
||||
<$> areq (textField & cfAnySeparatedSet) (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
|
||||
<*> areq checkBoxField (fslI MsgTableIsDefaultReroute ) (Just True)
|
||||
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
|
||||
mkAct _ FirmActChangeContactFirm = singletonMap FirmActChangeContactFirm $ FirmActChangeContactFirmData
|
||||
<$> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) Nothing
|
||||
<*> aopt (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail) Nothing
|
||||
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
|
||||
<* aformMessage (Message Info (toHtml $ mr MsgFirmActChangeContactFirmInfo) (Just IconNotificationNonactive))
|
||||
mkAct _ FirmActChangeContactUser = singletonMap FirmActChangeContactUser $ FirmActChangeContactUserData
|
||||
<$> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) Nothing
|
||||
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
|
||||
mkAct _ _ = mempty
|
||||
|
||||
firmActionForm :: _ -> [FirmAction] -> AForm Handler FirmActionData
|
||||
firmActionForm mr acts = multiActionA (firmActionMap mr acts) (fslI MsgTableAction) Nothing
|
||||
firmActionForm :: () -> Bool -> [FirmAction] -> AForm Handler FirmActionData
|
||||
firmActionForm mr isAdmin acts = multiActionA (firmActionMap mr isAdmin acts) (fslI MsgTableAction) Nothing
|
||||
|
||||
makeFirmActionForm :: CompanyId -> _ -> [FirmAction] -> Form (FirmActionData, Set CompanyId)
|
||||
makeFirmActionForm cid mr acts html = flip (renderAForm FormStandard) html $ (,Set.singleton cid) <$> firmActionForm mr acts
|
||||
@ -189,10 +190,10 @@ firmActionHandler route = flip formResult faHandler
|
||||
faHandler _ = addMessageI Error MsgErrorUnknownFormAction
|
||||
|
||||
|
||||
runFirmActionFormPost :: CompanyId -> Route UniWorX -> [FirmAction] -> Handler Widget
|
||||
runFirmActionFormPost cid route acts = do
|
||||
runFirmActionFormPost :: CompanyId -> Route UniWorX -> Bool -> [FirmAction] -> Handler Widget
|
||||
runFirmActionFormPost cid route isAdmin acts = do
|
||||
mr <- getMessageRender
|
||||
((faRes, faWgt), faEnctype) <- runFormPost . identifyForm FIDFirmAction $ makeFirmActionForm cid mr acts
|
||||
((faRes, faWgt), faEnctype) <- runFormPost . identifyForm FIDFirmAction $ makeFirmActionForm cid mr isAdmin acts
|
||||
let faAnchor = "firm-action-form" :: Text
|
||||
faRoute = route :#: faAnchor
|
||||
faForm = wrapForm faWgt FormSettings
|
||||
@ -590,7 +591,7 @@ mkFirmAllTable isAdmin uid = do
|
||||
, dbParamsFormAction = Nothing
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = FormSubmit
|
||||
, dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm mr [FirmActNotify, FirmActResetSupervision]
|
||||
, dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm mr isAdmin [FirmActNotify, FirmActResetSupervision]
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = id
|
||||
, dbParamsFormIdent = def
|
||||
@ -618,7 +619,7 @@ getFirmAllR, postFirmAllR :: Handler Html
|
||||
getFirmAllR = postFirmAllR
|
||||
postFirmAllR = do
|
||||
uid <- requireAuthId
|
||||
isAdmin <- hasReadAccessTo AdminR
|
||||
isAdmin <- checkAdmin
|
||||
(firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
|
||||
firmActionHandler FirmAllR firmRes
|
||||
siteLayoutMsg MsgMenuFirms $ do
|
||||
@ -839,7 +840,7 @@ mkFirmUserTable isAdmin cid = do
|
||||
getFirmUsersR, postFirmUsersR :: CompanyShorthand -> Handler Html
|
||||
getFirmUsersR = postFirmUsersR
|
||||
postFirmUsersR fsh = do
|
||||
isAdmin <- hasReadAccessTo AdminR
|
||||
isAdmin <- checkAdmin
|
||||
let cid = CompanyKey fsh
|
||||
(( Entity{entityVal=Company{..}}
|
||||
, E.Value nrCompanyUsers
|
||||
@ -897,7 +898,7 @@ postFirmUsersR fsh = do
|
||||
addMessageI Success $ MsgFirmUserChanges nrChanged
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
|
||||
formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) [FirmActNotify, FirmActResetSupervision, FirmActAddSupersvisors, FirmActChangeContactFirm, FirmActChangeContactUser]
|
||||
formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) isAdmin [FirmActNotify, FirmActResetSupervision, FirmActAddSupersvisors, FirmActChangeContactFirm, FirmActChangeContactUser]
|
||||
|
||||
siteLayout (citext2widget companyName) $ do
|
||||
setTitle $ toHtml $ CI.original companyShorthand <> "-" <> tshow companyAvsId
|
||||
@ -1064,7 +1065,7 @@ mkFirmSuperTable isAdmin cid = do
|
||||
getFirmSupersR, postFirmSupersR :: CompanyShorthand -> Handler Html
|
||||
getFirmSupersR = postFirmSupersR
|
||||
postFirmSupersR fsh = do
|
||||
isAdmin <- hasReadAccessTo AdminR
|
||||
isAdmin <- checkAdmin
|
||||
let cid = CompanyKey fsh
|
||||
(Company{..},(fsprRes,fsprTable)) <- runDB $ (,)
|
||||
<$> get404 cid
|
||||
@ -1092,7 +1093,7 @@ postFirmSupersR fsh = do
|
||||
cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser]
|
||||
redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
|
||||
|
||||
formFirmAction <- runFirmActionFormPost cid (FirmSupersR fsh) [FirmActAddSupersvisors, FirmActResetSupervision, FirmActChangeContactFirm]
|
||||
formFirmAction <- runFirmActionFormPost cid (FirmSupersR fsh) isAdmin [FirmActAddSupersvisors, FirmActResetSupervision, FirmActChangeContactFirm]
|
||||
|
||||
siteLayout (citext2widget fsh) $ do
|
||||
setTitle $ citext2Html $ fsh <> " Supers"
|
||||
|
||||
Reference in New Issue
Block a user