chore: use requireAuthPair (+ fix type errors)

This commit is contained in:
Wolfgang Witt 2021-04-13 13:15:03 +02:00 committed by Gregor Kleen
parent d6e39fb07c
commit 16abbc5da9

View File

@ -36,33 +36,30 @@ 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 -- should never return FavouriteCurrent
-- Nothing means blacklist newReason <- storedFavouriteReason tid ssh csh (Just authPair) <&> (\case
-- should never return FavouriteCurrent -- Maybe (Maybe reason, blacklist)
newReason <- storedFavouriteReason tid ssh csh muid <&> (\case Nothing -> Just FavouriteManual
-- Maybe (Maybe reason, blacklist) Just (_reason, True) -> Just FavouriteVisited
Nothing -> Just FavouriteManual Just (Just FavouriteManual, False) -> Nothing
Just (_reason, True) -> Just FavouriteVisited Just (_reason, False) -> Just FavouriteManual)
Just (Just FavouriteManual, False) -> Nothing -- change stored reason in DB
Just (_reason, False) -> Just FavouriteManual) case newReason of
-- change stored reason in DB (Just reason) -> do
case newReason of void $ E.upsertBy
(Just reason) -> do (UniqueCourseFavourite uid cid)
void $ E.upsertBy (CourseFavourite uid cid reason now)
(UniqueCourseFavourite uid cid) [P.Update CourseFavouriteReason reason P.Assign]
(CourseFavourite uid cid reason now) E.deleteBy $ UniqueCourseNoFavourite uid cid
[P.Update CourseFavouriteReason reason P.Assign] Nothing -> do
E.deleteBy $ UniqueCourseNoFavourite uid cid E.deleteBy $ UniqueCourseFavourite uid cid
Nothing -> do void $ E.upsertBy
E.deleteBy $ UniqueCourseFavourite uid cid (UniqueCourseNoFavourite uid cid)
void $ E.upsertBy (CourseNoFavourite uid cid)
(UniqueCourseNoFavourite uid cid) [] -- entry shouldn't exists, but keep it unchanged anyway
(CourseNoFavourite uid cid)
[] -- 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