fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore: chase error messages

Browse Source
This commit is contained in:
Wolfgang Witt 2021-03-10 15:39:45 +01:00 committed by Gregor Kleen
parent 1c24b8e5e2
commit 03a0899f5f
2 changed files with 4 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
src/Foundation/Authorization.hs
View File

@ -1505,7 +1505,8 @@ tagAccessPredicate AuthCapacity = APDB $ \_ _ _ route _ -> case route of
eid <- $cachedHereBinary (cid, examn) . MaybeT . getKeyBy $ UniqueExam cid examn eid <- $cachedHereBinary (cid, examn) . MaybeT . getKeyBy $ UniqueExam cid examn
Entity occId ExamOccurrence{..} <- $cachedHereBinary (eid, occn) . MaybeT . getBy $ UniqueExamOccurrence eid occn Entity occId ExamOccurrence{..} <- $cachedHereBinary (eid, occn) . MaybeT . getBy $ UniqueExamOccurrence eid occn
registered <- $cachedHereBinary occId . lift $ fromIntegral <$> count [ ExamRegistrationOccurrence ==. Just occId, ExamRegistrationExam ==. eid ] registered <- $cachedHereBinary occId . lift $ fromIntegral <$> count [ ExamRegistrationOccurrence ==. Just occId, ExamRegistrationExam ==. eid ]
guard $ examOccurrenceCapacity > registered -- Nothing means unlimited size
guard $ maybe True (> registered) examOccurrenceCapacity
return Authorized return Authorized
CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgTutorialNoCapacity) $ do CTutorialR tid ssh csh tutn _ -> maybeT (unauthorizedI MsgTutorialNoCapacity) $ do
cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh cid <- $cachedHereBinary (tid, ssh, csh) . MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh

4
src/Handler/Exam/Form.hs
View File

@ -59,7 +59,7 @@ data ExamOccurrenceForm = ExamOccurrenceForm
, eofName :: ExamOccurrenceName , eofName :: ExamOccurrenceName
, eofRoom :: Maybe RoomReference , eofRoom :: Maybe RoomReference
, eofRoomHidden :: Bool , eofRoomHidden :: Bool
, eofCapacity :: Word64 , eofCapacity :: Maybe Word64
, eofStart :: UTCTime , eofStart :: UTCTime
, eofEnd :: Maybe UTCTime , eofEnd :: Maybe UTCTime
, eofDescription :: Maybe StoredMarkup , eofDescription :: Maybe StoredMarkup
@ -232,7 +232,7 @@ examOccurrenceForm prev = wFormToAForm $ do
<*> apopt checkBoxField (fslI MsgExamRoomRoomHidden & setTooltip MsgExamRoomRoomHiddenTip & addName (nudge "room-hidden")) (eofRoomHidden <$> mPrev) <*> apopt checkBoxField (fslI MsgExamRoomRoomHidden & setTooltip MsgExamRoomRoomHiddenTip & addName (nudge "room-hidden")) (eofRoomHidden <$> mPrev)
let eofRoomRes = view _1 <$> eofRoomRes' let eofRoomRes = view _1 <$> eofRoomRes'
eofRoomHiddenRes = view _2 <$> eofRoomRes' eofRoomHiddenRes = view _2 <$> eofRoomRes'
(eofCapacityRes, eofCapacityView) <- mpreq (natFieldI MsgExamRoomCapacityNegative) (fslI MsgExamRoomCapacity & addName (nudge "capacity")) (eofCapacity <$> mPrev) (eofCapacityRes, eofCapacityView) <- mopt (natFieldI MsgExamRoomCapacityNegative) (fslI MsgExamRoomCapacity & addName (nudge "capacity")) (eofCapacity <$> mPrev)
(eofStartRes, eofStartView) <- mpreq utcTimeField (fslI MsgExamRoomStart & addName (nudge "start")) (eofStart <$> mPrev) (eofStartRes, eofStartView) <- mpreq utcTimeField (fslI MsgExamRoomStart & addName (nudge "start")) (eofStart <$> mPrev)
(eofEndRes, eofEndView) <- mopt utcTimeField (fslI MsgExamRoomEnd & addName (nudge "end")) (eofEnd <$> mPrev) (eofEndRes, eofEndView) <- mopt utcTimeField (fslI MsgExamRoomEnd & addName (nudge "end")) (eofEnd <$> mPrev)
(eofDescRes, eofDescView) <- mopt htmlField (fslI MsgExamRoomDescription & addName (nudge "description")) (eofDescription <$> mPrev) (eofDescRes, eofDescView) <- mopt htmlField (fslI MsgExamRoomDescription & addName (nudge "description")) (eofDescription <$> mPrev)