@@ -6,19 +6,19 @@ import qualified Control.Exception as Exception
6import Control.Monad
6import Control.Monad
7import Control.Monad.IO.Class
7import Control.Monad.IO.Class
8import Control.Monad.Trans.Maybe
8import Control.Monad.Trans.Maybe
9−import qualified Data.ByteString.Lazy.Char8 as LBS8
10import Data.List ( isSuffixOf, isPrefixOf )
9import Data.List ( isSuffixOf, isPrefixOf )
10+import qualified Data.Map as DB
11import Data.Maybe
11import Data.Maybe
12−import Distribution.Hackage.DB.Parsed
13import Distribution.Nixpkgs.Fetch
12import Distribution.Nixpkgs.Fetch
14import Distribution.Nixpkgs.Hashes
13import Distribution.Nixpkgs.Hashes
15import qualified Distribution.Nixpkgs.Haskell.Hackage as DB
14import qualified Distribution.Nixpkgs.Haskell.Hackage as DB
16import qualified Distribution.Package as Cabal
15import qualified Distribution.Package as Cabal
17−import qualified Distribution.Version as Cabal
18import Distribution.PackageDescription
16import Distribution.PackageDescription
19import qualified Distribution.PackageDescription as Cabal
17import qualified Distribution.PackageDescription as Cabal
18+import Distribution.PackageDescription.Parse as Cabal
20import Distribution.Text ( simpleParse, display )
19import Distribution.Text ( simpleParse, display )
20+import Distribution.Version
21−import OpenSSL.Digest ( digest, digestByName )
21+import OpenSSL.Digest ( digestString, digestByName )
22import System.Directory ( doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getHomeDirectory, getDirectoryContents )
22import System.Directory ( doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getHomeDirectory, getDirectoryContents )
23import System.Exit ( exitFailure )
23import System.Exit ( exitFailure )
24import System.FilePath ( (</>), (<.>) )
24import System.FilePath ( (</>), (<.>) )
@@ -30,42 +30,48 @@ data Package = Package
31 deriving (Show)
31 deriving (Show)
33−getPackage :: Maybe String -> Source -> IO Package
33+getPackage :: Maybe FilePath -> Source -> IO Package
34getPackage optHackageDB source = do
34getPackage optHackageDB source = do
35 (derivSource, pkgDesc) <- fetchOrFromDB optHackageDB source
35 (derivSource, pkgDesc) <- fetchOrFromDB optHackageDB source
36 flip Package pkgDesc <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
36 flip Package pkgDesc <$> maybe (sourceFromHackage (sourceHash source) (showPackageIdentifier pkgDesc) $ sourceCabalDir source) return derivSource
38−fetchOrFromDB :: Maybe String -> Source -> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
38+fetchOrFromDB :: Maybe FilePath -> Source -> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
39fetchOrFromDB optHackageDB src
39fetchOrFromDB 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
41 | otherwise = do
41 | otherwise = do
42 r <- fetch (\dir -> cabalFromPath (dir </> sourceCabalDir src)) src
42 r <- fetch (\dir -> cabalFromPath (dir </> sourceCabalDir src)) src
45− hPutStrLn stderr "*** failed to fetch source. Does the URL exist?" >> exitFailure
44+ Nothing -> fail "Failed to fetch source. Does the URL exist?"
46 Just (derivSource, (externalSource, pkgDesc)) -> do
45 Just (derivSource, (externalSource, pkgDesc)) -> do
47 return (derivSource <$ guard externalSource, pkgDesc)
46 return (derivSource <$ guard externalSource, pkgDesc)
49−fromDB :: Maybe String -> String -> IO Cabal.GenericPackageDescription
48+fromDB :: Maybe FilePath -> String -> IO (Maybe DerivationSource, Cabal.GenericPackageDescription)
50fromDB optHackageDB pkg = do
49fromDB optHackageDB pkg = do
51− pkgDesc <- (lookupVersion <=< DB.lookup name) <$> maybe DB.readHashedHackage DB.readHashedHackage' optHackageDB
50+ dbPath <- maybe DB.hackageTarball return optHackageDB
52− case pkgDesc of
51+ db <- DB.readTarball Nothing dbPath
53− Just r -> return r
52+ vd <- maybe unknownPackageError return (DB.lookup name db >>= lookupVersion)
54− Nothing -> hPutStrLn stderr "*** no such package in the cabal database (did you run cabal update?). " >> exitFailure
53+ let ds = case DB.tarballSha256 vd of
55+ Just hash -> Just (DerivationSource "url" url "" hash)
56+ return (ds, setCabalFileHash (DB.cabalFileSha256 vd) (DB.cabalFile vd))
56 pkgId :: Cabal.PackageIdentifier
58 pkgId :: Cabal.PackageIdentifier
57 pkgId = fromMaybe (error ("invalid Haskell package id " ++ show pkg)) (simpleParse pkg)
59 pkgId = fromMaybe (error ("invalid Haskell package id " ++ show pkg)) (simpleParse pkg)
58− name = Cabal.unPackageName (Cabal.packageName pkgId)
60+ name = Cabal.packageName pkgId
62+ unknownPackageError = fail "No such package in the cabal database. Did you run cabal update?"
64+ url = "mirror://hackage/" ++ display pkgId ++ ".tar.gz"
60− version :: [Int]
66+ version :: Version
61− version = Cabal.versionNumbers $ Cabal.packageVersion pkgId
67+ version = Cabal.packageVersion pkgId
63− lookupVersion :: DB.Map DB.Version Cabal.GenericPackageDescription -> Maybe Cabal.GenericPackageDescription
69+ lookupVersion :: DB.Map Version DB.VersionData -> Maybe DB.VersionData
64 -- No version is specified, pick latest one
70 -- No version is specified, pick latest one
65− lookupVersion m | [] <- version = fmap snd . listToMaybe $ DB.toDescList m
71+ lookupVersion m | version == nullVersion = fmap snd (listToMaybe (DB.toDescList m))
66− lookupVersion m = DB.lookup (DB.makeVersion version) m
72+ lookupVersion m = DB.lookup version m
68−readFileMay :: String -> IO (Maybe String)
74+readFileMay :: FilePath -> IO (Maybe String)
69readFileMay file = do
75readFileMay file = do
70 e <- doesFileExist file
76 e <- doesFileExist file
@@ -79,7 +85,7 @@ hashCachePath pid = do
79 createDirectoryIfMissing True cacheDir
85 createDirectoryIfMissing True cacheDir
80 return $ cacheDir </> pid <.> "sha256"
86 return $ cacheDir </> pid <.> "sha256"
82−sourceFromHackage :: Hash -> String -> String -> IO DerivationSource
88+sourceFromHackage :: Hash -> String -> FilePath -> IO DerivationSource
83sourceFromHackage optHash pkgId cabalDir = do
89sourceFromHackage optHash pkgId cabalDir = do
84 cacheFile <- hashCachePath pkgId
90 cacheFile <- hashCachePath pkgId
85 cachedHash <-
91 cachedHash <-
@@ -135,7 +141,7 @@ cabalFromDirectory dir = do
135 cabals <- liftIO $ getDirectoryContents dir >>= filterM doesFileExist . map (dir </>) . filter (".cabal" `isSuffixOf`)
141 cabals <- liftIO $ getDirectoryContents dir >>= filterM doesFileExist . map (dir </>) . filter (".cabal" `isSuffixOf`)
136 case cabals of
142 case cabals of
137 [cabalFile] -> cabalFromFile True cabalFile
143 [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.")
140handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
146handleIO :: (Exception.IOException -> IO a) -> IO a -> IO a
141handleIO = Exception.handle
147handleIO = Exception.handle
@@ -147,13 +153,16 @@ cabalFromFile failHard file =
147 -- wrap the whole block in `catchIO`, because of lazy IO. The `case` will force
153 -- wrap the whole block in `catchIO`, because of lazy IO. The `case` will force
148 -- the reading of the file, so we will always catch the expression here.
154 -- the reading of the file, so we will always catch the expression here.
149 MaybeT $ handleIO (\err -> Nothing <$ hPutStrLn stderr ("*** parsing cabal file: " ++ show err)) $ do
155 MaybeT $ handleIO (\err -> Nothing <$ hPutStrLn stderr ("*** parsing cabal file: " ++ show err)) $ do
150− buf <- LBS8.readFile file
156+ buf <- readFile file
151− let hash = printSHA256 (digest (digestByName "sha256") buf)
157+ let hash = printSHA256 (digestString (digestByName "sha256") buf)
152− case parsePackage' buf of
158+ case parseGenericPackageDescription buf of
153− Left msg -> if failHard
159+ ParseFailed perr -> if failHard
154− then fail ("*** cannot parse " ++ show file ++ ": " ++ msg)
160+ then fail ("cannot parse " ++ show file ++ ": " ++ show perr)
155− else return Nothing
161+ else return Nothing
162+ ParseOk _ pkg -> return $ Just $ setCabalFileHash hash pkg
164+setCabalFileHash :: String -> GenericPackageDescription -> GenericPackageDescription
156− Right pkg -> do return $ Just $ pkg { packageDescription = (packageDescription pkg) {
165+setCabalFileHash sha256 gpd = gpd { packageDescription = (packageDescription gpd) {
157− customFieldsPD = ("X-Cabal-File-Hash", hash) : customFieldsPD (packageDescription pkg)
166+ customFieldsPD = ("X-Cabal-File-Hash", sha256) : customFieldsPD (packageDescription gpd)