@@ -9,19 +9,20 @@ import Control.Monad.Trans.Maybe
99import qualified Data.ByteString.Lazy.Char8 as LBS8
1010import qualified Data.ByteString.Lazy.UTF8 as UTF8
1111import Data.List ( isSuffixOf, isPrefixOf )
12+import qualified Data.Map as DB
1213import Data.Maybe
13−import Distribution.Hackage.DB.Parsed
1414import Distribution.Nixpkgs.Fetch
1515import Distribution.Nixpkgs.Hashes
1616import qualified Distribution.Nixpkgs.Haskell.Hackage as DB
1717import qualified Distribution.Package as Cabal
18−import qualified Distribution.Version as Cabal
1918import Distribution.PackageDescription
2019import qualified Distribution.PackageDescription as Cabal
20+import Distribution.PackageDescription.Parse as Cabal
2121import Distribution.Text ( simpleParse, display )
22−import OpenSSL.Digest ( digest, digestByName )
22+import Distribution.Version
2323import qualified Hpack.Run as Hpack
2424import qualified Hpack.Config as Hpack
25+import OpenSSL.Digest ( digestString, digestByName )
2526import System.Directory ( doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getHomeDirectory, getDirectoryContents )
2627import System.Exit ( exitFailure )
2728import System.FilePath ( (</>), (<.>) )
@@ -35,43 +36,49 @@ data Package = Package
3536 deriving (Show)
3637
3738getPackage :: Bool -- ^ Whether hpack should regenerate the cabal file
38− -> Maybe String -> Source -> IO Package
39+ -> Maybe FilePath -> Source -> IO Package
3940getPackage optHpack optHackageDB source = do
4041 (derivSource, ranHpack, pkgDesc) <- fetchOrFromDB optHpack optHackageDB source
4142 (\s -> Package s ranHpack pkgDesc) <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
4243
4344fetchOrFromDB :: Bool -- ^ Whether hpack should regenerate the cabal file
44− -> Maybe String -> Source -> IO (Maybe DerivationSource, Bool, Cabal.GenericPackageDescription)
45+ -> Maybe FilePath -> Source -> IO (Maybe DerivationSource, Bool, Cabal.GenericPackageDescription)
4546fetchOrFromDB optHpack optHackageDB src
46− | "cabal://" `isPrefixOf` sourceUrl src = fmap ((,,) Nothing False) . fromDB optHackageDB . drop (length "cabal://") $ sourceUrl src
47+ | "cabal://" `isPrefixOf` sourceUrl src = fromDB optHackageDB . drop (length "cabal://") $ sourceUrl src
4748 | otherwise = do
4849 r <- fetch (\dir -> cabalFromPath optHpack (dir </> sourceCabalDir src)) src
4950 case r of
50− Nothing ->
51− hPutStrLn stderr "*** failed to fetch source. Does the URL exist?" >> exitFailure
51+ Nothing -> fail "Failed to fetch source. Does the URL exist?"
5252 Just (derivSource, (externalSource, ranHpack, pkgDesc)) -> do
5353 return (derivSource <$ guard externalSource, ranHpack, pkgDesc)
5454
55−fromDB :: Maybe String -> String -> IO Cabal.GenericPackageDescription
55+fromDB :: Maybe FilePath -> String -> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
5656fromDB optHackageDB pkg = do
57− pkgDesc <- (lookupVersion <=< DB.lookup name) <$> maybe DB.readHashedHackage DB.readHashedHackage' optHackageDB
58− case pkgDesc of
59− Just r -> return r
60− Nothing -> hPutStrLn stderr "*** no such package in the cabal database (did you run cabal update?). " >> exitFailure
57+ dbPath <- maybe DB.hackageTarball return optHackageDB
58+ db <- DB.readTarball Nothing dbPath
59+ vd <- maybe unknownPackageError return (DB.lookup name db >>= lookupVersion)
60+ let ds = case DB.tarballSha256 vd of
61+ Nothing -> Nothing
62+ Just hash -> Just (DerivationSource "url" url "" hash)
63+ return (ds, setCabalFileHash (DB.cabalFileSha256 vd) (DB.cabalFile vd))
6164 where
6265 pkgId :: Cabal.PackageIdentifier
6366 pkgId = fromMaybe (error ("invalid Haskell package id " ++ show pkg)) (simpleParse pkg)
64− name = Cabal.unPackageName (Cabal.packageName pkgId)
67+ name = Cabal.packageName pkgId
68+
69+ unknownPackageError = fail "No such package in the cabal database. Did you run cabal update?"
6570
66− version :: [Int]
67− version = Cabal.versionNumbers $ Cabal.packageVersion pkgId
71+ url = "mirror://hackage/" ++ display pkgId ++ ".tar.gz"
72+
73+ version :: Version
74+ version = Cabal.packageVersion pkgId
6875
69− lookupVersion :: DB.Map DB.Version Cabal.GenericPackageDescription -> Maybe Cabal.GenericPackageDescription
76+ lookupVersion :: DB.Map Version DB.VersionData -> Maybe DB.VersionData
7077 -- No version is specified, pick latest one
71− lookupVersion m | [] <- version = fmap snd . listToMaybe $ DB.toDescList m
72− lookupVersion m = DB.lookup (DB.makeVersion version) m
78+ lookupVersion m | version == nullVersion = fmap snd (listToMaybe (DB.toDescList m))
79+ lookupVersion m = DB.lookup version m
7380
74−readFileMay :: String -> IO (Maybe String)
81+readFileMay :: FilePath -> IO (Maybe String)
7582readFileMay file = do
7683 e <- doesFileExist file
7784 if e
@@ -85,7 +92,7 @@ hashCachePath pid = do
8592 createDirectoryIfMissing True cacheDir
8693 return $ cacheDir </> pid <.> "sha256"
8794
88−sourceFromHackage :: Hash -> String -> String -> IO DerivationSource
95+sourceFromHackage :: Hash -> String -> FilePath -> IO DerivationSource
8996sourceFromHackage optHash pkgId cabalDir = do
9097 cacheFile <- hashCachePath pkgId
9198 cachedHash <-
@@ -149,7 +156,7 @@ cabalFromDirectory False dir = do
149156 liftIO $ hPutStrLn stderr "*** found zero cabal files. Trying hpack..."
150157 hpackDirectory dir
151158 [cabalFile] -> (,) False <$> cabalFromFile True cabalFile
152− _ -> liftIO $ hPutStrLn stderr ("*** found more than one cabal file (" ++ show cabals ++ "). Exiting.") >> exitFailure
159+ _ -> liftIO $ fail ("*** found more than one cabal file (" ++ show cabals ++ "). Exiting.")
153160
154161handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
155162handleIO = Exception.handle
@@ -181,13 +188,16 @@ cabalFromFile failHard file =
181188 -- wrap the whole block in `catchIO`, because of lazy IO. The `case` will force
182189 -- the reading of the file, so we will always catch the expression here.
183190 MaybeT $ handleIO (\err -> Nothing <$ hPutStrLn stderr ("*** parsing cabal file: " ++ show err)) $ do
184− buf <- LBS8.readFile file
185− let hash = printSHA256 (digest (digestByName "sha256") buf)
186− case parsePackage' buf of
187− Left msg -> if failHard
188− then fail ("*** cannot parse " ++ show file ++ ": " ++ msg)
189− else return Nothing
190− Right pkg -> do return $ Just $ pkg { packageDescription = (packageDescription pkg) {
191− customFieldsPD = ("X-Cabal-File-Hash", hash) : customFieldsPD (packageDescription pkg)
192− }
193− }
191+ buf <- readFile file
192+ let hash = printSHA256 (digestString (digestByName "sha256") buf)
193+ case parseGenericPackageDescription buf of
194+ ParseFailed perr -> if failHard
195+ then fail ("cannot parse " ++ show file ++ ": " ++ show perr)
196+ else return Nothing
197+ ParseOk _ pkg -> return $ Just $ setCabalFileHash hash pkg
198+
199+setCabalFileHash :: String -> GenericPackageDescription -> GenericPackageDescription
200+setCabalFileHash sha256 gpd = gpd { packageDescription = (packageDescription gpd) {
201+ customFieldsPD = ("X-Cabal-File-Hash", sha256) : customFieldsPD (packageDescription gpd)
202+ }
203+ }