diff --git a/.github/workflows/update-flake-lock.yml b/.github/workflows/update-flake-lock.yml
new file mode 100644
index 00000000..320ffdab
--- /dev/null
+++ b/.github/workflows/update-flake-lock.yml
@@ -0,0 +1,22 @@
+# https://github.com/DeterminateSystems/update-flake-lock
+name: update-flake-lock
+on:
+ workflow_dispatch: # allows manual triggering
+ schedule:
+ - cron: '0 0 1 * *' # runs on first day of the month
+
+jobs:
+ lockfile:
+ runs-on: ubuntu-latest
+ steps:
+ - name: Checkout repository
+ uses: actions/checkout@v4
+ - name: Install Nix
+ uses: DeterminateSystems/nix-installer-action@main
+ - name: Update flake.lock
+ uses: DeterminateSystems/update-flake-lock@main
+ with:
+ pr-title: "Update flake.lock" # Title of PR to be created
+ pr-labels: | # Labels to be set on the PR
+ dependencies
+ automated
diff --git a/datafiles/static/hackage.css b/datafiles/static/hackage.css
index 2c8c2ccd..5cdf0230 100644
--- a/datafiles/static/hackage.css
+++ b/datafiles/static/hackage.css
@@ -147,6 +147,10 @@ table {
font:100%;
}
+pre {
+ border-radius: 3px;
+}
+
pre, code, kbd, samp, .src {
font-family: monospace;
}
diff --git a/datafiles/templates/Html/package-page.html.st b/datafiles/templates/Html/package-page.html.st
index 56947aad..079f91bb 100644
--- a/datafiles/templates/Html/package-page.html.st
+++ b/datafiles/templates/Html/package-page.html.st
@@ -5,6 +5,8 @@
$endif$
$hackageCssTheme()$
+
+
$package.name$$if(package.optional.hasSynopsis)$: $package.optional.synopsis$$endif$
@@ -293,6 +295,8 @@
[back to package description]
$package.optional.readme$
+
+
$endif$
diff --git a/flake.nix b/flake.nix
index 222b1924..82158c3a 100644
--- a/flake.nix
+++ b/flake.nix
@@ -37,7 +37,7 @@
echo 'Copying packages from real Hackage Server into local Hackage Server.'
echo 'This assumes the local Hackage Server uses default credentials;'
echo 'otherwise, override in nix-default-servers.cfg'
- hackage-mirror nix-default-servers.cfg
+ hackage-mirror nix-default-servers.cfg "$@"
'';
};
packages.default = config.packages.hackage-server;
diff --git a/src/Distribution/Server/Features/Documentation.hs b/src/Distribution/Server/Features/Documentation.hs
index 511a8ddb..9222024b 100644
--- a/src/Distribution/Server/Features/Documentation.hs
+++ b/src/Distribution/Server/Features/Documentation.hs
@@ -23,6 +23,7 @@ import Distribution.Server.Framework.BlobStorage (BlobId)
import qualified Distribution.Server.Framework.BlobStorage as BlobStorage
import qualified Distribution.Server.Util.ServeTarball as ServerTarball
import qualified Distribution.Server.Util.DocMeta as DocMeta
+import qualified Distribution.Server.Util.GZip as Gzip
import Distribution.Server.Features.BuildReports.BuildReport (PkgDetails(..), BuildStatus(..))
import Data.TarIndex (TarIndex)
import qualified Codec.Archive.Tar as Tar
@@ -46,7 +47,6 @@ import Data.Time.Clock (NominalDiffTime, diffUTCTime, getCurrentTime)
import System.Directory (getModificationTime)
import Control.Applicative
import Distribution.Server.Features.PreferredVersions
-import Distribution.Server.Features.PreferredVersions.State (getVersionStatus)
import Distribution.Server.Packages.Types
-- TODO:
-- 1. Write an HTML view for organizing uploads
@@ -327,8 +327,10 @@ documentationFeature name
-- \* Generate the new index
-- \* Drop the index for the old tar-file
-- \* Link the new documentation to the package
- fileContents <- expectUncompressedTarball
- mres <- liftIO $ BlobStorage.addWith store fileContents
+ fileContents <- expectCompressedTarball
+ let filename = display pkgid ++ "-docs" <.> "tar.gz"
+ unpacked = Gzip.decompressNamed filename fileContents
+ mres <- liftIO $ BlobStorage.addWith store unpacked
(\content -> return (checkDocTarball pkgid content))
case mres of
Left err -> errBadRequest "Invalid documentation tarball" [MText err]
@@ -377,15 +379,15 @@ documentationFeature name
helper (pkg:pkgs) = do
hasDoc <- queryHasDocumentation (pkgInfoId pkg)
let status = getVersionStatus prefInfo (packageVersion pkg)
- if hasDoc && status == NormalVersion
- then pure (Just (packageId pkg))
+ if hasDoc && status == NormalVersion
+ then pure (Just (packageId pkg))
else helper pkgs
helper2 [] = pure Nothing
helper2 (pkg:pkgs) = do
hasDoc <- queryHasDocumentation (pkgInfoId pkg)
if hasDoc
- then pure (Just (packageId pkg))
+ then pure (Just (packageId pkg))
else helper2 pkgs
withDocumentation :: Resource -> DynamicPath
@@ -400,7 +402,7 @@ documentationFeature name
then (var, unPackageName $ pkgName pkgid)
else e
| e@(var, _) <- dpath ]
- basePkgPath = (renderResource' self basedpath)
+ basePkgPath = renderResource' self basedpath
canonicalLink = show serverBaseURI ++ basePkgPath
canonicalHeader = "<" ++ canonicalLink ++ ">; rel=\"canonical\""
@@ -484,7 +486,7 @@ checkDocTarball pkgid =
------------------------------------------------------------------------------}
mapParaM :: Monad m => (a -> m b) -> [a] -> m [(a, b)]
-mapParaM f = mapM (\x -> (,) x `liftM` f x)
+mapParaM f = mapM (\x -> (,) x <$> f x)
getFileAge :: FilePath -> IO NominalDiffTime
getFileAge file = diffUTCTime <$> getCurrentTime <*> getModificationTime file
diff --git a/src/Distribution/Server/Features/PackageInfoJSON.hs b/src/Distribution/Server/Features/PackageInfoJSON.hs
index 3daf2f1e..ceabedef 100644
--- a/src/Distribution/Server/Features/PackageInfoJSON.hs
+++ b/src/Distribution/Server/Features/PackageInfoJSON.hs
@@ -85,7 +85,9 @@ initPackageInfoJSONFeature env = do
return $ \core preferred -> do
let coreR = coreResource core
- info = "Get basic package information"
+ info = "Get basic package information: \
+ \The response contains a JSON object where the keys are version numbers as strings, \
+ \and the values are whether the version is preferred or not"
vInfo = "Get basic package information at a specific metadata revision"
jsonResources = [
diff --git a/src/Distribution/Server/Framework/RequestContentTypes.hs b/src/Distribution/Server/Framework/RequestContentTypes.hs
index d3a0311d..94ec435b 100644
--- a/src/Distribution/Server/Framework/RequestContentTypes.hs
+++ b/src/Distribution/Server/Framework/RequestContentTypes.hs
@@ -19,7 +19,6 @@ module Distribution.Server.Framework.RequestContentTypes (
-- * various specific content types
expectTextPlain,
- expectUncompressedTarball,
expectCompressedTarball,
expectAesonContent,
expectCSV,
@@ -102,15 +101,6 @@ gzipDecompress content = go content decompressor
expectTextPlain :: ServerPartE LBS.ByteString
expectTextPlain = expectContentType "text/plain"
--- | Expect an uncompressed @.tar@ file.
---
--- The tar file is not validated.
---
--- A content-encoding of \"gzip\" is handled transparently.
---
-expectUncompressedTarball :: ServerPartE LBS.ByteString
-expectUncompressedTarball = expectContentType "application/x-tar"
-
-- | Expect a compressed @.tar.gz@ file.
--
-- Neither the gzip encoding nor the tar format are validated.
@@ -128,7 +118,7 @@ expectCompressedTarball = do
Just actual
| actual == "application/x-tar"
, contentEncoding == Just "gzip" -> consumeRequestBody
- | actual == "application/x-gzip"
+ | actual == "application/gzip" || actual == "application/x-gzip"
, contentEncoding == Nothing -> consumeRequestBody
_ -> errExpectedTarball
where
diff --git a/src/Distribution/Server/Packages/Unpack.hs b/src/Distribution/Server/Packages/Unpack.hs
index 2d9236d7..b939b59d 100644
--- a/src/Distribution/Server/Packages/Unpack.hs
+++ b/src/Distribution/Server/Packages/Unpack.hs
@@ -216,9 +216,11 @@ specVersionChecks specVerOk specVer = do
when (specVer < CabalSpecV1_2) $
throwError "'cabal-version' must be at least 1.2"
- -- To keep people from uploading packages most users cannot use.
+ -- To keep people from uploading packages most users cannot use. Disabled for now.
+{-
unless (specVer <= CabalSpecV3_6) $
throwError "'cabal-version' must be at most 3.6"
+-}
-- | The issue is that browsers can upload the file name using either unix
-- or windows convention, so we need to take the basename using either