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

Submission form shows submitter now

Browse Source
This commit is contained in:
SJost 2018-11-09 10:28:53 +01:00
parent ec06be2dfd
commit b235541500
1 changed files with 19 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
src/Handler/Submission.hs
View File

@ -47,22 +47,27 @@ import System.FilePath
-- numberOfSubmissionEditDates = 3 -- for debugging only, should be 1 in production.
makeSubmissionForm :: Maybe SubmissionId -> UploadMode -> SheetGroup -> [UserEmail] -> Form (Maybe (Source Handler File), [UserEmail])
makeSubmissionForm msmid uploadMode grouping buddies = identForm FIDsubmission $ \html -> do
makeSubmissionForm :: Maybe SubmissionId -> UploadMode -> SheetGroup -> NonEmpty UserEmail -> Form (Maybe (Source Handler File), NonEmpty UserEmail)
makeSubmissionForm msmid uploadMode grouping (self :| buddies) = identForm FIDsubmission $ \html -> do
let
fileUploadForm = case uploadMode of
NoUpload -> pure Nothing
(Upload unpackZips) -> (bool (\f fs _ -> Just <$> areq f fs Nothing) aopt $ isJust msmid) (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
flip (renderAForm FormStandard) html $ (,)
<$> fileUploadForm
<*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies ciField (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy
| g <- [1..(min (fromIntegral groupNr) $ length buddies)] -- groupNr might have decreased meanwhile
| buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
])
<*> ( (:|)
-- #227 Part I: change aforced to areq if the user is the lecturer or an admin (lecturer can upload for students)
<$> aforced ciField (fslpI (MsgSubmissionMember 1) "user@campus.lmu.de" ) self
<*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies ciField (fslpI (MsgSubmissionMember g) "user@campus.lmu.de" ) buddy
| g <- [2..(fromIntegral groupNr)]
| buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
])
)
<* submitButton
where
(groupNr, editableBuddies)
| Arbitrary{..} <- grouping = (pred maxParticipants, True) -- pred to account for the person submitting
| Arbitrary{..} <- grouping = (maxParticipants, True)
| RegisteredGroups <- grouping = (fromIntegral $ length buddies, False)
| otherwise = (0, False)
aforced' f fs (Just (Just v)) = Just <$> aforced f fs v
@ -95,7 +100,7 @@ getSubmissionOwnR tid ssh csh shn = do
submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html
submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
uid <- requireAuthId
(Entity uid userData) <- requireAuth
msmid <- traverse decrypt mcid
actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- affects visibility of Edit-Dates, Submission-Button, etc.
@ -141,7 +146,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
invalidArgsI [MsgSubmissionWrongSheet]
-- fetch buddies from current submission
(Any isOwner, buddies) <- do
submittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
submitters <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> 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]
@ -149,7 +154,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
let breakUserFromBuddies (E.Value userID, E.Value email)
| uid == userID = (Any True , [])
| otherwise = (Any False, [email])
return $ foldMap breakUserFromBuddies submittors
return $ foldMap breakUserFromBuddies submitters
lastEdits <- do
raw <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
@ -163,13 +168,14 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
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
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid sheetUploadMode sheetGrouping (userEmail userData :| buddies)
mCID <- runDBJobs $ do
res' <- case res of
FormMissing -> return FormMissing
(FormFailure failmsgs) -> return $ FormFailure failmsgs
(FormSuccess (mFiles,[])) -> return $ FormSuccess (mFiles,[]) -- Type change
(FormSuccess (mFiles,gEMails@(_:_))) -- Validate AdHoc Group Members
-- #227 Part II: no longer ignore submitter, if the user is lecturer or admin (allow lecturers to submit for their students)
(FormSuccess (mFiles,_submitter:|[])) -> return $ FormSuccess (mFiles,[]) -- Type change
(FormSuccess (mFiles,_submitter:|gEMails@(_:_))) -- Validate AdHoc Group Members
| 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))