feat(external-exams): requisite routes

This commit is contained in:
Gregor Kleen 2019-11-27 15:50:50 +01:00 committed by Gregor Kleen
parent e4393972f8
commit f25b21aa4b
19 changed files with 362 additions and 6 deletions

View File

@ -403,6 +403,7 @@ UnauthorizedSchoolAdmin: Sie sind nicht als Administrator für dieses Institut e
UnauthorizedAdminEscalation: Sie sind nicht Administrator für alle Institute, für die dieser Nutzer Administrator oder Veranstalter ist.
UnauthorizedExamOffice: Sie sind nicht Teil eines Prüfungsamts.
UnauthorizedExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer, für die Sie Teil eines assoziierten Prüfungsamts sind.
UnauthorizedExternalExamExamOffice: Es existieren keine Prüfungsergebnisse für Nutzer, für die Sie Teil eines assoziierten Prüfungsamts sind.
UnauthorizedSchoolLecturer: Sie sind nicht als Veranstalter für dieses Institut eingetragen.
UnauthorizedLecturer: Sie sind nicht als Veranstalter für diese Veranstaltung eingetragen.
UnauthorizedAllocationLecturer: Sie sind nicht als Veranstalter für eine Veranstaltung dieser Zentralanmeldung eingetragen.
@ -449,6 +450,8 @@ UnauthorizedTutor: Sie sind nicht Tutor.
UnauthorizedTutorialRegisterGroup: Sie sind bereits in einem Tutorium mit derselben Registrierungs-Gruppe.
UnauthorizedLDAP: Angegebener Nutzer meldet sich nicht mit Campus-Kennung an.
UnauthorizedPWHash: Angegebener Nutzer meldet sich nicht mit Uni2work-Kennung an.
UnauthorizedExternalExamListNotEmpty: Liste von externen Prüfungen ist nicht leer
UnauthorizedExternalExamLecturer: Sie sind nicht als Prüfer für diese externe Prüfung eingetragen
UnauthorizedPasswordResetToken: Dieses Authorisierungs-Token kann nicht mehr zum Passwort ändern benutzt werden
@ -1190,6 +1193,11 @@ MenuCourseNewsNew: Neue Kursnachricht
MenuCourseNewsEdit: Kursnachricht bearbeiten
MenuCourseEventNew: Neuer Kurstermin
MenuCourseEventEdit: Kurstermin bearbeiten
MenuExternalExamGrades: Prüfungsleistungen
MenuExternalExamUsers: Teilnehmer
MenuExternalExamEdit: Bearbeiten
MenuExternalExamNew: Neue externe Prüfung
MenuExternalExamList: Externe Prüfungen
BreadcrumbSubmissionFile: Datei
BreadcrumbSubmissionUserInvite: Einladung zur Abgabe
@ -1242,6 +1250,13 @@ BreadcrumbExamRegister: Anmelden
BreadcrumbApplicationFiles: Bewerbungsdateien
BreadcrumbCourseNewsArchive: Archiv
BreadcrumbCourseNewsFile: Datei
BreadcrumbExternalExam: Externe Prüfung
BreadcrumbExternalExamList: Externe Prüfungen
BreadcrumbExternalExamNew: Neue externe Prüfung
BreadcrumbExternalExamShow coursen@CourseName examn@ExamName: #{coursen}, #{examn}
BreadcrumbExternalExamEdit: Editieren
BreadcrumbExternalExamUsers: Teilnehmer
BreadcrumbExternalExamGrades: Prüfungsleistungen
TitleMetrics: Metriken

View File

@ -447,6 +447,7 @@ UnauthorizedTutor: You are no tutor.
UnauthorizedTutorialRegisterGroup: You are already registered for a tutorial with the same registration group.
UnauthorizedLDAP: Specified user does not log in with their campus account.
UnauthorizedPWHash: Specified user does not log in with an Uni2work-account.
UnauthorizedExternalExamListNotEmpty: List of external exams is not empty
UnauthorizedPasswordResetToken: This authorisation-token may no longer be used to change passwords
@ -1189,6 +1190,11 @@ MenuCourseNewsNew: Add course news
MenuCourseNewsEdit: Edit course news
MenuCourseEventNew: New course occurrence
MenuCourseEventEdit: Edit course occurrence
MenuExternalExamGrades: Exam results
MenuExternalExamUsers: Participants
MenuExternalExamEdit: Edit
MenuExternalExamNew: New external exam
MenuExternalExamList: External exams
BreadcrumbSubmissionFile: File
BreadcrumbSubmissionUserInvite: Invitation to participate in a submission
@ -1241,6 +1247,13 @@ BreadcrumbExamRegister: Register
BreadcrumbApplicationFiles: Application files
BreadcrumbCourseNewsArchive: Archive
BreadcrumbCourseNewsFile: File
BreadcrumbExternalExam: External exam
BreadcrumbExternalExamList: External exams
BreadcrumbExternalExamNew: New external exam
BreadcrumbExternalExamShow coursen@CourseName examn@ExamName: #{coursen}, #{examn}
BreadcrumbExternalExamEdit: Edit
BreadcrumbExternalExamUsers: Participants
BreadcrumbExternalExamGrades: Exam results
TitleMetrics: Metrics

View File

@ -11,4 +11,9 @@ ExamOfficeResultSynced
school SchoolId Maybe
office UserId
result ExamResultId
time UTCTime
ExamOfficeExternalResultSynced
school SchoolId Maybe
office UserId
result ExternalExamResultId
time UTCTime

View File

@ -0,0 +1,23 @@
ExternalExam
term TermId
school SchoolId
courseName (CI Text)
examName (CI Text)
defaultTime UTCTime Maybe
showGrades Bool
UniqueExternalExam term school courseName examName
ExternalExamResult
user UserId
exam ExternalExamId
result ExamResultGrade
time UTCTime
lastChanged UTCTime
UniqueExternalExamResult exam user
ExternalExamStaff
user UserId
exam ExternalExamId
UniqueExternalExamStaff exam user
ExternalExamOfficeSchool
school SchoolId
exam ExternalExamId
UniqueExternalExamOfficeSchool exam school

9
routes
View File

@ -80,6 +80,15 @@
/users EOUsersR GET POST
/users/invite EOUsersInviteR GET POST
/external-exam EExamListR GET !lecturer !¬empty
/external-exam/new EExamNewR GET POST !lecturer
/external-exam/#TermId/#SchoolId/#CourseName/#ExamName EExamR !lecturer:
/ EEShowR GET !exam-office
/edit EEEditR GET POST
/users EEUsersR GET POST
/grades EEGradesR GET POST !exam-office
/term TermShowR GET !free
/term/current TermCurrentR GET !free
/term/edit TermEditR GET POST

View File

@ -122,6 +122,7 @@ import Handler.Exam
import Handler.Allocation
import Handler.ExamOffice
import Handler.Metrics
import Handler.ExternalExam
-- This line actually creates our YesodDispatch instance. It is the second half

View File

@ -69,6 +69,7 @@ import qualified Control.Monad.Catch as C
import Handler.Utils.StudyFeatures
import Handler.Utils.SchoolLdap
import Handler.Utils.ExamOffice.Exam
import Handler.Utils.ExamOffice.ExternalExam
import Handler.Utils.ExamOffice.Course
import Handler.Utils.Profile
import Handler.Utils.Routes
@ -371,6 +372,19 @@ tagAccessPredicate AuthExamOffice = APDB $ \mAuthId route _ -> case route of
E.where_ $ examOfficeExamResultAuth (E.val authId) examResult
guardMExceptT hasUsers (unauthorizedI MsgUnauthorizedExamExamOffice)
return Authorized
EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
hasUsers <- lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` eexamResult) -> do
E.on $ eexam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam
E.where_ $ eexam E.^. ExternalExamTerm E.==. E.val tid
E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
E.where_ $ examOfficeExternalExamResultAuth (E.val authId) eexamResult
guardMExceptT hasUsers $ unauthorizedI MsgUnauthorizedExternalExamExamOffice
return Authorized
_other -> $cachedHereBinary mAuthId . exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
adrights <- lift $ selectFirst [UserFunctionUser ==. authId, UserFunctionFunction ==. SchoolExamOffice] []
@ -420,7 +434,18 @@ tagAccessPredicate AuthLecturer = APDB $ \mAuthId route _ -> case route of
E.&&. allocation E.^. AllocationTerm E.==. E.val tid
E.&&. allocation E.^. AllocationSchool E.==. E.val ssh
E.&&. allocation E.^. AllocationShorthand E.==. E.val ash
guardMExceptT isLecturer (unauthorizedI MsgUnauthorizedAllocationLecturer)
guardMExceptT isLecturer $ unauthorizedI MsgUnauthorizedAllocationLecturer
return Authorized
EExamR tid ssh coursen examn _ -> $cachedHereBinary (mAuthId, tid, ssh, coursen, examn) . exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
isLecturer <- lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` staff) -> do
E.on $ eexam E.^. ExternalExamId E.==. staff E.^. ExternalExamStaffExam
E.where_ $ staff E.^. ExternalExamStaffUser E.==. E.val authId
E.&&. eexam E.^. ExternalExamTerm E.==. E.val tid
E.&&. eexam E.^. ExternalExamSchool E.==. E.val ssh
E.&&. eexam E.^. ExternalExamCourseName E.==. E.val coursen
E.&&. eexam E.^. ExternalExamExamName E.==. E.val examn
guardMExceptT isLecturer $ unauthorizedI MsgUnauthorizedExternalExamLecturer
return Authorized
-- lecturer for any school will do
_ -> $cachedHereBinary mAuthId . exceptT return return $ do
@ -1033,7 +1058,14 @@ tagAccessPredicate AuthRegisterGroup = APDB $ \mAuthId route _ -> case route of
guard $ not hasOther
return Authorized
r -> $unsupportedAuthPredicate AuthRegisterGroup r
tagAccessPredicate AuthEmpty = APDB $ \_ route _ -> case route of
tagAccessPredicate AuthEmpty = APDB $ \mAuthId route _ -> case route of
EExamListR -> exceptT return return $ do
authId <- maybeExceptT AuthenticationRequired $ return mAuthId
hasExternalExams <- $cachedHereBinary authId . lift . E.selectExists . E.from $ \(eexam `E.InnerJoin` eexamStaff) -> do
E.on $ eexam E.^. ExternalExamId E.==. eexamStaff E.^. ExternalExamStaffExam
E.where_ $ eexamStaff E.^. ExternalExamStaffUser E.==. E.val authId
guardMExceptT (not hasExternalExams) $ unauthorizedI MsgUnauthorizedExternalExamListNotEmpty
return Authorized
CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNotEmpty) $ do
-- Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
@ -1500,8 +1532,9 @@ siteLayout' headingOverride widget = do
where
go crumbs Nothing = return crumbs
go crumbs (Just cRoute) = do
hasAccess <- hasReadAccessTo cRoute
(title, next) <- breadcrumb cRoute
go ((cRoute, title) : crumbs) next
go ((cRoute, title, hasAccess) : crumbs) next
(title, parents) <- breadcrumbs' mcurrentRoute
-- let isParent :: Route UniWorX -> Bool
@ -1588,7 +1621,7 @@ siteLayout' headingOverride widget = do
}
let highlight :: Route UniWorX -> Bool -- highlight last route in breadcrumbs, favorites taking priority
highlight = let crumbs = mcons mcurrentRoute $ fst <$> reverse parents
highlight = let crumbs = mcons mcurrentRoute $ view _1 <$> reverse parents
navItems = map (view _2) favourites ++ map (urlRoute . menuItemRoute . view _1) menuTypes
highR = find (`elem` navItems) . uncurry (++) $ partition (`elem` map (view _2) favourites) crumbs
in \r -> Just r == highR
@ -1933,6 +1966,25 @@ instance YesodBreadcrumbs UniWorX where
breadcrumb MessageListR = i18nCrumb MsgMenuMessageList $ Just AdminR
breadcrumb GlossaryR = i18nCrumb MsgMenuGlossary $ Just InfoR
breadcrumb EExamListR = i18nCrumb MsgMenuExternalExamList Nothing
breadcrumb EExamNewR = do
isEO <- hasReadAccessTo $ ExamOfficeR EOExamsR
i18nCrumb MsgBreadcrumbExternalExamNew . Just $ if
| isEO -> ExamOfficeR EOExamsR
| otherwise -> EExamListR
breadcrumb (EExamR tid ssh coursen examn sRoute) = case sRoute of
EEShowR -> do
isEO <- hasReadAccessTo $ ExamOfficeR EOExamsR
maybeT (i18nCrumb MsgBreadcrumbExternalExam . Just $ bool EExamListR (ExamOfficeR EOExamsR) isEO) $ do
guardM . hasReadAccessTo $ EExamR tid ssh coursen examn EEShowR
i18nCrumb (MsgBreadcrumbExternalExamShow coursen examn) . Just $ if
| isEO -> ExamOfficeR EOExamsR
| otherwise -> EExamListR
EEEditR -> i18nCrumb MsgBreadcrumbExternalExamEdit . Just $ EExamR tid ssh coursen examn EEShowR
EEUsersR -> i18nCrumb MsgBreadcrumbExternalExamUsers . Just $ EExamR tid ssh coursen examn EEShowR
EEGradesR -> i18nCrumb MsgBreadcrumbExternalExamGrades . Just $ EExamR tid ssh coursen examn EEShowR
-- breadcrumb _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
submissionList :: TermId -> CourseShorthand -> SheetName -> UserId -> DB [E.Value SubmissionId]
@ -2119,6 +2171,14 @@ pageActions (HomeR) =
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, MenuItem
{ menuItemType = PageActionSecondary
, menuItemLabel = MsgMenuExternalExamList
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute EExamListR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuOpenCourses
@ -3055,6 +3115,62 @@ pageActions (CorrectionsGradeR) =
return $ orOf (traverse . _Value . _submissionModeCorrector) sheets
}
]
pageActions EExamListR =
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuExternalExamNew
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute EExamNewR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (EExamR tid ssh coursen examn EEShowR) =
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuExternalExamEdit
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEEditR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuExternalExamUsers
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEUsersR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
, MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuExternalExamGrades
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEGradesR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (EExamR tid ssh coursen examn EEGradesR) =
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuExternalExamUsers
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEUsersR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions (EExamR tid ssh coursen examn EEUsersR) =
[ MenuItem
{ menuItemType = PageActionPrime
, menuItemLabel = MsgMenuExternalExamGrades
, menuItemIcon = Nothing
, menuItemRoute = SomeRoute $ EExamR tid ssh coursen examn EEGradesR
, menuItemModal = False
, menuItemAccessCallback' = return True
}
]
pageActions _ = []

View File

@ -31,6 +31,7 @@ deriving instance Generic SubmissionR
deriving instance Generic MaterialR
deriving instance Generic TutorialR
deriving instance Generic ExamR
deriving instance Generic EExamR
deriving instance Generic CourseApplicationR
deriving instance Generic AllocationR
deriving instance Generic SchoolR

View File

@ -6,3 +6,4 @@ import Handler.ExamOffice.Exams as Handler.ExamOffice
import Handler.ExamOffice.Fields as Handler.ExamOffice
import Handler.ExamOffice.Users as Handler.ExamOffice
import Handler.ExamOffice.Exam as Handler.ExamOffice
import Handler.ExamOffice.ExternalExam as Handler.ExamOffice

View File

@ -0,0 +1,10 @@
module Handler.ExamOffice.ExternalExam
( getEEGradesR, postEEGradesR
) where
import Import
getEEGradesR, postEEGradesR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
getEEGradesR = postEEGradesR
postEEGradesR = error "Not implemented"

View File

@ -0,0 +1,9 @@
module Handler.ExternalExam
( module Handler.ExternalExam
) where
import Handler.ExternalExam.List as Handler.ExternalExam
import Handler.ExternalExam.New as Handler.ExternalExam
import Handler.ExternalExam.Show as Handler.ExternalExam
import Handler.ExternalExam.Edit as Handler.ExternalExam
import Handler.ExternalExam.Users as Handler.ExternalExam

View File

@ -0,0 +1,10 @@
module Handler.ExternalExam.Edit
( getEEEditR, postEEEditR
) where
import Import
getEEEditR, postEEEditR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
getEEEditR = postEEEditR
postEEEditR = error "Not implemented"

View File

@ -0,0 +1,9 @@
module Handler.ExternalExam.List
( getEExamListR
) where
import Import
getEExamListR :: Handler Html
getEExamListR = error "Not implemented"

View File

@ -0,0 +1,10 @@
module Handler.ExternalExam.New
( getEExamNewR, postEExamNewR
) where
import Import
getEExamNewR, postEExamNewR :: Handler Html
getEExamNewR = postEExamNewR
postEExamNewR = error "Not implemented"

View File

@ -0,0 +1,9 @@
module Handler.ExternalExam.Show
( getEEShowR
) where
import Import
getEEShowR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
getEEShowR = error "Not implemented"

View File

@ -0,0 +1,10 @@
module Handler.ExternalExam.Users
( getEEUsersR, postEEUsersR
) where
import Import
getEEUsersR, postEEUsersR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
getEEUsersR = postEEUsersR
postEEUsersR = error "Not implemented"

View File

@ -0,0 +1,39 @@
module Handler.Utils.ExamOffice.ExternalExam
( examOfficeExternalExamResultAuth
) where
import Import.NoFoundation
import qualified Database.Esqueleto as E
examOfficeExternalExamResultAuth :: E.SqlExpr (E.Value UserId) -- ^ office
-> E.SqlExpr (Entity ExternalExamResult)
-> E.SqlExpr (E.Value Bool)
examOfficeExternalExamResultAuth authId eexamResult = authByUser E.||. authByField E.||. authBySchool E.||. authByExtraSchool
where
authByField = E.exists . E.from $ \(examOfficeField `E.InnerJoin` studyFeatures) -> do
E.on $ studyFeatures E.^. StudyFeaturesField E.==. examOfficeField E.^. ExamOfficeFieldField
E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. eexamResult E.^. ExternalExamResultUser
E.&&. examOfficeField E.^. ExamOfficeFieldOffice E.==. authId
E.&&. examOfficeField E.^. ExamOfficeFieldField E.==. studyFeatures E.^. StudyFeaturesField
E.where_ $ examOfficeField E.^. ExamOfficeFieldForced
E.||. E.exists (E.from $ \userFunction ->
E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
E.&&. userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
)
authByUser = E.exists . E.from $ \examOfficeUser ->
E.where_ $ examOfficeUser E.^. ExamOfficeUserOffice E.==. authId
E.&&. examOfficeUser E.^. ExamOfficeUserUser E.==. eexamResult E.^. ExternalExamResultUser
authBySchool = E.exists . E.from $ \(userFunction `E.InnerJoin` eexam) -> do
E.on $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
E.&&. userFunction E.^. UserFunctionSchool E.==. eexam E.^. ExternalExamSchool
E.where_ $ eexam E.^. ExternalExamId E.==. eexamResult E.^. ExternalExamResultExam
E.where_ $ userFunction E.^. UserFunctionUser E.==. authId
authByExtraSchool = E.exists . E.from $ \(userFunction `E.InnerJoin` eexamSchool) -> do
E.on $ userFunction E.^. UserFunctionFunction E.==. E.val SchoolExamOffice
E.&&. userFunction E.^. UserFunctionSchool E.==. eexamSchool E.^. ExternalExamOfficeSchoolSchool
E.where_ $ eexamSchool E.^. ExternalExamOfficeSchoolExam E.==. eexamResult E.^. ExternalExamResultExam
E.where_ $ userFunction E.^. UserFunctionUser E.==. authId

View File

@ -1,7 +1,10 @@
$newline never
<div .breadcrumbs__container>
<ul .breadcrumbs__list.list--inline>
$forall bc <- parents
$forall (bcRoute, bcTitle, hasAccess) <- parents
<li .breadcrumbs__item>
<a .breadcrumbs__link href="@{fst bc}">#{snd bc}
$if hasAccess
<a .breadcrumbs__link href="@{bcRoute}">#{bcTitle}
$else
<span .breadcrumbs__link>#{bcTitle}
<li .breadcrumbs__last-item>#{title}

View File

@ -0,0 +1,63 @@
.breadcrumbs__container {
position: relative;
color: var(--color-lightwhite);
padding: 4px 13px;
background-color: var(--color-dark);
line-height: 30px;
}
@media (min-width: 426px) {
.breadcrumbs__container {
padding: 7px 20px;
}
}
@media (min-width: 769px) {
.breadcrumbs__container {
padding: 7px 40px;
}
}
a.breadcrumbs__link {
color: var(--color-lightwhite);
&:hover {
color: var(--color-white);
}
}
.breadcrumbs__item {
padding-right: 14px;
position: relative;
line-height: 28px;
opacity: 0.8;
z-index: 1;
margin-right: 10px;
&:hover {
opacity: 1;
}
&::after {
content: '';
position: absolute;
top: 11px;
right: 0;
width: 7px;
height: 7px;
border-style: solid;
border-width: 0;
border-bottom-width: 1px;
border-right-width: 1px;
border-color: var(--color-white);
transform: rotate(-45deg);
z-index: 10;
opacity: 1;
}
}
.breadcrumbs__last-item {
line-height: 28px;
vertical-align: bottom;
font-weight: 600;
}