1{-# LANGUAGE NoImplicitPrelude #-} 2{-# LANGUAGE OverloadedStrings #-} 3{-# LANGUAGE RecordWildCards #-} 4module Pantry.ArchiveSpec (spec) where 5 6import Test.Hspec 7import Data.Maybe (fromJust) 8import RIO 9import RIO.Text as T 10import Pantry 11import Path.IO (resolveFile') 12 13data TestLocation 14 = TLFilePath String 15 | TLUrl Text 16 17data TestArchive = TestArchive 18 { testLocation :: !TestLocation 19 , testSubdir :: !Text 20 } 21 22getRawPackageLocationIdent' :: TestArchive -> IO PackageIdentifier 23getRawPackageLocationIdent' TestArchive{..} = do 24 testLocation' <- case testLocation of 25 TLFilePath relPath -> do 26 absPath <- resolveFile' relPath 27 return $ ALFilePath $ ResolvedPath 28 { resolvedRelative = RelFilePath $ fromString relPath 29 , resolvedAbsolute = absPath 30 } 31 TLUrl url -> return $ ALUrl url 32 let archive = RawArchive 33 { raLocation = testLocation' 34 , raHash = Nothing 35 , raSize = Nothing 36 , raSubdir = testSubdir 37 } 38 runPantryApp $ getRawPackageLocationIdent $ RPLIArchive archive metadata 39 where 40 metadata = RawPackageMetadata 41 { rpmName = Nothing 42 , rpmVersion = Nothing 43 , rpmTreeKey = Nothing 44 } 45 46parsePackageIdentifier' :: String -> PackageIdentifier 47parsePackageIdentifier' = fromJust . parsePackageIdentifier 48 49urlToStackCommit :: Text -> TestLocation 50urlToStackCommit commit = TLUrl $ T.concat 51 [ "https://github.com/commercialhaskell/stack/archive/" 52 , commit 53 , ".tar.gz" 54 ] 55 56treeWithoutCabalFile :: Selector PantryException 57treeWithoutCabalFile (TreeWithoutCabalFile _) = True 58treeWithoutCabalFile _ = False 59 60spec :: Spec 61spec = do 62 it "finds cabal file from tarball" $ do 63 ident <- getRawPackageLocationIdent' TestArchive 64 { testLocation = TLFilePath "attic/package-0.1.2.3.tar.gz" 65 , testSubdir = "" 66 } 67 ident `shouldBe` parsePackageIdentifier' "package-0.1.2.3" 68 it "finds cabal file from tarball with subdir '.'" $ do 69 ident <- getRawPackageLocationIdent' TestArchive 70 { testLocation = TLFilePath "attic/package-0.1.2.3.tar.gz" 71 , testSubdir = "." 72 } 73 ident `shouldBe` parsePackageIdentifier' "package-0.1.2.3" 74 it "finds cabal file from tarball with a package.yaml" $ do 75 ident <- getRawPackageLocationIdent' TestArchive 76 { testLocation = TLFilePath "attic/hpack-0.1.2.3.tar.gz" 77 , testSubdir = "" 78 } 79 ident `shouldBe` parsePackageIdentifier' "hpack-0.1.2.3" 80 it "finds cabal file from tarball with subdir '.' with a package.yaml" $ do 81 ident <- getRawPackageLocationIdent' TestArchive 82 { testLocation = TLFilePath "attic/hpack-0.1.2.3.tar.gz" 83 , testSubdir = "." 84 } 85 ident `shouldBe` parsePackageIdentifier' "hpack-0.1.2.3" 86 it "finds cabal file from tarball with subdir 'subs/pantry/'" $ do 87 ident <- getRawPackageLocationIdent' TestArchive 88 { testLocation = urlToStackCommit "2b846ff4fda13a8cd095e7421ce76df0a08b10dc" 89 , testSubdir = "subs/pantry/" 90 } 91 ident `shouldBe` parsePackageIdentifier' "pantry-0.1.0.0" 92 it "matches whole directory name" $ 93 getRawPackageLocationIdent' TestArchive 94 { testLocation = urlToStackCommit "2b846ff4fda13a8cd095e7421ce76df0a08b10dc" 95 , testSubdir = "subs/pant" 96 } 97 `shouldThrow` treeWithoutCabalFile 98 it "follows symlinks to directories" $ do 99 ident <- getRawPackageLocationIdent' TestArchive 100 { testLocation = TLFilePath "attic/symlink-to-dir.tar.gz" 101 , testSubdir = "symlink" 102 } 103 ident `shouldBe` parsePackageIdentifier' "foo-1.2.3" 104