module Distribution.Nixpkgs.Haskell.PackageSourceSpec
( Package(..), getPackage, getPackage', loadHackageDB, sourceFromHackage
) where
import qualified Control.Exception as Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe
import Data.List ( isSuffixOf, isPrefixOf )
import qualified Data.Map as DB
import Data.Maybe
import Data.Time
import Distribution.Nixpkgs.Fetch
import Distribution.Nixpkgs.Hashes
import qualified Distribution.Nixpkgs.Haskell.Hackage as DB
import qualified Distribution.Package as Cabal
import Distribution.PackageDescription
import qualified Distribution.PackageDescription as Cabal
import Distribution.PackageDescription.Parse as Cabal
import Distribution.Text ( simpleParse, display )
import Distribution.Version
import qualified Hpack.Run as Hpack
import qualified Hpack.Config as Hpack
import OpenSSL.Digest ( digestString, digestByName )
import System.Directory ( doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getHomeDirectory, getDirectoryContents )
import System.Exit ( exitFailure )
import System.FilePath ( (</>), (<.>) )
import System.IO ( hPutStrLn, stderr, hPutStr )
data Package = Package
{ pkgSource :: DerivationSource
, pkgRanHpack :: Bool
, pkgCabal :: Cabal.GenericPackageDescription
}
deriving (Show)
getPackage :: Bool
-> Maybe FilePath
-> Maybe UTCTime
-> Source
-> IO Package
getPackage optHpack optHackageDB optHackageSnapshot source = do
getPackage' optHpack (loadHackageDB optHackageDB optHackageSnapshot) source
getPackage' :: Bool
-> IO DB.HackageDB
-> Source
-> IO Package
getPackage' optHpack hackageDB source = do
(derivSource, ranHpack, pkgDesc) <- fetchOrFromDB optHpack hackageDB source
(\s -> Package s ranHpack pkgDesc) <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
fetchOrFromDB :: Bool
-> IO DB.HackageDB
-> Source
-> IO (Maybe DerivationSource, Bool, Cabal.GenericPackageDescription)
fetchOrFromDB optHpack hackageDB src
| "cabal://" `isPrefixOf` sourceUrl src = do
(msrc, pkgDesc) <- fromDB hackageDB . drop (length "cabal://") $ sourceUrl src
return (msrc, False, pkgDesc)
| otherwise = do
r <- fetch (\dir -> cabalFromPath optHpack (dir </> sourceCabalDir src)) src
case r of
Nothing -> fail "Failed to fetch source. Does the URL exist?"
Just (derivSource, (externalSource, ranHpack, pkgDesc)) -> do
return (derivSource <$ guard externalSource, ranHpack, pkgDesc)
loadHackageDB :: Maybe FilePath
-> Maybe UTCTime
-> IO DB.HackageDB
loadHackageDB optHackageDB optHackageSnapshot = do
dbPath <- maybe DB.hackageTarball return optHackageDB
DB.readTarball optHackageSnapshot dbPath
fromDB :: IO DB.HackageDB
-> String
-> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
fromDB hackageDBIO pkg = do
hackageDB <- hackageDBIO
vd <- maybe unknownPackageError return (DB.lookup name hackageDB >>= lookupVersion)
let ds = case DB.tarballSha256 vd of
Nothing -> Nothing
Just hash -> Just (DerivationSource "url" url "" hash)
return (ds, setCabalFileHash (DB.cabalFileSha256 vd) (DB.cabalFile vd))
where
pkgId :: Cabal.PackageIdentifier
pkgId = fromMaybe (error ("invalid Haskell package id " ++ show pkg)) (simpleParse pkg)
name = Cabal.packageName pkgId
unknownPackageError = fail $ "No such package " ++ display pkgId ++ " in the cabal database. Did you run cabal update?"
url = "mirror://hackage/" ++ display pkgId ++ ".tar.gz"
version :: Version
version = Cabal.packageVersion pkgId
lookupVersion :: DB.Map Version DB.VersionData -> Maybe DB.VersionData
lookupVersion m | version == nullVersion = fmap snd (listToMaybe (DB.toDescList m))
lookupVersion m = DB.lookup version m
readFileMay :: FilePath -> IO (Maybe String)
readFileMay file = do
e <- doesFileExist file
if e
then Just <$> readFile file
else return Nothing
hashCachePath :: String -> IO String
hashCachePath pid = do
home <- getHomeDirectory
let cacheDir = home </> ".cache/cabal2nix"
createDirectoryIfMissing True cacheDir
return $ cacheDir </> pid <.> "sha256"
sourceFromHackage :: Hash -> String -> FilePath -> IO DerivationSource
sourceFromHackage optHash pkgId cabalDir = do
cacheFile <- hashCachePath pkgId
cachedHash <-
case optHash of
Certain h -> return . Certain $ h
Guess h -> return . Guess $ h
_ -> fmap (maybe UnknownHash Certain) . readFileMay $ cacheFile
let url = "mirror://hackage/" ++ pkgId ++ ".tar.gz"
case cachedHash of
Guess hash -> return $ DerivationSource "url" url "" hash
Certain hash ->
seq (length hash) $
DerivationSource "url" url "" hash <$ writeFile cacheFile hash
UnknownHash -> do
maybeHash <- runMaybeT (derivHash . fst <$> fetchWith (False, "url", []) (Source url "" UnknownHash cabalDir))
case maybeHash of
Just hash ->
seq (length hash) $
DerivationSource "url" url "" hash <$ writeFile cacheFile hash
Nothing -> do
hPutStr stderr $ unlines
[ "*** cannot compute hash. (Not a hackage project?)"
, " If your project is not on hackage, please supply the path to the root directory of"
, " the project, not to the cabal file."
, ""
, " If your project is on hackage but you still want to specify the hash manually, you"
, " can use the --sha256 option."
]
exitFailure
showPackageIdentifier :: Cabal.GenericPackageDescription -> String
showPackageIdentifier pkgDesc = name ++ "-" ++ display version where
pkgId = Cabal.package . Cabal.packageDescription $ pkgDesc
name = Cabal.unPackageName (Cabal.packageName pkgId)
version = Cabal.packageVersion pkgId
cabalFromPath :: Bool
-> FilePath -> MaybeT IO (Bool, Bool, Cabal.GenericPackageDescription)
cabalFromPath optHpack path = do
d <- liftIO $ doesDirectoryExist path
if d
then do
(ranHpack, pkg) <- cabalFromDirectory optHpack path
return (d, ranHpack, pkg)
else (,,) d False <$> cabalFromFile False path
cabalFromDirectory :: Bool
-> FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
cabalFromDirectory True dir = hpackDirectory dir
cabalFromDirectory False dir = do
cabals <- liftIO $ getDirectoryContents dir >>= filterM doesFileExist . map (dir </>) . filter (".cabal" `isSuffixOf`)
case cabals of
[] -> do
liftIO $ hPutStrLn stderr "*** found zero cabal files. Trying hpack..."
hpackDirectory dir
[cabalFile] -> (,) False <$> cabalFromFile True cabalFile
_ -> liftIO $ fail ("*** found more than one cabal file (" ++ show cabals ++ "). Exiting.")
handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
handleIO = Exception.handle
hpackDirectory :: FilePath -> MaybeT IO (Bool, Cabal.GenericPackageDescription)
hpackDirectory dir = do
mPackage <- liftIO $ Hpack.readPackageConfig $ dir </> "package.yaml"
case mPackage of
Left err -> liftIO $ hPutStrLn stderr ("*** hpack error: " ++ show err ++ ". Exiting.") >> exitFailure
Right (_, pkg') -> do
let hpackOutput = Hpack.renderPackage Hpack.defaultRenderSettings 2 [] [] pkg'
hash = printSHA256 $ digestString (digestByName "sha256") hpackOutput
case parseGenericPackageDescription hpackOutput of
ParseFailed perr -> liftIO $ do
hPutStrLn stderr $ "*** cannot parse hpack output: " ++ show perr
hPutStrLn stderr $ "*** hpack output:\n" ++ hpackOutput
fail "*** Exiting."
ParseOk _ pkg -> MaybeT $ return $ Just $ (,) True $ setCabalFileHash hash pkg
cabalFromFile :: Bool -> FilePath -> MaybeT IO Cabal.GenericPackageDescription
cabalFromFile failHard file =
MaybeT $ handleIO (\err -> Nothing <$ hPutStrLn stderr ("*** parsing cabal file: " ++ show err)) $ do
buf <- readFile file
let hash = printSHA256 (digestString (digestByName "sha256") buf)
case parseGenericPackageDescription buf of
ParseFailed perr -> if failHard
then fail ("cannot parse " ++ show file ++ ": " ++ show perr)
else return Nothing
ParseOk _ pkg -> return $ Just $ setCabalFileHash hash pkg
setCabalFileHash :: String -> GenericPackageDescription -> GenericPackageDescription
setCabalFileHash sha256 gpd = gpd { packageDescription = (packageDescription gpd) {
customFieldsPD = ("X-Cabal-File-Hash", sha256) : customFieldsPD (packageDescription gpd)
}
}