http-client-tls 0.2.4.1 → 0.4.0
raw patch · 6 files changed
Files
- ChangeLog.md +92/−0
- Network/HTTP/Client/TLS.hs +354/−56
- README.md +1/−1
- bench/Bench.hs +20/−0
- http-client-tls.cabal +29/−6
- test/Spec.hs +77/−5
ChangeLog.md view
@@ -1,3 +1,95 @@+# 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)++## 0.3.5++* Add `newTlsManagerWith`+ [#278](https://github.com/snoyberg/http-client/issues/278), which+ provides a variant of `newTlsManager` that takes a `ManagerSettings`+ to base its settings off of.++## 0.3.4.2++* Never throw exceptions on 401 status in `applyDigestAuth`++## 0.3.4.1++* Better exception cleanup behavior++## 0.3.4++* Add 'newTlsManager'+ [#263](https://github.com/snoyberg/http-client/issues/263), which adds+ support for respecting `socks5://` and `socks5h://` `http_proxy` and+ `https_proxy` environment variables.++## 0.3.3.2++* Better handling of internal exceptions++## 0.3.3.1++* Better exception safety via `bracketOnError`++## 0.3.3++* Add `DigestAuthException` and generalize `applyDigestAuth`+* Global manager uses a shared TLS context (faster init)++## 0.3.2++* Add `mkManagerSettingsContext` [#228](https://github.com/snoyberg/http-client/issues/228)++## 0.3.1.1++* Minor doc updates++## 0.3.1++* Add `applyDigestAuth`++## 0.3.0++* Support http-client 0.5+ ## 0.2.4.1 * Cabal description fix
Network/HTTP/Client/TLS.hs view
@@ -1,22 +1,34 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-} -- | Support for making connections via the connection package and, in turn, -- the tls package suite. ----- Recommended reading: <https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md>+-- Recommended reading: <https://haskell-lang.org/library/http-client> module Network.HTTP.Client.TLS ( -- * Settings tlsManagerSettings , mkManagerSettings+ , mkManagerSettingsContext+ , newTlsManager+ , newTlsManagerWith+ -- * Digest authentication+ , applyDigestAuth+ , DigestAuthException (..)+ , DigestAuthExceptionDetails (..)+ , displayDigestAuthException -- * Global manager , getGlobalManager , setGlobalManager- -- * Internal- , getTlsConnection ) where -import Data.Default.Class-import Network.HTTP.Client-import Network.HTTP.Client.Internal+import Control.Applicative ((<|>))+import Control.Arrow (first)+import System.Environment (getEnvironment)+import Data.Default+import Network.HTTP.Client hiding (host, port)+import Network.HTTP.Client.Internal hiding (host, port) import Control.Exception import qualified Network.Connection as NC import Network.Socket (HostAddress)@@ -24,44 +36,81 @@ import qualified Data.ByteString as S import Data.IORef (IORef, newIORef, readIORef, writeIORef) import System.IO.Unsafe (unsafePerformIO)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad (guard, unless)+import qualified Data.CaseInsensitive as CI+import Data.Maybe (fromMaybe, isJust)+import Network.HTTP.Types (status401)+import qualified Crypto.Hash.MD5 as MD5+import Control.Arrow ((***))+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+import qualified Data.Text as T+import Data.Text.Read (decimal)+import qualified Network.URI as U -- | Create a TLS-enabled 'ManagerSettings' with the given 'NC.TLSSettings' and -- 'NC.SockSettings' mkManagerSettings :: NC.TLSSettings -> Maybe NC.SockSettings -> ManagerSettings-mkManagerSettings tls sock = defaultManagerSettings- { managerTlsConnection = getTlsConnection (Just tls) sock- , managerTlsProxyConnection = getTlsProxyConnection tls sock+mkManagerSettings = mkManagerSettingsContext Nothing++-- | Same as 'mkManagerSettings', but also takes an optional+-- 'NC.ConnectionContext'. Providing this externally can be an+-- optimization, though that may change in the future. For more+-- information, see:+--+-- <https://github.com/snoyberg/http-client/pull/227>+--+-- @since 0.3.2+mkManagerSettingsContext+ :: Maybe NC.ConnectionContext+ -> NC.TLSSettings+ -> Maybe NC.SockSettings+ -> ManagerSettings+mkManagerSettingsContext mcontext tls sock = mkManagerSettingsContext' defaultManagerSettings mcontext tls sock sock++-- | Internal, allow different SockSettings for HTTP and HTTPS+mkManagerSettingsContext'+ :: ManagerSettings+ -> Maybe NC.ConnectionContext+ -> NC.TLSSettings+ -> Maybe NC.SockSettings -- ^ insecure+ -> Maybe NC.SockSettings -- ^ secure+ -> ManagerSettings+mkManagerSettingsContext' set mcontext tls sockHTTP sockHTTPS = set+ { managerTlsConnection = getTlsConnection mcontext (Just tls) sockHTTPS+ , managerTlsProxyConnection = getTlsProxyConnection mcontext tls sockHTTPS , managerRawConnection =- case sock of+ case sockHTTP of Nothing -> managerRawConnection defaultManagerSettings- Just _ -> getTlsConnection Nothing sock+ Just _ -> getTlsConnection mcontext Nothing sockHTTP , 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- | otherwise -> case fromException e of- Just (_ :: IOException) -> True- _ ->- case fromException e of- -- Note: Some servers will timeout connections by accepting- -- the incoming packets for the new request, but closing- -- the connection as soon as we try to read. To make sure- -- we open a new connection under these circumstances, we- -- check for the NoResponseDataReceived exception.- Just NoResponseDataReceived -> True- Just IncompleteHeaders -> True- _ -> False- , managerWrapIOException = - let wrapper se =- case fromException se of- Just e -> toException $ InternalIOException e- Nothing -> case fromException se of- Just TLS.Terminated{} -> toException $ TlsException se- Just TLS.HandshakeFailed{} -> toException $ TlsException se- Just TLS.ConnectionNotEstablished -> toException $ TlsException se- _ -> se+#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'+ | Just (_ :: NC.HostNotResolved) <- fromException se = se'+ | Just (_ :: NC.HostCannotConnect) <- fromException se = se'+ | otherwise = se+ where+ se' = toException $ HttpExceptionRequest req $ InternalException se in handle $ throwIO . wrapper } @@ -69,46 +118,49 @@ tlsManagerSettings :: ManagerSettings tlsManagerSettings = mkManagerSettings def Nothing -getTlsConnection :: Maybe NC.TLSSettings+getTlsConnection :: Maybe NC.ConnectionContext+ -> Maybe NC.TLSSettings -> Maybe NC.SockSettings -> IO (Maybe HostAddress -> String -> Int -> IO Connection)-getTlsConnection tls sock = do- context <- NC.initConnectionContext- return $ \_ha host port -> do- conn <- NC.connectTo context NC.ConnectionParams- { NC.connectionHostname = host+getTlsConnection mcontext tls sock = do+ context <- maybe NC.initConnectionContext return mcontext+ return $ \_ha host port -> bracketOnError+ (NC.connectTo context NC.ConnectionParams+ { NC.connectionHostname = strippedHostName host , NC.connectionPort = fromIntegral port , NC.connectionUseSecure = tls , NC.connectionUseSocks = sock- }- convertConnection conn+ })+ NC.connectionClose+ convertConnection getTlsProxyConnection- :: NC.TLSSettings+ :: Maybe NC.ConnectionContext+ -> NC.TLSSettings -> Maybe NC.SockSettings -> IO (S.ByteString -> (Connection -> IO ()) -> String -> Maybe HostAddress -> String -> Int -> IO Connection)-getTlsProxyConnection tls sock = do- context <- NC.initConnectionContext- return $ \connstr checkConn serverName _ha host port -> do- --error $ show (connstr, host, port)- conn <- NC.connectTo context NC.ConnectionParams- { NC.connectionHostname = serverName+getTlsProxyConnection mcontext tls sock = do+ context <- maybe NC.initConnectionContext return mcontext+ return $ \connstr checkConn serverName _ha host port -> bracketOnError+ (NC.connectTo context NC.ConnectionParams+ { 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- }-- NC.connectionPut conn connstr- conn' <- convertConnection conn+ Nothing -> Just $ NC.OtherProxy (strippedHostName host) $ fromIntegral port+ })+ NC.connectionClose+ $ \conn -> do+ NC.connectionPut conn connstr+ conn' <- convertConnection conn - checkConn conn'+ checkConn conn' - NC.connectionSetSecure context conn tls+ NC.connectionSetSecure context conn tls - return conn'+ return conn' convertConnection :: NC.Connection -> IO Connection convertConnection conn = makeConnection@@ -119,9 +171,84 @@ -- already closed, and we get a @ResourceVanished@. (NC.connectionClose conn `Control.Exception.catch` \(_ :: IOException) -> return ()) +-- We may decide in the future to just have a global+-- ConnectionContext and use it directly in tlsManagerSettings, at+-- which point this can again be a simple (newManager+-- tlsManagerSettings >>= newIORef). See:+-- https://github.com/snoyberg/http-client/pull/227.+globalConnectionContext :: NC.ConnectionContext+globalConnectionContext = unsafePerformIO NC.initConnectionContext+{-# NOINLINE globalConnectionContext #-}++-- | Load up a new TLS manager with default settings, respecting proxy+-- environment variables.+--+-- @since 0.3.4+newTlsManager :: MonadIO m => m Manager+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.+--+-- @since 0.3.5+newTlsManagerWith :: MonadIO m => ManagerSettings -> m Manager+newTlsManagerWith set = 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' set (Just globalConnectionContext) def msocksHTTP msocksHTTPS+ 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+ -> Map.Map T.Text String -- ^ lower-cased keys+ -> T.Text -- ^ env name+ -> Maybe NC.SockSettings+parseSocksSettings env lenv n = do+ str <- lookup (T.unpack n) env <|> Map.lookup n lenv+ let allowedScheme x = x == "socks5:" || x == "socks5h:"+ uri <- U.parseURI str++ guard $ allowedScheme $ U.uriScheme uri+ guard $ null (U.uriPath uri) || U.uriPath uri == "/"+ guard $ null $ U.uriQuery uri+ guard $ null $ U.uriFragment uri++ auth <- U.uriAuthority uri+ port' <-+ case U.uriPort auth of+ "" -> Nothing -- should we use some default?+ ':':rest ->+ case decimal $ T.pack rest of+ Right (p, "") -> Just p+ _ -> Nothing+ _ -> Nothing++ Just $ NC.SockSettingsSimple (U.uriRegName auth) port'+ -- | Evil global manager, to make life easier for the common use case globalManager :: IORef Manager-globalManager = unsafePerformIO (newManager tlsManagerSettings >>= newIORef)+globalManager = unsafePerformIO $ newTlsManager >>= newIORef {-# NOINLINE globalManager #-} -- | Get the current global 'Manager'@@ -136,3 +263,174 @@ -- @since 0.2.4 setGlobalManager :: Manager -> IO () setGlobalManager = writeIORef globalManager++-- | Generated by 'applyDigestAuth' when it is unable to apply the+-- digest credentials to the request.+--+-- @since 0.3.3+data DigestAuthException+ = DigestAuthException Request (Response ()) DigestAuthExceptionDetails+ deriving (Show, Typeable)+instance Exception DigestAuthException where+#if MIN_VERSION_base(4, 8, 0)+ displayException = displayDigestAuthException+#endif++-- | User friendly display of a 'DigestAuthException'+--+-- @since 0.3.3+displayDigestAuthException :: DigestAuthException -> String+displayDigestAuthException (DigestAuthException req res det) = concat+ [ "Unable to submit digest credentials due to: "+ , details+ , ".\n\nRequest: "+ , show req+ , ".\n\nResponse: "+ , show res+ ]+ where+ details =+ case det of+ UnexpectedStatusCode -> "received unexpected status code"+ MissingWWWAuthenticateHeader ->+ "missing WWW-Authenticate response header"+ WWWAuthenticateIsNotDigest ->+ "WWW-Authenticate response header does not indicate Digest"+ MissingRealm ->+ "WWW-Authenticate response header does include realm"+ MissingNonce ->+ "WWW-Authenticate response header does include nonce"++-- | Detailed explanation for failure for 'DigestAuthException'+--+-- @since 0.3.3+data DigestAuthExceptionDetails+ = UnexpectedStatusCode+ | MissingWWWAuthenticateHeader+ | WWWAuthenticateIsNotDigest+ | MissingRealm+ | MissingNonce+ deriving (Show, Read, Typeable, Eq, Ord)++-- | Apply digest authentication to this request.+--+-- Note that this function will need to make an HTTP request to the+-- server in order to get the nonce, thus the need for a @Manager@ and+-- to live in @IO@. This also means that the request body will be sent+-- to the server. If the request body in the supplied @Request@ can+-- only be read once, you should replace it with a dummy value.+--+-- In the event of successfully generating a digest, this will return+-- a @Just@ value. If there is any problem with generating the digest,+-- it will return @Nothing@.+--+-- @since 0.3.1+applyDigestAuth :: (MonadIO m, MonadThrow n)+ => S.ByteString -- ^ username+ -> S.ByteString -- ^ password+ -> Request+ -> Manager+ -> m (n Request)+applyDigestAuth user pass req0 man = liftIO $ do+ res <- httpNoBody req man+ let throw' = throwM . DigestAuthException req res+ return $ do+ unless (responseStatus res == status401)+ $ throw' UnexpectedStatusCode+ h1 <- maybe (throw' MissingWWWAuthenticateHeader) return+ $ lookup "WWW-Authenticate" $ responseHeaders res+ h2 <- maybe (throw' WWWAuthenticateIsNotDigest) return+ $ stripCI "Digest " h1+ let pieces = map (strip *** strip) (toPairs h2)+ realm <- maybe (throw' MissingRealm) return+ $ lookup "realm" pieces+ nonce <- maybe (throw' MissingNonce) return+ $ lookup "nonce" pieces+ let qop = isJust $ lookup "qop" pieces+ digest+ | qop = md5 $ S.concat+ [ ha1+ , ":"+ , nonce+ , ":00000001:deadbeef:auth:"+ , ha2+ ]+ | otherwise = md5 $ S.concat [ha1, ":", nonce, ":", ha2]+ where+ ha1 = md5 $ S.concat [user, ":", realm, ":", pass]++ -- we always use no qop or qop=auth+ ha2 = md5 $ S.concat [method req, ":", path req]++ md5 = extractBase16 . encodeBase16' . MD5.hash+ key = "Authorization"+ val = S.concat+ [ "Digest username=\""+ , user+ , "\", realm=\""+ , realm+ , "\", nonce=\""+ , nonce+ , "\", uri=\""+ , path req+ , "\", response=\""+ , digest+ , "\""+ -- FIXME algorithm?+ , case lookup "opaque" pieces of+ Nothing -> ""+ Just o -> S.concat [", opaque=\"", o, "\""]+ , if qop+ then ", qop=auth, nc=00000001, cnonce=\"deadbeef\""+ else ""+ ]+ return req+ { requestHeaders = (key, val)+ : filter+ (\(x, _) -> x /= key)+ (requestHeaders req)+ , cookieJar = Just $ responseCookieJar res+ }+ where+ -- Since we're expecting a non-200 response, ensure we do not+ -- throw exceptions for such responses.+ req = req0 { checkResponse = \_ _ -> return () }++ stripCI x y+ | CI.mk x == CI.mk (S.take len y) = Just $ S.drop len y+ | otherwise = Nothing+ where+ len = S.length x++ _comma = 44+ _equal = 61+ _dquot = 34+ _space = 32++ strip = fst . S.spanEnd (== _space) . S.dropWhile (== _space)++ toPairs bs0+ | S.null bs0 = []+ | otherwise =+ let bs1 = S.dropWhile (== _space) bs0+ (key, bs2) = S.break (\w -> w == _equal || w == _comma) bs1+ in case () of+ ()+ | S.null bs2 -> [(key, "")]+ | S.head bs2 == _equal ->+ let (val, rest) = parseVal $ S.tail bs2+ in (key, val) : toPairs rest+ | otherwise ->+ assert (S.head bs2 == _comma) $+ (key, "") : toPairs (S.tail bs2)++ parseVal bs0 = fromMaybe (parseUnquoted bs0) $ do+ guard $ not $ S.null bs0+ guard $ S.head bs0 == _dquot+ let (x, y) = S.break (== _dquot) $ S.tail bs0+ guard $ not $ S.null y+ Just (x, S.drop 1 $ S.dropWhile (/= _comma) y)++ parseUnquoted bs =+ let (x, y) = S.break (== _comma) bs+ in (x, S.drop 1 y)
README.md view
@@ -1,7 +1,7 @@ ## http-client-tls Full tutorial docs are available at:-https://github.com/commercialhaskell/jump/blob/master/doc/http-client.md+https://haskell-lang.org/library/http-client Use the http-client package with the pure-Haskell tls package for secure connections. For the most part, you'll just want to replace
+ bench/Bench.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE CPP #-}+module Main where++#if MIN_VERSION_gauge(0, 2, 0)+import Gauge+#else+import Gauge.Main+#endif+import Network.HTTP.Client+import Network.HTTP.Client.TLS++main :: IO ()+main = defaultMain [+ bgroup "newManager" [+ bench "defaultManagerSettings" $+ whnfIO (newManager defaultManagerSettings)+ , bench "tlsManagerSettings" $+ whnfIO (newManager tlsManagerSettings)+ ]+ ]
http-client-tls.cabal view
@@ -1,5 +1,5 @@ name: http-client-tls-version: 0.2.4.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: <https://www.stackage.org/package/http-client-tls>. homepage: https://github.com/snoyberg/http-client@@ -16,14 +16,24 @@ library exposed-modules: Network.HTTP.Client.TLS other-extensions: ScopedTypeVariables- build-depends: base >= 4 && < 5- , data-default-class- , http-client >= 0.3.5- , connection >= 0.2.2+ 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+ , exceptions+ , containers+ , text+ , network-uri default-language: Haskell2010+ ghc-options: -Wall test-suite spec main-is: Spec.hs@@ -35,3 +45,16 @@ , http-client , http-client-tls , http-types+ , crypton-connection+ , data-default+ , tls++benchmark benchmark+ main-is: Bench.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: bench+ default-language: Haskell2010+ build-depends: base+ , gauge+ , http-client+ , http-client-tls
test/Spec.hs view
@@ -1,15 +1,87 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} import Test.Hspec+import Network.Connection import Network.HTTP.Client-import Network.HTTP.Client.TLS-import Network.HTTP.Client.Internal+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"- { checkStatus = \_ _ _ -> Nothing- } manager $ \res -> do+ withResponse "https://httpbin.org/status/418" manager $ \res -> responseStatus res `shouldBe` status418++ it "digest authentication" $ do+ man <- newManager defaultManagerSettings+ req <- join $ applyDigestAuth+ "user"+ "passwd"+ "http://httpbin.org/digest-auth/qop/user/passwd"+ man+ response <- httpNoBody req man+ responseStatus response `shouldBe` status200++ it "incorrect digest authentication" $ do+ man <- newManager defaultManagerSettings+ 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