fraport/fradrive
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
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.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
return (f, sf)
let anyChanges
| not (null collidingFiles) = any (/= file) [ f | (Entity _ f, _) <- collidingFiles ]
| otherwise = True
undoneDeletion = any submissionFileIsDeletion [ sf | (_, Entity _ sf) <- collidingFiles ]
-- 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.
--
-- We could check whether the new version of the file matches the
-- 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.
--
-- This idea was discarded since modification times make this difficult
-- to implement properly – should we equate file versions that differ in
-- modification time?
let collidingFiles = [ t | t@(_, Entity _ sf) <- otherVersions
, submissionFileIsUpdate sf == isUpdate
]
underlyingFiles = [ t | t@(_, Entity _ sf) <- otherVersions
, submissionFileIsUpdate sf == False
]
anyChanges
| not (null collidingFiles) = any (/~ file) [ f | (Entity _ f, _) <- collidingFiles ]
| otherwise = True
matchesUnderlying
| not (null underlyingFiles) = all (~~ file) [ f | (Entity _ f, Entity _ sf) <- underlyingFiles ]
| otherwise = False
undoneDeletion = any submissionFileIsDeletion [ sf | (_, Entity _ sf) <- collidingFiles
]
a /~ b = not $ a ~~ b
(~~) :: File -> File -> Bool
(~~) = (==)
-- 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
touchSubmission
when (not $ null collidingFiles) $
lift $ deleteCascadeWhere [ FileId <-. [ fId | (Entity fId _, _) <- collidingFiles ] ]
fileId <- lift $ insert file
lift . insert_ $ SubmissionFile
{ submissionFileSubmissionId = submissionId
, submissionFileFileId = fileId
, submissionFileIsUpdate = isUpdate
, submissionFileIsDeletion = False
}
lift $ case () of
_ | matchesUnderlying
, isUpdate
-> return ()
_ -> do
fileId <- insert file
insert_ $ SubmissionFile
{ submissionFileSubmissionId = submissionId
, submissionFileFileId = fileId
, submissionFileIsUpdate = isUpdate
, submissionFileIsDeletion = False
}
when undoneDeletion $ do
touchSubmission
lift $ deleteWhere [ SubmissionFileId <-. [ sfId | (_, Entity sfId sf) <- collidingFiles, submissionFileIsDeletion sf ] ]