Address date confusion

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

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