77 lines
2.9 KiB
Haskell
77 lines
2.9 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.Utils.ZipSpec where
|
|
|
|
import TestImport
|
|
|
|
import Utils ((<//>))
|
|
import Handler.Utils.Zip
|
|
|
|
import Data.Conduit
|
|
import qualified Data.Conduit.Combinators as C
|
|
|
|
import Data.List (dropWhileEnd)
|
|
|
|
import ModelSpec ()
|
|
|
|
import System.FilePath
|
|
import Data.Time
|
|
|
|
import Data.Universe
|
|
|
|
|
|
data ZipConsumptionStrategy
|
|
= ZipConsumeInterleaved
|
|
| ZipConsumeBuffered
|
|
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
|
deriving anyclass (Universe, Finite)
|
|
|
|
data ZipProductionStrategy
|
|
= ZipProduceInterleaved
|
|
| ZipProduceBuffered
|
|
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
|
deriving anyclass (Universe, Finite)
|
|
|
|
|
|
spec :: Spec
|
|
spec = describe "Zip file handling" $ do
|
|
describe "has compatible encoding to, and decoding from zip files" . forM_ universeF $ \strategy ->
|
|
modifyMaxSuccess (bool id (37 *) $ strategy == (ZipProduceInterleaved, ZipConsumeInterleaved)) . it (show strategy) . property $ do
|
|
zipFiles <- listOf arbitrary :: Gen [PureFile]
|
|
return . propertyIO $ do
|
|
let zipProduceBuffered
|
|
= evaluate . force <=< runConduitRes $ zipProduceInterleaved .| C.sinkLazy
|
|
zipProduceInterleaved
|
|
= C.yieldMany zipFiles .| C.map fromPureFile .| produceZip def
|
|
zipConsumeBuffered zipProd
|
|
= mapM toPureFile <=< runConduitRes $ void (consumeZip zipProd) .| C.foldMap pure
|
|
zipConsumeInterleaved zipProd
|
|
= void (consumeZip zipProd) .| C.mapM toPureFile .| C.foldMap pure
|
|
zipFiles' <- case strategy of
|
|
(ZipProduceBuffered, ZipConsumeInterleaved) ->
|
|
runConduitRes . zipConsumeInterleaved . C.sourceLazy =<< zipProduceBuffered
|
|
(ZipProduceBuffered, ZipConsumeBuffered) ->
|
|
zipConsumeBuffered . C.sourceLazy =<< zipProduceBuffered
|
|
(ZipProduceInterleaved, ZipConsumeInterleaved) ->
|
|
runConduitRes $ zipConsumeInterleaved zipProduceInterleaved
|
|
(ZipProduceInterleaved, ZipConsumeBuffered) ->
|
|
zipConsumeBuffered zipProduceInterleaved
|
|
|
|
let acceptableFilenameChanges file
|
|
= "." <//> fileTitle file
|
|
& normalise
|
|
& makeValid
|
|
& dropWhile isPathSeparator
|
|
& dropWhileEnd isPathSeparator
|
|
& bool id addTrailingPathSeparator (isNothing $ fileContent file)
|
|
& normalise
|
|
& makeValid
|
|
acceptableTimeDifference t1 t2 = abs (diffUTCTime t1 t2) <= 2
|
|
|
|
forM_ (zipFiles `zip` zipFiles') $ \(file, file') -> do
|
|
(shouldBe `on` acceptableFilenameChanges) file' file
|
|
(fileModified file', fileModified file) `shouldSatisfy` uncurry acceptableTimeDifference
|
|
(view _pureFileContent file' :: Maybe ByteString) `shouldBe` (view _pureFileContent file)
|