diff --git a/Stackage.hs b/Stackage.hs index 439e136..3f7700a 100755 --- a/Stackage.hs +++ b/Stackage.hs @@ -14,6 +14,7 @@ import qualified Crypto.Hash.SHA256 as SHA256 import Control.Monad (forM_, unless) import Data.Aeson.Types import Data.Bifunctor +import Data.List (intercalate) import Data.Yaml import Distribution.Package import Distribution.PackageDescription (FlagName, mkFlagName, unFlagName) @@ -31,6 +32,7 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BC +import qualified Data.List.NonEmpty as Nel import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified Distribution.Text as Cabal @@ -46,15 +48,17 @@ main = do "https://raw.githubusercontent.com/fpco/lts-haskell/master/" ++ resolver ++ ".yaml" _ -> "https://raw.githubusercontent.com/fpco/stackage-nightly/master/" ++ resolver ++ ".yaml" - ltsYaml <- downloadUrl manager ltsUrl + ltsYaml <- downloadUrl manager (ltsUrl Nel.:| []) plan <- case decodeEither' $ L.toStrict ltsYaml of Left err -> throw err Right (x :: BuildPlan) -> pure x shas <- flip Map.traverseWithKey (planPackages plan) $ \n p -> do - let hackageUrl = "https://hackage.haskell.org/package/" - ++ Cabal.display n ++ "-" ++ Cabal.display (planPackageVersion p) - ++ ".tar.gz" - tar <- downloadUrl manager hackageUrl + let + tarball = Cabal.display n ++ "-" ++ Cabal.display (planPackageVersion p) ++ ".tar.gz" + fpcoUrl = "http://hackage.fpcomplete.com/package/" + hackageUrl = "http://hackage.haskell.org/package/" + urls = fmap (++tarball) (fpcoUrl Nel.:| [hackageUrl]) + tar <- downloadUrl manager urls putStrLn (Cabal.display n) return $! SHA256.hashlazy tar writeFile out $ show $ @@ -88,16 +92,32 @@ flagsExpr :: Flags -> Expr flagsExpr m = ExprDict $ bimap (ExprString . unFlagName) ExprBool <$> Map.toList m -downloadUrl :: Manager -> String -> IO L.ByteString -downloadUrl manager url = do - req <- parseRequest url - resp <- httpLbs req manager - let status = responseStatus resp - unless (statusIsSuccessful status) - $ error $ "Unable to download " ++ show url - ++ "\nStatus: " ++ show (statusCode status) - ++ " " ++ BC.unpack (statusMessage status) - return $ responseBody resp +downloadUrl :: Manager -> Nel.NonEmpty String -> IO L.ByteString +downloadUrl manager urls = do + resp <- tryUrls urls + let + allUrls = intercalate ", " $ Nel.toList urls + status = responseStatus resp + unless (statusIsSuccessful status) + $ error $ "Unable to download any of " ++ allUrls + ++ "\n Last status: " ++ show (statusCode status) + ++ " " ++ BC.unpack (statusMessage status) + return $ responseBody resp + where + tryUrl u = do + req <- parseRequest u + httpLbs req manager + + tryUrls (u Nel.:| []) = do + resp <- tryUrl u + return resp + + tryUrls (u Nel.:|(u':us)) = do + resp <- tryUrl u + let status = responseStatus resp + if (statusIsSuccessful status) + then return resp + else tryUrls $ u' Nel.:| us -------------------------------------------------------------------------------- -- JSON data types and instances for parsing the LTS yaml file diff --git a/hazel.bzl b/hazel.bzl index 3f3ccd1..206643c 100644 --- a/hazel.bzl +++ b/hazel.bzl @@ -11,22 +11,28 @@ load("@bazel_tools//tools/build_defs/repo:http.bzl", load("//tools:ghc.bzl", "get_ghc_workspace", "default_ghc_workspaces") load("//tools:mangling.bzl", "hazel_binary", "hazel_library", "hazel_workspace") +def _mirrors(pkg): + return [package_url_template.format(pkg) for package_url_template in [ + "http://hackage.fpcomplete.com/package/{}.tar.gz", + "http://hackage.haskell.org/package/{}.tar.gz", + ]] + def _cabal_haskell_repository_impl(ctx): ghc_workspace = get_ghc_workspace(ctx.attr.ghc_workspaces, ctx) pkg = "{}-{}".format(ctx.attr.package_name, ctx.attr.package_version) - url = "https://hackage.haskell.org/package/{}.tar.gz".format(pkg) + urls = _mirrors(pkg) # If the SHA is wrong, the error message is very unhelpful: # https://github.com/bazelbuild/bazel/issues/3709 # As a workaround, we compute it manually if it's not set (and then fail # this rule). if not ctx.attr.sha256: - ctx.download(url=url, output="tar") + ctx.download(url=urls, output="tar") res = ctx.execute(["openssl", "sha", "-sha256", "tar"]) fail("Missing expected attribute \"sha256\" for {}; computed {}".format(pkg, res.stdout + res.stderr)) ctx.download_and_extract( - url=url, + url=urls, stripPrefix=ctx.attr.package_name + "-" + ctx.attr.package_version, sha256=ctx.attr.sha256, output="") @@ -216,10 +222,7 @@ def hazel_custom_package_hackage( build_file and build_file_content are mutually exclusive. """ package_id = package_name + "-" + version - url = "https://hackage.haskell.org/package/{0}/{1}.tar.gz".format( - package_id, - package_id, - ) + urls = _mirrors(package_id) if not build_file and not build_file_content: build_file = "//third_party/haskell:BUILD.{0}".format(package_name) http_archive( @@ -228,7 +231,7 @@ def hazel_custom_package_hackage( build_file_content = build_file_content, sha256 = sha256, strip_prefix = package_id, - urls = [url], + urls = urls, ) def hazel_custom_package_github(