@@ -6,19 +6,19 @@ import qualified Control.Exception as Exception
66import Control.Monad
77import Control.Monad.IO.Class
88import Control.Monad.Trans.Maybe
9−import qualified Data.ByteString.Lazy.Char8 as LBS8
109import Data.List ( isSuffixOf, isPrefixOf )
10+import qualified Data.Map as DB
1111import Data.Maybe
12−import Distribution.Hackage.DB.Parsed
1312import Distribution.Nixpkgs.Fetch
1413import Distribution.Nixpkgs.Hashes
1514import qualified Distribution.Nixpkgs.Haskell.Hackage as DB
1615import qualified Distribution.Package as Cabal
17−import qualified Distribution.Version as Cabal
1816import Distribution.PackageDescription
1917import qualified Distribution.PackageDescription as Cabal
18+import Distribution.PackageDescription.Parse as Cabal
2019import Distribution.Text ( simpleParse, display )
21−import OpenSSL.Digest ( digest, digestByName )
20+import Distribution.Version
21+import OpenSSL.Digest ( digestString, digestByName )
2222import System.Directory ( doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getHomeDirectory, getDirectoryContents )
2323import System.Exit ( exitFailure )
2424import System.FilePath ( (</>), (<.>) )
@@ -30,42 +30,48 @@ data Package = Package
3030 }
3131 deriving (Show)
3232
33−getPackage :: Maybe String -> Source -> IO Package
33+getPackage :: Maybe FilePath -> Source -> IO Package
3434getPackage optHackageDB source = do
3535 (derivSource, pkgDesc) <- fetchOrFromDB optHackageDB source
3636 flip Package pkgDesc <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
3737
38−fetchOrFromDB :: Maybe String -> Source -> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
38+fetchOrFromDB :: Maybe FilePath -> Source -> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
3939fetchOrFromDB optHackageDB src
40− | "cabal://" `isPrefixOf` sourceUrl src = fmap ((,) Nothing) . fromDB optHackageDB . drop (length "cabal://") $ sourceUrl src
40+ | "cabal://" `isPrefixOf` sourceUrl src = fromDB optHackageDB . drop (length "cabal://") $ sourceUrl src
4141 | otherwise = do
4242 r <- fetch (\dir -> cabalFromPath (dir </> sourceCabalDir src)) src
4343 case r of
44− Nothing ->
45− hPutStrLn stderr "*** failed to fetch source. Does the URL exist?" >> exitFailure
44+ Nothing -> fail "Failed to fetch source. Does the URL exist?"
4645 Just (derivSource, (externalSource, pkgDesc)) -> do
4746 return (derivSource <$ guard externalSource, pkgDesc)
4847
49−fromDB :: Maybe String -> String -> IO Cabal.GenericPackageDescription
48+fromDB :: Maybe FilePath -> String -> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
5049fromDB optHackageDB pkg = do
51− pkgDesc <- (lookupVersion <=< DB.lookup name) <$> maybe DB.readHashedHackage DB.readHashedHackage' optHackageDB
52− case pkgDesc of
53− Just r -> return r
54− Nothing -> hPutStrLn stderr "*** no such package in the cabal database (did you run cabal update?). " >> exitFailure
50+ dbPath <- maybe DB.hackageTarball return optHackageDB
51+ db <- DB.readTarball Nothing dbPath
52+ vd <- maybe unknownPackageError return (DB.lookup name db >>= lookupVersion)
53+ let ds = case DB.tarballSha256 vd of
54+ Nothing -> Nothing
55+ Just hash -> Just (DerivationSource "url" url "" hash)
56+ return (ds, setCabalFileHash (DB.cabalFileSha256 vd) (DB.cabalFile vd))
5557 where
5658 pkgId :: Cabal.PackageIdentifier
5759 pkgId = fromMaybe (error ("invalid Haskell package id " ++ show pkg)) (simpleParse pkg)
58− name = Cabal.unPackageName (Cabal.packageName pkgId)
60+ name = Cabal.packageName pkgId
61+
62+ unknownPackageError = fail "No such package in the cabal database. Did you run cabal update?"
5963
60− version :: [Int]
61− version = Cabal.versionNumbers $ Cabal.packageVersion pkgId
64+ url = "mirror://hackage/" ++ display pkgId ++ ".tar.gz"
65+
66+ version :: Version
67+ version = Cabal.packageVersion pkgId
6268
63− lookupVersion :: DB.Map DB.Version Cabal.GenericPackageDescription -> Maybe Cabal.GenericPackageDescription
69+ lookupVersion :: DB.Map Version DB.VersionData -> Maybe DB.VersionData
6470 -- No version is specified, pick latest one
65− lookupVersion m | [] <- version = fmap snd . listToMaybe $ DB.toDescList m
66− lookupVersion m = DB.lookup (DB.makeVersion version) m
71+ lookupVersion m | version == nullVersion = fmap snd (listToMaybe (DB.toDescList m))
72+ lookupVersion m = DB.lookup version m
6773
68−readFileMay :: String -> IO (Maybe String)
74+readFileMay :: FilePath -> IO (Maybe String)
6975readFileMay file = do
7076 e <- doesFileExist file
7177 if e
@@ -79,7 +85,7 @@ hashCachePath pid = do
7985 createDirectoryIfMissing True cacheDir
8086 return $ cacheDir </> pid <.> "sha256"
8187
82−sourceFromHackage :: Hash -> String -> String -> IO DerivationSource
88+sourceFromHackage :: Hash -> String -> FilePath -> IO DerivationSource
8389sourceFromHackage optHash pkgId cabalDir = do
8490 cacheFile <- hashCachePath pkgId
8591 cachedHash <-
@@ -135,7 +141,7 @@ cabalFromDirectory dir = do
135141 cabals <- liftIO $ getDirectoryContents dir >>= filterM doesFileExist . map (dir </>) . filter (".cabal" `isSuffixOf`)
136142 case cabals of
137143 [cabalFile] -> cabalFromFile True cabalFile
138− _ -> liftIO $ hPutStrLn stderr ("*** found zero or more than one cabal file (" ++ show cabals ++ "). Exiting.") >> exitFailure
144+ _ -> liftIO $ fail ("Found zero or more than one cabal files: " ++ show cabals ++ ". Exiting.")
139145
140146handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
141147handleIO = Exception.handle
@@ -147,13 +153,16 @@ cabalFromFile failHard file =
147153 -- wrap the whole block in `catchIO`, because of lazy IO. The `case` will force
148154 -- the reading of the file, so we will always catch the expression here.
149155 MaybeT $ handleIO (\err -> Nothing <$ hPutStrLn stderr ("*** parsing cabal file: " ++ show err)) $ do
150− buf <- LBS8.readFile file
151− let hash = printSHA256 (digest (digestByName "sha256") buf)
152− case parsePackage' buf of
153− Left msg -> if failHard
154− then fail ("*** cannot parse " ++ show file ++ ": " ++ msg)
155− else return Nothing
156− Right pkg -> do return $ Just $ pkg { packageDescription = (packageDescription pkg) {
157− customFieldsPD = ("X-Cabal-File-Hash", hash) : customFieldsPD (packageDescription pkg)
158− }
159− }
156+ buf <- readFile file
157+ let hash = printSHA256 (digestString (digestByName "sha256") buf)
158+ case parseGenericPackageDescription buf of
159+ ParseFailed perr -> if failHard
160+ then fail ("cannot parse " ++ show file ++ ": " ++ show perr)
161+ else return Nothing
162+ ParseOk _ pkg -> return $ Just $ setCabalFileHash hash pkg
163+
164+setCabalFileHash :: String -> GenericPackageDescription -> GenericPackageDescription
165+setCabalFileHash sha256 gpd = gpd { packageDescription = (packageDescription gpd) {
166+ customFieldsPD = ("X-Cabal-File-Hash", sha256) : customFieldsPD (packageDescription gpd)
167+ }
168+ }