diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 8ce8df7e3..2713994ba 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -111,24 +111,7 @@ sinkSubmission sheetId userId mExists = do 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. + undoneDeletion = any submissionFileIsDeletion [ sf | (_, Entity _ sf) <- collidingFiles ] when anyChanges $ do touchSubmission @@ -179,6 +162,23 @@ sinkSubmission sheetId userId mExists = do , SubmissionRatingComment =. ratingComment ] where + a /~ b = not $ a ~~ b + + (~~) :: File -> File -> Bool + (~~) a b + | isUpdate = fileTitle a == fileTitle b && fileContent a == fileContent b + | otherwise = a == b + -- 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. + -- + -- The check whether the new version matches the underlying file is + -- more lenient, considering only filename and -content. + touchSubmission :: StateT SubmissionSinkState (YesodDB UniWorX) () touchSubmission = do alreadyTouched <- gets $ getAny . sinkSubmissionTouched diff --git a/stack.yaml b/stack.yaml index a976d4ac2..c889ad49d 100644 --- a/stack.yaml +++ b/stack.yaml @@ -6,10 +6,6 @@ nix: extra-package-dbs: [] packages: - . -- location: - git: https://github.com/pngwjpgh/conduit-resumablesink.git - commit: ee0679dc31cdcedb2dad240b941262b9dc16f06d - extra-dep: true - location: git: https://github.com/pngwjpgh/zip-stream.git commit: 9272bbed000928d500febad1cdc98d1da29d399e @@ -18,6 +14,7 @@ extra-deps: - colonnade-1.1.1 - yesod-colonnade-1.1.0 # - zip-stream-0.1.0.1 +- conduit-resumablesink-0.2 - uuid-crypto-1.3.1.0 - filepath-crypto-0.0.0.0 - cryptoids-0.4.0.0 diff --git a/test/Handler/Utils/Zip/RatingSpec.hs b/test/Handler/Utils/Zip/RatingSpec.hs deleted file mode 100644 index dc26958c4..000000000 --- a/test/Handler/Utils/Zip/RatingSpec.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE RecordWildCards #-} - -{-# OPTIONS_GHC -fno-warn-orphans #-} - -module Handler.Utils.Zip.RatingSpec where - -import TestImport - -import Handler.Utils.Zip.Rating - -import qualified Data.ByteString.Lazy as Lazy.ByteString - -import qualified Data.Text as Text - -import Database.Persist.Class -import Database.Persist.Sql - - -instance Arbitrary Rating where - arbitrary = do - ratingCourseName <- arbitrary - ratingSheetName <- arbitrary - ratingSubmissionId <- SubmissionKey . SqlBackendKey <$> arbitrary - ratingComment <- (fmap Text.strip <$> arbitrary) `suchThat` maybe True (not . Text.null) - ratingPoints <- arbitrary - return Rating{..} - - -spec :: Spec -spec = describe "Rating files" $ do - it "have compatible formatting/parsing" . property $ - \rating@(Rating{..}) -> parseRating (Lazy.ByteString.toStrict $ formatRating rating) >>= (`shouldBe` (ratingPoints, ratingComment))