fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Address hlint

Browse Source
This commit is contained in:
Gregor Kleen 2018-11-02 19:57:42 +01:00
parent 6cdfe0891b
commit 12c1a4ca71
18 changed files with 291 additions and 286 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.hlint.yaml
View File

@ -5,6 +5,8 @@
- ignore: { name: "Parse error" }
- ignore: { name: "Reduce duplication" }
- ignore: { name: "Use ||" }
- ignore: { name: "Use &&" }
- ignore: { name: "Use ++" }
- arguments:
- -XQuasiQuotes

23
package.yaml
View File

@ -156,20 +156,16 @@ default-extensions:
- BinaryLiterals
- PolyKinds
ghc-options:
- -Wall
- -fno-warn-type-defaults
- -fno-warn-partial-type-signatures
when:
- condition: flag(pedantic)
then:
ghc-options:
- -Wall
- -Werror
- -fwarn-tabs
- -fno-warn-type-defaults
- -fno-warn-partial-type-signatures
else:
ghc-options:
- -Wall
- -fno-warn-type-defaults
- -fno-warn-partial-type-signatures
ghc-options:
- -Werror
- -fwarn-tabs
# The library contains all of our application code. The executable
# defined below is just a thin wrapper.
@ -219,6 +215,9 @@ tests:
source-dirs: hlint
dependencies:
- hlint-test
when:
- condition: "!flag(pedantic)"
buildable: false
# Define flags used by "yesod devel" to make compilation faster
flags:

2
routes
View File

@ -34,7 +34,7 @@
/ HomeR GET !free
/users UsersR GET -- no tags, i.e. admins only
/admin/test AdminTestR GET POST
/admin/user/#CryptoUUIDUser AdminUserR GET
/admin/user/#CryptoUUIDUser AdminUserR GET !development
/admin/user/#CryptoUUIDUser/hijack AdminHijackUserR POST
/admin/errMsg AdminErrMsgR GET POST
/info VersionR GET !free

2
shell.nix
View File

@ -22,7 +22,7 @@ let
'';
override = oldAttrs: {
nativeBuildInputs = oldAttrs.nativeBuildInputs ++ (with pkgs; [ postgresql cabal-install ]) ++ (with haskellPackages; [ stack yesod-bin ]);
nativeBuildInputs = oldAttrs.nativeBuildInputs ++ (with pkgs; [ postgresql ]) ++ (with haskellPackages; [ stack yesod-bin hlint cabal-install ]);
shellHook = ''
export PROMPT_INFO="${oldAttrs.name}"

4
src/Application.hs
View File

@ -96,7 +96,7 @@ mkYesodDispatch "UniWorX" resourcesUniWorX
-- the place to put your migrate statements to have automatic database
-- migrations handled by Yesod.
makeFoundation :: (MonadResource m, MonadBaseControl IO m) => AppSettings -> m UniWorX
makeFoundation appSettings@(AppSettings{..}) = do
makeFoundation appSettings@AppSettings{..} = do
-- Some basic initializations: HTTP connection manager, logger, and static
-- subsite.
appHttpManager <- newManager
@ -208,7 +208,7 @@ createSmtpPool SmtpConf{ smtpPool = ResourcePoolConf{..}, .. } = do
applyAuth SmtpAuthConf{..} conn = withLogging $ do
$logDebugS "SMTP" "Doing authentication"
authSuccess <- liftIO $ SMTP.authenticate smtpAuthType smtpAuthUsername smtpAuthPassword conn
when (not authSuccess) $ do
unless authSuccess $
fail "SMTP authentication failed"
return conn
liftIO $ createPool (mkConnection >>= maybe return applyAuth smtpAuth) reapConnection poolStripes poolTimeout poolLimit

2
src/CryptoID.hs
View File

@ -9,7 +9,7 @@ module CryptoID
import CryptoID.TH
import ClassyPrelude hiding (fromString)
import ClassyPrelude
import Model
import qualified Data.CryptoID as E

2
src/Data/Universe/Instances/Reverse/JSON.hs
View File

@ -24,4 +24,4 @@ instance (Eq a, Hashable a, Finite a, FromJSON b, FromJSONKey a) => FromJSON (a
vMap <- parseJSON val :: Parser (HashMap a b)
unless (HashSet.fromMap (HashMap.map (const ()) vMap) == HashSet.fromList universeF) $
fail "Not all required keys found"
return $ (vMap !)
return (vMap !)

6
src/Handler/Admin.hs
View File

@ -92,7 +92,7 @@ postAdminTestR = do
^{emailWidget}
|]
defaultLayout $ do
defaultLayout $
-- setTitle "Uni2work Admin Testpage"
$(widgetFile "adminTest")
@ -101,7 +101,7 @@ getAdminUserR :: CryptoUUIDUser -> Handler Html
getAdminUserR uuid = do
uid <- decrypt uuid
User{..} <- runDB $ get404 uid
defaultLayout $
defaultLayout
[whamlet|
<h1>TODO
<h2>Admin Page for User ^{nameWidget userDisplayName userSurname}
@ -130,7 +130,7 @@ postAdminErrMsgR = do
either (throwE . MsgErrMsgCouldNotDecodePlaintext . tshow) return $ Text.decodeUtf8' plainBS
defaultLayout $
defaultLayout
[whamlet|
$maybe t <- plaintext
<pre style="white-space:pre-wrap; font-family:monospace">

40
src/Handler/Corrections.hs
View File

@ -207,9 +207,9 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' = do
E.orderBy [E.asc $ user E.^. UserId]
return (user, pseudonym E.?. SheetPseudonymPseudonym)
let
submittorMap = foldr (\((Entity userId user, E.Value pseudo)) -> Map.insert userId (user, pseudo)) Map.empty submittors
submittorMap = foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors
dbtProj' (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, submittorMap)
dbTable psValidator $ DBTable
dbTable psValidator DBTable
{ dbtSQLQuery
, dbtColonnade
, dbtProj
@ -284,7 +284,7 @@ correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO
correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
tableForm <- makeCorrectionsTable whereClause displayColumns psValidator return
((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
((fmap (Map.keysSet . Map.filter id . getDBFormResult (const False)) -> selectionRes), table) <- tableForm csrf
(fmap $ Map.keysSet . Map.filter id . getDBFormResult (const False) -> selectionRes, table) <- tableForm csrf
(actionRes, action) <- multiAction actions Nothing
return ((,) <$> actionRes <*> selectionRes, table <> action)
@ -301,12 +301,12 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
now <- liftIO getCurrentTime
runDB $ do
alreadyAssigned <- selectList [SubmissionId <-. subs, SubmissionRatingBy !=. Nothing] []
when (not $ null alreadyAssigned) $ do
unless (null alreadyAssigned) $ do
mr <- (toHtml . ) <$> getMessageRender
alreadyAssigned' <- forM alreadyAssigned $ \Entity{..} -> (, entityVal) <$> (encrypt entityKey :: DB CryptoFileNameSubmission)
addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
let unassigned = Set.fromList subs `Set.difference` Set.fromList (entityKey <$> alreadyAssigned)
when (not $ null unassigned) $ do
unless (null unassigned) $ do
num <- updateWhereCount [SubmissionId <-. Set.toList unassigned]
[ SubmissionRatingBy =. Just uid
, SubmissionRatingAssigned =. Just now -- save, since only applies to unassigned
@ -335,18 +335,18 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
subs <- mapM decrypt $ Set.toList subs'
runDB $ do
alreadyAssigned <- selectList [SubmissionId <-. subs, SubmissionRatingBy !=. Nothing] []
when (not $ null alreadyAssigned) $ do
unless (null alreadyAssigned) $ do
mr <- (toHtml . ) <$> getMessageRender
alreadyAssigned' <- forM alreadyAssigned $ \Entity{..} -> (, entityVal) <$> (encrypt entityKey :: DB CryptoFileNameSubmission)
addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
let unassigned = Set.fromList subs `Set.difference` Set.fromList (entityKey <$> alreadyAssigned)
when (not $ null unassigned) $ do
unless (null unassigned) $ do
(assigned, stillUnassigned) <- assignSubmissions shid (Just unassigned)
when (not $ null assigned) $
unless (null assigned) $
addMessageI Success $ MsgUpdatedAssignedCorrectorsAuto (fromIntegral $ Set.size assigned)
when (not $ null stillUnassigned) $ do
unless (null stillUnassigned) $ do
mr <- (toHtml . ) <$> getMessageRender
unassigned' <- forM (Set.toList stillUnassigned) $ \sid -> (encrypt sid :: DB CryptoFileNameSubmission)
unassigned' <- forM (Set.toList stillUnassigned) $ \sid -> encrypt sid :: DB CryptoFileNameSubmission
addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
redirect currentRoute
@ -485,7 +485,7 @@ postCorrectionR tid ssh csh shn cid = do
NotGraded -> pure Nothing
_otherwise -> aopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType)
(fslpI MsgRatingPoints "Punktezahl")
(Just $ submissionRatingPoints)
(Just submissionRatingPoints)
((corrResult, corrForm), corrEncoding) <- runFormPost . identForm FIDcorrection . renderAForm FormStandard $ (,,)
<$> areq checkBoxField (fslI MsgRatingDone) (Just $ submissionRatingDone Submission{..})
@ -548,7 +548,7 @@ getCorrectionUserR tid ssh csh shn cid = do
mr <- getMessageRender
let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
sheetTypeDesc = mr sheetType
defaultLayout $ do
defaultLayout $
$(widgetFile "correction-user")
_ -> notFound
@ -574,7 +574,7 @@ postCorrectionsUploadR = do
addMessage Success =<< withUrlRenderer ($(ihamletFile "templates/messages/correctionsUploaded.hamlet") mr)
defaultLayout $ do
defaultLayout $
$(widgetFile "corrections-upload")
getCorrectionsCreateR, postCorrectionsCreateR :: Handler Html
@ -587,7 +587,7 @@ postCorrectionsCreateR = do
E.where_ $ sheetCorrector E.^. SheetCorrectorUser E.==. E.val uid
E.&&. sheet E.^. SheetSubmissionMode E.==. E.val CorrectorSubmissions
E.orderBy [E.desc $ course E.^. CourseTerm, E.asc $ course E.^. CourseShorthand, E.desc $ sheet E.^. SheetActiveFrom]
return $ (sheet E.^. SheetId, course E.^. CourseTerm, course E.^. CourseShorthand, sheet E.^. SheetName)
return (sheet E.^. SheetId, course E.^. CourseTerm, course E.^. CourseShorthand, sheet E.^. SheetName)
mkOptList :: [(E.Value SheetId, E.Value TermId, E.Value CourseShorthand, E.Value SheetName)] -> Handler (OptionList SheetId)
mkOptList opts = do
opts' <- mapM (\v@(E.Value sid, _, _, _) -> (, v) <$> encrypt sid) opts
@ -631,12 +631,12 @@ postCorrectionsCreateR = do
, submissionRatingAssigned = Just now
, submissionRatingTime = Nothing
}
when (not $ null duplicate)
unless (null duplicate)
$(addMessageFile Warning "templates/messages/submissionCreateDuplicates.hamlet")
existingSubUsers <- E.select . E.from $ \submissionUser -> do
E.where_ $ submissionUser E.^. SubmissionUserUser `E.in_` E.valList (sheetPseudonymUser <$> concat sps')
return submissionUser
when (not $ null existingSubUsers) $ do
unless (null existingSubUsers) $ do
(Map.toList -> subs) <- foldrM (\(Entity _ SubmissionUser{..}) mp -> Map.insertWith (<>) <$> (encrypt submissionUserSubmission :: DB CryptoFileNameSubmission) <*> pure (Set.fromList . map sheetPseudonymPseudonym . filter (\SheetPseudonym{..} -> sheetPseudonymUser == submissionUserUser) $ concat sps') <*> pure mp) Map.empty existingSubUsers
$(addMessageFile Warning "templates/messages/submissionCreateExisting.hamlet")
let sps'' = filter (not . null) $ filter (\spGroup -> not . flip any spGroup $ \SheetPseudonym{sheetPseudonymUser} -> sheetPseudonymUser `elem` map (submissionUserUser . entityVal) existingSubUsers) sps'
@ -692,7 +692,7 @@ postCorrectionsCreateR = do
redirect CorrectionsGradeR
defaultLayout $ do
defaultLayout $
$(widgetFile "corrections-create")
where
partitionEithers' :: [[Either a b]] -> ([[b]], [a])
@ -735,7 +735,7 @@ postCorrectionsGradeR = do
cID <- encrypt subId
void . assertM (== Authorized) . lift $ evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) True
return i
(((fmap unFormResult -> tableRes), table), tableEncoding) <- runFormPost tableForm
((fmap unFormResult -> tableRes, table), tableEncoding) <- runFormPost tableForm
case tableRes of
FormMissing -> return ()
@ -751,9 +751,9 @@ postCorrectionsGradeR = do
, SubmissionRatingBy =. Just uid
, SubmissionRatingTime =. now <$ guard rated
]
| otherwise -> return $ Nothing
| otherwise -> return Nothing
subs' <- traverse encrypt subs :: Handler [CryptoFileNameSubmission]
unless (null subs') $(addMessageFile Success "templates/messages/correctionsUploaded.hamlet")
defaultLayout $ do
defaultLayout $
$(widgetFile "corrections-grade")

99
src/Handler/Course.hs
View File

@ -105,7 +105,7 @@ course2Participants (course `E.InnerJoin` _school) = E.sub_select . E.from $ \co
return (E.countRows :: E.SqlExpr (E.Value Int64))
course2Registered :: Maybe UserId -> CourseTableExpr -> E.SqlExpr (E.Value Bool)
course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant -> do
course2Registered muid (course `E.InnerJoin` _school) = E.exists . E.from $ \courseParticipant ->
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. course E.^. CourseId
E.&&. E.just (courseParticipant E.^. CourseParticipantUser) E.==. E.val muid
@ -122,7 +122,7 @@ makeCourseTable whereClause colChoices psValidator = do
return (course, participants, registered, school)
dbtProj :: DBRow _ -> MaybeT (ReaderT SqlBackend (HandlerT UniWorX IO)) CourseTableData
dbtProj = traverse $ \(course, E.Value participants, E.Value registered, school) -> return (course, participants, registered, school)
dbTable psValidator $ DBTable
dbTable psValidator DBTable
{ dbtSQLQuery
, dbtColonnade = colChoices
, dbtProj
@ -134,7 +134,7 @@ makeCourseTable whereClause colChoices psValidator = do
, ( "schoolshort", SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolShorthand)
, ( "register-from", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterFrom)
, ( "register-to", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterTo)
, ( "participants", SortColumn $ course2Participants )
, ( "participants", SortColumn course2Participants )
, ( "registered", SortColumn $ course2Registered muid)
]
, dbtFilter = Map.fromList -- OverloadedLists does not work with the templates here
@ -206,9 +206,9 @@ getTermSchoolCourseListR tid ssh = do
, colParticipants
, maybe mempty (const colRegistered) muid
]
whereClause = \(course, _, _) ->
course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
whereClause (course, _, _) =
course E.^. CourseTerm E.==. E.val tid
E.&&. course E.^. CourseSchool E.==. E.val ssh
validator = def
& defaultSorting [("cshort", SortAsc)]
((), coursesTable) <- makeCourseTable whereClause colonnade validator
@ -230,7 +230,7 @@ getTermCourseListR tid = do
, colParticipants
, maybe mempty (const colRegistered) muid
]
whereClause = \(course, _, _) -> course E.^. CourseTerm E.==. E.val tid
whereClause (course, _, _) = course E.^. CourseTerm E.==. E.val tid
validator = def
& defaultSorting [("cshort", SortAsc)]
((), coursesTable) <- makeCourseTable whereClause colonnade validator
@ -254,21 +254,21 @@ getCShowR tid ssh csh = do
E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId
E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid
return $ user E.^. UserDisplayName
return $ (courseEnt,dependent,E.unValue <$> lecturers)
return (courseEnt,dependent,E.unValue <$> lecturers)
let course = entityVal courseEnt
(regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid ssh csh CRegisterR) True
mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course
mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course
defaultLayout $ do
setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|]
setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
$(widgetFile "course")
registerForm :: Bool -> Maybe Text -> Form Bool
registerForm registered msecret extra = do
(msecretRes', msecretView) <- case msecret of
(Just _) | not registered -> bimap Just Just <$> (mreq textField (fslpI MsgCourseSecret "Code") Nothing)
(Just _) | not registered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing
_ -> return (Nothing,Nothing)
(btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing
let widget = $(widgetFile "widgets/registerForm")
@ -282,7 +282,7 @@ postCRegisterR tid ssh csh = do
aid <- requireAuthId
(cid, course, registered) <- runDB $ do
(Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh
registered <- isJust <$> (getBy $ UniqueParticipant aid cid)
registered <- isJust <$> getBy (UniqueParticipant aid cid)
return (cid, course, registered)
((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course
case regResult of
@ -291,11 +291,11 @@ postCRegisterR tid ssh csh = do
runDB $ deleteBy $ UniqueParticipant aid cid
addMessageI Info MsgCourseDeregisterOk
| codeOk -> do
actTime <- liftIO $ getCurrentTime
actTime <- liftIO getCurrentTime
regOk <- runDB $ insertUnique $ CourseParticipant cid aid actTime
when (isJust regOk) $ addMessageI Success MsgCourseRegisterOk
| otherwise -> addMessageI Warning MsgCourseSecretWrong
(_other) -> return () -- TODO check this!
_other -> return () -- TODO check this!
redirect $ CourseR tid ssh csh CShowR
@ -316,20 +316,20 @@ getCourseNewR = do
let noTemplateAction = courseEditHandler True Nothing
case params of -- DO NOT REMOVE: without this distinction, lecturers would never see an empty newCourseForm any more!
FormMissing -> noTemplateAction
FormFailure msgs -> forM_ msgs ((addMessage Error) . toHtml) >>
FormFailure msgs -> forM_ msgs (addMessage Error . toHtml) >>
noTemplateAction
FormSuccess (fmap TermKey -> mbTid, fmap SchoolKey -> mbSsh, mbCsh) -> do
oldCourses <- runDB $ do
oldCourses <- runDB $
E.select $ E.from $ \course -> do
whenIsJust mbTid $ \tid -> E.where_ $ course E.^. CourseTerm E.==. E.val tid
whenIsJust mbSsh $ \ssh -> E.where_ $ course E.^. CourseSchool E.==. E.val ssh
whenIsJust mbCsh $ \csh -> E.where_ $ course E.^. CourseShorthand E.==. E.val csh
let lecturersCourse =
E.exists $ E.from $ \lecturer -> do
E.exists $ E.from $ \lecturer ->
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
E.&&. lecturer E.^. LecturerCourse E.==. course E.^. CourseId
let lecturersSchool =
E.exists $ E.from $ \user -> do
E.exists $ E.from $ \user ->
E.where_ $ user E.^. UserLecturerUser E.==. E.val uid
E.&&. user E.^. UserLecturerSchool E.==. course E.^. CourseSchool
let courseCreated c =
@ -343,7 +343,7 @@ getCourseNewR = do
return course
template <- case listToMaybe oldCourses of
(Just oldTemplate) ->
let newTemplate = (courseToForm oldTemplate) in
let newTemplate = courseToForm oldTemplate in
return $ Just $ newTemplate
{ cfCourseId = Nothing
, cfTerm = TermKey $ TermIdentifier 0 Winter -- invalid, will be ignored; undefined won't work due to strictness
@ -355,7 +355,7 @@ getCourseNewR = do
(tidOk,sshOk,cshOk) <- runDB $ (,,)
<$> ifMaybeM mbTid True existsKey
<*> ifMaybeM mbSsh True existsKey
<*> ifMaybeM mbCsh True (\csh -> (not . null) <$> selectKeysList [CourseShorthand ==. csh] [LimitTo 1])
<*> ifMaybeM mbCsh True (\csh -> not . null <$> selectKeysList [CourseShorthand ==. csh] [LimitTo 1])
unless tidOk $ addMessageI Warning $ MsgNoSuchTerm $ fromJust mbTid -- safe, since tidOk==True otherwise
unless sshOk $ addMessageI Warning $ MsgNoSuchSchool $ fromJust mbSsh -- safe, since sshOk==True otherwise
unless cshOk $ addMessageI Warning $ MsgNoSuchCourseShorthand $ fromJust mbCsh
@ -400,14 +400,14 @@ courseEditHandler _isGet mbCourseForm = do
aid <- requireAuthId -- TODO: Verify that Editor is owner of the Course to be Edited!!!
((result, formWidget), formEnctype) <- runFormPost $ newCourseForm mbCourseForm
case result of
(FormSuccess res@(
CourseForm { cfCourseId = Nothing
, cfShort = csh
, cfSchool = ssh
, cfTerm = tid
})) -> do -- create new course
(FormSuccess res@CourseForm
{ cfCourseId = Nothing
, cfShort = csh
, cfSchool = ssh
, cfTerm = tid
}) -> do -- create new course
now <- liftIO getCurrentTime
insertOkay <- runDB $ insertUnique $ Course
insertOkay <- runDB $ insertUnique Course
{ courseName = cfName res
, courseDescription = cfDesc res
, courseLinkExternal = cfLink res
@ -431,12 +431,12 @@ courseEditHandler _isGet mbCourseForm = do
Nothing ->
addMessageI Warning $ MsgCourseNewDupShort tid ssh csh
(FormSuccess res@(
CourseForm { cfCourseId = Just cid
, cfShort = csh
, cfSchool = ssh
, cfTerm = tid
})) -> do -- edit existing course
(FormSuccess res@CourseForm
{ cfCourseId = Just cid
, cfShort = csh
, cfSchool = ssh
, cfTerm = tid
}) -> do -- edit existing course
now <- liftIO getCurrentTime
-- addMessage "debug" [shamlet| #{show res}|]
success <- runDB $ do
@ -444,21 +444,20 @@ courseEditHandler _isGet mbCourseForm = do
case old of
Nothing -> addMessageI Error MsgInvalidInput $> False
(Just _) -> do
updOkay <- myReplaceUnique cid ( -- replaceUnique requires Eq Course, which we cannot have
Course { courseName = cfName res
, courseDescription = cfDesc res
, courseLinkExternal = cfLink res
, courseShorthand = cfShort res
, courseTerm = cfTerm res -- dangerous
, courseSchool = cfSchool res
, courseCapacity = cfCapacity res
, courseRegisterSecret = cfSecret res
, courseMaterialFree = cfMatFree res
, courseRegisterFrom = cfRegFrom res
, courseRegisterTo = cfRegTo res
, courseDeregisterUntil = cfDeRegUntil res
}
)
updOkay <- myReplaceUnique cid Course
{ courseName = cfName res
, courseDescription = cfDesc res
, courseLinkExternal = cfLink res
, courseShorthand = cfShort res
, courseTerm = cfTerm res -- dangerous
, courseSchool = cfSchool res
, courseCapacity = cfCapacity res
, courseRegisterSecret = cfSecret res
, courseMaterialFree = cfMatFree res
, courseRegisterFrom = cfRegFrom res
, courseRegisterTo = cfRegTo res
, courseDeregisterUntil = cfDeRegUntil res
}
case updOkay of
(Just _) -> addMessageI Warning (MsgCourseEditDupShort tid ssh csh) $> False
Nothing -> do
@ -468,7 +467,7 @@ courseEditHandler _isGet mbCourseForm = do
when success $ redirect $ CourseR tid ssh csh CShowR
(FormFailure _) -> addMessageI Warning MsgInvalidInput
(FormMissing) -> return ()
FormMissing -> return ()
actionUrl <- fromMaybe CourseNewR <$> getCurrentRoute
defaultLayout $ do
setTitleI MsgCourseEditTitle
@ -570,7 +569,7 @@ newCourseForm template = identForm FIDcourse $ \html -> do
validateCourse :: CourseForm -> [Text]
validateCourse (CourseForm{..}) =
validateCourse CourseForm{..} =
[ msg | (False, msg) <-
[
( NTop cfRegFrom <= NTop cfRegTo
@ -604,7 +603,7 @@ getCUserR _tid _ssh _csh uCId = do
-- - User is lecturer for course (?)
uid <- decrypt uCId
User{..} <- runDB $ get404 uid
defaultLayout $ -- TODO
defaultLayout -- TODO
[whamlet|
<p>^{nameWidget userDisplayName userSurname}
|]

47
src/Handler/Home.hs
View File

@ -55,43 +55,44 @@ homeAnonymous = do
let tableData :: E.SqlExpr (Entity Course)
-> E.SqlQuery (E.SqlExpr (Entity Course))
tableData course = do
E.where_ $ (E.not_ $ E.isNothing $ course E.^. CourseRegisterFrom) -- DO: do this with isAuthorized in dbtProj
E.where_ $ E.not_ (E.isNothing $ course E.^. CourseRegisterFrom) -- DO: do this with isAuthorized in dbtProj
E.&&. (course E.^. CourseRegisterFrom E.<=. E.val (Just cTime))
E.&&. ((E.isNothing $ course E.^. CourseRegisterTo)
E.||. (course E.^. CourseRegisterTo E.>=. E.val (Just cTime)))
E.&&. ( E.isNothing (course E.^. CourseRegisterTo)
E.||. course E.^. CourseRegisterTo E.>=. E.val (Just cTime)
)
return course
colonnade :: Colonnade Sortable (DBRow (Entity Course)) (DBCell (HandlerT UniWorX IO) ())
colonnade = mconcat
[ -- dbRow
sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
sortable (Just "term") (i18nCell MsgTerm) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
textCell $ display $ courseTerm course
, sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
, sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
textCell $ display $ courseSchool course
, sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> do
, sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=Entity{entityVal = course} } -> do
let tid = courseTerm course
ssh = courseSchool course
csh = courseShorthand course
anchorCell (CourseR tid ssh csh CShowR) (toWidget $ display csh)
, sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } ->
, sortable (Just "deadline") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=Entity{entityVal = course} } ->
cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget
]
((), courseTable) <- dbTable def $ DBTable
((), courseTable) <- dbTable def DBTable
{ dbtSQLQuery = tableData
, dbtColonnade = colonnade
, dbtProj = return
, dbtSorting = Map.fromList
[ ( "term"
, SortColumn $ \(course) -> course E.^. CourseTerm
, SortColumn $ \course -> course E.^. CourseTerm
)
, ( "school"
, SortColumn $ \(course) -> course E.^. CourseSchool
, SortColumn $ \course -> course E.^. CourseSchool
)
, ( "course"
, SortColumn $ \(course) -> course E.^. CourseShorthand
, SortColumn $ \course -> course E.^. CourseShorthand
)
, ( "deadline"
, SortColumn $ \(course) -> course E.^. CourseRegisterTo
, SortColumn $ \course -> course E.^. CourseRegisterTo
)
]
, dbtFilter = mempty {- [ ( "term"
@ -105,7 +106,7 @@ homeAnonymous = do
}
-- let features = $(widgetFile "featureList")
-- addMessage Warning "Vorabversion! Die Implementierung von Uni2work ist noch nicht abgeschlossen!"
defaultLayout $ do
defaultLayout
-- $(widgetFile "dsgvDisclaimer")
$(widgetFile "home")
@ -125,7 +126,7 @@ homeUser uid = do
, E.SqlExpr (E.Value (Maybe SubmissionId)))
tableData ((participant `E.InnerJoin` course `E.InnerJoin` sheet) `E.LeftOuterJoin` (submission `E.InnerJoin` subuser)) = do
E.on $ submission E.?. SubmissionId E.==. subuser E.?. SubmissionUserSubmission
E.&&. (E.just $ E.val uid) E.==. subuser E.?. SubmissionUserUser
E.&&. E.just (E.val uid) E.==. subuser E.?. SubmissionUserUser
E.on $ submission E.?. SubmissionSheet E.==. E.just(sheet E.^. SheetId)
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.on $ course E.^. CourseId E.==. participant E.^. CourseParticipantCourse
@ -163,14 +164,14 @@ homeUser uid = do
anchorCell (CSheetR tid ssh csh shn SShowR) (toWidget $ display shn)
, sortable (Just "deadline") (i18nCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, _, E.Value deadline, _) } ->
cell $ formatTime SelFormatDateTime deadline >>= toWidget
, sortable (Just "done") (i18nCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) }) ->
, sortable (Just "done") (i18nCell MsgDone) $ \DBRow{ dbrOutput=(E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, E.Value mbsid) } ->
case mbsid of
Nothing -> mempty
(Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
tickmark
]
let validator = def & defaultSorting [("done",SortDesc), ("deadline",SortDesc)]
((), sheetTable) <- dbTable validator $ DBTable
((), sheetTable) <- dbTable validator DBTable
{ dbtSQLQuery = tableData
, dbtColonnade = colonnade
, dbtProj = \row@DBRow{ dbrOutput = (E.Value tid, E.Value ssh, E.Value csh, E.Value shn, _, _) }
@ -205,7 +206,7 @@ homeUser uid = do
, dbtIdent = "upcomingdeadlines" :: Text
}
-- addMessage Warning "Vorabversion! Die Implementierung von Uni2work ist noch nicht abgeschlossen."
defaultLayout $ do
defaultLayout $
-- setTitle "Willkommen zum Uni2work Test!"
$(widgetFile "homeUser")
-- $(widgetFile "dsgvDisclaimer")
@ -275,12 +276,14 @@ postHelpR = do
((res,formWidget),formEnctype) <- runFormPost $ renderAForm FormStandard $ helpForm mReferer mUid
case res of
FormSuccess (HelpForm{..}) -> do
FormSuccess HelpForm{..} -> do
now <- liftIO getCurrentTime
queueJob' $ JobHelpRequest { jSender = hfUserId
, jHelpRequest = hfRequest
, jRequestTime = now
, jReferer = hfReferer }
queueJob' JobHelpRequest
{ jSender = hfUserId
, jHelpRequest = hfRequest
, jRequestTime = now
, jReferer = hfReferer
}
-- redirect $ HelpR
addMessageI Success MsgHelpSent
return ()

177
src/Handler/Profile.hs
View File

@ -67,7 +67,7 @@ getProfileR, postProfileR :: Handler Html
getProfileR = postProfileR
postProfileR = do
(uid, User{..}) <- requireAuthPair
let settingsTemplate = Just $ SettingsForm
let settingsTemplate = Just SettingsForm
{ stgMaxFavourties = userMaxFavourites
, stgTheme = userTheme
, stgDateTime = userDateTimeFormat
@ -92,13 +92,13 @@ postProfileR = do
-- prune Favourites to user-defined size
oldFavs <- selectKeysList [ CourseFavouriteUser ==. uid]
[ Desc CourseFavouriteTime
, OffsetBy $ stgMaxFavourties
, OffsetBy stgMaxFavourties
]
mapM_ delete oldFavs
addMessageI Info $ MsgSettingsUpdate
addMessageI Info MsgSettingsUpdate
redirect ProfileR -- TODO: them change does not happen without redirect
(FormFailure msgs) -> forM_ msgs $ (addMessage Warning) . toHtml
(FormFailure msgs) -> forM_ msgs $ addMessage Warning . toHtml
_ -> return ()
let formText = Nothing :: Maybe UniWorXMessage
@ -109,7 +109,7 @@ postProfileR = do
postProfileDataR :: Handler Html
postProfileDataR = do
((btnResult,_), _) <- runFormPost $ buttonForm
((btnResult,_), _) <- runFormPost buttonForm
case btnResult of
(FormSuccess BtnDelete) -> do
(uid, User{..}) <- requireAuthPair
@ -119,7 +119,7 @@ postProfileDataR = do
$(addMessageFile Success "templates/deletedUser.hamlet") -- USE THIS ONE
-- addMessageI Success $ MsgDeleteUser deletedSubmissions
-- when (groupSubmissions > 0) $ addMessageI Info $ MsgDeleteUserGroupSubmissions groupSubmissions
defaultLayout $ do
defaultLayout
$(widgetFile "deletedUser")
(FormSuccess BtnAbort ) -> do
@ -156,72 +156,76 @@ deleteUser duid = do
E.&&. subUsers E.^. SubmissionUserUser E.!=. E.val duid
return E.countRows
E.where_ $ suser E.^. SubmissionUserUser E.==. E.val duid
E.&&. (whereBuddies numBuddies)
E.&&. whereBuddies numBuddies
return $ submission E.^. SubmissionId
getSubmissionFiles :: SubmissionId -> DB [E.Value (Key File)]
getSubmissionFiles subId = E.select $ E.from $ \file -> do
E.where_ $ E.exists $ E.from $ \submissionFile -> do
E.where_ $ E.exists $ E.from $ \submissionFile ->
E.where_ $ submissionFile E.^. SubmissionFileSubmission E.==. E.val subId
E.&&. submissionFile E.^. SubmissionFileFile E.==. file E.^. FileId
return $ file E.^. FileId
deleteSingleSubmissionGroups = E.deleteCount $ E.from $ \submissionGroup -> do
E.where_ $ E.exists $ E.from $ \subGroupUser -> do
E.where_ $ E.exists $ E.from $ \subGroupUser ->
E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
E.&&. subGroupUser E.^. SubmissionGroupUserUser E.==. E.val duid
E.where_ $ E.notExists $ E.from $ \subGroupUser -> do
E.&&. subGroupUser E.^. SubmissionGroupUserUser E.==. E.val duid
E.where_ $ E.notExists $ E.from $ \subGroupUser ->
E.where_ $ subGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId
E.&&. subGroupUser E.^. SubmissionGroupUserUser E.!=. E.val duid
E.&&. subGroupUser E.^. SubmissionGroupUserUser E.!=. E.val duid
getProfileDataR :: Handler Html
getProfileDataR :: Handler Html
getProfileDataR = do
(uid, User{..}) <- requireAuthPair
-- mr <- getMessageRender
(admin_rights,lecturer_rights,lecture_corrector,studies) <- runDB $ (,,,) <$>
(E.select $ E.from $ \(adright `E.InnerJoin` school) -> do
E.where_ $ adright E.^. UserAdminUser E.==. E.val uid
E.on $ adright E.^. UserAdminSchool E.==. school E.^. SchoolId
return (school E.^. SchoolShorthand)
)
E.select
( E.from $ \(adright `E.InnerJoin` school) -> do
E.where_ $ adright E.^. UserAdminUser E.==. E.val uid
E.on $ adright E.^. UserAdminSchool E.==. school E.^. SchoolId
return (school E.^. SchoolShorthand)
)
<*>
(E.select $ E.from $ \(lecright `E.InnerJoin` school) -> do
E.where_ $ lecright E.^. UserLecturerUser E.==. E.val uid
E.on $ lecright E.^. UserLecturerSchool E.==. school E.^. SchoolId
return (school E.^. SchoolShorthand)
)
E.select
( E.from $ \(lecright `E.InnerJoin` school) -> do
E.where_ $ lecright E.^. UserLecturerUser E.==. E.val uid
E.on $ lecright E.^. UserLecturerSchool E.==. school E.^. SchoolId
return (school E.^. SchoolShorthand)
)
<*>
(E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
)
E.select
( E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
)
<*>
(E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
E.on $ studyfeat E.^. StudyFeaturesField E.==. studyterms E.^. StudyTermsId
E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
return ( ( studydegree E.^. StudyDegreeName
, studydegree E.^. StudyDegreeKey
)
, ( studyterms E.^. StudyTermsName
, studyterms E.^. StudyTermsKey
)
, studyfeat E.^. StudyFeaturesType
, studyfeat E.^. StudyFeaturesSemester)
)
E.select
( E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
E.on $ studyfeat E.^. StudyFeaturesField E.==. studyterms E.^. StudyTermsId
E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
return ( ( studydegree E.^. StudyDegreeName
, studydegree E.^. StudyDegreeKey
)
, ( studyterms E.^. StudyTermsName
, studyterms E.^. StudyTermsKey
)
, studyfeat E.^. StudyFeaturesType
, studyfeat E.^. StudyFeaturesSemester)
)
-- Tabelle mit eigenen Kursen
(hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
enrolledCoursesTable <- mkEnrolledCoursesTable uid
-- Tabelle mit allen Klausuren und Noten
examTable <- return [whamlet| Klausuren werden momentan leider noch nicht unterstützt.|]
let examTable = [whamlet| Klausuren werden momentan leider noch nicht unterstützt.|]
-- Tabelle mit allen Abgaben und Abgabe-Gruppen
submissionTable <- mkSubmissionTable uid
-- Tabelle mit allen Abgabegruppen
@ -229,42 +233,14 @@ getProfileDataR = do
-- Tabelle mit allen Korrektor-Aufgaben
correctionsTable <- mkCorrectionsTable uid
-- Tabelle mit allen eigenen Tutorials
ownTutorialTable <- return [whamlet| Übungsgruppen werden momentan leider noch nicht unterstützt.|]
let ownTutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
-- Tabelle mit allen Tutorials
tutorialTable <- return [whamlet| Übungsgruppen werden momentan leider noch nicht unterstützt.|]
let tutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
-- Delete Button
(btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form BtnDelete)
-- TODO: move this into a Message and/or Widget-File
let delWdgt = [whamlet|
<form .form-inline method=post action=@{ProfileDataR} enctype=#{btnEnctype}>
<h2>
Sind Sie sich absolut sicher, alle Ihre in Uni2work gespeicherten Daten zu löschen?
<div .container>
Während der Testphase von Uni2work können Sie hiermit
Ihren Account bei Uni2work vollständig löschen.
Mit Ihrem Campus-Account können Sie sich aber danach
jederzeit erneut einloggen, wodurch wieder ein leerer Account erstellt wird.
<div .container>
Hochgeladene Hausaufgaben-Dateien werden unabhhängig vom Urherber nur dann gelöscht,
wenn die Dateien ausschließlich Ihnen zugeordnet sind.
Dateien aus Gruppenabgaben werden also erst dann gelöscht,
wenn alle Gruppenmitglieder Ihren Account gelöscht haben.
<div .container>
<em>Achtung:
Auch abgegebene Hausübungen werden gelöscht!
Falls ein Veranstalter Informationen darüber nicht anderweitig gespeichert hat,
kann dadurch ein etwaiger Hausaufgabenbonus verloren gehen.
(Verbuchte Noten sollten dadurch nicht betroffen sein, aber in einem etwaigen
Streitfall konnen die per Uni2work verwalteten Hausaufgaben dann
auch nicht mehr rekonstruiert/berücksichtigt werden.)
<div .container>
<em>Nach der Testphase von Uni2work wird das Löschen eines Accounts etwas
eingeschränkt werden, da z.B. Klausurnoten 5 Jahre bis nach Exmatrikulation
aufbewahrt werden müssen.
<div .container>
^{btnWdgt}
|]
defaultLayout $ do
let delWdgt = $(widgetFile "widgets/data-delete")
$(widgetFile "profileData")
$(widgetFile "dsgvDisclaimer")
@ -280,14 +256,14 @@ mkOwnedCoursesTable =
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
withType = id
dbtSQLQuery' uid = \(course `E.InnerJoin` lecturer) -> do
dbtSQLQuery' uid (course `E.InnerJoin` lecturer) = do
E.on $ course E.^. CourseId E.==. lecturer E.^. LecturerCourse
E.where_ $ lecturer E.^. LecturerUser E.==. E.val uid
return ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
)
dbtProj = \x -> return $ x & _dbrOutput %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
dbtProj = return . (_dbrOutput %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh)))
dbtColonnade = mconcat
[ dbRow
@ -299,10 +275,10 @@ mkOwnedCoursesTable =
schoolCell <$> view (_dbrOutput . _1 . re _Just)
<*> view (_dbrOutput . _2 )
, sortable (Just "course") (i18nCell MsgCourse) $
courseCellCL <$> view (_dbrOutput)
courseCellCL <$> view _dbrOutput
]
validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc)]
validator = def & defaultSorting [ ("term", SortDesc), ("school", SortAsc), ("course", SortAsc) ]
dbtSorting = Map.fromList
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand)
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
@ -313,7 +289,7 @@ mkOwnedCoursesTable =
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> (dbTableWidget validator DBTable{..})
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid in (_1 %~ getAny) <$> dbTableWidget validator DBTable{..}
@ -340,7 +316,7 @@ mkEnrolledCoursesTable =
termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm)
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $
schoolCell <$> view ( _courseTerm . re _Just)
<*> view ( _courseSchool )
<*> view _courseSchool
, sortable (Just "course") (i18nCell MsgCourse) $
courseCell <$> view (_dbrOutput . _1 . _entityVal)
, sortable (Just "time") (i18nCell MsgRegistered) $ do
@ -374,17 +350,16 @@ mkSubmissionTable =
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
withType = id
dbtSQLQuery' uid = \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) -> do
dbtSQLQuery' uid (course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) = do
E.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
let crse = ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
)
let sht = ( sheet E.^. SheetName
)
let crse = ( course E.^. CourseTerm
, course E.^. CourseSchool
, course E.^. CourseShorthand
)
let sht = sheet E.^. SheetName
return (crse, sht, submission, lastSubEdit uid submission)
lastSubEdit uid submission = -- latest Edit-Time of this user for submission
@ -393,7 +368,7 @@ mkSubmissionTable =
E.&&. subEdit E.^. SubmissionEditUser E.==. E.val uid
return . E.max_ $ subEdit E.^. SubmissionEditTime
dbtProj = \x -> return $ x
dbtProj x = return $ x
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
& _dbrOutput . _2 %~ E.unValue
& _dbrOutput . _4 %~ E.unValue
@ -404,7 +379,7 @@ mkSubmissionTable =
termCell <$> view (_dbrOutput . _1 . _1)
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
schoolCell <$> view ( _1. re _Just)
<*> view ( _2 )
<*> view _2
, sortable (Just "course") (i18nCell MsgCourse) $
courseCellCL <$> view (_dbrOutput . _1)
, sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $
@ -439,7 +414,7 @@ mkSubmissionTable =
]
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
dbtSorting = dbtSorting' uid
in dbTableWidget' validator $ DBTable {..}
in dbTableWidget' validator DBTable{..}
-- in do dbtSQLQuery <- dbtSQLQuery'
-- dbtSorting <- dbtSorting'
-- return $ dbTableWidget' validator $ DBTable {..}
@ -455,7 +430,7 @@ mkSubmissionGroupTable =
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
withType = id
dbtSQLQuery' uid = \(course `E.InnerJoin` sgroup `E.InnerJoin` sguser) -> do
dbtSQLQuery' uid (course `E.InnerJoin` sgroup `E.InnerJoin` sguser) = do
E.on $ sguser E.^. SubmissionGroupUserSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
E.on $ sgroup E.^. SubmissionGroupCourse E.==. course E.^. CourseId
E.where_ $ sguser E.^. SubmissionGroupUserUser E.==. E.val uid
@ -471,7 +446,7 @@ mkSubmissionGroupTable =
E.where_ $ sgEdit E.^. SubmissionGroupEditSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
return . E.max_ $ sgEdit E.^. SubmissionGroupEditTime
dbtProj = \x -> return $ x
dbtProj x = return $ x
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
& _dbrOutput . _3 %~ E.unValue
@ -481,7 +456,7 @@ mkSubmissionGroupTable =
termCell <$> view (_dbrOutput . _1 . _1)
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
schoolCell <$> view ( _1. re _Just)
<*> view ( _2 )
<*> view _2
, sortable (Just "course") (i18nCell MsgCourse) $
courseCellCL <$> view (_dbrOutput . _1)
, sortable (Just "submissiongroup") (i18nCell MsgSubmissionGroupName) . magnify (_dbrOutput . _2 . _entityVal) $
@ -507,7 +482,7 @@ mkSubmissionGroupTable =
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
]
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
in dbTableWidget' validator $ DBTable {..}
in dbTableWidget' validator DBTable{..}
@ -524,15 +499,15 @@ mkCorrectionsTable =
corrsAssigned uid sheet = E.sub_select . E.from $ \submission -> do
E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
E.&&. submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
return $ E.countRows
return E.countRows
corrsCorrected uid sheet = E.sub_select . E.from $ \submission -> do
E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
E.&&. submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
E.&&. (E.not_ $ E.isNothing $ submission E.^. SubmissionRatingTime)
return $ E.countRows
E.&&. submission E.^. SubmissionRatingBy E.==. E.just (E.val uid)
E.&&. E.not_ (E.isNothing $ submission E.^. SubmissionRatingTime)
return E.countRows
dbtSQLQuery' uid = \(course `E.InnerJoin` sheet `E.InnerJoin` corrector) -> do
dbtSQLQuery' uid (course `E.InnerJoin` sheet `E.InnerJoin` corrector) = do
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
@ -542,7 +517,7 @@ mkCorrectionsTable =
)
return (crse, sheet E.^. SheetName, corrector, (corrsAssigned uid sheet, corrsCorrected uid sheet))
dbtProj = \x -> return $ x
dbtProj x = return $ x
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
& _dbrOutput . _2 %~ E.unValue
@ -580,5 +555,5 @@ mkCorrectionsTable =
, ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
]
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
in dbTableWidget' validator $ DBTable {..}
in dbTableWidget' validator DBTable{..}

81
src/Handler/Submission.hs
View File

@ -1,6 +1,6 @@
module Handler.Submission where
import Import hiding (joinPath)
import Import
import Jobs
@ -88,7 +88,7 @@ getSubmissionOwnR tid ssh csh shn = do
E.&&. submission E.^. SubmissionSheet E.==. E.val shid
return $ submission E.^. SubmissionId
case submissions of
((E.Value sid):_) -> return sid
(E.Value sid : _) -> return sid
[] -> notFound
cID <- encrypt sid
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
@ -131,7 +131,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
return (csheet, map E.unValue buddies, [])
(E.Value smid:_) -> do
cID <- encrypt smid
addMessageI Info $ MsgSubmissionAlreadyExists
addMessageI Info MsgSubmissionAlreadyExists
redirect $ CSubmissionR tid ssh csh shn cID SubShowR
(Just smid) -> do
void $ submissionMatchesSheet tid ssh csh shn (fromJust mcid)
@ -145,7 +145,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smid
E.orderBy [E.asc $ user E.^. UserEmail]
return $ (user E.^. UserId, user E.^. UserEmail)
return (user E.^. UserId, user E.^. UserEmail)
let breakUserFromBuddies (E.Value userID, E.Value email)
| uid == userID = (Any True , [])
| otherwise = (Any False, [email])
@ -160,17 +160,17 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
let userName = if isOwner || maySubmit
then E.just $ user E.^. UserDisplayName
else E.nothing
return $ (userName, submissionEdit E.^. SubmissionEditTime)
return (userName, submissionEdit E.^. SubmissionEditTime)
forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
return (csheet,buddies,lastEdits)
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping buddies
mCID <- runDBJobs $ do
res' <- case res of
(FormMissing ) -> return $ FormMissing
FormMissing -> return FormMissing
(FormFailure failmsgs) -> return $ FormFailure failmsgs
(FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change
(FormSuccess (mFiles,gEMails@(_:_))) -- Validate AdHoc Group Members
| (Arbitrary {..}) <- sheetGrouping -> do
| Arbitrary{..} <- sheetGrouping -> do
-- , length gEMails < maxParticipants -> do -- < since submitting user is already accounted for
let prep :: [(E.Value UserEmail, (E.Value UserId, E.Value Bool, E.Value Bool))] -> Map (CI Text) (Maybe (UserId, Bool, Bool))
prep ps = Map.filter (maybe True $ \(i,_,_) -> i /= uid) . Map.fromList $ map (, Nothing) gEMails ++ [(m, Just (i,p,s))|(E.Value m, (E.Value i, E.Value p, E.Value s)) <- ps]
@ -212,7 +212,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
case res' of
(FormSuccess (mFiles,(setFromList -> adhocIds))) -> do
(FormSuccess (mFiles, setFromList -> adhocIds)) -> do
smid <- do
smid <- case (mFiles, msmid) of
(Nothing, Just smid) -- no new files, existing submission partners updated
@ -261,13 +261,13 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
Just isFile = origIsFile <|> corrIsFile
in if
| Just True <- origIsFile -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionOriginal fileTitle')
([whamlet|#{fileTitle'}|])
[whamlet|#{fileTitle'}|]
| otherwise -> textCell $ bool (<> "/") id isFile fileTitle'
, sortable (toNothing "state") (i18nCell MsgCorState) $ \(coalesce -> (_, mCorr)) -> case mCorr of
Nothing -> cell mempty
Just (_, Entity _ File{..})
| isJust fileContent -> anchorCell (CSubmissionR tid ssh csh shn cid $ SubDownloadR SubmissionCorrected fileTitle)
([whamlet|_{MsgFileCorrected}|])
[whamlet|_{MsgFileCorrected}|]
| otherwise -> i18nCell MsgCorrected
, sortable (Just "time") (i18nCell MsgFileModified) $ \(coalesce -> (mOrig, mCorr)) -> let
origTime = fileModified . entityVal . snd <$> mOrig
@ -316,40 +316,39 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
getSubDownloadR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> SubmissionFileType -> FilePath -> Handler TypedContent
getSubDownloadR tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = do
runDB $ do
submissionID <- submissionMatchesSheet tid ssh csh shn cID
getSubDownloadR tid ssh csh shn cID (submissionFileTypeIsUpdate -> isUpdate) path = runDB $ do
submissionID <- submissionMatchesSheet tid ssh csh shn cID
isRating <- maybe False (== submissionID) <$> isRatingFile path
isRating <- (== Just submissionID) <$> isRatingFile path
when (isUpdate || isRating) $
guardAuthResult =<< evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) False
case isRating of
True
| isUpdate -> do
file <- runMaybeT $ lift . ratingFile cID =<< MaybeT (getRating submissionID)
maybe notFound (return . toTypedContent . Text.decodeUtf8) $ fileContent =<< file
| otherwise -> notFound
False -> do
results <- E.select . E.from $ \(sf `E.InnerJoin` f) -> do
E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
E.&&. f E.^. FileTitle E.==. E.val path
E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
-- E.&&. E.not_ (E.isNothing $ f E.^. FileContent) -- This is fine, we just return 204
return f
when (isUpdate || isRating) $
guardAuthResult =<< evalAccessDB (CSubmissionR tid ssh csh shn cID CorrectionR) False
case results of
[Entity _ File{ fileContent = Just c, fileTitle }] -> do
whenM downloadFiles $
addHeader "Content-Disposition" [st|attachment; filename="#{takeFileName fileTitle}"|]
return $ TypedContent (defaultMimeLookup (pack fileTitle) <> "; charset=utf-8") (toContent c)
[Entity _ File{ fileContent = Nothing }] -> sendResponseStatus noContent204 ()
other -> do
$logErrorS "SubDownloadR" $ "Multiple matching files: " <> tshow other
error "Multiple matching files found."
case isRating of
True
| isUpdate -> do
file <- runMaybeT $ lift . ratingFile cID =<< MaybeT (getRating submissionID)
maybe notFound (return . toTypedContent . Text.decodeUtf8) $ fileContent =<< file
| otherwise -> notFound
False -> do
results <- E.select . E.from $ \(sf `E.InnerJoin` f) -> do
E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile)
E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID
E.&&. f E.^. FileTitle E.==. E.val path
E.&&. E.not_ (sf E.^. SubmissionFileIsDeletion)
E.&&. sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
-- E.&&. E.not_ (E.isNothing $ f E.^. FileContent) -- This is fine, we just return 204
return f
case results of
[Entity _ File{ fileContent = Just c, fileTitle }] -> do
whenM downloadFiles $
addHeader "Content-Disposition" [st|attachment; filename="#{takeFileName fileTitle}"|]
return $ TypedContent (defaultMimeLookup (pack fileTitle) <> "; charset=utf-8") (toContent c)
[Entity _ File{ fileContent = Nothing }] -> sendResponseStatus noContent204 ()
other -> do
$logErrorS "SubDownloadR" $ "Multiple matching files: " <> tshow other
error "Multiple matching files found."
getSubArchiveR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> ZIPArchiveName SubmissionFileType -> Handler TypedContent
getSubArchiveR tid ssh csh shn cID (ZIPArchiveName sfType) = do

15
src/Handler/SystemMessage.hs
View File

@ -50,11 +50,12 @@ postMessageR cID = do
cID' <- encrypt tId
runFormPost . identForm (FIDSystemMessageModifyTranslation $ ciphertext cID') . renderAForm FormStandard
$ (,)
<$> ( fmap (Entity tId) $ SystemMessageTranslation
<$> pure systemMessageTranslationMessage
<*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") (Just systemMessageTranslationLanguage)
<*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") (Just systemMessageTranslationContent)
<*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") (Just systemMessageTranslationSummary)
<$> fmap (Entity tId)
( SystemMessageTranslation
<$> pure systemMessageTranslationMessage
<*> areq (langField False) (fslpI MsgSystemMessageLanguage "RFC1766-Sprachcode") (Just systemMessageTranslationLanguage)
<*> areq htmlField' (fslpI MsgSystemMessageContent "HTML") (Just systemMessageTranslationContent)
<*> aopt htmlField' (fslpI MsgSystemMessageSummary "HTML") (Just systemMessageTranslationSummary)
)
<*> combinedButtonField (universeF :: [BtnSubmitDelete])
@ -111,7 +112,7 @@ postMessageR cID = do
maySubmit <- (== Authorized) <$> evalAccess (MessageR cID) True
forms <- traverse (const mkForm) $ () <$ guard maySubmit
defaultLayout $
defaultLayout
$(widgetFile "system-message")
where
modifySystemMessage smId SystemMessage{..} = do
@ -248,5 +249,5 @@ postMessageListR = do
addMessageI Success $ MsgSystemMessageAdded cID
redirect $ MessageR cID
defaultLayout $
defaultLayout
$(widgetFile "system-message-list")

2
src/Handler/Utils/Zip.hs
View File

@ -57,7 +57,7 @@ consumeZip = unZipStream `fuseUpstream` consumeZip'
fileContent
| hasTrailingPathSeparator zipEntryName = Nothing
| otherwise = Just $ mconcat contentChunks
yield $ File{..}
yield File{..}
consumeZip'
accContents :: Monad m => Sink (Either a b) m [b]
accContents = do

2
src/Settings.hs
View File

@ -136,7 +136,7 @@ instance Show PWHashConf where
instance FromJSON PWHashConf where
parseJSON = withObject "PWHashConf" $ \o -> do
pwHashAlgorithm' <- (o .: "algorithm" :: Aeson.Parser Text)
pwHashAlgorithm' <- o .: "algorithm" :: Aeson.Parser Text
pwHashAlgorithm <- if
| pwHashAlgorithm' == "pbkdf1" -> return PWStore.pbkdf1
| pwHashAlgorithm' == "pbkdf2" -> return PWStore.pbkdf2

44
src/Utils.hs
View File

@ -57,7 +57,7 @@ import qualified Data.Aeson as Aeson
-- Yesod --
-----------
newtype MsgRendererS site = MsgRenderer { render :: (forall msg. RenderMessage site msg => msg -> Text) }
newtype MsgRendererS site = MsgRenderer { render :: forall msg. RenderMessage site msg => msg -> Text }
getMsgRenderer :: forall m site. (MonadHandler m, HandlerSite m ~ site) => m (MsgRendererS site)
getMsgRenderer = do
@ -104,29 +104,29 @@ tickmarkT = tickmark
text2Html :: Text -> Html
text2Html = toHtml -- prevents ambiguous types
toWgt :: (ToMarkup a, MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
a -> WidgetT site m ()
toWgt :: (ToMarkup a, MonadBaseControl IO m, MonadThrow m, MonadIO m)
=> a -> WidgetT site m ()
toWgt = toWidget . toHtml
-- Convenience Functions to avoid type signatures:
text2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
Text -> WidgetT site m ()
text2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m)
=> Text -> WidgetT site m ()
text2widget t = [whamlet|#{t}|]
citext2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
(CI Text) -> WidgetT site m ()
citext2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m)
=> CI Text -> WidgetT site m ()
citext2widget t = [whamlet|#{CI.original t}|]
str2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
String -> WidgetT site m ()
str2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m)
=> String -> WidgetT site m ()
str2widget s = [whamlet|#{s}|]
display2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m, DisplayAble a) =>
a -> WidgetT site m ()
display2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m, DisplayAble a)
=> a -> WidgetT site m ()
display2widget = text2widget . display
withFragment :: Monad m => MForm m (a, WidgetT site IO ()) -> Markup -> MForm m (a, WidgetT site IO ())
withFragment form html = (flip fmap) form $ \(x, widget) -> (x, toWidget html >> widget)
withFragment form html = flip fmap form $ over _2 (toWidget html >>)
-- Types that can be converted to Text for direct displayed to User! (Show for debugging, Display for Production)
@ -174,7 +174,7 @@ instance {-# OVERLAPPABLE #-} Show a => DisplayAble a where -- The easy way out
-}
textPercent :: Double -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
textPercent x = lz <> (pack $ show rx) <> "%"
textPercent x = lz <> pack (show rx) <> "%"
where
round' :: Double -> Int -- avoids annoying warning
round' = round
@ -260,10 +260,10 @@ infixl 5 !!!
(!!!) :: (Ord k, Monoid v) => Map k v -> k -> v
(!!!) m k = (fromMaybe mempty) $ Map.lookup k m
(!!!) m k = fromMaybe mempty $ Map.lookup k m
groupMap :: (Ord k, Ord v) => [(k,v)] -> Map k (Set v)
groupMap l = Map.fromListWith mappend $ [(k, Set.singleton v) | (k,v) <- l]
groupMap l = Map.fromListWith mappend [(k, Set.singleton v) | (k,v) <- l]
partMap :: (Ord k, Monoid v) => [(k,v)] -> Map k v
partMap = Map.fromListWith mappend
@ -368,19 +368,19 @@ whenIsRight (Left _) _ = return ()
maybeExceptT :: Monad m => e -> m (Maybe b) -> ExceptT e m b
maybeExceptT err act = lift act >>= maybe (throwE err) return
maybeMExceptT :: Monad m => (m e) -> m (Maybe b) -> ExceptT e m b
maybeMExceptT :: Monad m => m e -> m (Maybe b) -> ExceptT e m b
maybeMExceptT err act = lift act >>= maybe (lift err >>= throwE) return
whenExceptT :: Monad m => Bool -> e -> ExceptT e m ()
whenExceptT b err = when b $ throwE err
whenMExceptT :: Monad m => Bool -> (m e) -> ExceptT e m ()
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 :: 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
@ -398,9 +398,9 @@ catchIfMExceptT err p act = catchIf p (lift act) (throwE <=< lift . err)
shortCircuitM :: Monad m => (a -> Bool) -> m a -> m a -> (a -> a -> a) -> m a
shortCircuitM sc mx my bop = do
x <- mx
case sc x of
True -> return x
False -> bop <$> pure x <*> my
if
| sc x -> return x
| otherwise -> bop <$> pure x <*> my
guardM :: MonadPlus m => m Bool -> m ()
@ -435,7 +435,7 @@ allM xs f = andM $ fmap f xs
-- | Lazy monadic disjunction.
or2M :: Monad m => m Bool -> m Bool -> m Bool
or2M ma mb = ifM ma (return True) mb
or2M ma = ifM ma (return True)
orM :: (Foldable f, Monad m) => f (m Bool) -> m Bool
orM = Fold.foldr or2M (return False)

27
templates/widgets/data-delete.hamlet Normal file
View File

@ -0,0 +1,27 @@
<form .form-inline method=post action=@{ProfileDataR} enctype=#{btnEnctype}>
<h2>
Sind Sie sich absolut sicher, alle Ihre in Uni2work gespeicherten Daten zu löschen?
<div .container>
Während der Testphase von Uni2work können Sie hiermit
Ihren Account bei Uni2work vollständig löschen.
Mit Ihrem Campus-Account können Sie sich aber danach
jederzeit erneut einloggen, wodurch wieder ein leerer Account erstellt wird.
<div .container>
Hochgeladene Hausaufgaben-Dateien werden unabhhängig vom Urherber nur dann gelöscht,
wenn die Dateien ausschließlich Ihnen zugeordnet sind.
Dateien aus Gruppenabgaben werden also erst dann gelöscht,
wenn alle Gruppenmitglieder Ihren Account gelöscht haben.
<div .container>
<em>Achtung:
Auch abgegebene Hausübungen werden gelöscht!
Falls ein Veranstalter Informationen darüber nicht anderweitig gespeichert hat,
kann dadurch ein etwaiger Hausaufgabenbonus verloren gehen.
(Verbuchte Noten sollten dadurch nicht betroffen sein, aber in einem etwaigen
Streitfall konnen die per Uni2work verwalteten Hausaufgaben dann
auch nicht mehr rekonstruiert/berücksichtigt werden.)
<div .container>
<em>Nach der Testphase von Uni2work wird das Löschen eines Accounts etwas
eingeschränkt werden, da z.B. Klausurnoten 5 Jahre bis nach Exmatrikulation
aufbewahrt werden müssen.
<div .container>
^{btnWdgt}