http-client-tls 0.3.5.3 → 0.4.0
raw patch · 4 files changed
Files
- ChangeLog.md +28/−0
- Network/HTTP/Client/TLS.hs +14/−9
- http-client-tls.cabal +11/−9
- test/Spec.hs +38/−3
ChangeLog.md view
@@ -1,3 +1,31 @@+# 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)
Network/HTTP/Client/TLS.hs view
@@ -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@@ -357,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=\""
http-client-tls.cabal view
@@ -1,5 +1,5 @@ name: http-client-tls-version: 0.3.5.3+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: <https://www.stackage.org/package/http-client-tls>. 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@@ -41,11 +41,13 @@ hs-source-dirs: test default-language: Haskell2010 build-depends: base- , connection , hspec , http-client , http-client-tls , http-types+ , crypton-connection+ , data-default+ , tls benchmark benchmark main-is: Bench.hs
test/Spec.hs view
@@ -1,13 +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 ->@@ -29,16 +44,36 @@ `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 = TLSSettingsSimple+ tlsSettings' = tlsSettings { settingDisableCertificateValidation = True , settingDisableSession = False , settingUseServerName = False } socketSettings = Nothing- managerSettings = mkManagerSettings tlsSettings socketSettings+ managerSettings = mkManagerSettings tlsSettings' socketSettings manager <- newTlsManagerWith managerSettings let url = "https://wrong.host.badssl.com" request <- parseRequest url