From ad998b53d8a249afd6c6e12d4fead2a7f9d9f19a Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Fri, 25 May 2018 13:12:09 +0200
Subject: [PATCH] knownTags increased

---
 routes            | 20 ++++++++++----------
 src/Foundation.hs | 39 +++++++++++++++++++--------------------
 2 files changed, 29 insertions(+), 30 deletions(-)

diff --git a/routes b/routes
index d72557992..16cf1b3fd 100644
--- a/routes
+++ b/routes
@@ -40,19 +40,19 @@
 /course/                    CourseListR       GET             !free
 !/course/new                CourseNewR        GET POST        !lecturer
 /course/#TermId/#Text       CourseR                           !lecturer:
-  /show                       CShowR      GET POST            !free
-  /edit                       CEditR      GET POST
-  /ex                         SheetListR  GET                 !materials
-  !/ex/new                    SheetNewR   GET POST
+  /show                       CShowR          GET POST        !free
+  /edit                       CEditR          GET POST
+  /ex                         SheetListR      GET             !materials
+  !/ex/new                    SheetNewR       GET POST
   /ex/#Text SheetR                                            !materials:
-    /show                       SShowR    GET                 !time !corrector
-    /#SheetFileType/#FilePath   SFileR    GET                 !time !corrector
-    /edit                       SEditR    GET POST
-    /delete                     SDelR     GET POST
-    !/submission/#SubmissionMode SubmissionR GET POST         !timeANDregistered
+    /show                       SShowR        GET             !time !corrector
+    /#SheetFileType/#FilePath   SFileR        GET             !time !corrector
+    /edit                       SEditR        GET POST
+    /delete                     SDelR         GET POST
+    !/submission/#SubmissionMode SubmissionR  GET POST        !timeANDregistered
 
 
-!/#UUID CryptoUUIDDispatchR GET                                 !free
+!/#UUID CryptoUUIDDispatchR GET                               !free -- just redirect
 
 -- TODO below
 !/#{ZIPArchiveName SubmissionId} SubmissionDownloadArchiveR GET !deprecated
diff --git a/src/Foundation.hs b/src/Foundation.hs
index 5edc7f765..d8bbd682d 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -161,10 +161,12 @@ knownTags =
       $logWarnS "AccessControl" ("deprecated route: " <> tshow r)
       setMessageI $ MsgDeprecatedRoute
       return Authorized
-   )
+    )
   ,("lecturer", APDB $ \case
       CourseR tid csh -> maybeT (unauthorizedI MsgUnauthorizedLecturer) $ do
           authId <- lift requireAuthId
+          -- TODO: why not a getBy404 if the course does not exist?hg getBy404
+
           Entity cid _ <- MaybeT . getBy $ CourseTermShort tid csh
           void . MaybeT . getBy $ UniqueLecturer authId cid
           return Authorized
@@ -174,8 +176,16 @@ knownTags =
           case mul of
             Nothing  -> unauthorizedI $ MsgUnauthorizedSchoolLecturer
             (Just _) -> return Authorized
-   )
+    )
    -- TODO: Continue here!!!
+  ,("corrector", undefined)
+  ,("time", undefined)
+  ,("registered", undefined)
+  ,("materials", APDB $ \case
+      CourseR tid csh ->
+        Entity cid _ <- getBy404 $ CourseTermShort tid csh
+        undefined -- CONTINUE HERE
+    )
   ]
 
 
@@ -192,7 +202,7 @@ route2ap r = Set.foldr orAP adminAP attrsAND
     attrsAND = Set.map splitAnd $ routeAttrs r
     splitAND = foldr1 andAP . map tag2access . splitOn "AND"
 
-evalAccessDB :: Route -> DB Authorized
+evalAccessDB :: Route -> DB Authorized -- all requests, regardless of POST/GET, use isWriteRequest otherwise
 evalAccessDB r = case getAccess r of
   (APPure    p) -> lift $ runReader (p r) <$> getMessageRender
   (APHandler p) -> lift $ p r
@@ -369,21 +379,7 @@ instance Yesod UniWorX where
     -- The page to be redirected to when authentication is required.
     authRoute _ = Just $ AuthR LoginR
 
-    isAuthorized (AuthR _)           _ = return Authorized
-    isAuthorized  HomeR              _ = return Authorized
-    isAuthorized  FaviconR           _ = return Authorized
-    isAuthorized  RobotsR            _ = return Authorized
-    isAuthorized (StaticR _)         _ = return Authorized
-    isAuthorized  ProfileR           _ = isAuthenticated
-    isAuthorized  TermShowR          _ = return Authorized
-    isAuthorized  CourseListR        _ = return Authorized
-    isAuthorized (CourseListTermR _) _ = return Authorized
-    isAuthorized (CourseR _ _ CourseShowR) _ = return Authorized
-    isAuthorized (CryptoUUIDDispatchR _) _ = return Authorized
-    isAuthorized  SubmissionListR    _ = isAuthenticated
-    isAuthorized  SubmissionDownloadMultiArchiveR _ = isAuthenticated
---     isAuthorized  TestR        _ = return Authorized
-    isAuthorized route isWrite = runDB $ isAuthorizedDB route isWrite
+    isAuthorized route _isWrite = evalAccess route
 
     -- This function creates static content files in the static folder
     -- and names them based on a hash of their content. This allows
@@ -424,13 +420,14 @@ instance Yesod UniWorX where
 
     makeLogger = return . appLogger
 
+
+{- ALL DEPRECATED and will be deleted, once knownTags is completed
+
 isAuthorizedDB :: Route UniWorX -> Bool -> YesodDB UniWorX AuthResult
 isAuthorizedDB route@(routeAttrs -> attrs) writeable
   | "adminAny"    `member` attrs = adminAccess    Nothing
   | "lecturerAny" `member` attrs = lecturerAccess Nothing
 
-
-
 isAuthorizedDB UsersR _ = adminAccess Nothing
 isAuthorizedDB (SubmissionDemoR cID)       _ =  return Authorized -- submissionAccess $ Right cID
 isAuthorizedDB (SubmissionDownloadSingleR cID _) _ = submissionAccess $ Right cID
@@ -511,6 +508,8 @@ isAuthorizedDB' route isWrite = (== Authorized) <$> isAuthorizedDB route isWrite
 
 isAuthorized' :: Route UniWorX -> Bool -> Handler Bool
 isAuthorized' route isWrite = runDB $ isAuthorizedDB' route isWrite
+-}
+
 
 -- Define breadcrumbs.
 instance YesodBreadcrumbs UniWorX where