fraport/fradrive
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

51
src/Handler/Course.hs
View File

@ -36,33 +36,30 @@ postCNotesR _ _ _ = defaultLayout [whamlet|You have corrector access to this cou
postCFavouriteR :: TermId -> SchoolId -> CourseShorthand -> Handler ()
postCFavouriteR tid ssh csh = void $ do
muid <- maybeAuthPair
authPair@(uid, _) <- requireAuthPair
runDB $ void $ do
mcid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
if | Just cid <- mcid, Just uid <- view _1 <$> muid -> do
now <- liftIO getCurrentTime
-- Nothing means blacklist
-- should never return FavouriteCurrent
newReason <- storedFavouriteReason tid ssh csh muid <&> (\case
-- Maybe (Maybe reason, blacklist)
Nothing -> Just FavouriteManual
Just (_reason, True) -> Just FavouriteVisited
Just (Just FavouriteManual, False) -> Nothing
Just (_reason, False) -> Just FavouriteManual)
-- change stored reason in DB
case newReason of
(Just reason) -> do
void $ E.upsertBy
(UniqueCourseFavourite uid cid)
(CourseFavourite uid cid reason now)
[P.Update CourseFavouriteReason reason P.Assign]
E.deleteBy $ UniqueCourseNoFavourite uid cid
Nothing -> do
E.deleteBy $ UniqueCourseFavourite uid cid
void $ E.upsertBy
(UniqueCourseNoFavourite uid cid)
(CourseNoFavourite uid cid)
[] -- entry shouldn't exists, but keep it unchanged anyway
| otherwise -> pure ()
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
now <- liftIO getCurrentTime
-- should never return FavouriteCurrent
newReason <- storedFavouriteReason tid ssh csh (Just authPair) <&> (\case
-- Maybe (Maybe reason, blacklist)
Nothing -> Just FavouriteManual
Just (_reason, True) -> Just FavouriteVisited
Just (Just FavouriteManual, False) -> Nothing
Just (_reason, False) -> Just FavouriteManual)
-- change stored reason in DB
case newReason of
(Just reason) -> do
void $ E.upsertBy
(UniqueCourseFavourite uid cid)
(CourseFavourite uid cid reason now)
[P.Update CourseFavouriteReason reason P.Assign]
E.deleteBy $ UniqueCourseNoFavourite uid cid
Nothing -> do
E.deleteBy $ UniqueCourseFavourite uid cid
void $ E.upsertBy
(UniqueCourseNoFavourite uid cid)
(CourseNoFavourite uid cid)
[] -- entry shouldn't exists, but keep it unchanged anyway
-- show course page again
redirect $ CourseR tid ssh csh CShowR