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

SubmissionEdit page offers downloads now.

Browse Source
This commit is contained in:
SJost 2018-04-19 11:22:35 +02:00
parent 11c17e3dc8
commit 7329c84304
1 changed files with 30 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
src/Handler/Submission.hs
View File

@ -57,7 +57,7 @@ makeSubmissionForm unpackZips grouping buddies = identForm FIDsubmission $ \html
<$> areq (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing <$> areq (zipFileField unpackZips) (fsm $ bool MsgSubmissionFile MsgSubmissionArchive unpackZips) Nothing
<*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies textField (fsm $ MsgSubmissionMember g) buddy <*> (catMaybes <$> sequenceA [bool aforced' aopt editableBuddies textField (fsm $ MsgSubmissionMember g) buddy
| g <- [1..(max groupNr $ length buddies)] -- groupNr might have decreased meanwhile | g <- [1..(max groupNr $ length buddies)] -- groupNr might have decreased meanwhile
| buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies | buddy <- map (Just . Just) buddies ++ repeat Nothing -- show current buddies
]) ])
<* submitButton <* submitButton
where where
@ -74,7 +74,7 @@ getSubmissionR = postSubmissionR
postSubmissionR tid csh shn (SubmissionMode mcid) = do postSubmissionR tid csh shn (SubmissionMode mcid) = do
uid <- requireAuthId uid <- requireAuthId
msmid <- traverse decrypt mcid msmid <- traverse decrypt mcid
(Entity shid Sheet{..}, buddies) <- runDB $ do (Entity shid Sheet{..}, buddies, oldfiles) <- runDB $ do
sheet@(Entity shid Sheet{..}) <- fetchSheet tid csh shn sheet@(Entity shid Sheet{..}) <- fetchSheet tid csh shn
case msmid of case msmid of
Nothing -> do Nothing -> do
@ -102,7 +102,7 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
E.&&. submissionUser E.^. SubmissionUserUserId E.!=. E.val uid E.&&. submissionUser E.^. SubmissionUserUserId E.!=. E.val uid
E.orderBy [E.asc $ user E.^. UserEmail] E.orderBy [E.asc $ user E.^. UserEmail]
return $ user E.^. UserEmail return $ user E.^. UserEmail
return (sheet,buddies) return (sheet,buddies,[])
(E.Value smid:_) -> do (E.Value smid:_) -> do
cID <- encrypt smid cID <- encrypt smid
addMessageI "info" $ MsgSubmissionAlreadyExists addMessageI "info" $ MsgSubmissionAlreadyExists
@ -117,7 +117,8 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
E.&&. submissionUser E.^. SubmissionUserUserId E.!=. E.val uid E.&&. submissionUser E.^. SubmissionUserUserId E.!=. E.val uid
E.orderBy [E.asc $ user E.^. UserEmail] E.orderBy [E.asc $ user E.^. UserEmail]
return $ user E.^. UserEmail return $ user E.^. UserEmail
return (sheet,buddies) oldfiles <- sourceToList $ submissionFileSource smid
return (sheet,buddies,oldfiles)
let unpackZips = True -- undefined -- TODO let unpackZips = True -- undefined -- TODO
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm unpackZips sheetGrouping $ map E.unValue buddies ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm unpackZips sheetGrouping $ map E.unValue buddies
mCID <- runDB $ do mCID <- runDB $ do
@ -189,6 +190,9 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
Just cID -> redirect $ CourseR tid csh $ SheetR $ SubmissionR shn $ SubmissionMode $ Just cID Just cID -> redirect $ CourseR tid csh $ SheetR $ SubmissionR shn $ SubmissionMode $ Just cID
Nothing -> return () Nothing -> return ()
mArCid <- fmap (CI.original . ciphertext) <$> traverse encrypt msmid
let mCidArCid = (,) <$> mcid <*> mArCid
let pageTitle = MsgSubmissionTitle (unTermKey tid) csh shn let pageTitle = MsgSubmissionTitle (unTermKey tid) csh shn
let formTitle = pageTitle let formTitle = pageTitle
let formText = Nothing :: Maybe UniWorXMessage let formText = Nothing :: Maybe UniWorXMessage
@ -196,12 +200,34 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do
defaultLayout $ do defaultLayout $ do
setTitleI pageTitle setTitleI pageTitle
$(widgetFile "formPageI18n") $(widgetFile "formPageI18n")
[whamlet|
$maybe (cid, arCid) <-mCidArCid
<hr>
<h2>
<a href=@{SubmissionDownloadArchiveR arCid}>Archive
<h3>Enthaltene Dateien:
$forall (Entity _ File{..}) <- oldfiles
<a href=@{SubmissionDownloadSingleR cid fileTitle}>
#{fileTitle}
|]
submissionFileSource :: SubmissionId -> Source (YesodDB UniWorX) (Entity File)
submissionFileSource submissionID = E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionID
E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion
E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
return f
@ -309,13 +335,6 @@ getSubmissionDownloadSingleR cID path = do
[Entity _ File{ fileContent = Just c }] -> return $ TypedContent (defaultMimeLookup fileName) (toContent c) [Entity _ File{ fileContent = Just c }] -> return $ TypedContent (defaultMimeLookup fileName) (toContent c)
_ -> notFound _ -> notFound
submissionFileSource :: SubmissionId -> Source (YesodDB UniWorX) (Entity File)
submissionFileSource submissionID = E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do
E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionID
E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion
E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate]
return f
postSubmissionDownloadMultiArchiveR :: Handler TypedContent postSubmissionDownloadMultiArchiveR :: Handler TypedContent
postSubmissionDownloadMultiArchiveR = do postSubmissionDownloadMultiArchiveR = do