Index.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GADTs #-}

module Hackage.Index (
  getCabal,
  getCabals,
  withCabalFile,
  listPackages,
  packageVersions,
  latestVersion,
  preferredVersions,
  getTimestamp,
  indexFiles,
  getPackageDescription,
  getPackageDescription',
  packageIdOrLatest,
  getFileInfo,
  -- * Re-exports from hackage-security
  FileInfo(..),
  FileLength(..),
  fileInfoSHA256
  ) where

import qualified Data.ByteString.Lazy.Char8 as BL
import Data.List
import Data.Maybe
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Version.Extra (readVersion)
import System.Directory
import System.FilePath
import System.IO.Extra (withTempDir)

import Distribution.Version
#if MIN_VERSION_Cabal(3,0,0)
#else
  hiding (showVersion)
#endif
import Hackage.Security.Client
import qualified Hackage.Security.Client.Repository.Local as Local
import qualified Hackage.Security.Util.Path as Path
--import Hackage.Security.Util.Some
import qualified Hackage.Security.Client.Repository.Cache as Cache
import Hackage.Security.Util.Pretty

import SimpleCabal

-- | Get the contents of the .cabal file for package version
getCabal  :: PackageIdentifier -> IO BL.ByteString
getCabal pkgid =
  withLocalRepo $ \rep -> uncheckClientErrors $
    withIndex rep $ \ IndexCallbacks{..} ->
    trusted <$> indexLookupCabal pkgid

-- | Pass a temporary copy of .cabal file to some action
withCabalFile :: PackageIdentifier -> (FilePath -> IO a) -> IO a
withCabalFile pkgid act =
  withTempDir $ \ tmpdir -> do
    bs <- getCabal pkgid
    let filepath = tmpdir </> showPkgId pkgid <.> "cabal"
    BL.writeFile filepath bs
    act filepath

-- | Get two .cabal files at once!
getCabals  :: PackageIdentifier -> PackageIdentifier
           -> IO (BL.ByteString, BL.ByteString)
getCabals pkgid1 pkgid2 =
  withLocalRepo $ \rep -> uncheckClientErrors $
    withIndex rep $ \ IndexCallbacks{..} -> do
    bs1 <- trusted <$> indexLookupCabal pkgid1
    bs2 <- trusted <$> indexLookupCabal pkgid2
    return (bs1,bs2)

-- | Get FileInfo metadata for package version source
getFileInfo :: PackageIdentifier -> IO FileInfo
getFileInfo pkgid =
  withLocalRepo $ \rep -> uncheckClientErrors $
      withIndex rep $ \ IndexCallbacks{..} ->
        trusted <$> indexLookupFileInfo pkgid

-- | Get and try to parse the PackageDescription of a package version
getPackageDescription :: PackageIdentifier -> IO (Maybe PackageDescription)
getPackageDescription pkgid =
#if (defined(MIN_VERSION_simple_cabal) && MIN_VERSION_simple_cabal(0,1,2))
  do
  cabal <- getCabal pkgid
  parseFinalPackageDescription [] $ BL.toStrict cabal
#else
  Just <$> withCabalFile pkgid (finalPackageDescription [])
#endif

-- | Get and parse PackageDescription of package version
--
-- Raises an error on failure.
getPackageDescription' :: PackageIdentifier -> IO PackageDescription
getPackageDescription' pkgid = do
  mfpd <- getPackageDescription pkgid
  maybe (error "Failed to parse cabal file") return mfpd

-- | Easy access to the local Hackage repo
withLocalRepo :: (Repository Local.LocalFile -> IO a) -> IO a
withLocalRepo action = do
  home <- getHomeDirectory
  localrepo <- (Path.makeAbsolute . Path.fromFilePath) (home </> ".cabal")
  localcache <- (Path.makeAbsolute . Path.fromFilePath) (home </> ".cabal/packages/hackage.haskell.org")
  Local.withRepository localrepo (cache localcache) hackageRepoLayout hackageIndexLayout logTUF action
  where
    -- FIXME could also support 00-index
    cache localcache = Cache.Cache {
        Cache.cacheRoot   = localcache
      , Cache.cacheLayout = cabalCacheLayout
        { cacheLayoutIndexTar   = Path.rootPath $ Path.fragment "01-index.tar"
        , cacheLayoutIndexIdx   = Path.rootPath $ Path.fragment "01-index.tar.idx"
        , cacheLayoutIndexTarGz = Path.rootPath $ Path.fragment "01-index.tar.gz"}
    }

    logTUF msg = putStrLn $ "# " ++ pretty msg

-- | Get all versions of a package in the index
packageVersions :: PackageName -> IO [Version]
packageVersions pkgname =
  withLocalRepo $ \rep -> uncheckClientErrors $ do
    dir <- getDirectory rep
    let pkg = unPackageName pkgname
    return $ sort . mapMaybe (extractPkgVersion pkg . second) $ directoryEntries dir
  where
    second (_,b,_) = b

    extractPkgVersion :: String -> IndexPath -> Maybe Version
    extractPkgVersion pkg path =
      if Path.takeExtension path == ".cabal" then
        let namever = (Path.toUnrootedFilePath . Path.unrootPath . Path.takeDirectory) path
        in if takeDirectory namever == pkg
           then Just $ mkVersion' . readVersion $ takeFileName namever
           else Nothing
      else Nothing

-- | Get the preferred-versions metadata for package
preferredVersions :: PackageName -> IO (Maybe BL.ByteString)
preferredVersions pkgname =
  withLocalRepo $ \rep -> uncheckClientErrors $
    withIndex rep $ \ IndexCallbacks{..} ->
    fmap indexEntryContent <$> indexLookupFile (IndexPkgPrefs pkgname)

-- | List all files in the Hackage index
-- (.cabal files, metadata .json files, preferred-versions files)
indexFiles :: IO [String]
indexFiles =
  withLocalRepo $ \rep -> uncheckClientErrors $ do
    dir <- getDirectory rep
    return $ map dirEntryPath (directoryEntries dir)
  where
    second (_,b,_) = b

    dirEntryPath = Path.toUnrootedFilePath . Path.unrootPath . second

-- | Get the latest version of package from the index
--
-- Note: does not take preferred-versions into account
latestVersion :: PackageName -> IO (Maybe Version)
latestVersion pkgname = do
  versions <- packageVersions pkgname
  if null versions then return Nothing
    else return $ Just $ last versions

-- | Get the index timestamp for (the latest revision of) pkgid
getTimestamp :: PackageIdentifier -> IO (Maybe UTCTime)
getTimestamp pkgid =
  withLocalRepo $ \rep -> uncheckClientErrors $
    withIndex rep $ \ IndexCallbacks{..} ->
    fmap (posixSecondsToUTCTime . realToFrac . indexEntryTime) <$>
    indexLookupFile (IndexPkgCabal pkgid)

-- | Convert a PackageID if unversioned to latest package version
packageIdOrLatest :: PackageIdentifier -> IO PackageIdentifier
packageIdOrLatest pkgid = do
  let name = pkgName pkgid
  if pkgVersion pkgid == nullVersion then do
    mlatest <- latestVersion name
    return $ maybe pkgid (PackageIdentifier name) mlatest
    else return pkgid

-- | List all packages in the index (unsorted for performance)
listPackages :: IO [String]
listPackages =
  withLocalRepo $ \rep -> uncheckClientErrors $ do
    dir <- getDirectory rep
    return $ nub $ mapMaybe (extractPkg . second) (directoryEntries dir)
  where
    extractPkg path =
      if Path.takeExtension path == ".cabal" then
        (Just . takeWhile (/= '/') . Path.toUnrootedFilePath . Path.unrootPath) path
        else Nothing

    second (_,b,_) = b