Graceful handling of undone corrections

src/Handler/Utils/Zip/Rating.hs

@@ -267,17 +267,32 @@ 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
+        let collidingFiles = [ t | t@(_, Entity _ sf) <- otherVersions
-              | not (null collidingFiles) = any (/= file) [ f | (Entity _ f, _) <- collidingFiles ]
+                                 , submissionFileIsUpdate sf == isUpdate
+                                 ]
+            underlyingFiles = [ t | t@(_, Entity _ sf) <- otherVersions
+                                  , submissionFileIsUpdate sf == False
+                                  ]
+            anyChanges
+              | not (null collidingFiles)  = any (/~ file) [ f | (Entity _ f, _) <- collidingFiles ]
               | otherwise                  = True
-            undoneDeletion = any submissionFileIsDeletion [ sf | (_, Entity _ sf) <- collidingFiles ]
+            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.
@@ -286,21 +301,21 @@ sinkSubmission sheetId userId mExists = do
             -- 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
+            -- Similarly the check whether the new version matches the underlying
-        -- version of the file for which 'isUpdate' is different from this
+            -- file is arguably too agressive, marking files, differing only in
-        -- one's, and, if so, simply delete the version for which 'isUpdate' is
+            -- modification time, as modified.
-        -- '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?
   
         when anyChanges $ do
           touchSubmission
           when (not $ null collidingFiles) $
             lift $ deleteCascadeWhere [ FileId <-. [ fId | (Entity fId _, _) <- collidingFiles ] ]
-          fileId <- lift $ insert file
+          lift $ case () of
-          lift . insert_ $ SubmissionFile
+            _ | matchesUnderlying
+              , isUpdate
+                -> return ()
+            _   -> do
+              fileId <- insert file
+              insert_ $ SubmissionFile
                 { submissionFileSubmissionId = submissionId
                 , submissionFileFileId = fileId
                 , submissionFileIsUpdate = isUpdate