48 lines
1.7 KiB
Haskell
48 lines
1.7 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Handler.Utils.ZipSpec where
|
|
|
|
import TestImport
|
|
|
|
import Handler.Utils.Zip
|
|
|
|
import System.FilePath
|
|
|
|
import Data.Conduit
|
|
import qualified Data.Conduit.List as Conduit
|
|
|
|
import Data.List (dropWhileEnd)
|
|
import Data.Time
|
|
|
|
instance Arbitrary File where
|
|
arbitrary = do
|
|
fileTitle <- (joinPath <$> arbitrary) `suchThat` (any $ not . isPathSeparator)
|
|
date <- addDays <$> arbitrary <*> pure (fromGregorian 2043 7 2)
|
|
fileModified <- (addUTCTime <$> arbitrary <*> pure (UTCTime date 0)) `suchThat` inZipRange
|
|
fileContent <- arbitrary
|
|
return File{..}
|
|
shrink = genericShrink
|
|
|
|
spec :: Spec
|
|
spec = describe "Zip file handling" $ do
|
|
it "has compatible encoding/decoding to/from zip files" . property $
|
|
\zipFiles -> do
|
|
zipFiles' <- runConduit $ Conduit.sourceList zipFiles =$= produceZip def =$= void consumeZip =$= Conduit.consume
|
|
forM_ (zipFiles `zip` zipFiles') $ \(file, file') -> do
|
|
let acceptableFilenameChanges
|
|
= makeValid . dropWhile isPathSeparator . bool (dropWhileEnd isPathSeparator) addTrailingPathSeparator (isNothing $ fileContent file) . normalise . makeValid
|
|
acceptableTimeDifference t1 t2 = abs (diffUTCTime t1 t2) <= 2
|
|
(shouldBe `on` acceptableFilenameChanges) (fileTitle file') (fileTitle file)
|
|
(fileModified file', fileModified file) `shouldSatisfy` uncurry acceptableTimeDifference
|
|
(fileContent file') `shouldBe` (fileContent file)
|
|
|
|
inZipRange :: UTCTime -> Bool
|
|
inZipRange time
|
|
| time > UTCTime (fromGregorian 1980 1 1) 0
|
|
, time < UTCTime (fromGregorian 2107 1 1) 0
|
|
= True
|
|
| otherwise
|
|
= False
|