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

Cleanup

Browse Source 
Closes #14
This commit is contained in:
Gregor Kleen 2017-10-12 02:20:35 +02:00
parent 37a9836193
commit 264ea52b58
1 changed files with 6 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
src/Handler/Submission.hs
View File

@ -76,19 +76,18 @@ getSubmissionDownloadArchiveR path = do
cIDKey <- getsYesod appCryptoIDKey cIDKey <- getsYesod appCryptoIDKey
submissionID <- Base32.decrypt cIDKey cID submissionID <- Base32.decrypt cIDKey cID
cUUID <- UUID.encrypt cIDKey submissionID cUUID <- UUID.encrypt cIDKey submissionID
runDB $ do respondSourceDB "application/zip" $ do
rating <- getRating submissionID rating <- lift $ getRating submissionID
case rating of case rating of
Nothing -> notFound Nothing -> lift notFound
Just rating' -> do Just rating' -> do
sqlBackend <- ask
let fileEntitySource = E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do let fileEntitySource = 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.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId)
return f return f
fileEntitySource' :: Source (ResourceT IO) File fileEntitySource' :: Source (YesodDB UniWorX) File
fileEntitySource' = runReaderC sqlBackend fileEntitySource =$= Conduit.map entityVal >> maybe (return ()) yield (ratingFile cID rating') fileEntitySource' = fileEntitySource =$= Conduit.map entityVal >> maybe (return ()) yield (ratingFile cID rating')
info = ZipInfo { zipComment = Text.encodeUtf8 . tshow $ ciphertext (cUUID :: CryptoUUIDSubmission) } info = ZipInfo { zipComment = Text.encodeUtf8 . tshow $ ciphertext (cUUID :: CryptoUUIDSubmission) }
return . TypedContent "application/zip" . toContent $ fileEntitySource' =$= produceZip info fileEntitySource' =$= produceZip info =$= Conduit.map toFlushBuilder
getSubmissionR, postSubmissionR :: CryptoUUIDSubmission -> Handler Html getSubmissionR, postSubmissionR :: CryptoUUIDSubmission -> Handler Html
getSubmissionR = postSubmissionR getSubmissionR = postSubmissionR