Skip to content

Commit c2f2898

Browse files
committed
pathinfo ad-hoc check, [and email fix]
1 parent fa1d82c commit c2f2898

File tree

2 files changed

+21
-1
lines changed

2 files changed

+21
-1
lines changed

src/Distribution/Server/Features/UserSignup.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -491,7 +491,7 @@ userSignupFeature ServerEnv{serverBaseURI, serverCron}
491491
uriPath = "/users/register-request/"
492492
++ renderNonce nonce
493493
}
494-
, "endorselink" $- serverBaseURI {uriPath = "/user/" ++ username ++ "/endorse"
494+
, "endorselink" $= serverBaseURI {uriPath = "/user/" ++ T.unpack username ++ "/endorse"}
495495
, "serverhost" $= serverBaseURI
496496
]
497497
Just ourHost = uriAuthority serverBaseURI

src/Distribution/Server/Packages/Unpack.hs

Lines changed: 20 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -82,6 +82,10 @@ import qualified System.FilePath.Posix
8282
import Text.Printf
8383
( printf )
8484

85+
import Distribution.Types.BuildInfo.Lens
86+
import Distribution.Compat.Lens
87+
import Distribution.ModuleName
88+
8589
-- Whether to allow upload of "all rights reserved" packages
8690
allowAllRightsReserved :: Bool
8791
allowAllRightsReserved = False
@@ -284,6 +288,14 @@ tarOps pkgId tarIndex = CheckPackageContentOps {
284288
Just (Link fp) -> fileContents fp
285289
_ -> throwError ("getFileContents: file does not exist: " ++ path)
286290

291+
checkPathInfo :: PackageDescription -> UploadMonad ()
292+
checkPathInfo desc =
293+
let autogens = concat $ toListOf (traverseBuildInfos . autogenModules) desc
294+
matches x = case components x of
295+
[m] -> "PackageInfo_" `isPrefixOf` m
296+
_ -> False
297+
in if any matches autogens then throwError $ "Hackage does not yet allow uploads of packages with autogenerated module PackageInfo_*" else pure ()
298+
287299
-- Miscellaneous checks on package description
288300
extraChecks :: GenericPackageDescription
289301
-> PackageIdentifier
@@ -293,8 +305,16 @@ extraChecks genPkgDesc pkgId tarIndex = do
293305
let pkgDesc = flattenPackageDescription genPkgDesc
294306
fileChecks <- checkPackageContent (tarOps pkgId tarIndex) pkgDesc
295307

308+
309+
-- this path info check is just until we can depend on cabal 3.12 for PathInfo autogen modules.
310+
-- https://github.com/haskell/cabal/issues/9331
311+
checkPathInfo pkgDesc
312+
296313
let pureChecks = checkPackage genPkgDesc (Just pkgDesc)
297314
checks = pureChecks ++ fileChecks
315+
316+
317+
298318
isDistError (PackageDistSuspicious {}) = False -- just a warning
299319
isDistError (PackageDistSuspiciousWarn {}) = False -- just a warning
300320
isDistError _ = True

0 commit comments

Comments
 (0)