lzma-conduit-1.2.3: tests/Main.hs

import Test.Framework (defaultMain, testGroup)
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck
import Test.QuickCheck.Monadic
import Control.Monad.Trans.Resource

import qualified Data.ByteString as B
import qualified Data.Conduit as C
import qualified Data.Conduit.List as Cl
import Data.Either.Compat (isLeft)
import Data.List
import Data.Word
import Data.Conduit.Lzma
import System.IO.Error (tryIOError)

main = defaultMain tests

tests =
  [ testGroup "Compress" compressTests
  , testGroup "Decompress" decompressTests
  , testGroup "Chained" chainedTests
  ]

compressTests =
  [ testProperty "compressAndDiscard" prop_compressAndDiscard
  , testProperty "compressAndCheckLength" prop_compressAndCheckLength
  ]

decompressTests =
  [ testProperty "decompressRandom" prop_decompressRandom
  , testProperty "decompressCorrupt" prop_decompressCorrupt
  , testProperty "decompressEmpty" prop_decompressEmpty
  ]

chainedTests =
  [ testProperty "chain" prop_chain
  , testProperty "compressThenDecompress" prop_compressThenDecompress
  ]

someString :: Gen B.ByteString
someString = do
  val <- listOf $ elements [0..255::Word8]
  return $ B.pack val

someBigString :: Gen B.ByteString
someBigString = resize (8*1024) someString

prop_compressAndDiscard :: Property
prop_compressAndDiscard = monadicIO . forAllM someBigString $ \ str -> do
  run . runResourceT $ Cl.sourceList [str] C.$$ compress Nothing C.=$= Cl.sinkNull

prop_compressAndCheckLength :: Property
prop_compressAndCheckLength = monadicIO . forAllM someBigString $ \ str -> do
  len <- run . runResourceT $ Cl.sourceList [str] C.$$ compress Nothing C.=$= Cl.fold (\ acc el -> acc + B.length el) 0
  -- random strings don't compress very well
  assert (len > B.length str `div` 2)
  assert (len - 64 < B.length str * 2)

prop_chain :: Property
prop_chain = monadicIO . forAllM someBigString $ \ str -> do
  str' <- run . runResourceT $ Cl.sourceList [str] C.$$ compress Nothing C.=$= decompress Nothing C.=$= Cl.consume
  return $ str == B.concat str'

prop_compressThenDecompress :: Property
prop_compressThenDecompress = monadicIO . forAllM someBigString $ \ str -> do
  blob <- run . runResourceT $ Cl.sourceList [str] C.$$ compress Nothing C.=$= Cl.consume
  let blob' = B.concat blob
  randIdx <- pick $ elements [0..B.length blob'-1]
  let resplit = let (x,y) = B.splitAt randIdx blob' in [x,y]
  str' <- run . runResourceT $ Cl.sourceList resplit C.$$ decompress Nothing C.=$= Cl.consume
  return $ str == B.concat str'

prop_decompressRandom :: Property
prop_decompressRandom = monadicIO . forAllM someBigString $ \ str -> do
  -- The someBigString is not necessarily big. It can even be the empty string
  -- https://github.com/alphaHeavy/lzma-conduit/issues/19
  pre $ B.length str > 64
  header <- run . runResourceT $ Cl.sourceList [] C.$$ compress Nothing C.=$= Cl.consume
  let blob = header ++ [str]
  ioErrorE <- run $
    tryIOError (runResourceT $ Cl.sourceList blob C.$$ decompress Nothing C.=$= Cl.sinkNull)
  assert $ isLeft ioErrorE

prop_decompressCorrupt :: Property
prop_decompressCorrupt = monadicIO . forAllM someBigString $ \ str -> do
  header <- run . runResourceT $ Cl.sourceList [] C.$$ compress Nothing C.=$= Cl.consume
  let header' = B.concat header
  randVal <- pick $ elements [0..255::Word8]
  randIdx <- pick $ elements [0..B.length header'-1]
  let (left, right) = B.splitAt randIdx header'
      updated = left `B.append` (randVal `B.cons` B.tail right)
      blob = [updated, str]
  ioErrorE <- run $
    tryIOError (runResourceT $ Cl.sourceList blob C.$$ decompress Nothing C.=$= Cl.sinkNull)
  assert $ isLeft ioErrorE

prop_decompressEmpty :: Property
prop_decompressEmpty = monadicIO $ do
  count <- pick $ elements [0..10]
  let blob = replicate count B.empty
  ioErrorE <- run $
    tryIOError (runResourceT $ Cl.sourceList blob C.$$ decompress Nothing C.=$= Cl.sinkNull)
  assert $ isLeft ioErrorE