HackageGit.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module HackageGit
  ( Hackage, readHackage, readPackage, readPackageMeta
  , SHA256Hash, hashes
  )
  where

import Control.Lens hiding ( (<.>) )
import Control.Monad
import Data.Aeson
import qualified Data.ByteString.Char8 as BS
import Data.Map as Map
import Data.Set as Set
import Data.String
import Distribution.Nixpkgs.Hashes
import Distribution.Nixpkgs.Haskell.OrphanInstances ( )
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Parsec ( parseGenericPackageDescriptionMaybe )
import Distribution.Text
import Distribution.Version
import OpenSSL.Digest ( digest, digestByName )
import System.Directory
import System.FilePath

type Hackage = Map PackageName (Set Version)

readHackage :: FilePath -> IO Hackage
readHackage path = getSubDirs path >>= foldM discoverPackageVersions mempty
  where
    discoverPackageVersions :: Hackage -> String -> IO Hackage
    discoverPackageVersions db pkg = do
      vs <- getSubDirs (path </> pkg)
      return (Map.insert (mkPackageName pkg) (Set.fromList (Prelude.map fromString vs)) db)

getSubDirs :: FilePath -> IO [FilePath]
getSubDirs path = do
  let isDirectory p = doesDirectoryExist (path </> p)
  getDirectoryContents path >>= filterM isDirectory . Prelude.filter (\x -> head x /= '.')

type SHA256Hash = String

readPackage :: FilePath -> PackageIdentifier -> IO (GenericPackageDescription, SHA256Hash)
readPackage dirPrefix (PackageIdentifier name version) = do
  let cabalFile = dirPrefix </> unPackageName name </> display version </> unPackageName name <.> "cabal"
  buf <- BS.readFile cabalFile
  cabal <- case parseGenericPackageDescriptionMaybe buf of
             Just a  -> return a
             Nothing -> fail ("cannot parse cabal file " ++ cabalFile)
  return (cabal, printSHA256 (digest (digestByName "sha256") buf))

declareLenses [d|
  data Meta = Meta { hashes :: Map String String
                   }
    deriving (Show)
  |]

instance FromJSON Meta where
  parseJSON (Object v) = Meta
                         <$> v .: "package-hashes"
  parseJSON o          = fail ("invalid Cabal metadata: " ++ show o)

readPackageMeta :: FilePath -> PackageIdentifier -> IO Meta
readPackageMeta dirPrefix (PackageIdentifier name version) = do
  let metaFile = dirPrefix </> unPackageName name </> display version </> unPackageName name <.> "json"
  buf <- BS.readFile metaFile
  case eitherDecodeStrict buf of
    Left msg -> fail (metaFile ++ ": " ++ msg)
    Right x  -> return $ over (hashes . ix "SHA256") (printSHA256 . packHex) x