From 45182e5074b91698794faaf7c42b31591b52526e Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 19 Dec 2018 18:28:53 +0100
Subject: [PATCH] Tighten check for empty course

---
 src/Foundation.hs | 7 +++++--
 src/Utils.hs      | 3 +++
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index a84e7fb7a..080d9e2d5 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -491,8 +491,11 @@ tagAccessPredicate AuthEmpty = APDB $ \route _ -> case route of
   CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNotEmpty) $ do
     -- Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
     cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
-    registered <- lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ]
-    guard $ registered <= 0
+    assertM_ (<= 0) . lift $ count [ CourseParticipantCourse ==. cid ]
+    assertM_ ((<= 0) :: Int -> Bool) . lift . fmap (E.unValue . unsafeHead) $ E.select . E.from $ \(sheet `E.InnerJoin` submission) -> do
+      E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
+      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
+      return E.countRows
     return Authorized
   r -> $unsupportedAuthPredicate AuthEmpty r
 tagAccessPredicate AuthMaterials = APDB $ \route _ -> case route of
diff --git a/src/Utils.hs b/src/Utils.hs
index 4bc4c1c9f..7c99ca13c 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -448,6 +448,9 @@ guardM f = guard =<< f
 assertM :: MonadPlus m => (a -> Bool) -> m a -> m a
 assertM f x = x >>= assertM' f
 
+assertM_ :: MonadPlus m => (a -> Bool) -> m a -> m ()
+assertM_ f x = guard . f =<< x
+
 assertM' :: MonadPlus m => (a -> Bool) -> a -> m a
 assertM' f x = x <$ guard (f x)