From 6a1a64a6113fcae3a654e472fabdf5a3f622f549 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Tue, 15 Jun 2021 13:55:37 +0200 Subject: [PATCH] feat(allocations): delete allocation-users --- .../courses/allocation/de-de-formal.msg | 7 ++- .../categories/courses/allocation/en-eu.msg | 5 ++ .../navigation/breadcrumbs/de-de-formal.msg | 1 + .../utils/navigation/breadcrumbs/en-eu.msg | 1 + .../utils/navigation/menu/de-de-formal.msg | 1 + .../uniworx/utils/navigation/menu/en-eu.msg | 1 + routes | 1 + src/Audit/Types.hs | 9 +++ src/Foundation/I18n.hs | 43 ++++++++------ src/Foundation/Navigation.hs | 13 +++++ src/Handler/Allocation/EditUser.hs | 58 +++++++++++++++++++ src/Handler/Allocation/Register.hs | 1 + 12 files changed, 122 insertions(+), 19 deletions(-) diff --git a/messages/uniworx/categories/courses/allocation/de-de-formal.msg b/messages/uniworx/categories/courses/allocation/de-de-formal.msg index 37b313201..498808e9b 100644 --- a/messages/uniworx/categories/courses/allocation/de-de-formal.msg +++ b/messages/uniworx/categories/courses/allocation/de-de-formal.msg @@ -241,4 +241,9 @@ AllocationMatchingsLog: Protokoll AllocationMatchingsTime: Zeitpunkt AllocationMatchingsFingerprint: Prüfsumme -AllocationMatchingLogFileName tid@TermId ssh@SchoolId ash@AllocationShorthand cID@CryptoUUIDAllocationMatching: za-verteilung.#{toPathPiece tid}-#{ssh}-#{ash}.#{toPathPiece cID}.log \ No newline at end of file +AllocationMatchingLogFileName tid@TermId ssh@SchoolId ash@AllocationShorthand cID@CryptoUUIDAllocationMatching: za-verteilung.#{toPathPiece tid}-#{ssh}-#{ash}.#{toPathPiece cID}.log + +AllocationUserDeleteQuestion: Wollen Sie den/die unten aufgeführten Benutzer:in wirklich aus der Zentralanmeldung entfernen? +AllocationUserDeleted: Benutzer:in erfolgreich entfernt +AllocationApplicationsCount n@Word64: #{n} #{pluralDE n "Bewerbung" "Bewerbungen"} +AllocationAllocationsCount n@Word64: #{n} #{pluralDE n "Zuweisung" "Zuweisungen"} \ No newline at end of file diff --git a/messages/uniworx/categories/courses/allocation/en-eu.msg b/messages/uniworx/categories/courses/allocation/en-eu.msg index 04a48ff7c..d9a22d45d 100644 --- a/messages/uniworx/categories/courses/allocation/en-eu.msg +++ b/messages/uniworx/categories/courses/allocation/en-eu.msg @@ -241,3 +241,8 @@ AllocationMatchingsTime: Timestamp AllocationMatchingsFingerprint: Fingerprint AllocationMatchingLogFileName tid ssh ash cID: allocation-matching.#{toPathPiece tid}-#{ssh}-#{ash}.#{toPathPiece cID}.log + +AllocationUserDeleteQuestion: Do you really want to remove the allocation participant listed below? +AllocationUserDeleted: Participant successfully removed +AllocationApplicationsCount n: #{n} #{pluralENs n "application"} +AllocationAllocationsCount n: #{n} #{pluralENs n "allocation"} diff --git a/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg b/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg index 7e44bf414..158a13a18 100644 --- a/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg @@ -74,6 +74,7 @@ BreadcrumbAllocationCompute: Platzvergabe berechnen BreadcrumbAllocationAccept: Platzvergabe akzeptieren BreadcrumbAllocationAddUser: Bewerber:in hinzufügen BreadcrumbAllocationEditUser: Bewerber:in bearbeiten +BreadcrumbAllocationDelUser: Bewerber:in entfernen BreadcrumbMessageHide: Verstecken BreadcrumbFaq !ident-ok: FAQ BreadcrumbSheetPersonalisedFiles: Personalisierte Dateien herunterladen diff --git a/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg b/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg index bf60ba6aa..ecc66292b 100644 --- a/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg +++ b/messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg @@ -74,6 +74,7 @@ BreadcrumbAllocationCompute: Compute allocation BreadcrumbAllocationAccept: Accept allocation BreadcrumbAllocationAddUser: Add applicant BreadcrumbAllocationEditUser: Edit applicant +BreadcrumbAllocationDelUser: Remove participant BreadcrumbMessageHide: Hide BreadcrumbFaq: FAQ BreadcrumbSheetPersonalisedFiles: Download personalised sheet files diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 6787ac3ad..383616869 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -110,6 +110,7 @@ MenuAllocationPriorities: Zentrale Dringlichkeiten MenuAllocationCompute: Platzvergabe berechnen MenuAllocationAddUser: Bewerber:in hinzufügen +MenuAllocationDelUser: Bewerber:in entfernen MenuFaq !ident-ok: FAQ MenuSheetPersonalisedFiles: Personalisierte Dateien herunterladen MenuCourseSheetPersonalisedFiles: Vorlage für personalisierte Übungsblatt-Dateien herunterladen diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 262c1fa85..7a02ce02a 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -111,6 +111,7 @@ MenuAllocationPriorities: Central priorities MenuAllocationCompute: Compute allocation MenuAllocationAddUser: Add applicant +MenuAllocationDelUser: Remove participant MenuFaq: FAQ MenuSheetPersonalisedFiles: Download personalised sheet files MenuCourseSheetPersonalisedFiles: Download template for personalised sheet files diff --git a/routes b/routes index b697d57f3..584f6a225 100644 --- a/routes +++ b/routes @@ -162,6 +162,7 @@ /course/#CryptoUUIDCourse/apply AApplyR POST !timeANDallocation-registered /users AUsersR GET POST !allocation-admin /users/#CryptoUUIDUser AEditUserR GET POST !allocation-admin + /users/#CryptoUUIDUser/delete ADelUserR GET POST !allocation-admin !/users/add AAddUserR GET POST !allocation-admin /priorities APriosR GET POST !allocation-admin /compute AComputeR GET POST !allocation-admin diff --git a/src/Audit/Types.hs b/src/Audit/Types.hs index 7d4cfa87d..b5c3d1cf7 100644 --- a/src/Audit/Types.hs +++ b/src/Audit/Types.hs @@ -172,6 +172,15 @@ data Transaction { transactionUser :: UserId , transactionAssimilatedUser :: UserId } + + | TransactionAllocationUserEdited + { transactionUser :: UserId + , transactionAllocation :: AllocationId + } + | TransactionAllocationUserDeleted + { transactionUser :: UserId + , transactionAllocation :: AllocationId + } deriving (Eq, Ord, Read, Show, Generic, Typeable) diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 6d700a78f..65924822d 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -66,20 +66,20 @@ import Foundation.I18n.TH pluralDE :: (Eq a, Num a) - => a -- ^ Count - -> Text -- ^ Singular - -> Text -- ^ Plural - -> Text + => a -- ^ Count + -> Text -- ^ Singular + -> Text -- ^ Plural + -> Text pluralDE num singularForm pluralForm | num == 1 = singularForm | otherwise = pluralForm noneOneMoreDE :: (Eq a, Num a) - => a -- ^ Count - -> Text -- ^ None - -> Text -- ^ Singular - -> Text -- ^ Plural - -> Text + => a -- ^ Count + -> Text -- ^ None + -> Text -- ^ Singular + -> Text -- ^ Plural + -> Text noneOneMoreDE num noneText singularForm pluralForm | num == 0 = noneText | num == 1 = singularForm @@ -95,20 +95,27 @@ noneOneMoreDE num noneText singularForm pluralForm -- | otherwise = someText pluralEN :: (Eq a, Num a) - => a -- ^ Count - -> Text -- ^ Singular - -> Text -- ^ Plural - -> Text + => a -- ^ Count + -> Text -- ^ Singular + -> Text -- ^ Plural + -> Text pluralEN num singularForm pluralForm | num == 1 = singularForm | otherwise = pluralForm +pluralENs :: (Eq a, Num a) + => a -- ^ Count + -> Text -- ^ Singular + -> Text +-- ^ @pluralENs n "foo" = pluralEN n "foo" "foos"@ +pluralENs n t = pluralEN n t $ t `snoc` 's' + noneOneMoreEN :: (Eq a, Num a) - => a -- ^ Count - -> Text -- ^ None - -> Text -- ^ Singular - -> Text -- ^ Plural - -> Text + => a -- ^ Count + -> Text -- ^ None + -> Text -- ^ Singular + -> Text -- ^ Plural + -> Text noneOneMoreEN num noneText singularForm pluralForm | num == 0 = noneText | num == 1 = singularForm diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index 054732ad2..e97320722 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -218,6 +218,7 @@ breadcrumb (AllocationR tid ssh ash sRoute) = case sRoute of uid <- decrypt cID User{..} <- MaybeT $ get uid return (userDisplayName, Just $ AllocationR tid ssh ash AUsersR) + ADelUserR cID -> i18nCrumb MsgBreadcrumbAllocationDelUser . Just $ AllocationR tid ssh ash (AEditUserR cID) breadcrumb ParticipantsListR = i18nCrumb MsgBreadcrumbParticipantsList $ Just CourseListR breadcrumb (ParticipantsR _ _) = i18nCrumb MsgBreadcrumbParticipants $ Just ParticipantsListR @@ -1556,6 +1557,18 @@ pageActions (AllocationR tid ssh ash AUsersR) = return , navChildren = [] } ] +pageActions (AllocationR tid ssh ash (AEditUserR cID)) = return + [ NavPageActionSecondary + { navLink = NavLink + { navLabel = MsgMenuAllocationDelUser + , navRoute = AllocationR tid ssh ash $ ADelUserR cID + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + } + ] pageActions CourseListR = do participantsSecondary <- pageQuickActions NavQuickViewPageActionSecondary ParticipantsListR return diff --git a/src/Handler/Allocation/EditUser.hs b/src/Handler/Allocation/EditUser.hs index dcdf78ddb..d6ee01a6e 100644 --- a/src/Handler/Allocation/EditUser.hs +++ b/src/Handler/Allocation/EditUser.hs @@ -1,5 +1,6 @@ module Handler.Allocation.EditUser ( getAEditUserR, postAEditUserR + , getADelUserR, postADelUserR ) where import Import @@ -9,9 +10,14 @@ import Handler.Allocation.UserForm import Handler.Utils import qualified Data.Map.Strict as Map +import qualified Data.Set as Set import qualified Data.Conduit.Combinators as C +import Handler.Utils.Delete + +import qualified Database.Esqueleto as E + getAEditUserR, postAEditUserR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDUser -> Handler Html getAEditUserR = postAEditUserR @@ -39,6 +45,7 @@ postAEditUserR tid ssh ash cID = do , allocationUserTotalCourses = aauTotalCourses , allocationUserPriority = aauPriority } + audit $ TransactionAllocationUserEdited aauUser aId oldApps <- selectList [CourseApplicationUser ==. aauUser, CourseApplicationAllocation ==. Just aId] [] forM_ oldApps $ \(Entity appId CourseApplication{..}) -> do @@ -88,3 +95,54 @@ postAEditUserR tid ssh ash cID = do , formAnchor = Nothing :: Maybe Text } +getADelUserR, postADelUserR :: TermId -> SchoolId -> AllocationShorthand -> CryptoUUIDUser -> Handler Html +getADelUserR = postADelUserR +postADelUserR tid ssh ash cID = do + uid <- decrypt cID + (aId, auId) <- runDB . maybeT notFound $ do + aId <- MaybeT . getKeyBy $ TermSchoolAllocationShort tid ssh ash + auId <- MaybeT . getKeyBy $ UniqueAllocationUser aId uid + return (aId, auId) + + deleteR DeleteRoute + { drRecords = Set.singleton auId + , drGetInfo = \(allocationUser `E.InnerJoin` user) -> do + E.on $ allocationUser E.^. AllocationUserUser E.==. user E.^. UserId + + let appsCount = E.subSelectCount . E.from $ \courseApplication -> + E.where_ $ courseApplication E.^. CourseApplicationUser E.==. allocationUser E.^. AllocationUserUser + E.&&. courseApplication E.^. CourseApplicationAllocation E.==. E.just (allocationUser E.^. AllocationUserAllocation) + allocsCount = E.subSelectCount . E.from $ \courseParticipant -> + E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. allocationUser E.^. AllocationUserUser + E.&&. courseParticipant E.^. CourseParticipantAllocated E.==. E.just (allocationUser E.^. AllocationUserAllocation) + + return ( ( user E.^. UserDisplayName, user E.^. UserSurname ) + , appsCount :: E.SqlExpr (E.Value Word64) + , allocsCount :: E.SqlExpr (E.Value Word64) + ) + , drUnjoin = \(allocationUser `E.InnerJoin` _user) -> allocationUser + , drRenderRecord = \((E.Value dName, E.Value sName), E.Value (assertM' (> 0) -> appsCount), E.Value (assertM' (> 0) -> allocsCount)) -> return + [whamlet| + $newline never + ^{nameWidget dName sName} + $if is _Just appsCount || is _Just allocsCount + \ ( + $maybe c <- appsCount + _{MsgAllocationApplicationsCount c} + $if is _Just appsCount || is _Just allocsCount + , # + $maybe c <- appsCount + _{MsgAllocationAllocationsCount c} + ) + |] + , drRecordConfirmString = \((E.Value dName, _), _, _) -> return [st|#{dName}|] + , drFormMessage = \_ -> return Nothing + , drCaption = SomeMessage MsgAllocationUserDeleteQuestion + , drSuccessMessage = SomeMessage MsgAllocationUserDeleted + , drAbort = SomeRoute . AllocationR tid ssh ash $ AEditUserR cID + , drSuccess = SomeRoute $ AllocationR tid ssh ash AUsersR + , drDelete = \_k doDelete -> do + res <- doDelete + audit $ TransactionAllocationUserDeleted uid aId + return res + } diff --git a/src/Handler/Allocation/Register.hs b/src/Handler/Allocation/Register.hs index f5b91d0c6..374ed4556 100644 --- a/src/Handler/Allocation/Register.hs +++ b/src/Handler/Allocation/Register.hs @@ -67,6 +67,7 @@ postARegisterR tid ssh ash = do } [ AllocationUserTotalCourses =. arfTotalCourses ] + audit $ TransactionAllocationUserEdited uid aId if | isRegistered -> addMessageI Success MsgAllocationRegistrationEdited | otherwise -> addMessageI Success MsgAllocationRegistered