git.iko.soy/typeable/stackage2nix
on master help sign in
typeable/stackage2nix/src/AllCabalHashes.hs
88 lines 3.4 kB history raw
1module AllCabalHashes where
3import Control.Lens hiding ((<.>))
4import Data.Aeson as A
5import Data.ByteString as BS
6import Data.ByteString.Char8 as B8
7import Data.Map as M
8import Data.Tagged (Tagged(..))
9import Data.Text as T
10import Distribution.Nixpkgs.Hashes as NH
11import Distribution.Package
12import Distribution.PackageDescription
13import Distribution.PackageDescription.Parsec
14import Distribution.Text ( display )
15import Git
16import Git.Libgit2 as Libgit2
17import OpenSSL.Digest as SSL ( digest, digestByName )
18import System.FilePath
21type SHA1Hash = T.Text
22type SHA256Hash = String
24data Meta = Meta
25 { _mHashes :: !(Map String String)
26 , _mLocations :: ![String]
27 , _mPkgsize :: !Int
28 } deriving (Show)
30makeLenses ''Meta
32instance FromJSON Meta where
33 parseJSON (Object v) = Meta
34 <$> v .: "package-hashes"
35 <*> v .: "package-locations"
36 <*> v .: "package-size"
37 parseJSON o = fail ("invalid Cabal metadata: " ++ show o)
39readPackageByHash :: FilePath -> SHA1Hash -> IO (GenericPackageDescription, SHA256Hash)
40readPackageByHash repoDir sha1Hash = do
41 let repoOpts = defaultRepositoryOptions { repoPath = repoDir }
42 repo <- openLgRepository repoOpts
43 buf <- runLgRepository repo $ do
44 oid <- parseOid sha1Hash
45 catBlob (Tagged oid)
46 parseCabal ("Git SHA1 " ++ show sha1Hash) buf
48readPackageByName :: FilePath -> PackageIdentifier -> IO (GenericPackageDescription, SHA256Hash)
49readPackageByName repoDir (PackageIdentifier name version) = do
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
65parseCabal :: String -> BS.ByteString -> IO (GenericPackageDescription, SHA256Hash)
66parseCabal what blob = do
67 cabal <- let (_, res) = runParseResult (parseGenericPackageDescription blob)
68 in case res of Right a -> return a
69 Left (_, err) -> fail (what ++ ": " ++ show err)
70 let
71 hash = NH.printSHA256 (SSL.digest (SSL.digestByName "sha256") blob)
72 pkg = setCabalFileHash hash cabal
73 return (pkg, hash)
75setCabalFileHash :: SHA256Hash -> GenericPackageDescription -> GenericPackageDescription
76setCabalFileHash hash cabal = cabal
77 { packageDescription = (packageDescription cabal)
78 { customFieldsPD = ("X-Cabal-File-Hash", hash) : customFieldsPD (packageDescription cabal)
79 }
80 }
82readPackageMeta :: FilePath -> PackageIdentifier -> IO Meta
83readPackageMeta dirPrefix (PackageIdentifier name version) = do
84 let metaFile = dirPrefix </> unPackageName name </> display version </> unPackageName name <.> "json"
85 buf <- BS.readFile metaFile
86 case eitherDecodeStrict buf of
87 Left msg -> fail (metaFile ++ ": " ++ msg)
88 Right x -> return $ over (mHashes . ix "SHA256") (printSHA256 . packHex) x