feat(allocations): delete allocation-users

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
+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"}

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"}

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

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

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

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

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

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)
 

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

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

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
+    }

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