Include readme

Distribution/Server/Features.hs

@@ -165,11 +165,11 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
     packageContentsFeature <- mkPackageContentsFeature
                                 coreFeature
                                 tarIndexCacheFeature
+                                usersFeature
 
     packagesFeature <- mkRecentPackagesFeature
                          usersFeature
                          coreFeature
-                         packageContentsFeature
 
     userDetailsFeature <- mkUserDetailsFeature
                             usersFeature
@@ -250,7 +250,7 @@ initHackageFeatures env@ServerEnv{serverVerbosity = verbosity} = do
     htmlFeature     <- mkHtmlFeature
                          usersFeature
                          coreFeature
-                         packagesFeature
+                         packageContentsFeature
                          uploadFeature
                          candidatesFeature
                          versionsFeature

Distribution/Server/Features/Html.hs

@@ -9,7 +9,6 @@ import qualified Distribution.Server.Framework.ResponseContentTypes as Resource
 import Distribution.Server.Framework.Templating
 
 import Distribution.Server.Features.Core
-import Distribution.Server.Features.RecentPackages
 import Distribution.Server.Features.Upload
 import Distribution.Server.Features.BuildReports
 import Distribution.Server.Features.BuildReports.Render
@@ -20,6 +19,7 @@ import Distribution.Server.Features.Search
 import Distribution.Server.Features.Search as Search
 import Distribution.Server.Features.PreferredVersions
 -- [reverse index disabled] import Distribution.Server.Features.ReverseDependencies
+import Distribution.Server.Features.PackageContents (PackageContentsFeature(..))
 import Distribution.Server.Features.PackageList
 import Distribution.Server.Features.Tags
 import Distribution.Server.Features.Mirror
@@ -97,7 +97,7 @@ instance IsHackageFeature HtmlFeature where
 initHtmlFeature :: ServerEnv
                 -> IO (UserFeature
                     -> CoreFeature
-                    -> RecentPackagesFeature
+                    -> PackageContentsFeature
                     -> UploadFeature -> PackageCandidatesFeature
                     -> VersionsFeature
                     -- [reverse index disabled] -> ReverseFeature
@@ -176,7 +176,7 @@ initHtmlFeature ServerEnv{serverTemplatesDir, serverTemplatesMode,
 
 htmlFeature :: UserFeature
             -> CoreFeature
-            -> RecentPackagesFeature
+            -> PackageContentsFeature
             -> UploadFeature
             -> PackageCandidatesFeature
             -> VersionsFeature
@@ -199,7 +199,7 @@ htmlFeature :: UserFeature
 
 htmlFeature user
             core@CoreFeature{queryGetPackageIndex}
-            recent upload
+            packages upload
             candidates versions
             -- [reverse index disabled] ReverseFeature{..}
             tags download
@@ -243,7 +243,7 @@ htmlFeature user
                                       reportsCore
                                       download
                                       distros
-                                      recent
+                                      packages
                                       htmlTags
                                       htmlPreferred
                                       cachePackagesPage
@@ -433,7 +433,7 @@ mkHtmlCore :: HtmlUtilities
            -> ReportsFeature
            -> DownloadFeature
            -> DistroFeature
-           -> RecentPackagesFeature
+           -> PackageContentsFeature
            -> HtmlTags
            -> HtmlPreferred
            -> AsyncCache Response
@@ -455,7 +455,7 @@ mkHtmlCore HtmlUtilities{..}
            reportsFeature
            DownloadFeature{recentPackageDownloads,totalPackageDownloads}
            DistroFeature{queryPackageStatus}
-           RecentPackagesFeature{packageRender}
+           PackageContentsFeature{packageRender}
            HtmlTags{..}
            HtmlPreferred{..}
            cachePackagesPage

Distribution/Server/Features/PackageCandidates.hs

@@ -22,6 +22,7 @@ import Distribution.Server.Features.TarIndexCache
 import Distribution.Server.Packages.Types
 import Distribution.Server.Packages.Render
 import Distribution.Server.Packages.ChangeLog
+import Distribution.Server.Packages.Readme
 import qualified Distribution.Server.Users.Types as Users
 import qualified Distribution.Server.Users.Group as Group
 import qualified Distribution.Server.Framework.BlobStorage as BlobStorage
@@ -30,7 +31,6 @@ import Distribution.Server.Packages.PackageIndex (PackageIndex)
 import qualified Distribution.Server.Framework.ResponseContentTypes as Resource
 
 import Distribution.Server.Util.ServeTarball (serveTarEntry, serveTarball)
-import qualified Data.TarIndex as TarIndex
 
 import Distribution.Text
 import Distribution.Package
@@ -39,10 +39,8 @@ import Data.Version
 import Data.Function (fix)
 import Data.List (find)
 import Data.Time.Clock (getCurrentTime)
-import Control.Monad.Error (ErrorT(..))
 import qualified Data.Vector as Vec
 
-
 data PackageCandidatesFeature = PackageCandidatesFeature {
     candidatesFeatureInterface :: HackageFeature,
     candidatesCoreResource     :: CoreResource,
@@ -159,7 +157,7 @@ candidatesFeature ServerEnv{serverBlobStore = store}
                              , updateAddPackage
                              }
                   UploadFeature{..}
-                  TarIndexCacheFeature{cachedPackageTarIndex}
+                  TarIndexCacheFeature{packageTarball, findToplevelFile}
                   candidatesState
   = PackageCandidatesFeature{..}
   where
@@ -373,11 +371,18 @@ candidatesFeature ServerEnv{serverBlobStore = store}
     candidateRender cand = do
            users  <- queryGetUserDb
            index  <- queryGetPackageIndex
-           mChangeLog <- packageChangeLog (candPkgInfo cand)
-           let showChangeLogLink = case mChangeLog of Right _ -> True ; _ -> False
-           render <- doPackageRender users (candPkgInfo cand) showChangeLogLink
+           let pkg = candPkgInfo cand
+           mChangeLog <- findToplevelFile pkg isChangeLogFile
+           mReadme    <- findToplevelFile pkg isReadmeFile
+           let changeLog = case mChangeLog of Right (_,_,_,fname,contents) -> Just (fname, contents)
+                                              _                            -> Nothing
+               readme    = case mReadme    of Right (_,_,_,fname,contents) -> Just (fname, contents)
+                                              _                            -> Nothing
+               render = doPackageRender users pkg
            return $ CandidateRender {
-             candPackageRender = render { rendPkgUri = rendPkgUri render ++ "/candidate" },
+             candPackageRender = render { rendPkgUri = rendPkgUri render ++ "/candidate"
+                                        , rendChangeLog = changeLog
+                                        , rendReadme = readme},
              renderWarnings = candWarnings cand,
              hasIndexedPackage = not . null $ PackageIndex.lookupPackageName index (packageName cand)
            }
@@ -415,13 +420,13 @@ candidatesFeature ServerEnv{serverBlobStore = store}
     serveChangeLog :: DynamicPath -> ServerPartE Response
     serveChangeLog dpath = do
       pkg        <- packageInPath dpath >>= lookupCandidateId
-      mChangeLog <- liftIO $ packageChangeLog (candPkgInfo pkg)
+      mChangeLog <- liftIO $ findToplevelFile (candPkgInfo pkg) isChangeLogFile
       case mChangeLog of
         Left err ->
           errNotFound "Changelog not found" [MText err]
-        Right (fp, etag, offset, name) -> do
+        Right (fp, etag, offset, name, _contents) -> do
           cacheControl [Public, maxAgeMinutes 5] etag
-          liftIO $ serveTarEntry fp offset name
+          liftIO $ serveTarEntry fp offset name -- TODO: We've already loaded the contents; refactor
 
     -- return: not-found error or tarball
     serveContents :: DynamicPath -> ServerPartE Response
@@ -435,20 +440,3 @@ candidatesFeature ServerEnv{serverBlobStore = store}
           serveTarball (display (packageId pkg) ++ " candidate source tarball")
                        ["index.html"] (display (packageId pkg)) fp index
                        [Public, maxAgeMinutes 5] etag
-
-    packageTarball :: PkgInfo -> IO (Either String (FilePath, ETag, TarIndex.TarIndex))
-    packageTarball pkginfo
-      | Just (pkgTarball, _uploadinfo) <- pkgLatestTarball pkginfo = do
-          let blobid = pkgTarballNoGz pkgTarball
-              fp     = BlobStorage.filepath store blobid
-              etag   = BlobStorage.blobETag blobid
-          index <- cachedPackageTarIndex pkgTarball
-          return $ Right (fp, etag, index)
-      | otherwise = return $ Left "No tarball found"
-
-    packageChangeLog :: PkgInfo -> IO (Either String (FilePath, ETag, TarIndex.TarEntryOffset, FilePath))
-    packageChangeLog pkgInfo = runErrorT $ do
-      (fp, etag, index) <- ErrorT $ packageTarball pkgInfo
-      (offset, fname)   <- ErrorT $ return . maybe (Left "No changelog found") Right
-                                  $ findChangeLog pkgInfo index
-      return (fp, etag, offset, fname)

Distribution/Server/Features/PackageContents.hs

@@ -6,28 +6,29 @@ module Distribution.Server.Features.PackageContents (
   ) where
 
 import Distribution.Server.Framework
-import qualified Distribution.Server.Framework.BlobStorage as BlobStorage
 
 import Distribution.Server.Features.Core
 import Distribution.Server.Features.TarIndexCache
 
-import Distribution.Server.Packages.Types
 import Distribution.Server.Packages.ChangeLog
+import Distribution.Server.Packages.Readme
+import Distribution.Server.Packages.Types
+import Distribution.Server.Packages.Render
+import Distribution.Server.Features.Users
 import Distribution.Server.Util.ServeTarball (serveTarEntry, serveTarball)
-import qualified Data.TarIndex as TarIndex
+
 
 import Distribution.Text
 import Distribution.Package
 
-import Control.Monad.Error (ErrorT(..))
 
 data PackageContentsFeature = PackageContentsFeature {
     packageFeatureInterface :: HackageFeature,
     packageContentsResource :: PackageContentsResource,
 
-    -- Functionality exported to other features
-    packageTarball   :: PkgInfo -> IO (Either String (FilePath, ETag, TarIndex.TarIndex)),
-    packageChangeLog :: PkgInfo -> IO (Either String (FilePath, ETag, TarIndex.TarEntryOffset, FilePath))
+    -- necessary information for the representation of a package resource
+    -- This needs to be here in order to extract from the tar file
+    packageRender :: PkgInfo -> IO PackageRender
 }
 
 instance IsHackageFeature PackageContentsFeature where
@@ -42,25 +43,26 @@ data PackageContentsResource = PackageContentsResource {
 initPackageContentsFeature :: ServerEnv
                            -> IO (CoreFeature
                                -> TarIndexCacheFeature
+                               -> UserFeature
                                -> IO PackageContentsFeature)
-initPackageContentsFeature env@ServerEnv{} = do
-    return $ \core tarIndexCache -> do
-      let feature = packageContentsFeature env core tarIndexCache
+initPackageContentsFeature _ = do
+    return $ \core tarIndexCache user -> do
+      let feature = packageContentsFeature core tarIndexCache user
 
       return feature
 
-packageContentsFeature :: ServerEnv
-                       -> CoreFeature
+packageContentsFeature :: CoreFeature
                        -> TarIndexCacheFeature
+                       -> UserFeature
                        -> PackageContentsFeature
 
-packageContentsFeature ServerEnv{serverBlobStore = store}
-                       CoreFeature{ coreResource = CoreResource{
+packageContentsFeature CoreFeature{ coreResource = CoreResource{
                                       packageInPath
                                     , lookupPackageId
                                     }
                                   }
-                       TarIndexCacheFeature{cachedPackageTarIndex}
+                       TarIndexCacheFeature{packageTarball, findToplevelFile}
+                       UserFeature{queryGetUserDb}
   = PackageContentsFeature{..}
   where
     packageFeatureInterface = (emptyHackageFeature "package-contents") {
@@ -83,6 +85,18 @@ packageContentsFeature ServerEnv{serverBlobStore = store}
         , packageContentsChangeLogUri = \pkgid ->
             renderResource (packageContentsChangeLog packageContentsResource) [display pkgid, display (packageName pkgid)]
         }
+
+    packageRender :: PkgInfo -> IO PackageRender
+    packageRender pkg = do
+      users <- queryGetUserDb
+      mChangeLog <- findToplevelFile pkg isChangeLogFile
+      mReadme <- findToplevelFile pkg isReadmeFile
+      let changeLog = case mChangeLog of Right (_,_,_,fname,contents) -> Just (fname, contents) 
+                                         _                            -> Nothing
+          readme    = case mReadme    of Right (_,_,_,fname,contents) -> Just (fname, contents) 
+                                         _                            -> Nothing
+          render = doPackageRender users pkg
+      return $ render { rendChangeLog = changeLog, rendReadme = readme }
 
 {-------------------------------------------------------------------------------
   TODO: everything below is duplicated in PackageCandidates.
@@ -92,13 +106,15 @@ packageContentsFeature ServerEnv{serverBlobStore = store}
     serveChangeLog :: DynamicPath -> ServerPartE Response
     serveChangeLog dpath = do
       pkg        <- packageInPath dpath >>= lookupPackageId
-      mChangeLog <- liftIO $ packageChangeLog pkg
+      mChangeLog <- liftIO $ findToplevelFile pkg isChangeLogFile
       case mChangeLog of
         Left err ->
           errNotFound "Changelog not found" [MText err]
-        Right (fp, etag, offset, name) -> do
+        Right (fp, etag, offset, name, _contents) -> do
           cacheControl [Public, maxAgeDays 30] etag
-          liftIO $ serveTarEntry fp offset name
+          liftIO $ serveTarEntry fp offset name  -- TODO: We've already loaded the contents
+                                                 -- we do repeated work here by re-seeking in the tar.
+                                                 -- This should be refactored; same thing in PackageCandidates
 
     -- return: not-found error or tarball
     serveContents :: DynamicPath -> ServerPartE Response
@@ -112,20 +128,3 @@ packageContentsFeature ServerEnv{serverBlobStore = store}
           serveTarball (display (packageId pkg) ++ " source tarball")
                        ["index.html"] (display (packageId pkg)) fp index
                        [Public, maxAgeDays 30] etag
-
-    packageTarball :: PkgInfo -> IO (Either String (FilePath, ETag, TarIndex.TarIndex))
-    packageTarball pkginfo
-      | Just (pkgTarball, _uploadinfo) <- pkgLatestTarball pkginfo = do
-          let blobid = pkgTarballNoGz pkgTarball
-              fp     = BlobStorage.filepath store blobid
-              etag   = BlobStorage.blobETag blobid
-          index <- cachedPackageTarIndex pkgTarball
-          return $ Right (fp, etag, index)
-      | otherwise = return $ Left "No tarball found"
-
-    packageChangeLog :: PkgInfo -> IO (Either String (FilePath, ETag, TarIndex.TarEntryOffset, FilePath))
-    packageChangeLog pkgInfo = runErrorT $ do
-      (fp, etag, index) <- ErrorT $ packageTarball pkgInfo
-      (offset, fname)   <- ErrorT $ return . maybe (Left "No changelog found") Right
-                                  $ findChangeLog pkgInfo index
-      return (fp, etag, offset, fname)

Distribution/Server/Features/RecentPackages.hs

@@ -9,10 +9,8 @@ import Distribution.Server.Framework
 
 import Distribution.Server.Features.Core
 import Distribution.Server.Features.Users
-import Distribution.Server.Features.PackageContents (PackageContentsFeature(..))
 
 import Distribution.Server.Packages.Types
-import Distribution.Server.Packages.Render
 
 import qualified Distribution.Server.Packages.PackageIndex as PackageIndex
 import qualified Distribution.Server.Framework.ResponseContentTypes as Resource
@@ -26,10 +24,8 @@ import qualified Distribution.Server.Pages.Recent as Pages
 
 data RecentPackagesFeature = RecentPackagesFeature {
     recentPackagesFeatureInterface :: HackageFeature,
-    recentPackagesResource :: RecentPackagesResource,
+    recentPackagesResource :: RecentPackagesResource
 
-    -- necessary information for the representation of a package resource
-    packageRender :: PkgInfo -> IO PackageRender
     -- other informational hooks: perhaps a simplified CondTree so a browser script can dynamically change the package page based on flags
 }
 
@@ -45,15 +41,14 @@ data RecentPackagesResource = RecentPackagesResource {
 initRecentPackagesFeature :: ServerEnv
                           -> IO (UserFeature
                               -> CoreFeature
-                              -> PackageContentsFeature
                               -> IO RecentPackagesFeature)
 initRecentPackagesFeature env@ServerEnv{serverCacheDelay, serverVerbosity = verbosity} = do
-    return $ \user core@CoreFeature{packageChangeHook} packageContents -> do
+    return $ \user core@CoreFeature{packageChangeHook} -> do
 
       -- recent caches. in lieu of an ActionLog
       -- TODO: perhaps a hook, recentUpdated :: HookList ([PkgInfo] -> IO ())
       rec let (feature, updateRecentCache) =
-                recentPackagesFeature env user core packageContents
+                recentPackagesFeature env user core
                                       cacheRecent
 
           cacheRecent <- newAsyncCacheNF updateRecentCache
@@ -73,14 +68,12 @@ initRecentPackagesFeature env@ServerEnv{serverCacheDelay, serverVerbosity = verb
 recentPackagesFeature :: ServerEnv
                       -> UserFeature
                       -> CoreFeature
-                      -> PackageContentsFeature
                       -> AsyncCache (Response, Response, Response, Response)
                       -> (RecentPackagesFeature, IO (Response, Response, Response, Response))
 
 recentPackagesFeature env
                       UserFeature{..}
                       CoreFeature{..}
-                      PackageContentsFeature{packageChangeLog}
                       cacheRecent
   = (RecentPackagesFeature{..}, updateRecentCache)
   where
@@ -111,12 +104,6 @@ recentPackagesFeature env
           }
       }
 
-    packageRender pkg = do
-      users <- queryGetUserDb
-      changeLog <- packageChangeLog pkg
-      let showChangeLogLink = case changeLog of Right _ -> True ; _ -> False
-      doPackageRender users pkg showChangeLogLink
-
     updateRecentCache = do
         -- TODO: move the html version to the HTML feature
         pkgIndex <- queryGetPackageIndex