cabal-install/tests/UnitTests/Distribution/Client/Get.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE ScopedTypeVariables #-}
   3
   4 module UnitTests.Distribution.Client.Get (tests) where
   5
   6 import Distribution.Client.Get
   7
   8 import Distribution.Client.Types.SourceRepo (SourceRepositoryPackage (..))
   9 import Distribution.Types.PackageId
  10 import Distribution.Types.PackageName
  11 import Distribution.Types.SourceRepo (KnownRepoType (..), RepoKind (..), RepoType (..), SourceRepo (..), emptySourceRepo)
  12 import Distribution.Verbosity as Verbosity
  13 import Distribution.Version
  14
  15 import Control.Exception
  16 import Control.Monad
  17 import Data.Typeable
  18 import System.Directory
  19 import System.Exit
  20 import System.FilePath
  21 import System.IO.Error
  22
  23 import Test.Tasty
  24 import Test.Tasty.HUnit
  25 import Test.Utils.TempTestDir (withTestDir)
  26 import UnitTests.Options (RunNetworkTests (..))
  27
  28 tests :: [TestTree]
  29 tests =
  30   [ testGroup
  31       "forkPackages"
  32       [ testCase "no repos" testNoRepos
  33       , testCase "no repos of requested kind" testNoReposOfKind
  34       , testCase "no repo type specified" testNoRepoType
  35       , testCase "unsupported repo type" testUnsupportedRepoType
  36       , testCase "no repo location specified" testNoRepoLocation
  37       , testCase "correct repo kind selection" testSelectRepoKind
  38       , testCase "repo destination exists" testRepoDestinationExists
  39       , testCase "git fetch failure" testGitFetchFailed
  40       ]
  41   , askOption $ \(RunNetworkTests doRunNetTests) ->
  42       testGroup "forkPackages, network tests" $
  43         includeTestsIf doRunNetTests $
  44           [ testCase "git clone" testNetworkGitClone
  45           ]
  46   ]
  47   where
  48     includeTestsIf True xs = xs
  49     includeTestsIf False _ = []
  50
  51 verbosity :: Verbosity
  52 verbosity = Verbosity.silent -- for debugging try verbose
  53
  54 pkgidfoo :: PackageId
  55 pkgidfoo = PackageIdentifier (mkPackageName "foo") (mkVersion [1, 0])
  56
  57 -- ------------------------------------------------------------
  58
  59 -- * Unit tests
  60
  61 -- ------------------------------------------------------------
  62
  63 testNoRepos :: Assertion
  64 testNoRepos = do
  65   e <-
  66     assertException $
  67       clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos
  68   e @?= ClonePackageNoSourceRepos pkgidfoo
  69   where
  70     pkgrepos = [(pkgidfoo, [])]
  71
  72 testNoReposOfKind :: Assertion
  73 testNoReposOfKind = do
  74   e <-
  75     assertException $
  76       clonePackagesFromSourceRepo verbosity "." repokind [] pkgrepos
  77   e @?= ClonePackageNoSourceReposOfKind pkgidfoo repokind
  78   where
  79     pkgrepos = [(pkgidfoo, [repo])]
  80     repo = emptySourceRepo RepoHead
  81     repokind = Just RepoThis
  82
  83 testNoRepoType :: Assertion
  84 testNoRepoType = do
  85   e <-
  86     assertException $
  87       clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos
  88   e @?= ClonePackageNoRepoType pkgidfoo repo
  89   where
  90     pkgrepos = [(pkgidfoo, [repo])]
  91     repo = emptySourceRepo RepoHead
  92
  93 testUnsupportedRepoType :: Assertion
  94 testUnsupportedRepoType = do
  95   e <-
  96     assertException $
  97       clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos
  98   e @?= ClonePackageUnsupportedRepoType pkgidfoo repo' repotype
  99   where
 100     pkgrepos = [(pkgidfoo, [repo])]
 101     repo =
 102       (emptySourceRepo RepoHead)
 103         { repoType = Just repotype
 104         , repoLocation = Just "loc"
 105         }
 106     repo' =
 107       SourceRepositoryPackage
 108         { srpType = repotype
 109         , srpLocation = "loc"
 110         , srpTag = Nothing
 111         , srpBranch = Nothing
 112         , srpSubdir = Proxy
 113         , srpCommand = []
 114         }
 115     repotype = OtherRepoType "baz"
 116
 117 testNoRepoLocation :: Assertion
 118 testNoRepoLocation = do
 119   e <-
 120     assertException $
 121       clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos
 122   e @?= ClonePackageNoRepoLocation pkgidfoo repo
 123   where
 124     pkgrepos = [(pkgidfoo, [repo])]
 125     repo =
 126       (emptySourceRepo RepoHead)
 127         { repoType = Just repotype
 128         }
 129     repotype = KnownRepoType Darcs
 130
 131 testSelectRepoKind :: Assertion
 132 testSelectRepoKind =
 133   sequence_
 134     [ do
 135       e <- test requestedRepoType pkgrepos
 136       e @?= ClonePackageNoRepoType pkgidfoo expectedRepo
 137
 138       e' <- test requestedRepoType (reverse pkgrepos)
 139       e' @?= ClonePackageNoRepoType pkgidfoo expectedRepo
 140     | let test rt rs =
 141             assertException $
 142               clonePackagesFromSourceRepo verbosity "." rt [] rs
 143     , (requestedRepoType, expectedRepo) <- cases
 144     ]
 145   where
 146     pkgrepos = [(pkgidfoo, [repo1, repo2, repo3])]
 147     repo1 = emptySourceRepo RepoThis
 148     repo2 = emptySourceRepo RepoHead
 149     repo3 = emptySourceRepo (RepoKindUnknown "bar")
 150     cases =
 151       [ (Nothing, repo1)
 152       , (Just RepoThis, repo1)
 153       , (Just RepoHead, repo2)
 154       , (Just (RepoKindUnknown "bar"), repo3)
 155       ]
 156
 157 testRepoDestinationExists :: Assertion
 158 testRepoDestinationExists =
 159   withTestDir verbosity "repos" $ \tmpdir -> do
 160     let pkgdir = tmpdir </> "foo"
 161     createDirectory pkgdir
 162     e1 <-
 163       assertException $
 164         clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos
 165     e1 @?= ClonePackageDestinationExists pkgidfoo pkgdir True {- isdir -}
 166     removeDirectory pkgdir
 167
 168     writeFile pkgdir ""
 169     e2 <-
 170       assertException $
 171         clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos
 172     e2 @?= ClonePackageDestinationExists pkgidfoo pkgdir False {- isfile -}
 173   where
 174     pkgrepos = [(pkgidfoo, [repo])]
 175     repo =
 176       (emptySourceRepo RepoHead)
 177         { repoType = Just (KnownRepoType Darcs)
 178         , repoLocation = Just ""
 179         }
 180
 181 testGitFetchFailed :: Assertion
 182 testGitFetchFailed =
 183   withTestDir verbosity "repos" $ \tmpdir -> do
 184     let srcdir = tmpdir </> "src"
 185         repo =
 186           (emptySourceRepo RepoHead)
 187             { repoType = Just (KnownRepoType Git)
 188             , repoLocation = Just srcdir
 189             }
 190         repo' =
 191           SourceRepositoryPackage
 192             { srpType = KnownRepoType Git
 193             , srpLocation = srcdir
 194             , srpTag = Nothing
 195             , srpBranch = Nothing
 196             , srpSubdir = Proxy
 197             , srpCommand = []
 198             }
 199         pkgrepos = [(pkgidfoo, [repo])]
 200     e1 <-
 201       assertException $
 202         clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos
 203     e1 @?= ClonePackageFailedWithExitCode pkgidfoo repo' "git" (ExitFailure 128)
 204
 205 testNetworkGitClone :: Assertion
 206 testNetworkGitClone =
 207   withTestDir verbosity "repos" $ \tmpdir -> do
 208     let repo1 =
 209           (emptySourceRepo RepoHead)
 210             { repoType = Just (KnownRepoType Git)
 211             , repoLocation = Just "https://github.com/haskell/zlib.git"
 212             }
 213     clonePackagesFromSourceRepo
 214       verbosity
 215       tmpdir
 216       Nothing
 217       []
 218       [(mkpkgid "zlib1", [repo1])]
 219     assertFileContains (tmpdir </> "zlib1/zlib/zlib.cabal") ["name:", "zlib"]
 220
 221     let repo2 =
 222           (emptySourceRepo RepoHead)
 223             { repoType = Just (KnownRepoType Git)
 224             , repoLocation = Just (tmpdir </> "zlib1")
 225             }
 226     clonePackagesFromSourceRepo
 227       verbosity
 228       tmpdir
 229       Nothing
 230       []
 231       [(mkpkgid "zlib2", [repo2])]
 232     assertFileContains (tmpdir </> "zlib2/zlib/zlib.cabal") ["name:", "zlib"]
 233
 234     let repo3 =
 235           (emptySourceRepo RepoHead)
 236             { repoType = Just (KnownRepoType Git)
 237             , repoLocation = Just (tmpdir </> "zlib1")
 238             , repoTag = Just "0.5.0.0"
 239             }
 240     clonePackagesFromSourceRepo
 241       verbosity
 242       tmpdir
 243       Nothing
 244       []
 245       [(mkpkgid "zlib3", [repo3])]
 246     assertFileContains (tmpdir </> "zlib3/zlib.cabal") ["version:", "0.5.0.0"]
 247   where
 248     mkpkgid nm = PackageIdentifier (mkPackageName nm) (mkVersion [])
 249
 250 -- ------------------------------------------------------------
 251
 252 -- * HUnit utils
 253
 254 -- ------------------------------------------------------------
 255
 256 assertException :: forall e a. (Exception e, HasCallStack) => IO a -> IO e
 257 assertException action = do
 258   r <- try action
 259   case r of
 260     Left e -> return e
 261     Right _ ->
 262       assertFailure $
 263         "expected exception of type "
 264           ++ show (typeOf (undefined :: e))
 265
 266 -- | Expect that one line in a file matches exactly the given words (i.e. at
 267 -- least insensitive to whitespace)
 268 assertFileContains :: HasCallStack => FilePath -> [String] -> Assertion
 269 assertFileContains file expected = do
 270   c <-
 271     readFile file `catch` \e ->
 272       if isDoesNotExistError e
 273         then assertFailure $ "expected a file to exist: " ++ file
 274         else throwIO e
 275   unless (expected `elem` map words (lines c)) $
 276     assertFailure $
 277       "expected the file "
 278         ++ file
 279         ++ " to contain "
 280         ++ show (take 100 expected)