From daed94ae332f021ae1e9db4429dc5f03384e685f Mon Sep 17 00:00:00 2001 From: SJost Date: Fri, 16 Mar 2018 17:54:28 +0100 Subject: [PATCH] Several Cleanups --- FragenSJ.txt | 15 ++++-- src/Foundation.hs | 26 +++++----- src/Handler/Course.hs | 9 +++- src/Handler/Sheet.hs | 52 ++++++++++--------- templates/newSheet.hamlet | 20 ------- .../{sheetAdmin.hamlet => sheetList.hamlet} | 7 ++- 6 files changed, 65 insertions(+), 64 deletions(-) delete mode 100644 templates/newSheet.hamlet rename templates/{sheetAdmin.hamlet => sheetList.hamlet} (77%) diff --git a/FragenSJ.txt b/FragenSJ.txt index 8bdb6f8e6..c1d6833e9 100644 --- a/FragenSJ.txt +++ b/FragenSJ.txt @@ -1,11 +1,9 @@ ** i18n: - i18n der - Links -> + Links -> MenuItems verwenden wie bisher Page Titles -> setTitleI Buttons? Was ist mit einfachen Text Feldern, z.B. die Beschriftung von Knöpfen wie in Handler.Course.getCourseListTermR, Zeile 66 "pageActions" für menuItemLabel? - Was ist mit PageTitles, z.B. in Handler.Term.termEditHandler: - -- setTitle [whamlet| _{MsgTermNewTitle} |] -- TODO, does not work ** Page pageActions - Berechtigungen prüfen? @@ -13,6 +11,13 @@ ** FORMS - 3 - Sheets: Multiple Files - - Versionen für Studenten/Korrektoren/Lecturers/Admins?! + 3 - Sheets: Multiple Files -> wird später gemacht + - Versionen für Studenten/Korrektoren/Lecturers/Admins + -> ja über isAuthorizedDB siehe unten, + -> Lecturer kann gleich auf Edit-Seite gehen wie in UniWorX + +Freischaltung von Teilen einer Webseite: + - Freigabe der Links über Authorisierung in der Foundation + - Anzeige der Links nach Authorisierung wie in menItemAccessCallback + - möglichst direkt isAuthorizedDB in einem runDB aufrufen!!! diff --git a/src/Foundation.hs b/src/Foundation.hs index 8fa0a34bf..e1abfb272 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -193,21 +193,21 @@ instance Yesod UniWorX where isAuthorizedDB :: Route UniWorX -> Bool -> YesodDB UniWorX AuthResult isAuthorizedDB UsersR _ = adminAccess Nothing -isAuthorizedDB (SubmissionR cID) _ = submissionAccess $ Right cID +isAuthorizedDB (SubmissionR cID) _ = submissionAccess $ Right cID isAuthorizedDB (SubmissionDownloadSingleR cID _) _ = submissionAccess $ Right cID isAuthorizedDB (SubmissionDownloadArchiveR (splitExtension -> (baseName, _))) _ = submissionAccess . Left . CryptoID $ CI.mk baseName -isAuthorizedDB TermEditR _ = adminAccess Nothing -isAuthorizedDB (TermEditExistR _) _ = adminAccess Nothing -isAuthorizedDB CourseNewR _ = lecturerAccess Nothing -isAuthorizedDB (CourseEditR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) -isAuthorizedDB (SheetListR t c) False = return Authorized -- -isAuthorizedDB (SheetShowR t c s) _ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor -isAuthorizedDB (SheetFileR t c s _ _ )_ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor -isAuthorizedDB (SheetListR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) -isAuthorizedDB (SheetNewR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) -isAuthorizedDB (SheetEditR t c s) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) -isAuthorizedDB (SheetDelR t c s) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) -isAuthorizedDB (CourseEditIDR cID) _ = do +isAuthorizedDB TermEditR _ = adminAccess Nothing +isAuthorizedDB (TermEditExistR _) _ = adminAccess Nothing +isAuthorizedDB CourseNewR _ = lecturerAccess Nothing +isAuthorizedDB (CourseEditR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) +isAuthorizedDB (SheetListR t c) False = return Authorized -- +isAuthorizedDB (SheetShowR t c s) _ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor +isAuthorizedDB (SheetFileR t c s _ _) _ = return Authorized -- TODO: nur für angemeldete Kursteilnehmer falls sichtbar, sonst nur Lectrurer oder Korrektor +isAuthorizedDB (SheetListR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) +isAuthorizedDB (SheetNewR t c) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) +isAuthorizedDB (SheetEditR t c s) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) +isAuthorizedDB (SheetDelR t c s) _ = courseLecturerAccess . entityKey =<< getBy404 (CourseTermShort t c) +isAuthorizedDB (CourseEditIDR cID) _ = do courseId <- decrypt cID courseLecturerAccess courseId isAuthorizedDB _route _isWrite = return $ Unauthorized "No access to this route." -- Calling isAuthorized here creates infinite loop! diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index f0da6d33d..c74a72156 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -92,7 +92,14 @@ getCourseShowR tid csh = do return $ (courseEnt,dependent) let course = entityVal courseEnt (regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerButton $ mbRegistered - defaultLayout $ do + let pageActions = + [ NavbarLeft $ MenuItem + { menuItemLabel = "Übungsblätter" + , menuItemRoute = SheetListR tid csh + , menuItemAccessCallback = (== Authorized) <$> isAuthorized (SheetListR tid csh) False + } + ] + defaultLinkLayout pageActions $ do setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|] $(widgetFile "course") diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index a95e3e719..6b3ac63fd 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -10,10 +10,11 @@ module Handler.Sheet where import Import +import System.FilePath + import Handler.Utils import Handler.Utils.Zip - -- import Data.Time import qualified Data.Text as T -- import Data.Function ((&)) @@ -28,6 +29,8 @@ import qualified Database.Esqueleto as E import Network.Mime + + {- * Implement Handlers * Implement Breadcrumbs in Foundation @@ -130,7 +133,7 @@ getSheetList courseEnt = do rated <- count $ (SubmissionRatingTime !=. Nothing):sheetsub return (sid, sheet, (submissions, rated)) let colSheets = mconcat - [ headed "Blatt" $ toWgt . sheetName . snd3 + [ headed "Blatt" $ \(sid,sheet,_) -> linkButton (toWgt $ sheetName sheet) BCLink $ SheetShowR tid csh (sheetName sheet) , headed "Abgabe ab" $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3 , headed "Abgabe bis" $ toWgt . formatTimeGerWD . sheetActiveTo . snd3 , headed "Bewertung" $ toWgt . show . sheetType . snd3 @@ -172,7 +175,7 @@ getSheetShowR tid csh shn = do defaultLayout $ do setTitle $ toHtml $ T.append "Übung " $ sheetName sheet - $(widgetFile "sheetAdmin") + $(widgetFile "sheetList") [whamlet| Under Construction !!! |] -- TODO @@ -207,7 +210,7 @@ getSheetNewR tid csh = do aid <- requireAuthId (Entity cid course) <- runDB $ getBy404 $ CourseTermShort tid csh let template = Nothing -- TODO: provide convenience by interpolating name/nr/dates+7days - ((res,wdgt), enc) <- runFormPost $ makeSheetForm cid template + ((res,formWidget), formEnctype) <- runFormPost $ makeSheetForm cid template case res of (FormSuccess SheetForm{..}) -> do actTime <- liftIO getCurrentTime @@ -233,32 +236,20 @@ getSheetNewR tid csh = do case insertOkay of Nothing -> insertOkay <$ addMessageI "danger" (MsgSheetNewDup tident csh sfName) (Just sid) -> do - addMessageI "info" $ MsgSheetNewOk tident csh sfName -- Save Files in DB: - -- Prüfe, das FileTitle innerhalb des Sheets eindeutig ist für diesen SheetFileTpye - whenIsJust sfSheetF $ \sinfo -> do - let sheetInsert file = do - fid <- insert file - void . insert $ SheetFile sid fid SheetExercise -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step - runConduit $ (sourceFiles sinfo) =$= C.mapM_ sheetInsert - -- - whenIsJust sfHintF $ \sinfo -> do - let sheetInsert file = do - fid <- insert file - void . insert $ SheetFile sid fid SheetHint -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step - runConduit $ (sourceFiles sinfo) =$= C.mapM_ sheetInsert - -- - whenIsJust sfSolutionF $ \sinfo -> do - let sheetInsert file = do - fid <- insert file - void . insert $ SheetFile sid fid SheetSolution -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step - runConduit $ (sourceFiles sinfo) =$= C.mapM_ sheetInsert + whenIsJust sfSheetF $ insertSheetFile sid SheetExercise + whenIsJust sfHintF $ insertSheetFile sid SheetHint + whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution + addMessageI "info" $ MsgSheetNewOk tident csh sfName return insertOkay when (isJust saveOkay) $ redirect $ SheetShowR tid csh sfName (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml _ -> return () + let formTitle = "Neues Übungsblatt anlegen" :: Text + let actionUrl = SheetNewR tid csh + -- actionUrl <- getCurrentRoute defaultLayout $ do - $(widgetFile "newSheet") + $(widgetFile "formPage") postSheetNewR :: TermId -> Text -> Handler Html postSheetNewR = getSheetNewR @@ -300,3 +291,16 @@ getCourseShowR tid csh = do setTitle $ [shamlet| #{termToText tid} - #{csh}|] $(widgetFile "course") -} + + +insertSheetFile :: SheetId -> SheetFileType -> FileInfo -> YesodDB UniWorX () +insertSheetFile sid ftype finfo = do + runConduit $ (sourceFiles finfo) =$= C.mapM_ finsert + where + finsert file = do + fid <- insert file + void . insert $ SheetFile sid fid ftype -- cannot fail due to uniqueness, since we generated a fresh FileId in the previous step + + + + diff --git a/templates/newSheet.hamlet b/templates/newSheet.hamlet deleted file mode 100644 index 83a5a3606..000000000 --- a/templates/newSheet.hamlet +++ /dev/null @@ -1,20 +0,0 @@ -
-
-
-
-
-

Neuen Blatt anlegen: - -

- Bitte alles ausfüllen! - -

-
-
-
- ^{wdgt} - -