@@ -3,8 +3,9 @@ module AllCabalHashes where
33import Control.Lens hiding ((<.>))
44import Data.Aeson as A
55import Data.ByteString as BS
6−import Data.ByteString.Lazy as BSL
6+import Data.ByteString.Char8 as B8
77import Data.Map as M
8+import Data.Tagged (Tagged(..))
89import Data.Text as T
910import Distribution.Nixpkgs.Hashes as NH
1011import Distribution.Package
@@ -40,28 +41,34 @@ readPackageByHash repoDir sha1Hash = do
4041 let repoOpts = defaultRepositoryOptions { repoPath = repoDir }
4142 repo <- openLgRepository repoOpts
4243 buf <- runLgRepository repo $ do
43− BlobObj (Blob _ contents) <- lookupObject =<< parseOid sha1Hash
44− case contents of
45− BlobString bs -> return bs
46− BlobStringLazy bsl -> return $ BSL.toStrict bsl
47− _ -> fail $ "Git SHA1 " ++ show sha1Hash ++ ": expected single Blob"
48− cabal <- let (_, res) = runParseResult (parseGenericPackageDescription buf)
49− in case res of Right a -> return a
50− Left (_, err) -> fail ("Git SHA1 " ++ show sha1Hash ++ ": " ++ show err)
51− let
52− hash = printSHA256 (digest (digestByName "sha256") buf)
53− pkg = setCabalFileHash hash cabal
54− return (pkg, hash)
44+ oid <- parseOid sha1Hash
45+ catBlob (Tagged oid)
46+ parseCabal ("Git SHA1 " ++ show sha1Hash) buf
5547
5648readPackageByName :: FilePath -> PackageIdentifier -> IO (GenericPackageDescription, SHA256Hash)
5749readPackageByName repoDir (PackageIdentifier name version) = do
58− let cabalFile = repoDir </> unPackageName name </> display version </> unPackageName name <.> "cabal"
59− buf <- BS.readFile cabalFile
60− cabal <- let (_, res) = runParseResult (parseGenericPackageDescription buf)
50+ let cabalFile = unPackageName name </> display version </> unPackageName name <.> "cabal"
51+ let repoOpts = defaultRepositoryOptions { repoPath = repoDir }
52+ repo <- openLgRepository repoOpts
53+ buf <- runLgRepository repo $ do
54+ headCommit <- resolveReference "HEAD" >>= \case
55+ Nothing -> fail "Failed to parse HEAD ref"
56+ Just oid -> lookupCommit $ Tagged oid
57+ blobOid <- commitTreeEntry headCommit (B8.pack cabalFile) >>= \case
58+ Nothing -> fail (cabalFile ++ ": no such file at HEAD")
59+ Just (BlobEntry oid PlainBlob) -> pure oid
60+ Just (BlobEntry _ _) -> fail (cabalFile ++ " is not a plain blob")
61+ _ -> fail (cabalFile ++ " points to a non-blob!")
62+ catBlob blobOid
63+ parseCabal cabalFile buf
64+
65+parseCabal :: String -> BS.ByteString -> IO (GenericPackageDescription, SHA256Hash)
66+parseCabal what blob = do
67+ cabal <- let (_, res) = runParseResult (parseGenericPackageDescription blob)
6168 in case res of Right a -> return a
62− Left (_, err) -> fail (cabalFile ++ ": " ++ show err)
69+ Left (_, err) -> fail (what ++ ": " ++ show err)
6370 let
64− hash = NH.printSHA256 (SSL.digest (SSL.digestByName "sha256") buf)
71+ hash = NH.printSHA256 (SSL.digest (SSL.digestByName "sha256") blob)
6572 pkg = setCabalFileHash hash cabal
6673 return (pkg, hash)
6774