From 87ab470072ba1a72235832006e9749e0838417de Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Tue, 29 May 2018 10:49:46 +0200
Subject: [PATCH] Minor refactor andAP and adminAP

---
 src/Foundation.hs | 25 ++++++++++++-------------
 src/Utils.hs      | 14 ++++++++++----
 2 files changed, 22 insertions(+), 17 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index 0d610b932..467bb59fc 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -159,14 +159,12 @@ orAR  _  _ Authorized = Authorized
 orAR  _  AuthenticationRequired _  = AuthenticationRequired
 orAR  _  _ AuthenticationRequired  = AuthenticationRequired
 orAR  mr (Unauthorized x) (Unauthorized y) = Unauthorized . render mr $  MsgUnauthorizedOr x y
-andAR _  Authorized Authorized = Authorized
-andAR _  Authorized other      = other
-andAR _  other      Authorized = other
-andAR _  AuthenticationRequired other = other
-andAR _  other AuthenticationRequired = other
+-- and
 andAR mr (Unauthorized x) (Unauthorized y) = Unauthorized . render mr $  MsgUnauthorizedAnd x y
-
-
+andAR _  reason@(Unauthorized x) _ = reason
+andAR _  _ reason@(Unauthorized x) = reason
+andAR _  Authorized          other = other
+andAR _  AuthenticationRequired  _ = AuthenticationRequired
 
 orAP,andAP :: AccessPredicate -> AccessPredicate -> AccessPredicate
 orAP  = liftAR  orAR (== Authorized)
@@ -190,8 +188,9 @@ trueAP  = APPure . const $ return Authorized
 falseAP = APPure . const $ Unauthorized . ($ MsgUnauthorized) . render <$> ask
 -- TODO: I believe falseAP := adminAP
 
-adminAP :: AccessPredicate
+adminAP :: AccessPredicate -- access for admins (of appropriate school in case of course-routes)
 adminAP = APDB $ \case
+    -- Courses: access only to school admins
     CourseR tid csh _ -> exceptT return return $ do
         authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
         [E.Value c] <- lift . E.select . E.from $ \(course `E.InnerJoin` userAdmin) -> do
@@ -200,15 +199,15 @@ adminAP = APDB $ \case
                 E.&&. course E.^. CourseTerm      E.==. E.val tid
                 E.&&. course E.^. CourseShorthand E.==. E.val csh
           return (E.countRows :: E.SqlExpr (E.Value Int64))
-        guardMExceptT (unauthorizedI MsgUnauthorizedSchoolAdmin) (c > 0)
+        guardMExceptT (c > 0) (unauthorizedI MsgUnauthorizedSchoolAdmin)
         return Authorized
-
+    -- other routes: access to any admin is granted here
     _other -> exceptT return return $ do
         authId <- maybeExceptT AuthenticationRequired $ lift maybeAuthId
         adrights <- lift $ selectFirst [UserAdminUser ==. authId] []
-        case adrights of
-          (Just _) -> return Authorized
-          Nothing  -> lift $ unauthorizedI $ MsgUnauthorized
+        guardMExceptT (isJust adrights) (unauthorizedI $ MsgUnauthorized)
+        return Authorized
+
 
 knownTags :: Map (CI Text) AccessPredicate
 knownTags = -- should not throw exceptions, i.e. no getBy404 or requireAuthId
diff --git a/src/Utils.hs b/src/Utils.hs
index 0024dc117..868049a1f 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -93,11 +93,17 @@ maybeExceptT err act = lift act >>= maybe (throwE err) return
 maybeMExceptT :: Monad m => (m e) -> m (Maybe b) -> ExceptT e m b
 maybeMExceptT err act = lift act >>= maybe (lift err >>= throwE) return
 
-guardExceptT :: Monad m => e -> Bool -> ExceptT e m ()
-guardExceptT err b = unless b $ throwE err
+whenExceptT :: Monad m => Bool -> e -> ExceptT e m ()
+whenExceptT b err = when b $ throwE err
 
-guardMExceptT :: Monad m => (m e) -> Bool -> ExceptT e m ()
-guardMExceptT err b = unless b $ lift err >>= throwE
+whenMExceptT :: Monad m => Bool -> (m e) -> ExceptT e m ()
+whenMExceptT b err = when b $ lift err >>= throwE
+
+guardExceptT :: Monad m => Bool -> e -> ExceptT e m ()
+guardExceptT b err = unless b $ throwE err
+
+guardMExceptT :: Monad m => Bool -> (m e) -> ExceptT e m ()
+guardMExceptT b err = unless b $ lift err >>= throwE
 
 exceptT :: Monad m => (e -> m b) -> (a -> m b) -> ExceptT e m a -> m b
 exceptT f g = either f g <=< runExceptT