diff --git a/FragenSJ.txt b/FragenSJ.txt index cd1a0cef8..974d52943 100644 --- a/FragenSJ.txt +++ b/FragenSJ.txt @@ -1,4 +1,4 @@ -** Sicherheitsabfragen?` +** Sicherheitsabfragen? - Verschlüsselung des Zugriffs? - SheetDelR tid csh sn : GET zeigt Sicherheitsabfrage @@ -12,9 +12,7 @@ - Handler.Sheet.postSheetDelR: deleteCascade für Files? Klappt das? Kann man abfragen, was bei deleteCascade alles gelöscht wird? - - Verständnis: Getrennte Handler get/post Handler in SheetEditR haben nicht funktioniert. Warum? - - Sheets.redirectBack(): Wollen wir das wirklich? Schöner? ** i18n: - i18n der diff --git a/models b/models index d7f1f3fc8..5c73fe32e 100644 --- a/models +++ b/models @@ -103,11 +103,15 @@ Sheet activeTo UTCTime hintFrom UTCTime Maybe solutionFrom UTCTime Maybe - created UTCTime - changed UTCTime - createdBy UserId - changedBy UserId + created UTCTime -- delete + changed UTCTime -- delete + createdBy UserId -- delete + changedBy UserId -- delete CourseSheet courseId name +SheetEdit + sheet SheetId + user UserId + time UTCTime SheetFile sheetId SheetId fileId FileId diff --git a/routes b/routes index 2cdbe03fe..33692ba6f 100644 --- a/routes +++ b/routes @@ -15,9 +15,20 @@ /course/ CourseListR GET !/course/new CourseNewR GET POST !/course/#TermId CourseListTermR GET + +-- /course/#TermId/#Text CourseR !tag: +-- /edit CourseEditR GET POST +-- /show CourseShowR GET POST -- CourseR tid csh CourseShowR +-- /ex/#Text SheetR: !registered +-- /show +-- /edit -- CourseR tid csg (SheetR csh SheetEditR) +-- /delete + /course/#TermId/#Text/edit CourseEditR GET /course/#TermId/#Text/show CourseShowR GET POST + + /course/#TermId/#Text/ex/ SheetListR GET /course/#TermId/#Text/ex/#Text/show SheetShowR GET /course/#TermId/#Text/ex/#Text/#SheetFileType/#FilePath SheetFileR GET diff --git a/src/Foundation.hs b/src/Foundation.hs index c2d2a2496..b39b64f7e 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -232,7 +232,7 @@ adminAccess school = do adrights <- selectList ((UserAdminUser ==. authId) : maybe [] (\s -> [UserAdminSchool ==. s]) school) [] return $ if (not $ null adrights) then Authorized - else Unauthorized "No admin access" + else Unauthorized "No admin access" -- TODO internationalize lecturerAccess :: Maybe SchoolId -> YesodDB UniWorX AuthResult @@ -241,11 +241,10 @@ lecturerAccess school = do lecrights <- selectList ((UserLecturerUser ==. authId) : maybe [] (\s -> [UserLecturerSchool ==. s]) school) [] return $ if (not $ null lecrights) then Authorized - else Unauthorized "No lecturer access" + else Unauthorized "No lecturer access" -- TODO internationalize lecturerAccess' :: SchoolId -> YesodDB UniWorX AuthResult lecturerAccess' = authorizedFor UniqueSchoolLecturer MsgUnauthorizedSchoolLecturer --- Continue here courseLecturerAccess :: CourseId -> YesodDB UniWorX AuthResult courseLecturerAccess = authorizedFor UniqueLecturer MsgUnauthorizedLecturer @@ -256,7 +255,10 @@ courseCorrectorAccess = authorizedFor UniqueCorrector MsgUnauthorizedCorrect courseParticipantAccess :: CourseId -> YesodDB UniWorX AuthResult courseParticipantAccess = authorizedFor UniqueParticipant MsgUnauthorizedParticipant -authorizedFor :: (PersistEntityBackend record ~ BaseBackend backend, RenderMessage master msg, PersistEntity record, YesodAuth master, PersistUniqueRead backend) +authorizedFor :: ( PersistEntityBackend record ~ BaseBackend backend + , PersistEntity record, PersistUniqueRead backend + , YesodAuth master, RenderMessage master msg + ) => (AuthId master -> t -> Unique record) -> msg -> t -> ReaderT backend (HandlerT master IO) AuthResult authorizedFor authType msg courseId = do authId <- lift requireAuthId diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index c1839eb0f..891875077 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -27,6 +27,7 @@ import qualified Data.UUID.Cryptographic as UUID import qualified Data.Conduit.List as C import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Internal.Sql as E import Network.Mime @@ -107,12 +108,35 @@ makeSheetForm template = identForm FIDsheet $ \html -> do ] ] +fetchSheetAux :: ( BaseBackend backend ~ SqlBackend + , E.SqlSelect b a + , Typeable a, MonadHandler m, IsPersistBackend backend + , PersistQueryRead backend, PersistUniqueRead backend + ) + => (E.SqlExpr (Entity Sheet) -> b) + -> Key Term -> Text -> Text -> ReaderT backend m a +fetchSheetAux prj tid csh shn = + let cachId = encodeUtf8 $ tshow (tid,csh,shn) + in cachedBy cachId $ do + -- Mit Yesod: + -- cid <- getKeyBy404 $ CourseTermShort tid csh + -- getBy404 $ CourseSheet cid shn + -- Mit Esqueleto: + sheetList <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourseId + E.where_ $ course E.^. CourseTermId E.==. E.val tid + E.&&. course E.^. CourseShorthand E.==. E.val csh + E.&&. sheet E.^. SheetName E.==. E.val shn + return $ prj sheet + case sheetList of + [sheet] -> return sheet + _other -> notFound + fetchSheet :: TermId -> Text -> Text -> YesodDB UniWorX (Entity Sheet) -fetchSheet tid csh shn = do - -- TODO: More efficient with Esquleto? - -- (Entity cid _course) <- getBy404 $ CourseTermShort tid csh - cid <- getKeyBy404 $ CourseTermShort tid csh - getBy404 $ CourseSheet cid shn +fetchSheet = fetchSheetAux id + +fetchSheetId :: TermId -> Text -> Text -> YesodDB UniWorX (Key Sheet) +fetchSheetId tid cid shn = E.unValue <$> fetchSheetAux (E.^. SheetId) tid cid shn -- List Sheets getSheetListCID :: CourseId -> Handler Html @@ -150,7 +174,8 @@ getSheetList courseEnt = do , headed "" $ \s -> linkButton "Delete" BCLink $ SheetDelR tid csh $ sheetName $ snd3 s ] showAdmin <- case sheets of - ((_,firstSheet,_):_) -> + ((_,firstSheet,_):_) -> do + setUltDestCurrent (Authorized ==) <$> isAuthorized (SheetEditR tid csh $ sheetName firstSheet) False _otherwise -> return False let colSheets = if showAdmin @@ -252,8 +277,7 @@ getSheetEditR tid csh shn = do } let action newSheet = do replaceRes <- myReplaceUnique sid $ newSheet - { sheetCourseId = sheetCourseId - , sheetCreated = sheetCreated + { sheetCreated = sheetCreated , sheetCreatedBy = sheetChangedBy } case replaceRes of Nothing -> return $ Just sid @@ -286,7 +310,7 @@ handleSheetEdit tid csh template dbAction = do , sheetActiveTo = sfActiveTo , sheetHintFrom = sfHintFrom , sheetSolutionFrom = sfSolutionFrom - , sheetCreated = actTime -- dbAction adjusts this for replacement + , sheetCreated = actTime -- dbAction adjusts this for replacement, TODO: eigene Tabelle für changedBy , sheetChanged = actTime , sheetCreatedBy = aid -- dbAction adjusts this for replacement , sheetChangedBy = aid @@ -317,21 +341,17 @@ handleSheetEdit tid csh template dbAction = do getSheetDelR :: TermId -> Text -> Text -> Handler Html getSheetDelR tid csh shn = do let tident = unTermKey tid - ((result,formWidget), formEnctype) <- runFormPost (buttonForm :: Form BtnDelete ) + ((result,formWidget), formEnctype) <- runFormPost (buttonForm :: Form BtnDelete) case result of - (FormSuccess BtnAbort) -> redirectBack + (FormSuccess BtnAbort) -> redirectUltDest $ SheetShowR tid csh shn (FormSuccess BtnDelete) -> do - runDB $ do - -- (Entity cid _course) <- getBy404 $ CourseTermShort tid csh - cid <- getKeyBy404 $ CourseTermShort tid csh - sid <- getKeyBy404 $ CourseSheet cid shn - -- deleteBy $ CourseSheet cid shn - deleteCascade sid + runDB $ fetchSheetId tid csh shn >>= deleteCascade + -- TODO: deleteCascade löscht aber nicht die hochgeladenen Dateien!!! setMessageI $ MsgSheetDelOk tident csh shn redirect $ SheetListR tid csh _other -> do submissionno <- runDB $ do - Entity { entityKey = sid } <- fetchSheet tid csh shn + sid <- fetchSheetId tid csh shn count [SubmissionSheetId ==. sid] let formTitle = MsgSheetDelTitle tident csh shn let formText = Just $ MsgSheetDelText submissionno @@ -343,6 +363,8 @@ getSheetDelR tid csh shn = do postSheetDelR :: TermId -> Text -> Text -> Handler Html postSheetDelR = getSheetDelR + + insertSheetFile :: SheetId -> SheetFileType -> FileInfo -> YesodDB UniWorX () insertSheetFile sid ftype finfo = do runConduit $ (sourceFiles finfo) =$= C.mapM_ finsert @@ -351,12 +373,3 @@ insertSheetFile sid ftype finfo = 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 - --- TODO: Move below to utils, did not work somehow -redirectBack :: Handler Html --- -- redirectBack :: HandlerT UniWorX IO Html -redirectBack = defaultLayout $ do - toWidget [julius| window.history.go(-2); |] - [whamlet| BACK |] -- TODO - -