From d01404047fee5c1aef2384e484b6051544380bbd Mon Sep 17 00:00:00 2001
From: Gregor Kleen <kleen@cip.ifi.lmu.de>
Date: Thu, 12 Oct 2017 15:47:18 +0200
Subject: [PATCH] Graceful handling of undone corrections

---
 src/Handler/Utils/Zip/Rating.hs | 73 ++++++++++++++++++++-------------
 1 file changed, 44 insertions(+), 29 deletions(-)

diff --git a/src/Handler/Utils/Zip/Rating.hs b/src/Handler/Utils/Zip/Rating.hs
index cd6260db6..ba20bfd8e 100644
--- a/src/Handler/Utils/Zip/Rating.hs
+++ b/src/Handler/Utils/Zip/Rating.hs
@@ -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 ] ]