hackage-proxy 0.1.0.0 → 0.2.0.0
raw patch · 4 files changed
+37/−23 lines, 4 filesdep +basic-preludedep +containersdep +unordered-containersdep −classy-preludedep ~http-conduit
Dependencies added: basic-prelude, containers, unordered-containers
Dependencies removed: classy-prelude
Dependency ranges changed: http-conduit
Files
- HackageProxy.hs +16/−12
- TweakCabal.hs +9/−3
- hackage-proxy.cabal +5/−3
- hackage-proxy.hs +7/−5
HackageProxy.hs view
@@ -6,7 +6,7 @@ module HackageProxy where import Blaze.ByteString.Builder (fromByteString)-import ClassyPrelude+import BasicPrelude import qualified Codec.Archive.Tar as Tar import Codec.Compression.GZip (compress) import qualified Data.ByteString as S@@ -22,6 +22,10 @@ import Network.Wai.Handler.Warp (run) import System.FilePath (takeExtension) import TweakCabal+import qualified Data.Text as T+import qualified Data.HashSet as HashSet+import Data.Text.Encoding (encodeUtf8)+import qualified Data.ByteString.Lazy as L data HackageProxySettings = HackageProxySettings { hpsPort :: Int@@ -31,9 +35,9 @@ runHackageProxy :: HackageProxySettings -> IO () runHackageProxy HackageProxySettings {..} = do- baseReq <- parseUrl $ unpack hpsSource+ baseReq <- parseUrl $ T.unpack hpsSource run hpsPort $ app baseReq- { checkStatus = \_ _ -> Nothing+ { checkStatus = \_ _ _ -> Nothing -- Sometimes Hackage can be slow at responding. , responseTimeout = Just 30000000 }@@ -50,33 +54,33 @@ (src, _) <- unwrapResumable $ responseBody res let resStatus = responseStatus res- resHeaders = (filter ((`elem` safeResponseHeaders) . fst) (responseHeaders res))+ resHeaders = (filter ((`HashSet.member` safeResponseHeaders) . fst) (responseHeaders res)) if isTarball res then do- lbs <- fromChunks <$> lazyConsume (src $= ungzip)+ lbs <- L.fromChunks <$> lazyConsume (src $= ungzip) entries <- mapEntries tweakEntry $ Tar.read lbs return $ responseLBS resStatus resHeaders (compress $ Tar.write entries) else return $ ResponseSource resStatus resHeaders (mapOutput (Chunk . fromByteString) src) where isTarball res =- ".tar.gz" `isSuffixOf` rawPathInfo waiReq+ ".tar.gz" `S.isSuffixOf` rawPathInfo waiReq && responseStatus res == status200 req = baseReq { path = path baseReq `combine` rawPathInfo' } rawPathInfo' = case pathInfo waiReq of- ["package", stripSuffix ".tar.gz" -> Just packver] | Just package <- mpackage ->+ ["package", T.stripSuffix ".tar.gz" -> Just packver] | Just package <- mpackage -> encodeUtf8 $ intercalate "/" [package, version, packver ++ ".tar.gz"] where- (stripSuffix "-" -> mpackage, version) = breakOnEnd "-" packver+ (T.stripSuffix "-" -> mpackage, version) = breakOnEnd "-" packver _ -> rawPathInfo waiReq combine a b- | "/" `isSuffixOf` a || "/" `S.isPrefixOf` b = a ++ b- | otherwise = concat [a, "/", b]+ | "/" `S.isSuffixOf` a || "/" `S.isPrefixOf` b = a ++ b+ | otherwise = mconcat [a, "/", b] tweakEntry e@(Tar.entryContent -> Tar.NormalFile lbs _) | takeExtension (Tar.entryPath e) == ".cabal" = e- { Tar.entryContent = Tar.NormalFile lbs' $ length lbs'+ { Tar.entryContent = Tar.NormalFile lbs' $ L.length lbs' } where lbs' = tweakCabal tcs lbs@@ -87,7 +91,7 @@ mapEntries _ (Tar.Fail e) = throwIO e safeResponseHeaders :: HashSet (CI ByteString)-safeResponseHeaders = pack+safeResponseHeaders = HashSet.fromList [ "content-type" , "etag" , "expires"
TweakCabal.hs view
@@ -2,7 +2,13 @@ {-# LANGUAGE RecordWildCards #-} module TweakCabal where -import ClassyPrelude+import BasicPrelude+import qualified Data.Set as Set+import qualified Data.Text as T+import Data.Text.Encoding.Error (lenientDecode)+import Data.Text.Lazy (pack, unpack)+import Data.Text.Lazy.Encoding (decodeUtf8With,+ encodeUtf8) import Debug.Trace import Distribution.Package import Distribution.PackageDescription@@ -18,7 +24,7 @@ tweakCabal :: TweakCabalSettings -> LByteString -> LByteString tweakCabal TweakCabalSettings {..} bs = fromMaybe bs $ do gpd <-- case parsePackageDescription $ unpack $ decodeUtf8 bs of+ case parsePackageDescription $ unpack $ decodeUtf8With lenientDecode bs of ParseFailed _ -> Nothing ParseOk _ x -> Just x let string = showGenericPackageDescription gpd@@ -43,7 +49,7 @@ tweakConstraints = map tweakDependency tweakDependency orig@(Dependency name'@(PackageName name) _)- | pack name `elem` tcsNoBounds = Dependency name' anyVersion+ | T.pack name `Set.member` tcsNoBounds = Dependency name' anyVersion | otherwise = orig tweakComponents (a, b, c) =
hackage-proxy.cabal view
@@ -1,5 +1,5 @@ name: hackage-proxy-version: 0.1.0.0+version: 0.2.0.0 synopsis: Provide a proxy for Hackage which modifies responses in some way. description: The motivating use case for this is testing packages with newer versions of GHC. In this case, upper bounds on base, process, and a few other packages will often prevent compilation. This proxy will allow you to strip those upper bounds and proceed with compilation. In the future, other features may be added as well, such as package replacement. homepage: http://github.com/snoyberg/hackage-proxy@@ -16,11 +16,11 @@ other-modules: HackageProxy TweakCabal build-depends: base >= 4.5 && < 5- , classy-prelude >= 0.5+ , basic-prelude >= 0.3.5 , Cabal >= 1.12 , wai >=1.3 , warp >=1.3- , http-conduit >=1.8+ , http-conduit >=1.9 , transformers >= 0.2 , case-insensitive , conduit >= 0.5@@ -33,3 +33,5 @@ , bytestring >= 0.9 , text >= 0.11 , optparse-applicative >= 0.5+ , containers+ , unordered-containers
hackage-proxy.hs view
@@ -1,8 +1,10 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-}-import ClassyPrelude+import BasicPrelude import HackageProxy import Options.Applicative+import qualified Data.Text as T+import qualified Data.Set as Set hackageProxySettings :: Parser HackageProxySettings hackageProxySettings = HackageProxySettings@@ -19,7 +21,7 @@ <> short 'n' <> metavar "PACKAGE" )))- <*> (pack <$> strOption+ <*> (T.pack <$> strOption ( long "source" <> help "Hackage source URL we're proxying from" <> short 's'@@ -27,14 +29,14 @@ <> metavar "URL" )) where- fixNoBounds [] = pack $ words "base process Cabal directory template-haskell"- fixNoBounds x = pack $ map pack x+ fixNoBounds [] = Set.fromList $ words "base process Cabal directory template-haskell"+ fixNoBounds x = Set.fromList $ map T.pack x main :: IO () main = do hps <- execParser opts putStrLn $ "Listening on port: " ++ show (hpsPort hps)- putStrLn $ "Dropping bounds for: " ++ unwords (unpack $ hpsNoBounds hps)+ putStrLn $ "Dropping bounds for: " ++ unwords (Set.toList $ hpsNoBounds hps) putStrLn $ "Downloading from: " ++ hpsSource hps runHackageProxy hps where