diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +0.1.1 +----- +* Implement updated HttpLib API from hackage-security 0.5 + 0.1.0.2 ------- * Allow for hackage-security 0.3.* diff --git a/hackage-security-HTTP.cabal b/hackage-security-HTTP.cabal --- a/hackage-security-HTTP.cabal +++ b/hackage-security-HTTP.cabal @@ -1,5 +1,5 @@ name: hackage-security-HTTP -version: 0.1.0.2 +version: 0.1.1 synopsis: Hackage security bindings against the HTTP library description: The hackage security library provides a 'HttpLib' abstraction to allow to bind against different HTTP @@ -12,12 +12,18 @@ maintainer: edsko@well-typed.com copyright: Copyright 2015 Well-Typed LLP category: Distribution +homepage: https://github.com/well-typed/hackage-security +bug-reports: https://github.com/well-typed/hackage-security/issues build-type: Simple cabal-version: >=1.10 extra-source-files: ChangeLog.md +source-repository head + type: git + location: https://github.com/well-typed/hackage-security.git + flag use-network-uri description: Are we using network-uri? manual: False @@ -29,7 +35,7 @@ HTTP >= 4000.2.19 && < 4000.3, mtl >= 2.2 && < 2.3, zlib >= 0.5 && < 0.7, - hackage-security >= 0.1 && < 0.4 + hackage-security >= 0.5 && < 0.6 hs-source-dirs: src default-language: Haskell2010 default-extensions: DeriveDataTypeable diff --git a/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs b/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs --- a/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs +++ b/src/Hackage/Security/Client/Repository/HttpLib/HTTP.hs @@ -21,16 +21,11 @@ import Data.List (intercalate) import Data.Typeable (Typeable) import Network.URI -import qualified Data.ByteString.Lazy as BS.L -import qualified Control.Monad.State as State -import qualified Codec.Compression.GZip as GZip -import qualified Network.Browser as HTTP -import qualified Network.HTTP as HTTP -import qualified Network.HTTP.Proxy as HTTP - -#if MIN_VERSION_zlib(0,6,0) -import qualified Codec.Compression.Zlib.Internal as GZip (DecompressError) -#endif +import qualified Data.ByteString.Lazy as BS.L +import qualified Control.Monad.State as State +import qualified Network.Browser as HTTP +import qualified Network.HTTP as HTTP +import qualified Network.HTTP.Proxy as HTTP import Hackage.Security.Client import Hackage.Security.Client.Repository.HttpLib @@ -69,6 +64,8 @@ get browser reqHeaders uri callback = wrapCustomEx $ do response <- request browser $ setRequestHeaders reqHeaders + -- avoid silly `Content-Length: 0` header inserted by `mkRequest` + $ removeHeader HTTP.HdrContentLength $ HTTP.mkRequest HTTP.GET uri case HTTP.rspCode response of (2, 0, 0) -> withResponse response callback @@ -77,17 +74,25 @@ getRange :: Throws SomeRemoteError => Browser -> [HttpRequestHeader] -> URI -> (Int, Int) - -> ([HttpResponseHeader] -> BodyReader -> IO a) + -> (HttpStatus -> [HttpResponseHeader] -> BodyReader -> IO a) -> IO a getRange browser reqHeaders uri (from, to) callback = wrapCustomEx $ do response <- request browser $ setRange from to $ setRequestHeaders reqHeaders + -- avoid silly `Content-Length: 0` header inserted by `mkRequest` + $ removeHeader HTTP.HdrContentLength $ HTTP.mkRequest HTTP.GET uri case HTTP.rspCode response of - (2, 0, 6) -> withResponse response callback + (2, 0, 0) -> withResponse response $ callback HttpStatus200OK + (2, 0, 6) -> withResponse response $ callback HttpStatus206PartialContent otherCode -> throwChecked $ UnexpectedResponse uri otherCode +removeHeader :: HTTP.HasHeaders a => HTTP.HeaderName -> a -> a +removeHeader name h = HTTP.setHeaders h newHeaders + where + newHeaders = [ x | x@(HTTP.Header n _) <- HTTP.getHeaders h, name /= n ] + {------------------------------------------------------------------------------- Auxiliary methods used to implement the HttpClient interface -------------------------------------------------------------------------------} @@ -97,47 +102,25 @@ -> ([HttpResponseHeader] -> BodyReader -> IO a) -> IO a withResponse response callback = wrapCustomEx $ do - br <- bodyReaderFromBS $ decompress (HTTP.rspBody response) - callback responseHeaders $ wrapCustomEx (checkDecompressError br) + br <- bodyReaderFromBS $ HTTP.rspBody response + callback responseHeaders $ wrapCustomEx br where - responseHeaders = getResponseHeaders response - needsDecompression = HttpResponseContentCompression `elem` responseHeaders - decompress = if needsDecompression then GZip.decompress else id + responseHeaders = getResponseHeaders response {------------------------------------------------------------------------------- Custom exception types -------------------------------------------------------------------------------} -#if MIN_VERSION_zlib(0,6,0) wrapCustomEx :: ( ( Throws UnexpectedResponse , Throws IOException - , Throws GZip.DecompressError ) => IO a) -> (Throws SomeRemoteError => IO a) -wrapCustomEx act = handleChecked (\(ex :: UnexpectedResponse) -> go ex) - $ handleChecked (\(ex :: IOException) -> go ex) - $ handleChecked (\(ex :: GZip.DecompressError) -> go ex) - $ act - where - go ex = throwChecked (SomeRemoteError ex) - -checkDecompressError :: Throws GZip.DecompressError => IO a -> IO a -checkDecompressError = handle $ \(ex :: GZip.DecompressError) -> throwChecked ex -#else -wrapCustomEx :: ( ( Throws UnexpectedResponse - , Throws IOException - ) => IO a) - -> (Throws SomeRemoteError => IO a) wrapCustomEx act = handleChecked (\(ex :: UnexpectedResponse) -> go ex) $ handleChecked (\(ex :: IOException) -> go ex) $ act where go ex = throwChecked (SomeRemoteError ex) -checkDecompressError :: IO a -> IO a -checkDecompressError = id -#endif - data UnexpectedResponse = UnexpectedResponse URI (Int, Int, Int) deriving (Typeable) @@ -265,8 +248,6 @@ trOpt (insert HTTP.HdrCacheControl ["max-age=0"] acc) os trOpt acc (HttpRequestNoTransform:os) = trOpt (insert HTTP.HdrCacheControl ["no-transform"] acc) os - trOpt acc (HttpRequestContentCompression:os) = - trOpt (insert HTTP.HdrAcceptEncoding ["gzip"] acc) os -- Some headers are comma-separated, others need multiple headers for -- multiple options. @@ -289,8 +270,5 @@ -- and [ HttpResponseAcceptRangesBytes | "bytes" `elem` map HTTP.hdrValue (HTTP.retrieveHeaders hAcceptRanges response) - ] - , [ HttpResponseContentCompression - | HTTP.findHeader HTTP.HdrContentEncoding response == Just "gzip" ] ]