Merge pull request #1273 from haskell/gb/ad-hoc-pathinfo-check

pathinfo ad-hoc check for central-server

Author: gbaz

src/Distribution/Server/Features/UserSignup.hs

@@ -491,7 +491,7 @@ userSignupFeature ServerEnv{serverBaseURI, serverCron}
                                    uriPath = "/users/register-request/"
                                           ++ renderNonce nonce
                                  }
-              , "endorselink" $- serverBaseURI {uriPath = "/user/" ++ username ++ "/endorse"
+              , "endorselink" $= serverBaseURI {uriPath = "/user/" ++ T.unpack username ++ "/endorse"}
               , "serverhost"  $= serverBaseURI
               ]
             Just ourHost = uriAuthority serverBaseURI

src/Distribution/Server/Packages/Unpack.hs

@@ -82,6 +82,10 @@ import qualified System.FilePath.Posix
 import Text.Printf
          ( printf )
 
+import Distribution.Types.BuildInfo.Lens
+import Distribution.Compat.Lens
+import Distribution.ModuleName
+
 -- Whether to allow upload of "all rights reserved" packages
 allowAllRightsReserved :: Bool
 allowAllRightsReserved = False
@@ -284,6 +288,14 @@ tarOps pkgId tarIndex = CheckPackageContentOps {
         Just (Link fp) -> fileContents fp
         _ -> throwError ("getFileContents: file does not exist: " ++ path)
 
+checkPathInfo :: PackageDescription -> UploadMonad ()
+checkPathInfo desc =
+   let autogens = concat $ toListOf (traverseBuildInfos . autogenModules) desc
+       matches x = case components x of
+           [m] -> "PackageInfo_" `isPrefixOf` m
+           _ -> False
+   in if any matches autogens then throwError $ "Hackage does not yet allow uploads of packages with autogenerated module PackageInfo_*" else pure ()
+
 -- Miscellaneous checks on package description
 extraChecks :: GenericPackageDescription
             -> PackageIdentifier
@@ -293,8 +305,16 @@ extraChecks genPkgDesc pkgId tarIndex = do
   let pkgDesc = flattenPackageDescription genPkgDesc
   fileChecks <- checkPackageContent (tarOps pkgId tarIndex) pkgDesc
 
+
+  -- this path info check is just until we can depend on cabal 3.12 for PathInfo autogen modules.
+  -- https://github.com/haskell/cabal/issues/9331
+  checkPathInfo pkgDesc
+
   let pureChecks = checkPackage genPkgDesc (Just pkgDesc)
       checks = pureChecks ++ fileChecks
+
+
+
       isDistError (PackageDistSuspicious     {}) = False -- just a warning
       isDistError (PackageDistSuspiciousWarn {}) = False -- just a warning
       isDistError _                              = True