{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GADTs #-}
module Hackage.Index (
getCabal,
getCabals,
withCabalFile,
listPackages,
packageVersions,
latestVersion,
preferredVersions,
getTimestamp,
indexFiles,
getPackageDescription,
getPackageDescription',
packageIdOrLatest,
getFileInfo,
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 qualified Hackage.Security.Client.Repository.Cache as Cache
import Hackage.Security.Util.Pretty
import SimpleCabal
getCabal :: PackageIdentifier -> IO BL.ByteString
getCabal pkgid =
withLocalRepo $ \rep -> uncheckClientErrors $
withIndex rep $ \ IndexCallbacks{..} ->
trusted <$> indexLookupCabal pkgid
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
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)
getFileInfo :: PackageIdentifier -> IO FileInfo
getFileInfo pkgid =
withLocalRepo $ \rep -> uncheckClientErrors $
withIndex rep $ \ IndexCallbacks{..} ->
trusted <$> indexLookupFileInfo pkgid
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
getPackageDescription' :: PackageIdentifier -> IO PackageDescription
getPackageDescription' pkgid = do
mfpd <- getPackageDescription pkgid
maybe (error "Failed to parse cabal file") return mfpd
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
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
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
preferredVersions :: PackageName -> IO (Maybe BL.ByteString)
preferredVersions pkgname =
withLocalRepo $ \rep -> uncheckClientErrors $
withIndex rep $ \ IndexCallbacks{..} ->
fmap indexEntryContent <$> indexLookupFile (IndexPkgPrefs pkgname)
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
latestVersion :: PackageName -> IO (Maybe Version)
latestVersion pkgname = do
versions <- packageVersions pkgname
if null versions then return Nothing
else return $ Just $ last versions
getTimestamp :: PackageIdentifier -> IO (Maybe UTCTime)
getTimestamp pkgid =
withLocalRepo $ \rep -> uncheckClientErrors $
withIndex rep $ \ IndexCallbacks{..} ->
fmap (posixSecondsToUTCTime . realToFrac . indexEntryTime) <$>
indexLookupFile (IndexPkgCabal pkgid)
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
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