http-client-auth 0.1.0.0 → 0.1.0.1

raw patch · 2 files changed

+48/−28 lines, 2 filesdep +http-clientdep +resourcetdep ~basedep ~base64-stringdep ~blaze-builderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: http-client, resourcet

Dependency ranges changed: base, base64-string, blaze-builder, bytestring, case-insensitive, conduit, crypto-conduit, http-conduit, pureMD5, transformers, utf8-string

API changes (from Hackage documentation)

Files

• http-client-auth.cabal +15/−13
• src/Network/HTTP/Client/Auth.hs +33/−15

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/
 
 name:                http-client-auth
-version:             0.1.0.0
+version:             0.1.0.1
 synopsis:            HTTP authorization (both basic and digest) done right
 description:         Multiple challenges aren't implemented. Authentication-Info header isn't either.
 license:             BSD3
@@ -17,15 +17,17 @@ library
   exposed-modules:     Network.HTTP.Client.Auth
   -- other-modules:       
-  build-depends:       base ==4.6.*,
-                       blaze-builder ==0.3.*,
-                       base64-string ==0.2.*,
-                       transformers ==0.3.*,
-                       crypto-conduit ==0.5.*,
-                       bytestring ==0.10.*,
-                       utf8-string ==0.3.*,
-                       case-insensitive ==1.0.*,
-                       conduit ==1.0.*,
-                       pureMD5 ==2.1.*,
-                       http-conduit ==1.9.*
-  hs-source-dirs:      src+  build-depends:       base >= 4.0 && < 10.0,
+                       blaze-builder >= 0.3,
+                       base64-string >= 0.2,
+                       transformers >= 0.3,
+                       crypto-conduit >= 0.5,
+                       bytestring >= 0.10,
+                       utf8-string >= 0.3,
+                       case-insensitive >= 1.0,
+                       conduit >= 1.0,
+                       pureMD5 >= 2.1,
+                       http-conduit >= 2.1,
+                       resourcet >= 1.1,
+                       http-client >= 0.4
+  hs-source-dirs:      src

@@ -19,27 +19,31 @@ import Control.Monad (join, guard, mplus, mzero) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT(MaybeT, runMaybeT), mapMaybeT)+import Control.Monad.Trans.Resource (ResourceT, runResourceT) import Control.Monad.Trans.State (State, evalState, get, put) import Crypto.Conduit (sinkHash) import qualified Data.ByteString.Lazy as L (toChunks) import qualified Data.ByteString.Lazy.UTF8 as LU (fromString)+import qualified Data.ByteString as B (ByteString, null) import qualified Data.ByteString.UTF8 as BU (fromString, toString) import Data.CaseInsensitive (mk) import Data.Char (isAlphaNum, isAscii, isSpace)-import Data.Conduit (ResourceT, runResourceT, yield, (=$), ($$))+import Data.Conduit (Source, yield, (=$), ($$)) import qualified Data.Conduit.List as CL (concatMap, sourceList) import Data.Digest.Pure.MD5 (md5, MD5Digest)+import Data.IORef (newIORef, readIORef, writeIORef) import Data.List (intersperse, isPrefixOf) import Data.Maybe (catMaybes) import Data.Monoid (Monoid (mappend, mconcat, mempty))+import Network.HTTP.Client (GivesPopper, Popper) import Network.HTTP.Conduit     (Request(checkStatus, method, path, queryString, requestBody, requestHeaders),      RequestBody      (       RequestBodyBS,       RequestBodyBuilder,-      RequestBodySource,-      RequestBodySourceChunked,+      RequestBodyStream,+      RequestBodyStreamChunked,       RequestBodyLBS      ),      Response(responseHeaders))@@ -283,17 +287,17 @@       Just header -> parseChallenge header -- | This function creates a string that should be sent in the Authorization header. makeRequestHeader -    :: Monad m => String -- ^ login+    :: String -- ^ login     -> String -- ^ password     -> String -- ^ string to use as cnonce, not very important yet-    -> Request m -- ^ first request, already sent to the server+    -> Request -- ^ first request, already sent to the server     -> Challenge -- ^ challenge generated by server in responce to that request-    -> MaybeT m String+    -> MaybeT (ResourceT IO) String makeRequestHeader _ _ _ _ None = mzero makeRequestHeader login password _ _ (Basic _) =     return $ "Basic " ++ concat (lines $ B64.encode $ login ++ ':' : password) makeRequestHeader login password cnonce req (Digest dc) =-    do entityBodyHash <- lift $ makeRequestBodyHash req+    do entityBodyHash <- lift $ lift $ makeRequestBodyHash req        let fields =                [                 return "Digest",@@ -314,8 +318,8 @@                   Just o -> return $ "opaque=\"" ++ o ++ "\"",                 case qop dc of                   Nothing -> mzero-                  Just Auth -> return "qop=auth"-                  Just AuthInt -> return "qop=auth-int",+                  Just Auth -> return "qop=\"auth\""+                  Just AuthInt -> return "qop=\"auth-int\"",                 case qop dc of                   Nothing -> mzero                   Just _ -> return "nc=00000001"@@ -348,22 +352,36 @@        return $ concat $ intersperse " " $ catMaybes fields where -- | This function extracts URI part from the request. -- It wouldn't include the host name.-makeRequestUri :: Request m -> String+makeRequestUri :: Request -> String makeRequestUri req =     let p = BU.toString $ path req         pp = if "/" `isPrefixOf` p then p else '/' : p         q = BU.toString $ queryString req         qq = if "?" `isPrefixOf` q then q else '?' : q     in pp ++ qq+popperToSource :: Popper -> Source IO B.ByteString+popperToSource p = src where+    src =+        do str <- lift p+           if B.null str then return() else+               do yield str+                  src+gpToHash :: GivesPopper () -> IO MD5Digest+gpToHash gp =+    do ref <- newIORef $ md5 $ LU.fromString ""+       gp $ \p ->+           do str <- popperToSource p $$ sinkHash+              writeIORef ref str+       readIORef ref -- | This function makes an MD5 hash of the request body-makeRequestBodyHash :: Monad m => Request m -> m String+makeRequestBodyHash :: Request -> IO String makeRequestBodyHash req =     case requestBody req of       RequestBodyLBS lbs -> CL.sourceList (L.toChunks lbs) $$ hashSink       RequestBodyBS bs -> yield bs $$ hashSink       RequestBodyBuilder _ bldr -> yield bldr $$ bldrSink-      RequestBodySource _ bldr -> bldr $$ bldrSink-      RequestBodySourceChunked bldr -> bldr $$ bldrSink+      RequestBodyStream _ gp -> fmap show $ gpToHash gp+      RequestBodyStreamChunked gp -> fmap show $ gpToHash gp     where       bldrSink = CL.concatMap (L.toChunks . toLazyByteString) =$ hashSink       hashSink = fmap (show :: MD5Digest -> String) sinkHash@@ -373,9 +391,9 @@ requestWithAuth     :: String -- ^ login     -> String -- ^ password-    -> (Request (ResourceT IO) -> IO (Response body))+    -> (Request -> IO (Response body))     -- ^ function like @withManager . httpLbs@, to actually send a request-    -> Request (ResourceT IO) -- ^ request to send (without authorization)+    -> Request -- ^ request to send (without authorization)     -> MaybeT IO (Response body) requestWithAuth login password query req =     do let safeReq = req {checkStatus = \_ _ _ -> Nothing}