Skip to content

Commit 0fe76b0

Browse files
ysangkokysangkok
committed
Merge branches 'no-prefversions' and 'structured-pkginfo'
2 parents 398d86e + 736bd90 commit 0fe76b0

11 files changed

Lines changed: 61 additions & 50 deletions

File tree

‎src/Distribution/Server/Features/Core.hs‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -726,10 +726,9 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
726726

727727
serveCabalFileRevisionsList :: DynamicPath -> ServerPartE Response
728728
serveCabalFileRevisionsList dpath = do
729-
pkginfo <- packageInPath dpath >>= lookupPackageId
729+
revisions <- fmap pkgMetadataRevisions $ packageInPath dpath >>= lookupPackageId
730730
users <- queryGetUserDb
731-
let revisions = pkgMetadataRevisions pkginfo
732-
revisionToObj rev (cabalFileText, (utime, uid)) =
731+
let revisionToObj rev (cabalFileText, (utime, uid)) =
733732
let uname = userIdToName users uid
734733
hash = sha256 (fromStrict $ cabalFileByteString cabalFileText)
735734
in
@@ -746,8 +745,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
746745
serveCabalFileRevision dpath = do
747746
pkginfo <- packageInPath dpath >>= lookupPackageId
748747
let mrev = lookup "revision" dpath >>= fromReqURI
749-
revisions = pkgMetadataRevisions pkginfo
750-
case mrev >>= \rev -> revisions Vec.!? rev of
748+
case mrev >>= pkgSpecificRevision pkginfo of
751749
Just (fileRev, (utime, _uid)) -> return $ toResponse cabalfile
752750
where
753751
cabalfile = Resource.CabalFile (fromStrict $ cabalFileByteString fileRev) utime

‎src/Distribution/Server/Features/Html.hs‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,6 @@ import Data.List (intercalate, intersperse, insert)
6767
import Data.Function (on)
6868
import qualified Data.Map as Map
6969
import qualified Data.Set as Set
70-
import qualified Data.Vector as Vec
7170
import qualified Data.Text as T
7271
import qualified Data.ByteString.Lazy as BS (LazyByteString, fromStrict)
7372
import qualified Network.URI as URI
@@ -805,32 +804,33 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
805804
users <- queryGetUserDb
806805
let pkgid = packageId pkginfo
807806
pkgname = packageName pkginfo
808-
revisions = reverse $ Vec.toList (pkgMetadataRevisions pkginfo)
807+
cabalFiles = reverse $ pkgAllRevisionsCabalFiles pkginfo
808+
uploadInfos = reverse $ pkgAllRevisionsUploadInfos pkginfo
809809
numRevisions = pkgNumRevisions pkginfo
810810

811811
revchanges :: [(SHA256Digest, [Change])]
812-
revchanges = start revisions where
812+
revchanges = start cabalFiles where
813813
start [] = []
814814
start (curr:rest) = go curr rest
815815

816-
go curr [] = [(sha256 (BS.fromStrict (cabalFileByteString (fst curr))), [])]
816+
go curr [] = [(sha256 (BS.fromStrict (cabalFileByteString curr)), [])]
817817
go curr (prev:rest) =
818-
( sha256 (BS.fromStrict (cabalFileByteString (fst curr)))
818+
( sha256 (BS.fromStrict (cabalFileByteString curr))
819819
, changes curr prev )
820820
: go prev rest
821821

822822
changes curr prev = either (const []) id $
823823
diffCabalRevisionsByteString
824-
(cabalFileByteString (fst prev))
825-
(cabalFileByteString (fst curr))
824+
(cabalFileByteString prev)
825+
(cabalFileByteString curr)
826826

827827
cacheControl [NoCache] (etagFromHash numRevisions)
828828
template <- getTemplate templates "revisions.html"
829829
return $ toResponse $ template
830830
[ "pkgname" $= pkgname
831831
, "pkgid" $= pkgid
832832
, "revisions" $= zipWith3 (revisionToTemplate users)
833-
(map snd revisions)
833+
uploadInfos
834834
[numRevisions-1, numRevisions-2..]
835835
revchanges
836836
]

‎src/Distribution/Server/Features/PackageCandidates.hs‎

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ import Distribution.Text
4141
import Distribution.Package
4242
import Distribution.Version
4343

44+
import Data.Maybe (maybeToList)
4445
import qualified Data.ByteString.Lazy as BS (toStrict, fromStrict)
4546
import qualified Data.Text as T
4647
import qualified Text.XHtml.Strict as XHtml
@@ -283,12 +284,12 @@ candidatesFeature ServerEnv{serverBlobStore = store}
283284
let lupUserName uid = (uid, fmap Users.userName (Users.lookupUserId uid users))
284285

285286
let pvs = [ object [ Key.fromString "version" .= (T.pack . display . packageVersion . candInfoId) p
286-
, Key.fromString "sha256" .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball
287-
, Key.fromString "time" .= (fst . snd) tarball
288-
, Key.fromString "uploader" .= (lupUserName . snd . snd) tarball
287+
, Key.fromString "sha256" .= (blobInfoHashSHA256 . pkgTarballGz) tarball
288+
, Key.fromString "time" .= time
289+
, Key.fromString "uploader" .= lupUserName uploader
289290
]
290291
| p <- pkgs
291-
, let tarball = Vec.last . pkgTarballRevisions . candPkgInfo $ p
292+
, (tarball, (time, uploader), _) <- maybeToList $ pkgLatestTarball $ candPkgInfo p
292293
]
293294

294295
return . toResponse . toJSON $ pvs
@@ -312,10 +313,10 @@ candidatesFeature ServerEnv{serverBlobStore = store}
312313
where
313314
pn = T.pack . display . pkgName . candInfoId . head $ pkgs
314315
pvs = [ object [ Key.fromString "version" .= (T.pack . display . packageVersion . candInfoId) p
315-
, Key.fromString "sha256" .= (blobInfoHashSHA256 . pkgTarballGz . fst) tarball
316+
, Key.fromString "sha256" .= (blobInfoHashSHA256 . pkgTarballGz) tarball
316317
]
317318
| p <- pkgs
318-
, let tarball = Vec.last . pkgTarballRevisions . candPkgInfo $ p
319+
, (tarball, _, _) <- maybeToList $ pkgLatestTarball $ candPkgInfo p
319320
]
320321

321322
postCandidate :: ServerPartE Response

‎src/Distribution/Server/Features/PackageInfoJSON.hs‎

Lines changed: 16 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,6 @@ import Data.Aeson ((.=))
2121
import qualified Data.Aeson.Key as Key
2222
import qualified Data.Map.Strict as Map
2323
import qualified Data.Text as T
24-
import qualified Data.Vector as Vector
2524

2625
import Distribution.License (licenseToSPDX)
2726
import Distribution.Package (PackageIdentifier(..),
@@ -39,7 +38,7 @@ import qualified Distribution.Server.Framework as Framework
3938
import Distribution.Server.Features.Core (CoreFeature(..),
4039
CoreResource(..))
4140
import qualified Distribution.Server.Features.PreferredVersions as Preferred
42-
import Distribution.Server.Packages.Types (CabalFileText(..), pkgMetadataRevisions)
41+
import Distribution.Server.Packages.Types (CabalFileText(..), pkgSpecificRevision, pkgLatestRevision, pkgMaxRevision, pkgNumRevisions)
4342

4443
import Distribution.Utils.ShortText (fromShortText)
4544
import Data.Foldable (toList)
@@ -245,24 +244,23 @@ servePackageBasicDescription resource userFeature preferred dpath = do
245244
guardValidPackageId resource pkgid
246245
pkg <- lookupPackageId resource pkgid
247246

248-
let metadataRevs = fst <$> pkgMetadataRevisions pkg
249-
uploadInfos = snd <$> pkgMetadataRevisions pkg
250-
nMetadata = Vector.length metadataRevs
251-
metadataInd = fromMaybe (nMetadata - 1) metadataRev
252-
descr <- getPackageDescr metadataInd nMetadata metadataRevs uploadInfos
247+
(metadataInd, (cabalFile, uploadInfo)) <- do
248+
case metadataRev of
249+
Nothing ->
250+
pure (pkgMaxRevision pkg, pkgLatestRevision pkg)
251+
Just ix ->
252+
case pkgSpecificRevision pkg ix of
253+
Nothing ->
254+
Framework.errNotFound "Revision not found"
255+
[Framework.MText
256+
$ "There are " <> show (pkgNumRevisions pkg) <> " metadata revisions. Index "
257+
<> show ix <> " is out of bounds."]
258+
Just rev -> pure (ix, rev)
259+
260+
descr <- getPackageDescr cabalFile uploadInfo metadataInd
253261
return $ Framework.toResponse $ Aeson.toJSON descr
254262

255-
getPackageDescr metadataInd nMetadata metadataRevs uploadInfos = do
256-
when (metadataInd < 0 || metadataInd >= nMetadata)
257-
(Framework.errNotFound "Revision not found"
258-
[Framework.MText
259-
$ "There are " <> show nMetadata <> " metadata revisions. Index "
260-
<> show metadataInd <> " is out of bounds."]
261-
)
262-
263-
let cabalFile = metadataRevs Vector.! metadataInd
264-
uploadedAt = fst $ uploadInfos Vector.! metadataInd
265-
uploaderId = snd $ uploadInfos Vector.! metadataInd
263+
getPackageDescr cabalFile (uploadedAt, uploaderId) metadataInd = do
266264
uploader <- userName <$> lookupUserInfo userFeature uploaderId
267265
let pkgDescr = getBasicDescription uploadedAt cabalFile metadataInd
268266
case pkgDescr of

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -116,7 +116,7 @@ migratePkgs ServerEnv{ serverBlobStore = store } updatePackage precomputed =
116116
updatePackage (pkgInfoId pkg) pkg'
117117
return stats
118118
where
119-
tarballs = Vec.toList (pkgTarballRevisions pkg)
119+
tarballs = pkgAllTarballs pkg
120120

121121
migrateTarball :: PkgTarball -> IO (Migrated PkgTarball)
122122
migrateTarball pkgTarball@PkgTarball{} =

‎src/Distribution/Server/Features/Sitemap.hs‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,6 @@ import Distribution.Text (display)
1919
import Distribution.Server.Packages.Types
2020

2121
import qualified Distribution.Server.Packages.PackageIndex as PackageIndex
22-
import qualified Data.Vector as Vec
2322
import qualified Data.Map as Map
2423
import qualified Data.Text as T
2524
import Data.ByteString.Lazy (ByteString)
@@ -233,7 +232,7 @@ generateSitemap serverBaseURI pageBuildDate alltags pkgIndex docIndex cachedTarI
233232
[ ( prefixPkgURI ++ display (packageName pkg)
234233
, uploadtime)
235234
| pkg <- map head pkgss
236-
, let (_, (uploadtime, _user)) = Vec.head (pkgMetadataRevisions pkg)
235+
, let (uploadtime, _user) = pkgLatestUploadInfo pkg
237236
]
238237
Daily 1.0
239238

@@ -293,4 +292,4 @@ generateSitemap serverBaseURI pageBuildDate alltags pkgIndex docIndex cachedTarI
293292
entryToPaths _ (Tar.TarFileEntry _) = []
294293
entryToPaths base (Tar.TarDir content) = map ((base </>) . fst) content ++
295294
[ file | (folder, entry) <- content, file <- entryToPaths (base </> folder) entry ]
296-
-}
295+
-}

‎src/Distribution/Server/Features/UserNotify.hs‎

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,6 @@ import qualified Data.ByteString.Lazy.Char8 as BS
8282
import qualified Data.Text as T
8383
import qualified Data.Text.Lazy as TL
8484
import qualified Data.Text.Lazy.Encoding as TL
85-
import qualified Data.Vector as Vec
8685

8786

8887
-- A feature to manage notifications to users when package metadata, etc is updated.
@@ -582,9 +581,7 @@ userNotifyFeature UserFeature{..}
582581
{ notifyPackageId = pkgInfoId pkg
583582
, notifyRevisions =
584583
filter (\(t, _) -> earlier < t && t <= now)
585-
. map snd
586-
. Vec.toList
587-
$ pkgMetadataRevisions pkg
584+
$ pkgAllRevisionsUploadInfos pkg
588585
}
589586
else do
590587
guard notifyUpload

‎src/Distribution/Server/Packages/Index.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ import Distribution.Server.Framework.MemSize
1717

1818
import Distribution.Server.Packages.Types
1919
( CabalFileText(..), PkgInfo(..)
20+
, pkgSpecificRevision
2021
, pkgLatestCabalFileText, pkgLatestUploadInfo
2122
)
2223
import Distribution.Server.Packages.Metadata
@@ -100,7 +101,7 @@ writeIncremental pkgs =
100101
mkTarEntry (CabalFileEntry pkgid revno timestamp userid username) = do
101102
pkginfo <- PackageIndex.lookupPackageId pkgs pkgid
102103
cabalfile <- fmap (cabalFileByteString . fst) $
103-
pkgMetadataRevisions pkginfo Vec.!? revno
104+
pkgSpecificRevision pkginfo revno
104105
tarPath <- either (const Nothing) Just $
105106
Tar.toTarPath False fileName
106107
let !tarEntry = addTimestampAndOwner timestamp userid username $

‎src/Distribution/Server/Packages/Metadata.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -29,8 +29,7 @@ computePkgMetadata :: PkgInfo -- ^ Package
2929
-> (FilePath, BS.Lazy.ByteString)
3030
computePkgMetadata pkg revNo = (inIndexPkgMetadata pkgId, raw)
3131
where
32-
tarballs = pkgTarballRevisions pkg
33-
(tarball, _) = tarballs Vec.! revNo
32+
Just (tarball, _) = pkgSpecificTarball pkg revNo
3433
pkgId = pkgInfoId pkg
3534
targets = pkgTarballTargets revNo pkgId tarball
3635
signed = Sec.withSignatures' [] targets

‎src/Distribution/Server/Packages/Render.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -119,12 +119,12 @@ doPackageRender users info = PackageRender
119119
str -> categorySplit str
120120
, rendRepoHeads = catMaybes (map rendRepo $ sourceRepos desc)
121121
, rendModules = renderModules
122-
, rendHasTarball = not . Vec.null $ pkgTarballRevisions info
122+
, rendHasTarball = not . null $ pkgAllTarballs info
123123
, rendChangeLog = Nothing -- populated later
124124
, rendReadme = Nothing -- populated later
125125
, rendUploadInfo = let (utime, uid) = pkgOriginalUploadInfo info
126126
in (utime, Users.lookupUserId uid users)
127-
, rendUpdateInfo = let maxrevision = Vec.length (pkgMetadataRevisions info) - 1
127+
, rendUpdateInfo = let maxrevision = pkgMaxRevision info
128128
(utime, uid) = pkgLatestUploadInfo info
129129
uinfo = Users.lookupUserId uid users
130130
in if maxrevision > 0

0 commit comments

Comments
 (0)