Several Cleanups

2018-03-16 17:54:28 +01:00 · 2018-03-16 17:54:28 +01:00 · daed94ae33
commit daed94ae33
parent c35f718054
6 changed files with 65 additions and 64 deletions
--- 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!!!
--- 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!
--- 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")
      
--- 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
+
+
+
+
--- a/templates/newSheet.hamlet
+++ b/templates/newSheet.hamlet
@ -1,20 +0,0 @@
-<div .container>
-    <div .bs-docs-section>
-        <div .row>
-            <div .col-lg-12>
-                <div .page-header>
-                    <h1 #forms>Neuen Blatt anlegen:
-
-                    <p>
-                        Bitte alles ausfüllen!
-
-        <div .row>
-            <div .col-lg-6>
-                <div .bs-callout bs-callout-info well>
-                    <form .form-horizontal method=post #forms enctype=#{enc}>
-                        ^{wdgt}
-
-                        <button .btn.btn-primary type="submit">
-                            Blatt anlegen
-
-
--- a/templates/sheetAdmin.hamlet
+++ b/templates/sheetAdmin.hamlet
@ -27,7 +27,12 @@
                <h2>Dateien
                <ul>
                  $forall fileLink <- fileLinks
-                    <li> <a href=@{fileLink}>@{fileLink}
+                    <li>
+                      $case fileLink
+                        $of SheetFileR _ _ _ typ name
+                          #{toPathPiece typ} <a href=@{fileLink}>#{name}
+                        $of other
+                          <a href=@{fileLink}>@{fileLink}

    <hr>