From 94a120808dad0bea3b74ecb17f17e7daad5cb3f1 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 5 Aug 2019 13:01:36 +0200 Subject: [PATCH] feat(allocations): prevent course (de)registrations --- messages/uniworx/de.msg | 4 ++++ routes | 6 +++--- src/Foundation.hs | 36 ++++++++++++++++++++++++++++++++++++ src/Handler/Exam/AddUser.hs | 2 ++ src/Model/Types/Security.hs | 1 + 5 files changed, 46 insertions(+), 3 deletions(-) diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 6cadf5d76..2e8cf79b3 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -339,6 +339,9 @@ UnauthorizedPWHash: Angegebener Nutzer meldet sich nicht mit Uni2work-Kennung an UnauthorizedPasswordResetToken: Dieses Authorisierungs-Token kann nicht mehr zum Passwort ändern benutzt werden +UnauthorizedAllocatedCourseRegister: Direkte Anmeldungen zum Kurs sind aufgrund einer Zentralanmeldung aktuell nicht gestattet +UnauthorizedAllocatedCourseDeregister: Abmeldungen vom Kurs sind aufgrund einer Zentralanmeldung aktuell nicht gestattet + EMail: E-Mail EMailUnknown email@UserEmail: E-Mail #{email} gehört zu keinem bekannten Benutzer. NotAParticipant email@UserEmail tid@TermId csh@CourseShorthand: #{email} ist nicht im Kurs #{tid}-#{csh} angemeldet. @@ -952,6 +955,7 @@ AuthTagLecturer: Nutzer ist Dozent AuthTagCorrector: Nutzer ist Korrektor AuthTagTutor: Nutzer ist Tutor AuthTagTime: Zeitliche Einschränkungen sind erfüllt +AuthTagAllocationTime: Zeitliche Einschränkungen durch Zentralanmeldung sind erfüllt AuthTagCourseRegistered: Nutzer ist Kursteilnehmer AuthTagTutorialRegistered: Nutzer ist Tutoriumsteilnehmer AuthTagExamRegistered: Nutzer ist Klausurteilnehmer diff --git a/routes b/routes index 46dd746fc..223539390 100644 --- a/routes +++ b/routes @@ -86,12 +86,12 @@ !/course/new CourseNewR GET POST !lecturer /course/#TermId/#SchoolId/#CourseShorthand CourseR !lecturer: / CShowR GET !free - /register CRegisterR GET POST !timeANDcapacity + /register CRegisterR GET POST !timeANDcapacityANDallocation-time !lecturerANDallocation-time /edit CEditR GET POST /lecturer-invite CLecInviteR GET POST /delete CDeleteR GET POST !lecturerANDempty /users CUsersR GET POST - !/users/new CAddUserR GET POST !lecturerANDtime -- TODO: time + !/users/new CAddUserR GET POST !lecturerANDallocation-time !/users/invite CInviteR GET POST /users/#CryptoUUIDUser CUserR GET POST !lecturerANDparticipant /correctors CHiWisR GET @@ -150,7 +150,7 @@ /edit EEditR GET POST /corrector-invite ECInviteR GET POST /users EUsersR GET POST - /users/new EAddUserR GET POST -- TODO: add check that this is not used to circumvent CAddUserR + /users/new EAddUserR GET POST /users/invite EInviteR GET POST /register ERegisterR POST !timeANDcourse-registered !timeANDexam-registered diff --git a/src/Foundation.hs b/src/Foundation.hs index 2d67f1f9e..7d8d42654 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -795,6 +795,42 @@ tagAccessPredicate AuthTime = APDB $ \mAuthId route _ -> case route of return Authorized r -> $unsupportedAuthPredicate AuthTime r +tagAccessPredicate AuthAllocationTime = APDB $ \mAuthId route _ -> case route of + CourseR tid ssh csh CRegisterR -> do + now <- liftIO getCurrentTime + mba <- mbAllocation tid ssh csh + case mba of + Nothing -> return Authorized + Just (cid, Allocation{..}) -> do + registered <- case mAuthId of + Just uid -> $cachedHereBinary (uid, cid) . existsBy $ UniqueParticipant uid cid + _ -> return False + if + | not registered + , NTop allocationRegisterByCourse >= NTop (Just now) + -> unauthorizedI MsgUnauthorizedAllocatedCourseRegister + | registered + , NTop (Just now) >= NTop allocationOverrideDeregister + -> unauthorizedI MsgUnauthorizedAllocatedCourseDeregister + | otherwise + -> return Authorized + + CourseR tid ssh csh CAddUserR -> do + now <- liftIO getCurrentTime + mba <- mbAllocation tid ssh csh + case mba of + Just (_, Allocation{..}) + | NTop allocationRegisterByStaffTo <= NTop (Just now) + , NTop allocationRegisterByStaffFrom >= NTop (Just now) + -> unauthorizedI MsgUnauthorizedAllocatedCourseRegister + _other -> return Authorized + + r -> $unsupportedAuthPredicate AuthAllocationTime r + where + mbAllocation tid ssh csh = $cachedHereBinary (tid, ssh, csh) . runMaybeT $ do + cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh + Entity _ AllocationCourse{..} <- MaybeT . getBy $ UniqueAllocationCourse cid + (cid,) <$> MaybeT (get allocationCourseAllocation) tagAccessPredicate AuthCourseRegistered = APDB $ \mAuthId route _ -> case route of CourseR tid ssh csh _ -> exceptT return return $ do authId <- maybeExceptT AuthenticationRequired $ return mAuthId diff --git a/src/Handler/Exam/AddUser.hs b/src/Handler/Exam/AddUser.hs index f9a19d5c9..744c96b7c 100644 --- a/src/Handler/Exam/AddUser.hs +++ b/src/Handler/Exam/AddUser.hs @@ -134,6 +134,8 @@ postEAddUserR tid ssh csh examn = do unless registerCourse $ throwError $ mempty { aurNoCourseRegistration = pure userEmail } + guardAuthResult =<< lift (lift $ evalAccessDB (CourseR tid ssh csh CAddUserR) True) + features <- lift . lift $ selectKeysList [ StudyFeaturesUser ==. uid, StudyFeaturesValid ==. True, StudyFeaturesType ==. FieldPrimary ] [] let courseParticipantField diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs index 93bafc1b5..e76588b51 100644 --- a/src/Model/Types/Security.hs +++ b/src/Model/Types/Security.hs @@ -47,6 +47,7 @@ data AuthTag -- sortiert nach gewünschter Reihenfolge auf /authpreds, d.h. Prä | AuthExamRegistered | AuthParticipant | AuthTime + | AuthAllocationTime | AuthMaterials | AuthOwner | AuthRated