Skip to content

Commit 374498f

Browse files
gbazgbaz
committed
Merge branch 'master' into central-server
2 parents 8da7b68 + 1594efc commit 374498f

34 files changed

+473
-602
lines changed

‎datafiles/static/hackage.css‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1313,3 +1313,11 @@ p.registration-email {
13131313
background: #222;
13141314
}
13151315
}
1316+
1317+
1318+
@media (prefer-color-scheme: dark) {
1319+
thead th{
1320+
background-color: #5E5184;
1321+
color: #e0e0e0;
1322+
}
1323+
}

‎datafiles/templates/Html/candidate-page.html.st‎

Lines changed: 12 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -95,21 +95,25 @@
9595
$if(package.optional.hasHomePage)$
9696
<tr>
9797
<th>Home page</th>
98-
<td>
99-
<a href=$package.optional.homepage$>
100-
$package.optional.homepage$
101-
</a>
98+
<td class="word-wrap">
99+
$if(package.optional.homepageIsSafeURI)$
100+
<a href="$package.optional.homepage$">$package.optional.homepage$</a>
101+
$else$
102+
$package.optional.homepage$
103+
$endif$
102104
</td>
103105
</tr>
104106
$endif$
105107

106108
$if(package.optional.hasBugTracker)$
107109
<tr>
108110
<th>Bug&nbsp;tracker</th>
109-
<td>
110-
<a href="$package.optional.bugTracker$">
111-
$package.optional.bugTracker$
112-
</a>
111+
<td class="word-wrap">
112+
$if(package.optional.bugTrackerIsSafeURI)$
113+
<a href="$package.optional.bugTracker$">$package.optional.bugTracker$</a>
114+
$else$
115+
$package.optional.bugTracker$
116+
$endif$
113117
</td>
114118
</tr>
115119
$endif$

‎datafiles/templates/Html/package-page.html.st‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -203,7 +203,11 @@
203203
<tr>
204204
<th>Home page</th>
205205
<td class="word-wrap">
206-
<a href=$package.optional.homepage$>$package.optional.homepage$</a>
206+
$if(package.optional.homepageIsSafeURI)$
207+
<a href="$package.optional.homepage$">$package.optional.homepage$</a>
208+
$else$
209+
$package.optional.homepage$
210+
$endif$
207211
</td>
208212
</tr>
209213
$endif$
@@ -212,7 +216,11 @@
212216
<tr>
213217
<th>Bug&nbsp;tracker</th>
214218
<td class="word-wrap">
219+
$if(package.optional.bugTrackerIsSafeURI)$
215220
<a href="$package.optional.bugTracker$">$package.optional.bugTracker$</a>
221+
$else$
222+
$package.optional.bugTracker$
223+
$endif$
216224
</td>
217225
</tr>
218226
$endif$

‎flake.nix‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,8 @@
5555

5656
sandwich.check = false;
5757

58+
threads.check = false;
59+
5860
unicode-data.check = false;
5961
};
6062
packages = {

‎hackage-server.cabal‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 3.0
22
name: hackage-server
3-
version: 0.5.1
3+
version: 0.6
44

55
category: Distribution
66
synopsis: The Hackage web server
@@ -149,7 +149,7 @@ common defaults
149149
, array >= 0.5 && < 0.6
150150
, base >= 4.18 && < 4.22
151151
, binary >= 0.8 && < 0.9
152-
, bytestring >= 0.10 && < 0.13
152+
, bytestring >= 0.11.2 && < 0.13
153153
, containers >= 0.6.0 && < 0.9
154154
, deepseq >= 1.4 && < 1.6
155155
, directory >= 1.3 && < 1.4
@@ -228,6 +228,7 @@ library
228228
Distribution.Server.Framework.BlobStorage
229229
Distribution.Server.Framework.Cache
230230
Distribution.Server.Framework.Cron
231+
Distribution.Server.Framework.CSRF
231232
Distribution.Server.Framework.Error
232233
Distribution.Server.Framework.Logging
233234
Distribution.Server.Framework.Feature
@@ -364,7 +365,6 @@ library
364365
Distribution.Server.Features.HaskellPlatform
365366
Distribution.Server.Features.HaskellPlatform.State
366367
Distribution.Server.Features.PackageInfoJSON
367-
Distribution.Server.Features.PackageInfoJSON.State
368368
Distribution.Server.Features.Search
369369
Distribution.Server.Features.Search.BM25F
370370
Distribution.Server.Features.Search.DocIdSet

‎src/Distribution/Server.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ import qualified Distribution.Server.Framework.Auth as Auth
3232
import Distribution.Server.Framework.Templating (TemplatesMode(..))
3333
import Distribution.Server.Framework.AuthTypes (PasswdPlain(..))
3434
import Distribution.Server.Framework.HtmlFormWrapper (htmlFormWrapperHack)
35+
import Distribution.Server.Framework.CSRF (csrfMiddleware)
3536

3637
import Distribution.Server.Framework.Feature as Feature
3738
import qualified Distribution.Server.Features as Features
@@ -301,10 +302,9 @@ initState server (admin, pass) = do
301302
impl :: Server -> ServerPart Response
302303
impl server = logExceptions $
303304
runServerPartE $
304-
handleErrorResponse (serveErrorResponse errHandlers Nothing) $
305-
renderServerTree [] serverTree
306-
`mplus`
307-
fallbackNotFound
305+
handleErrorResponse (serveErrorResponse errHandlers Nothing) $ do
306+
csrfMiddleware
307+
renderServerTree [] serverTree `mplus` fallbackNotFound
308308
where
309309
serverTree :: ServerTree (DynamicPath -> ServerPartE Response)
310310
serverTree =

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

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ import qualified Codec.Compression.GZip as GZip
2727
import Data.Aeson (Value (..), toJSON)
2828
import qualified Data.Aeson.Key as Key
2929
import qualified Data.Aeson.KeyMap as KeyMap
30-
import Data.ByteString.Lazy (ByteString)
30+
import Data.ByteString.Lazy (LazyByteString, fromStrict)
3131
import qualified Data.Foldable as Foldable
3232
import qualified Data.Text as Text
3333
import Data.Time.Clock (UTCTime, getCurrentTime)
@@ -130,7 +130,7 @@ data CoreFeature = CoreFeature {
130130
-- modification time for the tar entry.
131131
--
132132
-- This runs a `PackageChangeIndexExtra` hook when done.
133-
updateArchiveIndexEntry :: forall m. MonadIO m => FilePath -> ByteString -> UTCTime -> m (),
133+
updateArchiveIndexEntry :: forall m. MonadIO m => FilePath -> LazyByteString -> UTCTime -> m (),
134134

135135
-- | Notification of package or index changes.
136136
packageChangeHook :: Hook PackageChange (),
@@ -175,7 +175,7 @@ data PackageChange
175175
| PackageChangeInfo PackageUpdate PkgInfo PkgInfo
176176
-- | A file has changed in the package index tar not covered by any of the
177177
-- other change types.
178-
| PackageChangeIndexExtra String ByteString UTCTime
178+
| PackageChangeIndexExtra String LazyByteString UTCTime
179179

180180
-- | A predicate to use with `packageChangeHook` and `registerHookJust` for
181181
-- keeping other features synchronized with the main package index.
@@ -212,7 +212,7 @@ isPackageDeleteVersion :: Maybe PackageId,
212212
isPackageChangeCabalFile :: Maybe (PackageId, CabalFileText),
213213
isPackageChangeCabalFileUploadInfo :: Maybe (PackageId, UploadInfo),
214214
isPackageChangeTarball :: Maybe (PackageId, PkgTarball),
215-
isPackageIndexExtraChange :: Maybe (String, ByteString, UTCTime)
215+
isPackageIndexExtraChange :: Maybe (String, LazyByteString, UTCTime)
216216
-}
217217

218218
data CoreResource = CoreResource {
@@ -591,7 +591,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
591591
runHook_ packageChangeHook (PackageChangeInfo PackageUpdatedUploadTime oldpkginfo newpkginfo)
592592
return True
593593

594-
updateArchiveIndexEntry :: MonadIO m => FilePath -> ByteString -> UTCTime -> m ()
594+
updateArchiveIndexEntry :: MonadIO m => FilePath -> LazyByteString -> UTCTime -> m ()
595595
updateArchiveIndexEntry entryName entryData entryTime = logTiming maxBound ("updateArchiveIndexEntry " ++ show entryName) $ do
596596
updateState packagesState $
597597
AddOtherIndexEntry $ ExtraEntry entryName entryData entryTime
@@ -721,7 +721,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
721721
-- check that the cabal name matches the package
722722
guard (lookup "cabal" dpath == Just (display $ packageName pkginfo))
723723
let (fileRev, (utime, _uid)) = pkgLatestRevision pkginfo
724-
cabalfile = Resource.CabalFile (cabalFileByteString fileRev) utime
724+
cabalfile = Resource.CabalFile (fromStrict $ cabalFileByteString fileRev) utime
725725
return $ toResponse cabalfile
726726

727727
serveCabalFileRevisionsList :: DynamicPath -> ServerPartE Response
@@ -731,7 +731,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
731731
let revisions = pkgMetadataRevisions pkginfo
732732
revisionToObj rev (cabalFileText, (utime, uid)) =
733733
let uname = userIdToName users uid
734-
hash = sha256 (cabalFileByteString cabalFileText)
734+
hash = sha256 (fromStrict $ cabalFileByteString cabalFileText)
735735
in
736736
Object $ KeyMap.fromList
737737
[ (Key.fromString "number", Number (fromIntegral rev))
@@ -750,7 +750,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
750750
case mrev >>= \rev -> revisions Vec.!? rev of
751751
Just (fileRev, (utime, _uid)) -> return $ toResponse cabalfile
752752
where
753-
cabalfile = Resource.CabalFile (cabalFileByteString fileRev) utime
753+
cabalfile = Resource.CabalFile (fromStrict $ cabalFileByteString fileRev) utime
754754
Nothing -> errNotFound "Package revision not found"
755755
[MText "Cannot parse revision, or revision out of range."]
756756

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

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -98,7 +98,7 @@ doPackageImport (PartialIndex packages updatelog) entry = case entry of
9898
list <- importCSV "tarball.csv" bs >>= importTarballMetadata fp
9999
return $ partial { partialTarballUpload = list }
100100
[other] | Just version <- extractVersion other (packageName pkgId) ".cabal" ->
101-
return $ partial { partialCabal = (version, CabalFileText bs):partialCabal partial }
101+
return $ partial { partialCabal = (version, CabalFileText $ BS.toStrict bs) : partialCabal partial }
102102
_ -> return partial
103103
return $! PartialIndex (Map.insert pkgId partial' packages) updatelog
104104
BackupBlob filename@["package",pkgStr,other] blobId -> do
@@ -198,7 +198,7 @@ partialToFullPkg (pkgId, PartialPkg{..}) = do
198198
filename = display pkgId ++ ".cabal"
199199

200200
case runParseResult $ parseGenericPackageDescription $
201-
BS.toStrict $ cabalFileByteString latestCabalFile of
201+
cabalFileByteString latestCabalFile of
202202
(_, Left (_, errs)) -> fail $ unlines (map (showPError filename) $ toList errs)
203203
(_, Right _) -> return ()
204204

@@ -322,8 +322,8 @@ cabalListToExport pkgId cabalInfos =
322322
cabalName = display (packageName pkgId) ++ ".cabal"
323323

324324
blobEntry :: (Int, CabalFileText) -> BackupEntry
325-
blobEntry (0, CabalFileText bs) = BackupByteString (pkgPath pkgId cabalName) bs
326-
blobEntry (n, CabalFileText bs) = BackupByteString (pkgPath pkgId (cabalName ++ "-" ++ show n)) bs
325+
blobEntry (0, CabalFileText bs) = BackupByteString (pkgPath pkgId cabalName) (BS.fromStrict bs)
326+
blobEntry (n, CabalFileText bs) = BackupByteString (pkgPath pkgId (cabalName ++ "-" ++ show n)) (BS.fromStrict bs)
327327

328328
cabalMetadata :: CSV
329329
cabalMetadata =

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

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,8 @@ import Distribution.Server.Util.CabalRevisions
2323
(Change(..), diffCabalRevisions, insertRevisionField)
2424
import Text.StringTemplate.Classes (SElem(SM))
2525

26-
import Data.ByteString.Lazy (ByteString)
26+
import Data.ByteString (StrictByteString)
27+
import Data.ByteString.Lazy (LazyByteString)
2728
import qualified Data.ByteString.Lazy as BS.L
2829
import qualified Data.Map as Map
2930
import Data.Time (getCurrentTime)
@@ -84,7 +85,7 @@ editCabalFilesFeature _env templates
8485
ok $ toResponse $ template
8586
[ "pkgid" $= pkgid
8687
, "cabalfile" $= insertRevisionField (pkgNumRevisions pkg)
87-
(cabalFileByteString (pkgLatestCabalFileText pkg))
88+
(BS.L.fromStrict (cabalFileByteString (pkgLatestCabalFileText pkg)))
8889
]
8990

9091
serveEditCabalFilePost :: DynamicPath -> ServerPartE Response
@@ -98,11 +99,11 @@ editCabalFilesFeature _env templates
9899
uid <- guardAuthorised [ InGroup (maintainersGroup pkgname)
99100
, InGroup trusteesGroup ]
100101
let oldVersion = cabalFileByteString (pkgLatestCabalFileText pkg)
101-
newRevision <- getCabalFile
102+
newRevision <- BS.L.toStrict <$> getCabalFile
102103
shouldPublish <- getPublish
103104
case diffCabalRevisionsByteString oldVersion newRevision of
104105
Left errs ->
105-
responseTemplate template pkgid newRevision
106+
responseTemplate template pkgid (BS.L.fromStrict newRevision)
106107
shouldPublish [errs] []
107108

108109
Right changes
@@ -117,7 +118,7 @@ editCabalFilesFeature _env templates
117118
, "changes" $= changes
118119
]
119120
| otherwise ->
120-
responseTemplate template pkgid newRevision
121+
responseTemplate template pkgid (BS.L.fromStrict newRevision)
121122
shouldPublish [] changes
122123

123124
where
@@ -126,7 +127,7 @@ editCabalFilesFeature _env templates
126127
(look "publish" >> return True)
127128

128129
responseTemplate :: ([TemplateAttr] -> Template) -> PackageId
129-
-> ByteString -> Bool -> [String] -> [Change]
130+
-> LazyByteString -> Bool -> [String] -> [Change]
130131
-> ServerPartE Response
131132
responseTemplate template pkgid cabalFile publish errors changes =
132133
ok $ toResponse $ template
@@ -139,11 +140,11 @@ editCabalFilesFeature _env templates
139140

140141

141142
-- | Wrapper around 'diffCabalRevisions' which operates on
142-
-- 'ByteString' decoded with lenient UTF8 and with any leading BOM
143+
-- 'LazyByteString' decoded with lenient UTF8 and with any leading BOM
143144
-- stripped.
144-
diffCabalRevisionsByteString :: ByteString -> ByteString -> Either String [Change]
145+
diffCabalRevisionsByteString :: StrictByteString -> StrictByteString -> Either String [Change]
145146
diffCabalRevisionsByteString oldRevision newRevision =
146-
maybe (diffCabalRevisions (BS.L.toStrict oldRevision) (BS.L.toStrict newRevision))
147+
maybe (diffCabalRevisions oldRevision newRevision)
147148
Left
148149
parseSpecVerCheck
149150
where

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

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ import qualified Data.Map as Map
6868
import qualified Data.Set as Set
6969
import qualified Data.Vector as Vec
7070
import qualified Data.Text as T
71-
import qualified Data.ByteString.Lazy.Char8 as BS (ByteString)
71+
import qualified Data.ByteString.Lazy as BS (LazyByteString, fromStrict)
7272
import qualified Network.URI as URI
7373

7474
import Text.XHtml.Strict
@@ -650,7 +650,7 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
650650
pkgVotes <- pkgNumVotes pkgname
651651
pkgScore <- pkgNumScore pkgname
652652
auth <- checkAuthenticated
653-
userRating <- case auth of Just (uid,_) -> pkgUserVote pkgname uid; _ -> return Nothing
653+
userRating <- case auth of Just uid -> pkgUserVote pkgname uid; _ -> return Nothing
654654
mdoctarblob <- queryDocumentation realpkg
655655
tags <- queryTagsForPackage pkgname
656656
rdeps <- queryReverseDeps pkgname
@@ -812,9 +812,9 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
812812
start [] = []
813813
start (curr:rest) = go curr rest
814814

815-
go curr [] = [(sha256 (cabalFileByteString (fst curr)), [])]
815+
go curr [] = [(sha256 (BS.fromStrict (cabalFileByteString (fst curr))), [])]
816816
go curr (prev:rest) =
817-
( sha256 (cabalFileByteString (fst curr))
817+
( sha256 (BS.fromStrict (cabalFileByteString (fst curr)))
818818
, changes curr prev )
819819
: go prev rest
820820

@@ -849,7 +849,7 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
849849

850850

851851
-- | Common helper used by 'serveCandidatePage' and 'servePackagePage'
852-
makeReadme :: MonadIO m => PackageRender -> m (Maybe BS.ByteString)
852+
makeReadme :: MonadIO m => PackageRender -> m (Maybe BS.LazyByteString)
853853
makeReadme render = case rendReadme render of
854854
Just (tarfile, _, offset, _) ->
855855
either (\_err -> return Nothing) (return . Just . snd) =<<

0 commit comments

Comments
 (0)