summaryrefslogtreecommitdiff
path: root/test/Spec.hs
blob: c1805d4184896bcf9a1705b83cbedc90cf23cd29 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
{-# LANGUAGE OverloadedStrings #-}
module Main ( main ) where

import           Codec.Archive
import           Codec.Archive.Roundtrip (itPacksUnpacks, itPacksUnpacksViaFS, roundtrip, roundtripFreaky, roundtripStrict)
import           Codec.Archive.Test
import           Data.Either             (isRight)
import           Data.Foldable           (traverse_)
import           System.Directory        (doesDirectoryExist, listDirectory)
import           System.FilePath         ((</>))
import           System.IO.Temp          (withSystemTempDirectory)
import           Test.Hspec

testFp :: FilePath -> Spec
testFp fp = parallel $ it ("sucessfully unpacks/packs (" ++ fp ++ ")") $
    roundtrip fp >>= (`shouldSatisfy` isRight)

testFpStrict :: FilePath -> Spec
testFpStrict fp = parallel $ it ("works on strict bytestring (" ++ fp ++ ")") $
    roundtripStrict fp >>= (`shouldSatisfy` isRight)

testFpFreaky :: FilePath -> Spec
testFpFreaky fp = parallel $ it ("works on nonstandard bytestring (" ++ fp ++ ")") $
    roundtripFreaky fp >>= (`shouldSatisfy` isRight)

unpack :: FilePath -> IO (Either ArchiveResult ())
unpack fp = withSystemTempDirectory "libarchive" $
    \tmp -> runArchiveM $ unpackArchive fp tmp

readArchiveFile' :: FilePath -> IO (Either ArchiveResult [Entry])
readArchiveFile' = runArchiveM . readArchiveFile

testUnpackLibarchive :: FilePath -> Spec
testUnpackLibarchive fp = parallel $ it ("unpacks " ++ fp) $
    unpack fp >>= (`shouldSatisfy` isRight)

testReadArchiveFile :: FilePath -> Spec
testReadArchiveFile fp = parallel $ it ("reads " ++ fp) $
    readArchiveFile' fp >>= (`shouldSatisfy` isRight)

main :: IO ()
main = do

    dir <- doesDirectoryExist "test/data"
    tarballs <- if dir then listDirectory "test/data" else pure []
    let tarPaths = ("test/data" </>) <$> tarballs

    hspec $
        describe "roundtrip" $ do

            traverse_ testFp tarPaths
            traverse_ testFpFreaky tarPaths
            traverse_ testFpStrict tarPaths
            traverse_ testUnpackLibarchive tarPaths
            traverse_ testReadArchiveFile tarPaths

            context "with symlinks" $ do
                let entries =
                        [ simpleDir "x/"
                        , simpleFile "x/a.txt" (NormalFile "referenced")
                        , simpleFile "x/b.txt" (Symlink "a.txt" SymlinkUndefined)
                        ]
                itPacksUnpacks entries
                itPacksUnpacksViaFS entries

            context "with hardlinks" $ do
                let entries =
                        [ simpleDir "x/"
                        , simpleFile "x/a.txt" (NormalFile "shared")
                        , simpleFile "x/b.txt" (Hardlink "x/a.txt")
                        ]
                itPacksUnpacks entries
                context "issue#4" $ itPacksUnpacksViaFS entries

            context "with forward referenced hardlinks" $ do
                let entries =
                        [ simpleDir "x/"
                        , simpleFile "x/b.txt" (Hardlink "x/a.txt")
                        , simpleFile "x/a.txt" (NormalFile "shared")
                        ]
                itPacksUnpacks entries
                xcontext "re-ordering on unpack" $ itPacksUnpacksViaFS entries

            xcontext "having entry without ownership" . itPacksUnpacks $
                [ stripOwnership (simpleFile "a.txt" (NormalFile "text")) ]
            xcontext "having entry without timestamp" . itPacksUnpacks $
                [ stripTime (simpleFile "a.txt" (NormalFile "text")) ]