From c5c4a62de0c92bde660f177d062c4874e232d8bc Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 22 Nov 2023 17:59:15 +0100 Subject: [PATCH] chore(firm): various - multiSelectField working - section hiding demo working - modal links access rights checking --- src/Handler/Firm.hs | 35 +++++++++++++++++++------------- src/Handler/Utils/Table/Cells.hs | 19 +++++++++-------- src/Handler/Utils/Widgets.hs | 9 ++++++++ src/Utils/Frontend/Modal.hs | 2 +- 4 files changed, 42 insertions(+), 23 deletions(-) diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index d4e9176f6..9e4c7655d 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -325,7 +325,12 @@ mkFirmAllTable isAdmin uid = do unless isAdmin $ E.where_ $ E.exists $ do -- only show associated companies usrCmpy <- E.from $ E.table @UserCompany E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId - E.&&. usrCmpy E.^. UserCompanyUser E.==. E.val uid + E.&&. ((usrCmpy E.^. UserCompanyUser E.==. E.val uid E.&&. usrCmpy E.^. UserCompanySupervisor) + E.||. E.exists (do + usrSpr <- E.from $ E.table @UserSupervisor + E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmpy E.^. UserCompanyUser + E.&&. usrSpr E.^. UserSupervisorSupervisor E.==. E.val uid + )) return ( cmpy -- 1 , cmpy & firmCountUsers -- 2 , cmpy & firmHasSupervisors -- 3 @@ -598,7 +603,7 @@ mkFirmUserTable isAdmin cid = do dbtRowKey = queryUserUser >>> (E.^. UserId) dbtProj = dbtProjId dbtColonnade = formColonnade $ mconcat - [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultUserUser . _entityKey)) + [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultUserUser . _entityKey)) , colUserNameModalHdr MsgTableCompanyUser ForProfileDataR , sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \(view resultUserUser -> entUsr ) -> cellHasMatrikelnummerLinked entUsr , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \(view $ resultUserUser . _userCompanyPersonalNumber -> t) -> foldMap textCell t @@ -676,7 +681,7 @@ mkFirmUserTable isAdmin cid = do dbtFilterUI mPrev = mconcat [ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev , prismAForm (singletonFilter "supervisor-is" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField) (fslI MsgFilterSupervisor) - -- , prismAForm (multiFilter "supervisors-are" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor) + , prismAForm (multiFilter "supervisors-are" . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor) , prismAForm (singletonFilter "has-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor) , prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh) , prismAForm (singletonFilter "has-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorForeign fsh) @@ -785,17 +790,19 @@ postFirmUsersR fsh = do , formSubmit = FormSubmit , formAnchor = Just addFormAnchor } - formResult fucrRes $ \FirmUserChangeRequest{..} -> when (isJust fucrPostalPref || 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 + formResult fucrRes $ \FirmUserChangeRequest{fucrPostalPref=fucrPPref, fucrPostalAddr=fucrPAddr} -> do + -- let fucrPAddr = canonical fucrPAddr' TODO + when (isJust fucrPPref || isJust fucrPAddr) $ do + let changes = foldMap (\pp -> [UserPrefersPostal E.=. E.val pp]) fucrPPref <> + foldMap (\pa -> [UserPostAddress E.=. E.justVal pa]) fucrPAddr -- 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 diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 2dee91389..2cab48fc2 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -226,7 +226,7 @@ cellHasUserModal toLink user = nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^. _entityVal . _userSurname) lWdgt = do uuid <- liftHandler $ encrypt uid - modal nWdgt (Left $ SomeRoute $ toLink uuid) + modalAccess False nWdgt nWdgt $ toLink uuid in cell lWdgt -- | like `cellHasUserModal` but with fixed route and showing an edit icon instead @@ -234,10 +234,10 @@ cellEditUserModal :: (IsDBTable m c, HasEntity u User) => u -> DBCell m c cellEditUserModal user = let userEntity = user ^. hasEntityUser uid = userEntity ^. _entityKey - nWdgt = toWidget $ icon IconUserEdit + nWdgt = toWidget $ icon IconUserEdit lWdgt = do uuid <- liftHandler $ encrypt uid - modal nWdgt (Left $ SomeRoute $ ForProfileR uuid) + modalAccess True nWdgt mempty $ ForProfileR uuid in cell lWdgt cellHasMatrikelnummer :: (IsDBTable m a, HasUser u) => u -> DBCell m a cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer @@ -246,7 +246,7 @@ cellHasMatrikelnummerLinked :: (IsDBTable m a, HasEntity u User) => u -> DBCell cellHasMatrikelnummerLinked usr | Just matNr <- usrEntity ^. _userMatrikelnummer = cell $ do uuid <- liftHandler $ encrypt $ usrEntity ^. _entityKey - modal (text2widget matNr) (Left $ SomeRoute $ AdminAvsUserR uuid) + modalAccess False (text2widget matNr) mempty (AdminAvsUserR uuid) | otherwise = mempty where usrEntity = usr ^. hasEntityUser @@ -364,7 +364,7 @@ qualificationValidUntilCell' mbToLink d qb qu = cell $ case mbToLink of Nothing -> headWgt <> dateWgt Just toLink -> do uuid <- liftHandler $ encrypt $ qu ^. hasQualificationUser . _qualificationUserUser - let modalWgt = modal dateWgt (Left $ SomeRoute $ toLink uuid) + let modalWgt = modalAccess False dateWgt dateWgt $ toLink uuid headWgt <> modalWgt where dateWgt = formatTimeW SelFormatDate (qu ^. hasQualificationUser . _qualificationUserValidUntil) @@ -385,7 +385,8 @@ qualificationValidReasonCell' mbToLink showReason d qb qu = ic <> foldMap blc qb dc tstamp | Just toLink <- mbToLink = cell $ do uuid <- liftHandler $ encrypt uid - modal (formatTimeW SelFormatDate tstamp) (Left $ SomeRoute $ toLink uuid) + let dWgt = formatTimeW SelFormatDate tstamp + modalAccess False dWgt dWgt $ toLink uuid -- anchorCellM (toLink <$> encrypt uid) | otherwise = dateCell tstamp uid = qu ^. hasQualificationUser . _qualificationUserUser @@ -403,7 +404,8 @@ qualificationValidReasonCell'' mbToLink showReason d qb qu extValid = ic <> icEr dc tstamp | Just toLink <- mbToLink = cell $ do uuid <- liftHandler $ encrypt uid - modal (formatTimeW SelFormatDate tstamp) (Left $ SomeRoute $ toLink uuid) + let dWgt = formatTimeW SelFormatDate tstamp + modalAccess False dWgt dWgt $ toLink uuid -- anchorCellM (toLink <$> encrypt uid) | otherwise = dateCell tstamp uid = qu ^. hasQualificationUser . _qualificationUserUser @@ -463,7 +465,8 @@ avsPersonNoCell = numCell . view _userAvsNoPerson avsPersonNoLinkedCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c avsPersonNoLinkedCell a = cell $ do uuid <- liftHandler $ encrypt $ a ^. _userAvsUser - modal (toWgt $ toMessage $ a ^. _userAvsNoPerson) (Left $ SomeRoute $ AdminAvsUserR uuid) + let nWgt = toWgt $ toMessage $ a ^. _userAvsNoPerson + modalAccess False nWgt nWgt $ AdminAvsUserR uuid avsPersonCardCell :: (IsDBTable m c) => Set AvsDataPersonCard -> DBCell m c avsPersonCardCell cards = wgtCell diff --git a/src/Handler/Utils/Widgets.hs b/src/Handler/Utils/Widgets.hs index 23a4b3a37..61c3c298e 100644 --- a/src/Handler/Utils/Widgets.hs +++ b/src/Handler/Utils/Widgets.hs @@ -123,6 +123,15 @@ editedByW fmt tm usr = do [whamlet|_{MsgUtilEditedBy usr ft}|] +-- | like `modal`, but checks access rights to the link +modalAccess :: Bool -> Widget -> Widget -> Route UniWorX -> Widget +modalAccess writeAccess wdgtYes wdgtNo route = do + authOk <- liftHandler $ bool hasReadAccessTo hasWriteAccessTo writeAccess route + if authOk + then modal wdgtYes (Left $ SomeRoute route) + else wdgtNo + + ---------- -- HEAT -- ---------- diff --git a/src/Utils/Frontend/Modal.hs b/src/Utils/Frontend/Modal.hs index c7c3ad8d0..304326ccc 100644 --- a/src/Utils/Frontend/Modal.hs +++ b/src/Utils/Frontend/Modal.hs @@ -38,7 +38,7 @@ customModal Modal{..} = do route <- traverse toTextUrl $ modalContent ^? _Left modalTrigger route triggerId' --- | Create a link to a modal +-- | Create a link to a modal, does not check link, see `Handler.Utils.Widget.modalAccess` for a checking variant modal :: WidgetFor site () -- ^ Widget that represents the link -> Either (SomeRoute site) (WidgetFor site ()) -- ^ Modal contant: either dynamic link or static widget -> WidgetFor site () -- ^ result widget