@@ -3,8 +3,9 @@ module AllCabalHashes where
3import Control.Lens hiding ((<.>))
3import Control.Lens hiding ((<.>))
4import Data.Aeson as A
4import Data.Aeson as A
5import Data.ByteString as BS
5import Data.ByteString as BS
6−import Data.ByteString.Lazy as BSL
6+import Data.ByteString.Char8 as B8
7import Data.Map as M
7import Data.Map as M
8+import Data.Tagged (Tagged(..))
8import Data.Text as T
9import Data.Text as T
9import Distribution.Nixpkgs.Hashes as NH
10import Distribution.Nixpkgs.Hashes as NH
10import Distribution.Package
11import Distribution.Package
@@ -40,28 +41,34 @@ readPackageByHash repoDir sha1Hash = do
40 let repoOpts = defaultRepositoryOptions { repoPath = repoDir }
41 let repoOpts = defaultRepositoryOptions { repoPath = repoDir }
41 repo <- openLgRepository repoOpts
42 repo <- openLgRepository repoOpts
42 buf <- runLgRepository repo $ do
43 buf <- runLgRepository repo $ do
43− BlobObj (Blob _ contents) <- lookupObject =<< parseOid sha1Hash
44+ oid <- parseOid sha1Hash
44− case contents of
45+ catBlob (Tagged oid)
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)
46+ parseCabal ("Git SHA1 " ++ show sha1Hash) buf
52− hash = printSHA256 (digest (digestByName "sha256") buf)
53− pkg = setCabalFileHash hash cabal
56readPackageByName :: FilePath -> PackageIdentifier -> IO (GenericPackageDescription, SHA256Hash)
48readPackageByName :: FilePath -> PackageIdentifier -> IO (GenericPackageDescription, SHA256Hash)
57readPackageByName repoDir (PackageIdentifier name version) = do
49readPackageByName repoDir (PackageIdentifier name version) = do
58− let cabalFile = repoDir </> unPackageName name </> display version </> unPackageName name <.> "cabal"
50+ let cabalFile = unPackageName name </> display version </> unPackageName name <.> "cabal"
59− buf <- BS.readFile cabalFile
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!")
63+ parseCabal cabalFile buf
65+parseCabal :: String -> BS.ByteString -> IO (GenericPackageDescription, SHA256Hash)
66+parseCabal what blob = do
60− cabal <- let (_, res) = runParseResult (parseGenericPackageDescription buf)
67+ cabal <- let (_, res) = runParseResult (parseGenericPackageDescription blob)
61 in case res of Right a -> return a
68 in case res of Right a -> return a
62− Left (_, err) -> fail (cabalFile ++ ": " ++ show err)
69+ Left (_, err) -> fail (what ++ ": " ++ show err)
64− hash = NH.printSHA256 (SSL.digest (SSL.digestByName "sha256") buf)
71+ hash = NH.printSHA256 (SSL.digest (SSL.digestByName "sha256") blob)
65 pkg = setCabalFileHash hash cabal
72 pkg = setCabalFileHash hash cabal
66 return (pkg, hash)
73 return (pkg, hash)