http-client-tls 0.3.2 → 0.3.3

raw patch · 4 files changed

+94/−12 lines, 4 filesdep +exceptionsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: exceptions

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Network/HTTP/Client/TLS.hs +79/−10
• http-client-tls.cabal +2/−1
• test/Spec.hs +8/−1

@@ -1,3 +1,8 @@+## 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)

@@ -1,5 +1,7 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveDataTypeable #-} -- | Support for making connections via the connection package and, in turn, -- the tls package suite. --@@ -11,6 +13,9 @@     , mkManagerSettingsContext       -- * Digest authentication     , applyDigestAuth+    , DigestAuthException (..)+    , DigestAuthExceptionDetails (..)+    , displayDigestAuthException       -- * Global manager     , getGlobalManager     , setGlobalManager@@ -24,17 +29,18 @@ import Network.Socket (HostAddress) import qualified Network.TLS as TLS import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as S8 import Data.IORef (IORef, newIORef, readIORef, writeIORef) import System.IO.Unsafe (unsafePerformIO) import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad (guard)+import Control.Monad (guard, unless) import qualified Data.CaseInsensitive as CI import Data.Maybe (fromMaybe, isJust) import Network.HTTP.Types (status401) import Crypto.Hash (hash, Digest, MD5) import Control.Arrow ((***)) import Data.ByteArray.Encoding (convertToBase, Base (Base16))+import Data.Typeable (Typeable)+import Control.Monad.Catch (MonadThrow, throwM)  -- | Create a TLS-enabled 'ManagerSettings' with the given 'NC.TLSSettings' and -- 'NC.SockSettings'@@ -140,7 +146,16 @@  -- | Evil global manager, to make life easier for the common use case globalManager :: IORef Manager-globalManager = unsafePerformIO (newManager tlsManagerSettings >>= newIORef)+globalManager = unsafePerformIO $ do+    -- 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.+    context <- NC.initConnectionContext+    let settings = mkManagerSettingsContext (Just context) def Nothing+    manager <- newManager settings+    newIORef manager {-# NOINLINE globalManager #-}  -- | Get the current global 'Manager'@@ -156,6 +171,54 @@ 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@@ -169,21 +232,27 @@ -- it will return @Nothing@. -- -- @since 0.3.1-applyDigestAuth :: MonadIO m+applyDigestAuth :: (MonadIO m, MonadThrow n)                 => S.ByteString -- ^ username                 -> S.ByteString -- ^ password                 -> Request                 -> Manager-                -> m (Maybe Request)+                -> m (n Request) applyDigestAuth user pass req man = liftIO $ do     res <- httpNoBody req man+    let throw' = throwM . DigestAuthException req res     return $ do-        guard $ responseStatus res == status401-        h1 <- lookup "WWW-Authenticate" $ responseHeaders res-        h2 <- stripCI "Digest " h1+        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 <- lookup "realm" pieces-        nonce <- lookup "nonce" pieces+        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

@@ -1,5 +1,5 @@ name:                http-client-tls-version:             0.3.2+version:             0.3.3 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@@ -28,6 +28,7 @@                      , http-types                      , cryptonite                      , memory+                     , exceptions   default-language:    Haskell2010   ghc-options:         -Wall 

@@ -3,6 +3,7 @@ import Network.HTTP.Client import Network.HTTP.Client.TLS import Network.HTTP.Types+import Control.Monad (join)  main :: IO () main = hspec $ do@@ -13,10 +14,16 @@      it "digest authentication" $ do         man <- newManager defaultManagerSettings-        Just req <- applyDigestAuth+        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