Structured use of PkgInfo

src/Distribution/Server/Features/Core.hs

@@ -726,10 +726,9 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
 
     serveCabalFileRevisionsList :: DynamicPath -> ServerPartE Response
     serveCabalFileRevisionsList dpath = do
-      pkginfo <- packageInPath dpath >>= lookupPackageId
+      revisions <- fmap pkgMetadataRevisions $ packageInPath dpath >>= lookupPackageId
       users   <- queryGetUserDb
-      let revisions = pkgMetadataRevisions pkginfo
-          revisionToObj rev (cabalFileText, (utime, uid)) =
+      let revisionToObj rev (cabalFileText, (utime, uid)) =
             let uname = userIdToName users uid
                 hash = sha256 (fromStrict $ cabalFileByteString cabalFileText)
             in
@@ -746,8 +745,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
     serveCabalFileRevision dpath = do
       pkginfo <- packageInPath dpath >>= lookupPackageId
       let mrev      = lookup "revision" dpath >>= fromReqURI
-          revisions = pkgMetadataRevisions pkginfo
-      case mrev >>= \rev -> revisions Vec.!? rev of
+      case mrev >>= pkgSpecificRevision pkginfo of
         Just (fileRev, (utime, _uid)) -> return $ toResponse cabalfile
           where
             cabalfile = Resource.CabalFile (fromStrict $ cabalFileByteString fileRev) utime

src/Distribution/Server/Features/Html.hs

@@ -67,7 +67,6 @@ import Data.List (intercalate, intersperse, insert)
 import Data.Function (on)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import qualified Data.Vector as Vec
 import qualified Data.Text as T
 import qualified Data.ByteString.Lazy as BS (LazyByteString, fromStrict)
 import qualified Network.URI as URI
@@ -805,32 +804,33 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
       users    <- queryGetUserDb
       let pkgid        = packageId pkginfo
           pkgname      = packageName pkginfo
-          revisions    = reverse $ Vec.toList (pkgMetadataRevisions pkginfo)
+          cabalFiles   = reverse $ pkgAllRevisionsCabalFiles pkginfo
+          uploadInfos  = reverse $ pkgAllRevisionsUploadInfos pkginfo
           numRevisions = pkgNumRevisions pkginfo
 
           revchanges   :: [(SHA256Digest, [Change])]
-          revchanges   = start revisions where
+          revchanges   = start cabalFiles where
             start []          = []
             start (curr:rest) = go curr rest
 
-            go curr [] = [(sha256 (BS.fromStrict (cabalFileByteString (fst curr))), [])]
+            go curr [] = [(sha256 (BS.fromStrict (cabalFileByteString curr)), [])]
             go curr (prev:rest) =
-                ( sha256 (BS.fromStrict (cabalFileByteString (fst curr)))
+                ( sha256 (BS.fromStrict (cabalFileByteString curr))
                 , changes curr prev )
                 : go prev rest
 
             changes curr prev = either (const []) id $
               diffCabalRevisionsByteString
-                (cabalFileByteString (fst prev))
-                (cabalFileByteString (fst curr))
+                (cabalFileByteString prev)
+                (cabalFileByteString curr)
 
       cacheControl [NoCache] (etagFromHash numRevisions)
       template <- getTemplate templates "revisions.html"
       return $ toResponse $ template
         [ "pkgname"   $= pkgname
         , "pkgid"     $= pkgid
         , "revisions" $= zipWith3 (revisionToTemplate users)
-                                  (map snd revisions)
+                                  uploadInfos
                                   [numRevisions-1, numRevisions-2..]
                                   revchanges
         ]

src/Distribution/Server/Features/PackageCandidates.hs

@@ -41,6 +41,7 @@ import Distribution.Text
 import Distribution.Package
 import Distribution.Version
 
+import Data.Maybe (maybeToList)
 import qualified Data.ByteString.Lazy     as BS (toStrict, fromStrict)
 import qualified Data.Text                as T
 import qualified Text.XHtml.Strict        as XHtml
@@ -283,12 +284,12 @@ candidatesFeature ServerEnv{serverBlobStore = store}
         let lupUserName uid = (uid, fmap Users.userName (Users.lookupUserId uid users))
 
         let pvs = [ object [ Key.fromString "version"  .= (T.pack . display . packageVersion . candInfoId) p
-                           , Key.fromString "sha256"   .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball
-                           , Key.fromString "time"     .= (fst . snd) tarball
-                           , Key.fromString "uploader" .= (lupUserName . snd . snd) tarball
+                           , Key.fromString "sha256"   .= (blobInfoHashSHA256 . pkgTarballGz) tarball
+                           , Key.fromString "time"     .= time
+                           , Key.fromString "uploader" .= lupUserName uploader
                            ]
                   | p <- pkgs
-                  , let tarball = Vec.last . pkgTarballRevisions . candPkgInfo $ p
+                  , (tarball, (time, uploader), _) <- maybeToList $ pkgLatestTarball $ candPkgInfo p
                   ]
 
         return . toResponse . toJSON $ pvs
@@ -312,10 +313,10 @@ candidatesFeature ServerEnv{serverBlobStore = store}
           where
             pn = T.pack . display . pkgName . candInfoId . head $ pkgs
             pvs = [ object [ Key.fromString "version" .= (T.pack . display . packageVersion . candInfoId) p
-                           , Key.fromString "sha256"  .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball
+                           , Key.fromString "sha256"  .= (blobInfoHashSHA256 . pkgTarballGz) tarball
                            ]
                   | p <- pkgs
-                  , let tarball = Vec.last . pkgTarballRevisions . candPkgInfo $ p
+                  , (tarball, _, _) <- maybeToList $ pkgLatestTarball $ candPkgInfo p
                   ]
 
     postCandidate :: ServerPartE Response

src/Distribution/Server/Features/PackageInfoJSON.hs

@@ -21,7 +21,6 @@ import           Data.Aeson                 ((.=))
 import qualified Data.Aeson.Key             as Key
 import qualified Data.Map.Strict      as Map
 import qualified Data.Text                  as T
-import qualified Data.Vector                as Vector
 
 import           Distribution.License                         (licenseToSPDX)
 import           Distribution.Package                         (PackageIdentifier(..),
@@ -39,7 +38,7 @@ import qualified Distribution.Server.Framework                as Framework
 import           Distribution.Server.Features.Core            (CoreFeature(..),
                                                                CoreResource(..))
 import qualified Distribution.Server.Features.PreferredVersions as Preferred
-import           Distribution.Server.Packages.Types           (CabalFileText(..), pkgMetadataRevisions)
+import           Distribution.Server.Packages.Types           (CabalFileText(..), pkgSpecificRevision, pkgLatestRevision, pkgMaxRevision, pkgNumRevisions)
 
 import Distribution.Utils.ShortText (fromShortText)
 import Data.Foldable (toList)
@@ -246,24 +245,23 @@ servePackageBasicDescription resource userFeature preferred dpath = do
       guardValidPackageId resource pkgid
       pkg <- lookupPackageId resource pkgid
 
-      let metadataRevs = fst <$> pkgMetadataRevisions pkg
-          uploadInfos  = snd <$> pkgMetadataRevisions pkg
-          nMetadata    = Vector.length metadataRevs
-          metadataInd  = fromMaybe (nMetadata - 1) metadataRev
-      descr <- getPackageDescr metadataInd nMetadata metadataRevs uploadInfos
+      (metadataInd, (cabalFile, uploadInfo)) <- do
+        case metadataRev of
+          Nothing ->
+            pure (pkgMaxRevision pkg, pkgLatestRevision pkg)
+          Just ix ->
+            case pkgSpecificRevision pkg ix of
+              Nothing ->
+                Framework.errNotFound "Revision not found"
+                  [Framework.MText
+                    $ "There are " <> show (pkgNumRevisions pkg) <> " metadata revisions. Index "
+                    <> show ix <> " is out of bounds."]
+              Just rev -> pure (ix, rev)
+
+      descr <- getPackageDescr cabalFile uploadInfo metadataInd
       return $ Framework.toResponse $ Aeson.toJSON descr
 
-    getPackageDescr metadataInd nMetadata metadataRevs uploadInfos = do
-      when (metadataInd < 0 || metadataInd >= nMetadata)
-        (Framework.errNotFound "Revision not found"
-         [Framework.MText
-           $ "There are " <> show nMetadata <> " metadata revisions. Index "
-           <> show metadataInd <> " is out of bounds."]
-        )
-
-      let cabalFile = metadataRevs Vector.! metadataInd
-          uploadedAt = fst $ uploadInfos Vector.! metadataInd
-          uploaderId = snd $ uploadInfos Vector.! metadataInd
+    getPackageDescr cabalFile (uploadedAt, uploaderId) metadataInd = do
       uploader <- userName <$> lookupUserInfo userFeature uploaderId
       let pkgDescr  = getBasicDescription uploadedAt cabalFile metadataInd
       case pkgDescr of

src/Distribution/Server/Features/Security/Migration.hs

@@ -116,7 +116,7 @@ migratePkgs ServerEnv{ serverBlobStore = store } updatePackage precomputed =
             updatePackage (pkgInfoId pkg) pkg'
             return stats
       where
-        tarballs = Vec.toList (pkgTarballRevisions pkg)
+        tarballs = pkgAllTarballs pkg
 
     migrateTarball :: PkgTarball -> IO (Migrated PkgTarball)
     migrateTarball pkgTarball@PkgTarball{} =

src/Distribution/Server/Features/Sitemap.hs

@@ -19,7 +19,6 @@ import Distribution.Text (display)
 import Distribution.Server.Packages.Types
 
 import qualified Distribution.Server.Packages.PackageIndex as PackageIndex
-import qualified Data.Vector as Vec
 import qualified Data.Map  as Map
 import qualified Data.Text as T
 import Data.ByteString.Lazy (ByteString)
@@ -233,7 +232,7 @@ generateSitemap serverBaseURI pageBuildDate alltags pkgIndex docIndex cachedTarI
         [ ( prefixPkgURI ++ display (packageName pkg)
           , uploadtime)
         | pkg <- map head pkgss
-        , let (_, (uploadtime, _user)) = Vec.head (pkgMetadataRevisions pkg)
+        , let (uploadtime, _user) = pkgLatestUploadInfo pkg
         ]
         Daily 1.0
 
@@ -293,4 +292,4 @@ generateSitemap serverBaseURI pageBuildDate alltags pkgIndex docIndex cachedTarI
     entryToPaths _    (Tar.TarFileEntry _) = []
     entryToPaths base (Tar.TarDir content) = map ((base </>) . fst) content ++
       [ file | (folder, entry) <- content, file <- entryToPaths (base </> folder) entry ]
--}
+-}

src/Distribution/Server/Features/UserNotify.hs

@@ -82,7 +82,6 @@ import qualified Data.ByteString.Lazy.Char8 as BS
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TL
-import qualified Data.Vector as Vec
 
 
 -- A feature to manage notifications to users when package metadata, etc is updated.
@@ -582,9 +581,7 @@ userNotifyFeature UserFeature{..}
                     { notifyPackageId = pkgInfoId pkg
                     , notifyRevisions =
                         filter (\(t, _) -> earlier < t && t <= now)
-                          . map snd
-                          . Vec.toList
-                          $ pkgMetadataRevisions pkg
+                          $ pkgAllRevisionsUploadInfos pkg
                     }
               else do
                 guard notifyUpload

src/Distribution/Server/Packages/Index.hs

@@ -17,6 +17,7 @@ import Distribution.Server.Framework.MemSize
 
 import Distribution.Server.Packages.Types
          ( CabalFileText(..), PkgInfo(..)
+         , pkgSpecificRevision
          , pkgLatestCabalFileText, pkgLatestUploadInfo
          )
 import Distribution.Server.Packages.Metadata
@@ -100,7 +101,7 @@ writeIncremental pkgs =
     mkTarEntry (CabalFileEntry pkgid revno timestamp userid username) = do
         pkginfo   <- PackageIndex.lookupPackageId pkgs pkgid
         cabalfile <- fmap (cabalFileByteString . fst) $
-                     pkgMetadataRevisions pkginfo Vec.!? revno
+                     pkgSpecificRevision pkginfo revno
         tarPath   <- either (const Nothing) Just $
                      Tar.toTarPath False fileName
         let !tarEntry = addTimestampAndOwner timestamp userid username $

src/Distribution/Server/Packages/Metadata.hs

@@ -29,8 +29,7 @@ computePkgMetadata :: PkgInfo   -- ^ Package
                    -> (FilePath, BS.Lazy.ByteString)
 computePkgMetadata pkg revNo = (inIndexPkgMetadata pkgId, raw)
   where
-    tarballs     = pkgTarballRevisions pkg
-    (tarball, _) = tarballs Vec.! revNo
+    Just (tarball, _) = pkgSpecificTarball pkg revNo
     pkgId        = pkgInfoId pkg
     targets      = pkgTarballTargets revNo pkgId tarball
     signed       = Sec.withSignatures' [] targets

src/Distribution/Server/Packages/Render.hs

@@ -119,12 +119,12 @@ doPackageRender users info = PackageRender
                            str -> categorySplit str
     , rendRepoHeads    = catMaybes (map rendRepo $ sourceRepos desc)
     , rendModules      = renderModules
-    , rendHasTarball   = not . Vec.null $ pkgTarballRevisions info
+    , rendHasTarball   = not . null $ pkgAllTarballs info
     , rendChangeLog    = Nothing -- populated later
     , rendReadme       = Nothing -- populated later
     , rendUploadInfo   = let (utime, uid) = pkgOriginalUploadInfo info
                          in (utime, Users.lookupUserId uid users)
-    , rendUpdateInfo   = let maxrevision  = Vec.length (pkgMetadataRevisions info) - 1
+    , rendUpdateInfo   = let maxrevision  = pkgMaxRevision info
                              (utime, uid) = pkgLatestUploadInfo info
                              uinfo        = Users.lookupUserId uid users
                          in if maxrevision > 0

src/Distribution/Server/Packages/Types.hs

@@ -176,6 +176,21 @@ pkgOriginalUploadUser = snd . pkgOriginalUploadInfo
 pkgLatestRevision :: PkgInfo -> (CabalFileText, UploadInfo)
 pkgLatestRevision = Vec.last . pkgMetadataRevisions
 
+pkgSpecificRevision :: PkgInfo -> Int -> Maybe (CabalFileText, UploadInfo)
+pkgSpecificRevision pkg revno = pkgMetadataRevisions pkg Vec.!? revno
+
+pkgAllRevisionsCabalFiles :: PkgInfo -> [CabalFileText]
+pkgAllRevisionsCabalFiles = fmap fst . Vec.toList . pkgMetadataRevisions
+
+pkgSpecificTarball :: PkgInfo -> Int -> Maybe (PkgTarball, UploadInfo)
+pkgSpecificTarball pkg revno = pkgTarballRevisions pkg Vec.!? revno
+
+pkgAllTarballs :: PkgInfo -> [(PkgTarball, UploadInfo)]
+pkgAllTarballs = Vec.toList . pkgTarballRevisions
+
+pkgAllRevisionsUploadInfos :: PkgInfo -> [UploadInfo]
+pkgAllRevisionsUploadInfos = fmap snd . Vec.toList . pkgMetadataRevisions
+
 pkgLatestCabalFileText :: PkgInfo -> CabalFileText
 pkgLatestCabalFileText = fst . pkgLatestRevision
 
@@ -191,6 +206,9 @@ pkgLatestUploadUser = snd . pkgLatestUploadInfo
 pkgNumRevisions :: PkgInfo -> Int
 pkgNumRevisions = Vec.length . pkgMetadataRevisions
 
+pkgMaxRevision :: PkgInfo -> Int
+pkgMaxRevision = subtract 1 . pkgNumRevisions
+
 -- | The latest tarball for a package (if any)
 --
 -- For packages with a @.cabal@ file but no tarball we return 'Nothing'.