diff --git a/src/Handler/Zip.hs b/src/Handler/Zip.hs index 51fdd5179..fab24fc85 100644 --- a/src/Handler/Zip.hs +++ b/src/Handler/Zip.hs @@ -68,7 +68,7 @@ consumeZip handleEntry = Zip.unZipStream `fuseBoth` consumeZip' contentChunks <- accContents let zipEntryName = normalise $ makeValid zipEntryName' - zipEntryTime = fixZipEpoch . localTimeToUTC utc $ Zip.zipEntryTime e + zipEntryTime = localTimeToUTC utc $ Zip.zipEntryTime e zipEntryContents | hasTrailingPathSeparator zipEntryName' = Nothing | otherwise = Just $ Lazy.ByteString.fromChunks contentChunks @@ -81,13 +81,6 @@ consumeZip handleEntry = Zip.unZipStream `fuseBoth` consumeZip' Just (Left x) -> [] <$ leftover (Left x) _ -> return [] -fixZipEpoch :: UTCTime -> UTCTime --- ^ Testing showed that the zip library used introduces a weird offset into --- dates when packing/unpacking zip files. --- This is fixed here, for now. -fixZipEpoch u@(UTCTime{..}) = u{ utctDay = addDays (-46751) utctDay } - - produceZip :: ( MonadBase b m , PrimMonad b , MonadThrow m diff --git a/test/Handler/ZipSpec.hs b/test/Handler/ZipSpec.hs index 61712ec39..eebcb72d3 100644 --- a/test/Handler/ZipSpec.hs +++ b/test/Handler/ZipSpec.hs @@ -19,7 +19,8 @@ import Data.Time instance Arbitrary ZipEntry where arbitrary = do zipEntryName <- joinPath <$> arbitrary - zipEntryTime <- arbitrary + let date = addDays <$> arbitrary <*> pure (fromGregorian 2043 7 2) + zipEntryTime <- UTCTime <$> date <*> arbitrary zipEntryContents <- arbitrary return ZipEntry{..} @@ -30,8 +31,17 @@ spec = describe "Zip file handling" $ do (_, zipFiles') <- runConduit $ Conduit.sourceList zipFiles =$= produceZip def =$= consumeZip return forM_ (zipFiles `zip` zipFiles') $ \(file, file') -> do let acceptableFilenameChanges - = bool (dropWhileEnd isPathSeparator) addTrailingPathSeparator (isNothing $ zipEntryContents file) . normalise . makeValid + = makeValid . bool (dropWhileEnd isPathSeparator) addTrailingPathSeparator (isNothing $ zipEntryContents file) . normalise . makeValid acceptableTimeDifference t1 t2 = abs (diffUTCTime t1 t2) <= 2 (shouldBe `on` acceptableFilenameChanges) (zipEntryName file') (zipEntryName file) - (zipEntryTime file', zipEntryTime file) `shouldSatisfy` uncurry acceptableTimeDifference + when (inZipRange $ zipEntryTime file) $ + (zipEntryTime file', zipEntryTime file) `shouldSatisfy` uncurry acceptableTimeDifference (zipEntryContents file') `shouldBe` (zipEntryContents file) + +inZipRange :: UTCTime -> Bool +inZipRange time + | time > UTCTime (fromGregorian 1980 1 1) 0 + , time < UTCTime (fromGregorian 2107 1 1) 0 + = True + | otherwise + = False