diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,40 @@ +# Changelog for http-client-tls + +## 0.4.0 + +* For MD5 hashes in Base16 format, depend on packages `cryptohash-md5` and + `base16` rather than `crypton` and `memory` (the latter is unmaintained). + +## 0.3.6.4 + +* data-default-class -> data-default [#546](https://github.com/snoyberg/http-client/pull/546/files) + +## 0.3.6.3 + +* catching up to tls 1.8.0 [#515](https://github.com/snoyberg/http-client/pull/515) + +## 0.3.6.2 + +* Migrate to `crypton` + +## 0.3.6.1 + +* [#482](https://github.com/snoyberg/http-client/issues/482): + Raise lower bound on `http-client` to fix build. + +## 0.3.6 + +* Allow making requests to raw IPv6 hosts [#477](https://github.com/snoyberg/http-client/pull/477) + +## 0.3.5.3 + +* Fix `newTlsManager` [#325](https://github.com/snoyberg/http-client/issues/325) + +## 0.3.5.2 + +* [#289](https://github.com/snoyberg/http-client/issues/289): + Keep original `TLSSettings` when creating a `Manager` using `newTlsManagerWith`. + ## 0.3.5.1 * Also catch TLSError exceptions [#273](https://github.com/snoyberg/http-client/pull/273) diff --git a/Network/HTTP/Client/TLS.hs b/Network/HTTP/Client/TLS.hs --- a/Network/HTTP/Client/TLS.hs +++ b/Network/HTTP/Client/TLS.hs @@ -26,7 +26,7 @@ import Control.Applicative ((<|>)) import Control.Arrow (first) import System.Environment (getEnvironment) -import Data.Default.Class +import Data.Default import Network.HTTP.Client hiding (host, port) import Network.HTTP.Client.Internal hiding (host, port) import Control.Exception @@ -41,9 +41,10 @@ import qualified Data.CaseInsensitive as CI import Data.Maybe (fromMaybe, isJust) import Network.HTTP.Types (status401) -import Crypto.Hash (hash, Digest, MD5) +import qualified Crypto.Hash.MD5 as MD5 import Control.Arrow ((***)) -import Data.ByteArray.Encoding (convertToBase, Base (Base16)) +import Data.Base16.Types (extractBase16) +import Data.ByteString.Base16 (encodeBase16') import Data.Typeable (Typeable) import Control.Monad.Catch (MonadThrow, throwM) import qualified Data.Map as Map @@ -91,18 +92,22 @@ , managerRetryableException = \e -> case () of () +#if MIN_VERSION_tls(1,8,0) + | ((fromException e)::(Maybe TLS.TLSException))==Just (TLS.PostHandshake TLS.Error_EOF) -> True +#else | ((fromException e)::(Maybe TLS.TLSError))==Just TLS.Error_EOF -> True +#endif | otherwise -> managerRetryableException defaultManagerSettings e , managerWrapException = \req -> let wrapper se | Just (_ :: IOException) <- fromException se = se' | Just (_ :: TLS.TLSException) <- fromException se = se' +#if !MIN_VERSION_tls(1,8,0) | Just (_ :: TLS.TLSError) <- fromException se = se' +#endif | Just (_ :: NC.LineTooLong) <- fromException se = se' -#if MIN_VERSION_connection(0,2,7) | Just (_ :: NC.HostNotResolved) <- fromException se = se' | Just (_ :: NC.HostCannotConnect) <- fromException se = se' -#endif | otherwise = se where se' = toException $ HttpExceptionRequest req $ InternalException se @@ -121,7 +126,7 @@ context <- maybe NC.initConnectionContext return mcontext return $ \_ha host port -> bracketOnError (NC.connectTo context NC.ConnectionParams - { NC.connectionHostname = host + { NC.connectionHostname = strippedHostName host , NC.connectionPort = fromIntegral port , NC.connectionUseSecure = tls , NC.connectionUseSocks = sock @@ -138,13 +143,13 @@ context <- maybe NC.initConnectionContext return mcontext return $ \connstr checkConn serverName _ha host port -> bracketOnError (NC.connectTo context NC.ConnectionParams - { NC.connectionHostname = serverName + { NC.connectionHostname = strippedHostName serverName , NC.connectionPort = fromIntegral port , NC.connectionUseSecure = Nothing , NC.connectionUseSocks = case sock of Just _ -> error "Cannot use SOCKS and TLS proxying together" - Nothing -> Just $ NC.OtherProxy host $ fromIntegral port + Nothing -> Just $ NC.OtherProxy (strippedHostName host) $ fromIntegral port }) NC.connectionClose $ \conn -> do @@ -180,7 +185,16 @@ -- -- @since 0.3.4 newTlsManager :: MonadIO m => m Manager -newTlsManager = newTlsManagerWith defaultManagerSettings +newTlsManager = liftIO $ do + env <- getEnvironment + let lenv = Map.fromList $ map (first $ T.toLower . T.pack) env + msocksHTTP = parseSocksSettings env lenv "http_proxy" + msocksHTTPS = parseSocksSettings env lenv "https_proxy" + settings = mkManagerSettingsContext' defaultManagerSettings (Just globalConnectionContext) def msocksHTTP msocksHTTPS + settings' = maybe id (const $ managerSetInsecureProxy proxyFromRequest) msocksHTTP + $ maybe id (const $ managerSetSecureProxy proxyFromRequest) msocksHTTPS + settings + newManager settings' -- | Load up a new TLS manager based upon specified settings, -- respecting proxy environment variables. @@ -196,6 +210,14 @@ settings' = maybe id (const $ managerSetInsecureProxy proxyFromRequest) msocksHTTP $ maybe id (const $ managerSetSecureProxy proxyFromRequest) msocksHTTPS settings + -- We want to keep the original TLS settings that were + -- passed in. Sadly they aren't available as a record + -- field on `ManagerSettings`. So instead we grab the + -- fields that depend on the TLS settings. + -- https://github.com/snoyberg/http-client/issues/289 + { managerTlsConnection = managerTlsConnection set + , managerTlsProxyConnection = managerTlsProxyConnection set + } newManager settings' parseSocksSettings :: [(String, String)] -- ^ original environment @@ -340,7 +362,7 @@ -- we always use no qop or qop=auth ha2 = md5 $ S.concat [method req, ":", path req] - md5 bs = convertToBase Base16 (hash bs :: Digest MD5) + md5 = extractBase16 . encodeBase16' . MD5.hash key = "Authorization" val = S.concat [ "Digest username=\"" diff --git a/bench/Bench.hs b/bench/Bench.hs --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -1,6 +1,11 @@ +{-# LANGUAGE CPP #-} module Main where -import Criterion.Main +#if MIN_VERSION_gauge(0, 2, 0) +import Gauge +#else +import Gauge.Main +#endif import Network.HTTP.Client import Network.HTTP.Client.TLS diff --git a/http-client-tls.cabal b/http-client-tls.cabal --- a/http-client-tls.cabal +++ b/http-client-tls.cabal @@ -1,5 +1,5 @@ name: http-client-tls -version: 0.3.5.1 +version: 0.4.0 synopsis: http-client backend using the connection package and tls library description: Hackage documentation generation is not reliable. For up to date documentation, please see: . homepage: https://github.com/snoyberg/http-client @@ -16,18 +16,18 @@ library exposed-modules: Network.HTTP.Client.TLS other-extensions: ScopedTypeVariables - build-depends: base >= 4 && < 5 - , data-default-class - , http-client >= 0.5.0 - , connection >= 0.2.5 + build-depends: base >= 4.10 && < 5 + , base16 >= 1.0 + , cryptohash-md5 + , data-default + , http-client >= 0.7.11 + , crypton-connection , network - , tls >= 1.2 + , tls >= 2.1.2 , bytestring , case-insensitive , transformers , http-types - , cryptonite - , memory , exceptions , containers , text @@ -45,6 +45,9 @@ , http-client , http-client-tls , http-types + , crypton-connection + , data-default + , tls benchmark benchmark main-is: Bench.hs @@ -52,6 +55,6 @@ hs-source-dirs: bench default-language: Haskell2010 build-depends: base - , criterion + , gauge , http-client , http-client-tls diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,12 +1,28 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} import Test.Hspec +import Network.Connection import Network.HTTP.Client -import Network.HTTP.Client.TLS +import Network.HTTP.Client.TLS hiding (tlsManagerSettings) import Network.HTTP.Types import Control.Monad (join) +import Data.Default +import qualified Network.TLS as TLS main :: IO () main = hspec $ do + let tlsSettings = def + -- Since the release of v2.0.0 of the `tls` package , the default value of + -- the `supportedExtendedMainSecret` parameter `is `RequireEMS`, this means + -- that all the connections to a server not supporting TLS1.2+EMS will fail. + -- The badssl.com service does not yet support TLS1.2+EMS connections, so + -- let's switch to the value `AllowEMS`, ie: TLS1.2 conenctions without EMS. +#if MIN_VERSION_crypton_connection(0,4,0) + {settingClientSupported = def {TLS.supportedExtendedMainSecret = TLS.AllowEMS}} +#endif + + let tlsManagerSettings = mkManagerSettings tlsSettings Nothing + it "make a TLS connection" $ do manager <- newManager tlsManagerSettings withResponse "https://httpbin.org/status/418" manager $ \res -> @@ -27,3 +43,45 @@ join (applyDigestAuth "user" "passwd" "http://httpbin.org/" man) `shouldThrow` \(DigestAuthException _ _ det) -> det == UnexpectedStatusCode + + it "BadSSL: expired" $ do + manager <- newManager tlsManagerSettings + let action = withResponse "https://expired.badssl.com/" manager (const (return ())) + action `shouldThrow` anyException + + it "BadSSL: self-signed" $ do + manager <- newManager tlsManagerSettings + let action = withResponse "https://self-signed.badssl.com/" manager (const (return ())) + action `shouldThrow` anyException + + it "BadSSL: wrong.host" $ do + manager <- newManager tlsManagerSettings + let action = withResponse "https://wrong.host.badssl.com/" manager (const (return ())) + action `shouldThrow` anyException + + it "BadSSL: we do have case-insensitivity though" $ do + manager <- newManager $ tlsManagerSettings + withResponse "https://BADSSL.COM" manager $ \res -> + responseStatus res `shouldBe` status200 + + -- https://github.com/snoyberg/http-client/issues/289 + it "accepts TLS settings" $ do + let + tlsSettings' = tlsSettings + { settingDisableCertificateValidation = True + , settingDisableSession = False + , settingUseServerName = False + } + socketSettings = Nothing + managerSettings = mkManagerSettings tlsSettings' socketSettings + manager <- newTlsManagerWith managerSettings + let url = "https://wrong.host.badssl.com" + request <- parseRequest url + response <- httpNoBody request manager + responseStatus response `shouldBe` status200 + + it "global supports TLS" $ do + manager <- getGlobalManager + request <- parseRequest "https://httpbin.org" + response <- httpNoBody request manager + responseStatus response `shouldBe` status200