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

Graceful handling of undone corrections

Browse Source
This commit is contained in:
Gregor Kleen 2017-10-12 15:47:18 +02:00
parent f6e7b3fe25
commit d01404047f
1 changed files with 44 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
src/Handler/Utils/Zip/Rating.hs
View File

@ -267,45 +267,60 @@ sinkSubmission sheetId userId mExists = do
when alreadySeen . throwM $ DuplicateFileTitle fileTitle when alreadySeen . throwM $ DuplicateFileTitle fileTitle
tell $ mempty{ sinkFilenames = Set.singleton fileTitle } tell $ mempty{ sinkFilenames = Set.singleton fileTitle }
collidingFiles <- lift . E.select . E.from $ \(sf `E.InnerJoin` f) -> do otherVersions <- lift . E.select . E.from $ \(sf `E.InnerJoin` f) -> do
E.on $ sf E.^. SubmissionFileFileId E.==. f E.^. FileId E.on $ sf E.^. SubmissionFileFileId E.==. f E.^. FileId
E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionId E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionId
E.where_ $ sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate -- E.where_ $ sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate
E.where_ $ f E.^. FileTitle E.==. E.val fileTitle -- 'Zip.hs' normalises filenames already, so this should work E.where_ $ f E.^. FileTitle E.==. E.val fileTitle -- 'Zip.hs' normalises filenames already, so this should work
return (f, sf) return (f, sf)
let anyChanges let collidingFiles = [ t | t@(_, Entity _ sf) <- otherVersions
| not (null collidingFiles) = any (/= file) [ f | (Entity _ f, _) <- collidingFiles ] , submissionFileIsUpdate sf == isUpdate
| otherwise = True ]
undoneDeletion = any submissionFileIsDeletion [ sf | (_, Entity _ sf) <- collidingFiles ] underlyingFiles = [ t | t@(_, Entity _ sf) <- otherVersions
-- The Eq Instance for File compares modification time exactly even , submissionFileIsUpdate sf == False
-- though zip archives have very limited accuracy and range regarding ]
-- timestamps. anyChanges
-- We thus expect to replace files a little more often than is actually | not (null collidingFiles) = any (/~ file) [ f | (Entity _ f, _) <- collidingFiles ]
-- necessary. | otherwise = True
-- This was done on the premise that changes in file modification time matchesUnderlying
-- break file identity under upload and re-download. | not (null underlyingFiles) = all (~~ file) [ f | (Entity _ f, Entity _ sf) <- underlyingFiles ]
-- | otherwise = False
-- We could check whether the new version of the file matches the undoneDeletion = any submissionFileIsDeletion [ sf | (_, Entity _ sf) <- collidingFiles
-- version of the file for which 'isUpdate' is different from this ]
-- one's, and, if so, simply delete the version for which 'isUpdate' is
-- 'True', reverting the correction. a /~ b = not $ a ~~ b
--
-- This idea was discarded since modification times make this difficult (~~) :: File -> File -> Bool
-- to implement properly – should we equate file versions that differ in (~~) = (==)
-- modification time? -- The Eq Instance for File compares modification time exactly even
-- though zip archives have very limited accuracy and range regarding
-- timestamps.
-- We thus expect to replace files a little more often than is actually
-- necessary.
-- This was done on the premise that changes in file modification time
-- break file identity under upload and re-download.
--
-- Similarly the check whether the new version matches the underlying
-- file is arguably too agressive, marking files, differing only in
-- modification time, as modified.
when anyChanges $ do when anyChanges $ do
touchSubmission touchSubmission
when (not $ null collidingFiles) $ when (not $ null collidingFiles) $
lift $ deleteCascadeWhere [ FileId <-. [ fId | (Entity fId _, _) <- collidingFiles ] ] lift $ deleteCascadeWhere [ FileId <-. [ fId | (Entity fId _, _) <- collidingFiles ] ]
fileId <- lift $ insert file lift $ case () of
lift . insert_ $ SubmissionFile _ | matchesUnderlying
{ submissionFileSubmissionId = submissionId , isUpdate
, submissionFileFileId = fileId -> return ()
, submissionFileIsUpdate = isUpdate _ -> do
, submissionFileIsDeletion = False fileId <- insert file
} insert_ $ SubmissionFile
{ submissionFileSubmissionId = submissionId
, submissionFileFileId = fileId
, submissionFileIsUpdate = isUpdate
, submissionFileIsDeletion = False
}
when undoneDeletion $ do when undoneDeletion $ do
touchSubmission touchSubmission
lift $ deleteWhere [ SubmissionFileId <-. [ sfId | (_, Entity sfId sf) <- collidingFiles, submissionFileIsDeletion sf ] ] lift $ deleteWhere [ SubmissionFileId <-. [ sfId | (_, Entity sfId sf) <- collidingFiles, submissionFileIsDeletion sf ] ]