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

chore: use requireAuthPair (+ fix type errors)

Browse Source
This commit is contained in:
Wolfgang Witt 2021-04-13 13:15:03 +02:00 committed by Gregor Kleen
parent d6e39fb07c
commit 16abbc5da9
1 changed files with 24 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/Handler/Course.hs
View File

@ -36,14 +36,12 @@ postCNotesR _ _ _ = defaultLayout [whamlet|You have corrector access to this cou
postCFavouriteR :: TermId -> SchoolId -> CourseShorthand -> Handler () postCFavouriteR :: TermId -> SchoolId -> CourseShorthand -> Handler ()
postCFavouriteR tid ssh csh = void $ do postCFavouriteR tid ssh csh = void $ do
muid <- maybeAuthPair authPair@(uid, _) <- requireAuthPair
runDB $ void $ do runDB $ void $ do
mcid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
if | Just cid <- mcid, Just uid <- view _1 <$> muid -> do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
-- Nothing means blacklist
-- should never return FavouriteCurrent -- should never return FavouriteCurrent
newReason <- storedFavouriteReason tid ssh csh muid <&> (\case newReason <- storedFavouriteReason tid ssh csh (Just authPair) <&> (\case
-- Maybe (Maybe reason, blacklist) -- Maybe (Maybe reason, blacklist)
Nothing -> Just FavouriteManual Nothing -> Just FavouriteManual
Just (_reason, True) -> Just FavouriteVisited Just (_reason, True) -> Just FavouriteVisited
@ -63,6 +61,5 @@ postCFavouriteR tid ssh csh = void $ do
(UniqueCourseNoFavourite uid cid) (UniqueCourseNoFavourite uid cid)
(CourseNoFavourite uid cid) (CourseNoFavourite uid cid)
[] -- entry shouldn't exists, but keep it unchanged anyway [] -- entry shouldn't exists, but keep it unchanged anyway
| otherwise -> pure ()
-- show course page again -- show course page again
redirect $ CourseR tid ssh csh CShowR redirect $ CourseR tid ssh csh CShowR