hackage-db 2.0.1 → 2.1.0

raw patch · 9 files changed

+180/−161 lines, 9 filesdep +exceptionsdep ~Cabaldep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: exceptions

Dependency ranges changed: Cabal, base

API changes (from Hackage documentation)

Files

• example/list-known-versions.hs +1/−1
• example/show-meta-data.hs +1/−1
• hackage-db.cabal +61/−85
• src/Distribution/Hackage/DB/Builder.hs +50/−0
• src/Distribution/Hackage/DB/MetaData.hs +0/−4
• src/Distribution/Hackage/DB/Parsed.hs +16/−12
• src/Distribution/Hackage/DB/Path.hs +1/−1
• src/Distribution/Hackage/DB/Unparsed.hs +32/−53
• src/Distribution/Hackage/DB/Utility.hs +18/−4

@@ -4,7 +4,7 @@ import Distribution.Hackage.DB.Unparsed  import Control.Monad-import qualified Data.ByteString.Lazy as BS+import qualified Data.ByteString as BS import Data.List as List import Data.Map as Map import Distribution.Text

@@ -5,7 +5,7 @@ import Distribution.Hackage.DB.Utility  import Control.Monad-import Data.ByteString.Lazy.UTF8 as BS+import Data.ByteString.UTF8 as BS import Data.Map as Map import Distribution.Package import System.Environment

@@ -1,106 +1,82 @@-name:                   hackage-db-version:                2.0.1-license:                BSD3-license-file:           LICENSE-author:                 Peter Simons, Alexander Altman, Ben James-maintainer:             Peter Simons <simons@cryp.to>-homepage:               https://github.com/peti/hackage-db#readme-bug-reports:            https://github.com/peti/hackage-db/issues-category:               Distribution-synopsis:               Access Hackage's package database via Data.Map-cabal-version:          >= 1.10-build-type:             Simple-tested-with:            GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3-                      , GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1--description:-  This is an early and mostly undocumented release of the 2.x version of-  hackage-db that's intended mostly for experimenting with and testing of the-  new API. Porting code from 1.x to 2.x is pretty simple, but if you do that at-  this point, please expect minor details of this API to change in forthcoming-  releases.-  .-  Check out https://github.com/peti/hackage-db/tree/master/example/ for a-  collection of simple example programs that demonstrate how to use this code.+name:          hackage-db+version:       2.1.0+synopsis:      Access cabal-install's Hackage database via Data.Map+description:   This library provides convenient access to the local copy of the Hackage+               database that \"cabal update\" creates. Check out+               https:\//github.com/peti/hackage-db/tree/master/example\/ for a collection+               of simple example programs that demonstrate how to use this code.+license:       BSD3+license-file:  LICENSE+author:        Peter Simons, Alexander Altman, Ben James+maintainer:    Peter Simons <simons@cryp.to>+tested-with:   GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.1+category:      Distribution+homepage:      https://github.com/peti/hackage-db#readme+bug-reports:   https://github.com/peti/hackage-db/issues+build-type:    Simple+cabal-version: >= 1.10  source-repository head-  type: git+  type:     git   location: git://github.com/peti/hackage-db.git  flag install-examples-  description:   Build and install example programs.-  default:       False+  default:     False+  description: Build and install example programs.  library-  hs-source-dirs:-      src-  other-extensions: DeriveDataTypeable DeriveGeneric-  build-depends:-      base >= 3 && < 5-    , Cabal >2.2-    , containers-    , aeson-    , bytestring-    , directory-    , filepath-    , tar >= 0.4-    , time-    , utf8-string-  exposed-modules:-      Distribution.Hackage.DB-      Distribution.Hackage.DB.Errors-      Distribution.Hackage.DB.MetaData-      Distribution.Hackage.DB.Parsed-      Distribution.Hackage.DB.Path-      Distribution.Hackage.DB.Unparsed-      Distribution.Hackage.DB.Utility-  other-modules:-      Paths_hackage_db+  exposed-modules:  Distribution.Hackage.DB+                    Distribution.Hackage.DB.Builder+                    Distribution.Hackage.DB.Errors+                    Distribution.Hackage.DB.MetaData+                    Distribution.Hackage.DB.Parsed+                    Distribution.Hackage.DB.Path+                    Distribution.Hackage.DB.Unparsed+                    Distribution.Hackage.DB.Utility+  other-modules:    Paths_hackage_db+  hs-source-dirs:   src+  build-depends:    base        >= 4.9 && < 5+                  , Cabal       > 3+                  , aeson+                  , bytestring+                  , containers+                  , directory+                  , exceptions+                  , filepath+                  , tar         >= 0.4+                  , time+                  , utf8-string   default-language: Haskell2010+  other-extensions: DeriveDataTypeable+                    DeriveGeneric  executable list-known-versions-  main-is:              list-known-versions.hs-  hs-source-dirs:       example+  main-is:          list-known-versions.hs+  hs-source-dirs:   example+  default-language: Haskell2010+   if flag(install-examples)-    buildable:          True-    build-depends:-        base >= 3 && < 5-      , Cabal-      , containers-      , hackage-db-      , bytestring+    build-depends: base >= 3 && < 5, Cabal, bytestring, containers, hackage-db   else-    buildable:          False-  default-language: Haskell2010+    buildable: False  executable show-meta-data-  main-is: show-meta-data.hs-  hs-source-dirs:-      example+  main-is:          show-meta-data.hs+  hs-source-dirs:   example+  default-language: Haskell2010+   if flag(install-examples)-    buildable:          True-    build-depends:-        base >= 3 && < 5-      , Cabal-      , containers-      , hackage-db-      , utf8-string+    build-depends: base >= 3 && < 5, Cabal, containers, hackage-db, utf8-string   else-    buildable:          False-  default-language: Haskell2010+    buildable: False  executable show-package-versions-  main-is: show-package-versions.hs-  hs-source-dirs:-      example+  main-is:          show-package-versions.hs+  hs-source-dirs:   example+  default-language: Haskell2010   other-extensions: CPP+   if flag(install-examples)-    buildable:          True-    build-depends:-        base >= 3 && < 5-      , Cabal-      , containers-      , hackage-db+    build-depends: base >= 3 && < 5, Cabal, containers, hackage-db   else-    buildable:          False-  default-language: Haskell2010+    buildable: False

@@ -0,0 +1,50 @@+{-# LANGUAGE BangPatterns #-}++{- |+   Maintainer:  simons@cryp.to+   Stability:   provisional+   Portability: portable+ -}++module Distribution.Hackage.DB.Builder+  ( readTarball, parseTarball+  , Builder(..)+  )+  where++import Distribution.Hackage.DB.Errors+import Distribution.Hackage.DB.Utility++import Codec.Archive.Tar as Tar+import Codec.Archive.Tar.Entry as Tar+import Control.Monad.Catch+import qualified Data.ByteString.Lazy as BSL+import Distribution.Types.PackageName+import Distribution.Types.Version+import System.FilePath++readTarball :: FilePath -> IO (Entries FormatError)+readTarball = fmap Tar.read . BSL.readFile++data Builder m a = Builder+  { insertPreferredVersions :: PackageName -> EpochTime -> BSL.ByteString -> a -> m a+  , insertCabalFile :: PackageName -> Version -> EpochTime -> BSL.ByteString -> a -> m a+  , insertMetaFile :: PackageName -> Version -> EpochTime -> BSL.ByteString -> a -> m a+  }++{-# INLINABLE parseTarball #-}+parseTarball :: MonadThrow m => Builder m a -> Maybe EpochTime -> Entries FormatError -> a -> m a+parseTarball b (Just et) (Next e es) !db = if entryTime e > et then return db else insertEntry b e db >>= parseTarball b (Just et) es+parseTarball b Nothing   (Next e es) !db = insertEntry b e db >>= parseTarball b Nothing es+parseTarball _ _         (Fail err)  _   = throwM err+parseTarball _ _         Done        !db = return db++{-# INLINABLE insertEntry #-}+insertEntry :: MonadThrow m => Builder m a -> Entry -> a -> m a+insertEntry b e db =+  case (splitDirectories (entryPath e), entryContent e) of+    ([pn,"preferred-versions"], NormalFile buf _) -> insertPreferredVersions b (mkPackageName pn) (entryTime e) buf db+    ([pn,v,file],               NormalFile buf _)+      | takeExtension file == ".cabal"            -> insertCabalFile b (mkPackageName pn) (parseText "Version" v) (entryTime e) buf db+      | takeExtension file == ".json"             -> insertMetaFile b (mkPackageName pn) (parseText "Version" v) (entryTime e) buf db+    _                                             -> throwM (UnsupportedTarEntry e)

@@ -30,10 +30,6 @@ -- >>> :set -XOverloadedStrings -- >>> parseMetaData "{\"signatures\":[],\"signed\":{\"_type\":\"Targets\",\"expires\":null,\"targets\":{\"<repo>/package/jailbreak-cabal-1.3.2.tar.gz\":{\"hashes\":{\"md5\":\"ba42b3e68323ccbeb3ac900cd68f9e90\",\"sha256\":\"212a8bbc3dfc748c4063282414a2726709d651322f3984c9989179d2352950f4\"},\"length\":2269}},\"version\":0}}" -- MetaData {signed = SignedMetaData {version = 0, expires = Nothing, _type = "Targets", targets = fromList [("<repo>/package/jailbreak-cabal-1.3.2.tar.gz",TargetData {length = 2269, hashes = fromList [("md5","ba42b3e68323ccbeb3ac900cd68f9e90"),("sha256","212a8bbc3dfc748c4063282414a2726709d651322f3984c9989179d2352950f4")]})]}, signatures = []}--- >>> parseMetaData "{}"--- *** Exception: InvalidMetaFile "Error in $: key \"signed\" not present"--- >>> parseMetaData ""--- *** Exception: InvalidMetaFile "Error in $: not enough input"  parseMetaData :: ByteString -> MetaData parseMetaData = either (throw . InvalidMetaFile) id . eitherDecode

@@ -13,9 +13,13 @@ import qualified Distribution.Hackage.DB.Unparsed as U import Distribution.Hackage.DB.Utility +import Codec.Archive.Tar+import Codec.Archive.Tar.Entry import Control.Exception-import Data.ByteString.Lazy as BS-import Data.ByteString.Lazy.UTF8 as BS+import Control.Monad.Catch+import Data.ByteString as BSS+import Data.ByteString.Lazy as BSL+import Data.ByteString.UTF8 as BSS import Data.Map as Map import Data.Maybe import Data.Time.Clock@@ -36,10 +40,10 @@   deriving (Show, Eq, Generic)  readTarball :: Maybe UTCTime -> FilePath -> IO HackageDB-readTarball snapshot path = fmap (parseTarball snapshot path) (BS.readFile path)+readTarball snapshot tarball = fmap parseDB (U.readTarball snapshot tarball) -parseTarball :: Maybe UTCTime -> FilePath -> ByteString -> HackageDB-parseTarball snapshot path buf = parseDB (U.parseTarball snapshot path buf)+parseTarball :: MonadThrow m => Maybe UTCTime -> Entries FormatError -> m HackageDB+parseTarball snapshot es = fmap parseDB (U.parseTarball snapshot es mempty)  parseDB :: U.HackageDB -> HackageDB parseDB = Map.mapWithKey parsePackageData@@ -50,8 +54,8 @@     Map.mapWithKey (parseVersionData pn) $       Map.filterWithKey (\v _ -> v `withinRange` vr) vs'   where-    Dependency _ vr | BS.null pv = Dependency pn anyVersion-                    | otherwise  = parseText "preferred version range" (toString pv)+    Dependency _ vr _ | BSS.null pv = Dependency pn anyVersion mempty+                      | otherwise  = parseText "preferred version range" (toString pv)  parseVersionData :: PackageName -> Version -> U.VersionData -> VersionData parseVersionData pn v (U.VersionData cf m) =@@ -59,12 +63,12 @@      VersionData gpd (parseMetaData pn v m)   where     gpd = fromMaybe (throw (InvalidCabalFile (show (pn,v)))) $-            parseGenericPackageDescriptionMaybe (toStrict cf)+            parseGenericPackageDescriptionMaybe cf -parseMetaData :: PackageName -> Version -> ByteString -> Map String String-parseMetaData pn v buf | BS.null buf = Map.empty-                       | otherwise   = maybe Map.empty U.hashes targetData+parseMetaData :: PackageName -> Version -> BSS.ByteString -> Map String String+parseMetaData pn v buf | BSS.null buf = Map.empty+                       | otherwise    = maybe Map.empty U.hashes targetData   where-    targets = U.targets (U.signed (U.parseMetaData buf))+    targets = U.targets (U.signed (U.parseMetaData (BSL.fromStrict buf)))     target  = "<repo>/package/" ++ display pn ++ "-" ++ display v ++ ".tar.gz"     targetData = Map.lookup target targets

@@ -38,7 +38,7 @@   let idx00 = htd </> "00-index.tar"       idx01 = htd </> "01-index.tar"   -- Using 'msum' here would be nice, but unfortunetaly there was no reliable-  -- MonadPlus instance for IO in pre 8.x versions of GHC. Se we use the ugly+  -- MonadPlus instance for IO in pre 8.x versions of GHC. So we use the ugly   -- code for sake of portability.   have01 <- doesFileExist idx01   if have01 then return idx01 else do

@@ -9,82 +9,61 @@ module Distribution.Hackage.DB.Unparsed   ( HackageDB, PackageData(..), VersionData(..)   , readTarball, parseTarball+  , builder   )   where -import Distribution.Hackage.DB.Errors+import qualified Distribution.Hackage.DB.Builder as Build+import Distribution.Hackage.DB.Builder ( Builder(..) ) import Distribution.Hackage.DB.Utility  import Codec.Archive.Tar as Tar import Codec.Archive.Tar.Entry as Tar import Control.Exception-import Data.ByteString.Lazy as BS ( ByteString, empty, readFile )-import Data.Map as Map+import Control.Monad.Catch+import Data.ByteString ( ByteString )+import Data.ByteString.Lazy ( toStrict )+import Data.Map.Strict as Map import Data.Time.Clock-import Distribution.Package-import Distribution.Version+import Distribution.Types.PackageName+import Distribution.Types.Version import GHC.Generics ( Generic ) import System.FilePath  type HackageDB = Map PackageName PackageData -data PackageData = PackageData { preferredVersions :: ByteString-                               , versions          :: Map Version VersionData+data PackageData = PackageData { preferredVersions :: !ByteString+                               , versions          :: !(Map Version VersionData)                                }   deriving (Show, Eq, Generic) -data VersionData = VersionData { cabalFile :: ByteString-                               , metaFile  :: ByteString+data VersionData = VersionData { cabalFile :: !ByteString+                               , metaFile  :: !ByteString                                }   deriving (Show, Eq, Generic)  readTarball :: Maybe UTCTime -> FilePath -> IO HackageDB-readTarball snapshot path = fmap (parseTarball snapshot path) (BS.readFile path)--parseTarball :: Maybe UTCTime -> FilePath -> ByteString -> HackageDB-parseTarball snapshot path buf =-  mapException (\e -> HackageDBTarball path (e :: SomeException)) $-    foldEntriesUntil (maybe maxBound toEpochTime snapshot) Map.empty (Tar.read buf)--foldEntriesUntil :: EpochTime -> HackageDB -> Entries FormatError -> HackageDB-foldEntriesUntil _        db  Done       = db-foldEntriesUntil _        _  (Fail err)  = throw (IncorrectTarfile err)-foldEntriesUntil snapshot db (Next e es) | entryTime e <= snapshot = foldEntriesUntil snapshot (handleEntry db e) es-                                         | otherwise               = db--handleEntry :: HackageDB -> Entry -> HackageDB-handleEntry db e =-  let (pn':ep) = splitDirectories (entryPath e)-      pn = parseText "PackageName" pn'-  in-  case (ep, entryContent e) of--    (["preferred-versions"], NormalFile buf _) -> insertWith setConstraint pn (PackageData buf Map.empty) db--    ([v',file], NormalFile buf _) -> let v = parseText "Version" v' in-          if file == pn' <.> "cabal" then insertVersionData setCabalFile pn v (VersionData buf BS.empty) db else-          if file == "package.json" then insertVersionData setMetaFile pn v (VersionData BS.empty buf) db else-          throw (UnsupportedTarEntry e)--    (_, Directory) -> db                -- some tarballs have these superfluous entries-    ([], NormalFile {}) -> db-    ([], OtherEntryType {}) -> db+readTarball snapshot tarball = Build.readTarball tarball >>= \es -> parseTarball snapshot es mempty -    _ -> throw (UnsupportedTarEntry e)+parseTarball :: MonadThrow m => Maybe UTCTime -> Entries FormatError -> HackageDB -> m HackageDB+parseTarball = Build.parseTarball builder . fmap toEpochTime -setConstraint :: PackageData -> PackageData -> PackageData-setConstraint new old = old { preferredVersions = preferredVersions new }+builder :: Applicative m => Builder m HackageDB+builder = Builder+  { insertPreferredVersions = \pn _ buf   -> let new     = PackageData (toStrict buf) mempty+                                                 f _ old = old { preferredVersions = preferredVersions new }+                                             in pure . Map.insertWith f pn new -insertVersionData :: (VersionData -> VersionData -> VersionData)-                   -> PackageName -> Version -> VersionData-                   -> HackageDB -> HackageDB-insertVersionData setFile pn v vd = insertWith mergeVersionData pn pd-  where-    pd = PackageData BS.empty (Map.singleton v vd)-    mergeVersionData _ old = old { versions = insertWith setFile v vd (versions old) }+  , insertCabalFile         = \pn v _ buf -> let f Nothing   = PackageData mempty (Map.singleton v new)+                                                 f (Just pd) = pd { versions = Map.insertWith g v new (versions pd) }+                                                 new         = VersionData (toStrict buf) mempty+                                                 g _ old     = old { cabalFile = cabalFile new }+                                             in pure . Map.alter (Just . f) pn -setCabalFile :: VersionData -> VersionData -> VersionData-setCabalFile new old = old { cabalFile = cabalFile new }+  , insertMetaFile          = \pn v _ buf -> let f Nothing   = PackageData mempty (Map.singleton v new)+                                                 f (Just pd) = pd { versions = Map.insertWith g v new (versions pd) } -setMetaFile :: VersionData -> VersionData -> VersionData-setMetaFile new old = old { metaFile = metaFile new }+                                                 new         = VersionData mempty (toStrict buf)+                                                 g _ old     = old { metaFile = metaFile new }+                                             in pure . Map.alter (Just . f) pn+  }

@@ -8,15 +8,17 @@  import Distribution.Hackage.DB.Errors -import Control.Exception import Codec.Archive.Tar.Entry as Tar+import Control.Exception+import Control.Monad.Fail import Data.Maybe import Data.Time.Clock import Data.Time.Clock.POSIX-import Distribution.Text+import Data.Time.Format+import Distribution.Parsec -parseText :: Text a => String -> String -> a-parseText t x = fromMaybe (throw (InvalidRepresentationOfType t x)) (simpleParse x)+parseText :: Parsec a => String -> String -> a+parseText t x = fromMaybe (throw (InvalidRepresentationOfType t x)) (simpleParsec x)  -- | Convert the the 'EpochTime' used by the @tar@ library into a standard -- 'UTCTime' type.@@ -29,3 +31,15 @@  toEpochTime :: UTCTime -> EpochTime toEpochTime = floor . utcTimeToPOSIXSeconds++-- | Parse an UTC timestamp in extended ISO8601 format a standard 'UTCTime'+-- type. This function is useful to parse the "snapshot" identifier printed by+-- @cabal-install@ after a database update into a useable type. Combine with+-- 'toEpochTime' to obtain an 'EpochTime' that can be passed to the Hackage DB+-- reading code from this library.+--+-- >>> parseIso8601 "2018-12-21T13:17:40Z"+-- 2018-12-21 13:17:40 UTC++parseIso8601 :: MonadFail m => String -> m UTCTime+parseIso8601 = parseTimeM False defaultTimeLocale (iso8601DateFormat (Just "%H:%M:%SZ"))