wreq 0.4.1.0 → 0.5.0.0
raw patch · 12 files changed
+127/−80 lines, 12 filesdep ~aeson-prettydep ~authenticate-oauthdep ~basenew-uploader
Dependency ranges changed: aeson-pretty, authenticate-oauth, base, http-client, http-client-tls, snap-core
Files
- Network/Wreq.hs +4/−3
- Network/Wreq/Internal.hs +9/−9
- Network/Wreq/Internal/Lens.hs +1/−2
- Network/Wreq/Internal/Types.hs +6/−7
- Network/Wreq/Lens.hs +5/−5
- Network/Wreq/Lens/TH.hs +1/−1
- Network/Wreq/Session.hs +20/−6
- Network/Wreq/Types.hs +2/−2
- changelog.md +8/−0
- httpbin/HttpBin/Server.hs +3/−3
- tests/UnitTests.hs +58/−34
- wreq.cabal +10/−8
Network/Wreq.hs view
@@ -82,7 +82,7 @@ , Lens.params , Lens.cookie , Lens.cookies- , Lens.checkStatus+ , Lens.checkResponse -- ** Authentication -- $auth@@ -192,7 +192,8 @@ get url = getWith defaults url withManager :: (Options -> IO a) -> IO a-withManager act = HTTP.withManager defaultManagerSettings $ \mgr ->+withManager act = do+ mgr <- HTTP.newManager defaultManagerSettings act defaults { Wreq.manager = Right mgr } -- | Issue a GET request, using the supplied 'Options'.@@ -373,7 +374,7 @@ -- | Issue a custom-method request with a payload, using the supplied 'Options'. customPayloadMethodWith :: Postable a => String -> Options -> String -> a -> IO (Response L.ByteString)- + customPayloadMethodWith method opts url payload = runRead =<< preparePayloadMethod methodBS opts url payload where
Network/Wreq/Internal.hs view
@@ -24,6 +24,7 @@ import Control.Applicative ((<$>)) import Control.Arrow ((***)) import Control.Lens ((&), (.~), (%~))+import Control.Monad ((>=>)) import Data.Monoid ((<>)) import Data.Text.Encoding (encodeUtf8) import Data.Version (showVersion)@@ -42,7 +43,7 @@ import qualified Network.Wreq.Internal.Lens as Lens import qualified Network.Wreq.Internal.AWS as AWS (signRequest) import qualified Network.Wreq.Internal.OAuth1 as OAuth1 (signRequest)-import qualified Network.Wreq.Lens as Lens hiding (checkStatus)+import qualified Network.Wreq.Lens as Lens hiding (checkResponse) -- This mess allows this module to continue to load during interactive -- development in ghci :-(@@ -66,7 +67,7 @@ , params = [] , redirects = 10 , cookies = Just (HTTP.createCookieJar [])- , checkStatus = Nothing+ , checkResponse = Nothing } where userAgent = "haskell wreq-" <> Char8.pack (showVersion version) @@ -101,18 +102,18 @@ request modify opts url act = run (manager opts) act =<< prepare modify opts url run :: Mgr -> (Response BodyReader -> IO a) -> Request -> IO a-run emgr act req = either (flip HTTP.withManager go) go emgr+run emgr act req = either (HTTP.newManager >=> go) go emgr where go mgr = HTTP.withResponse req mgr act prepare :: (Request -> IO Request) -> Options -> String -> IO Request prepare modify opts url = do- signRequest =<< modify =<< frob <$> HTTP.parseUrl url+ signRequest =<< modify =<< frob <$> HTTP.parseUrlThrow url where frob req = req & Lens.requestHeaders %~ (headers opts ++) & setQuery opts & setAuth opts & setProxy opts- & setCheckStatus opts+ & setCheckResponse opts & setRedirects opts & Lens.cookieJar .~ cookies opts signRequest :: Request -> IO Request@@ -146,9 +147,9 @@ setProxy = maybe id f . proxy where f (Proxy host port) = addProxy host port -setCheckStatus :: Options -> Request -> Request-setCheckStatus = maybe id f . checkStatus- where f cs = ( & Lens.checkStatus .~ cs)+setCheckResponse :: Options -> Request -> Request+setCheckResponse = maybe id f . checkResponse+ where f cs = ( & Lens.checkResponse .~ cs) prepareGet :: Options -> String -> IO Req prepareGet opts url = Req (manager opts) <$> prepare return opts url@@ -166,7 +167,6 @@ preparePayloadMethod :: Postable a => HTTP.Method -> Options -> String -> a -> IO Req- preparePayloadMethod method opts url payload = Req (manager opts) <$> prepare (postPayload payload . (Lens.method .~ method)) opts url
Network/Wreq/Internal/Lens.hs view
@@ -20,8 +20,7 @@ , decompress , redirectCount , responseTimeout- , checkStatus- , getConnectionWrapper+ , checkResponse , cookieJar , seshCookies , seshManager
Network/Wreq/Internal/Types.hs view
@@ -19,7 +19,7 @@ , Mgr , Auth(..) , AWSAuthVersion(..)- , StatusChecker+ , ResponseChecker -- * Request payloads , Payload(..) , Postable(..)@@ -43,16 +43,16 @@ , CacheEntry(..) ) where -import Control.Exception (Exception, SomeException)+import Control.Exception (Exception) import Data.IORef (IORef)-import Data.Monoid ((<>), mconcat)+import Data.Monoid ((<>)) import Data.Text (Text) import Data.Time.Clock (UTCTime) import Data.Typeable (Typeable) import Network.HTTP.Client (CookieJar, Manager, ManagerSettings, Request, RequestBody) import Network.HTTP.Client.Internal (Response, Proxy)-import Network.HTTP.Types (Header, Status, ResponseHeaders)+import Network.HTTP.Types (Header) import Prelude hiding (head) import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy as L@@ -150,7 +150,7 @@ -- etc.), this field will be used only for the /first/ HTTP request -- to be issued during a 'Network.Wreq.Session.Session'. Any changes -- changes made for subsequent requests will be ignored.- , checkStatus :: Maybe StatusChecker+ , checkResponse :: Maybe ResponseChecker -- ^ Function that checks the status code and potentially returns an -- exception. --@@ -161,8 +161,7 @@ -- | A function that checks the result of a HTTP request and -- potentially returns an exception.-type StatusChecker = Status -> ResponseHeaders -> CookieJar- -> Maybe SomeException+type ResponseChecker = Request -> Response HTTP.BodyReader -> IO () -- | Supported authentication types. --
Network/Wreq/Lens.hs view
@@ -45,8 +45,8 @@ , params , cookie , cookies- , StatusChecker- , checkStatus+ , ResponseChecker+ , checkResponse -- ** Proxy setup , Proxy@@ -113,7 +113,7 @@ import Network.HTTP.Types.Status (Status) import Network.HTTP.Types.Version (HttpVersion) import Network.Mime (MimeType)-import Network.Wreq.Types (Auth, Link, Options, StatusChecker)+import Network.Wreq.Types (Auth, Link, Options, ResponseChecker) import qualified Network.Wreq.Lens.TH as TH -- | A lens onto configuration of the connection manager provided by@@ -228,8 +228,8 @@ redirects = TH.redirects -- | A lens to get the optional status check function-checkStatus :: Lens' Options (Maybe StatusChecker)-checkStatus = TH.checkStatus+checkResponse :: Lens' Options (Maybe ResponseChecker)+checkResponse = TH.checkResponse -- | A traversal onto the cookie with the given name, if one exists. --
Network/Wreq/Lens/TH.hs view
@@ -15,7 +15,7 @@ , redirects , cookie , cookies- , checkStatus+ , checkResponse , HTTP.Cookie , cookieName
Network/Wreq/Session.hs view
@@ -56,6 +56,7 @@ , options , put , delete+ , customMethod -- ** Configurable verbs , getWith , postWith@@ -63,6 +64,7 @@ , optionsWith , putWith , deleteWith+ , customMethodWith -- * Extending a session , Lens.seshRun ) where@@ -75,9 +77,11 @@ import Network.Wreq.Internal.Types (Body(..), Req(..), Session(..)) import Network.Wreq.Types (Postable, Putable, Run) import Prelude hiding (head)+import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Lazy as L import qualified Network.HTTP.Client as HTTP import qualified Network.Wreq.Internal.Lens as Lens+import qualified Network.Wreq.Lens as Lens -- | Create a 'Session', passing it to the given function. The -- 'Session' will no longer be valid after that function returns.@@ -109,11 +113,11 @@ -> (Session -> IO a) -> IO a withSessionControl mj settings act = do mref <- maybe (return Nothing) (fmap Just . newIORef) mj- HTTP.withManager settings $ \mgr ->- act Session { seshCookies = mref- , seshManager = mgr- , seshRun = runWith- }+ mgr <- HTTP.newManager settings+ act Session { seshCookies = mref+ , seshManager = mgr+ , seshRun = runWith+ } -- | 'Session'-specific version of 'Network.Wreq.get'. get :: Session -> String -> IO (Response L.ByteString)@@ -125,7 +129,7 @@ -- | 'Session'-specific version of 'Network.Wreq.head_'. head_ :: Session -> String -> IO (Response ())-head_ = headWith defaults+head_ = headWith (defaults & Lens.redirects .~ 0) -- | 'Session'-specific version of 'Network.Wreq.options'. options :: Session -> String -> IO (Response ())@@ -139,6 +143,10 @@ delete :: Session -> String -> IO (Response L.ByteString) delete = deleteWith defaults +-- | 'Session'-specific version of 'Network.Wreq.customMethod'.+customMethod :: String -> Session -> String -> IO (Response L.ByteString)+customMethod = flip customMethodWith defaults+ -- | 'Session'-specific version of 'Network.Wreq.getWith'. getWith :: Options -> Session -> String -> IO (Response L.ByteString) getWith opts sesh url = run string sesh =<< prepareGet opts url@@ -165,6 +173,12 @@ -- | 'Session'-specific version of 'Network.Wreq.deleteWith'. deleteWith :: Options -> Session -> String -> IO (Response L.ByteString) deleteWith opts sesh url = run string sesh =<< prepareDelete opts url++-- | 'Session'-specific version of 'Network.Wreq.customMethodWith'.+customMethodWith :: String -> Options -> Session -> String -> IO (Response L.ByteString)+customMethodWith method opts sesh url = run string sesh =<< prepareMethod methodBS opts url+ where+ methodBS = BC8.pack method runWith :: Session -> Run Body -> Run Body runWith Session{..} act (Req _ req) = do
Network/Wreq/Types.hs view
@@ -18,7 +18,7 @@ Options(..) , Auth(..) , AWSAuthVersion(..)- , StatusChecker+ , ResponseChecker -- * Request payloads , Payload(..) , Postable(..)@@ -40,7 +40,7 @@ import Control.Lens ((&), (.~)) import Data.Aeson (Value, encode) import Data.Int (Int8, Int16, Int32, Int64)-import Data.Word (Word, Word8, Word16, Word32, Word64)+import Data.Word (Word8, Word16, Word32, Word64) import Network.HTTP.Client (Request) import Network.HTTP.Client.MultipartFormData (Part, formDataBody) import Network.Wreq.Internal.Types
changelog.md view
@@ -1,5 +1,13 @@ -*- markdown -*- +2017-01-09 0.5.0.0++* Compatible with `http-client` >= 0.5++* This compatibility change required a small API change: `checkStatus`+ is now named `checkResponse` for compatibility with the+ `http-client` package+ 2015-05-10 0.4.0.0 * Compatible with GHC 7.10.
httpbin/HttpBin/Server.hs view
@@ -8,7 +8,7 @@ import Control.Applicative ((<$>)) import Control.Monad.IO.Class (liftIO) import Data.Aeson (Value(..), eitherDecode, object, toJSON)-import Data.Aeson.Encode.Pretty (Config(..), encodePretty')+import Data.Aeson.Encode.Pretty (Config(..), Indent(Spaces), defConfig, encodePretty') import Data.ByteString.Char8 (pack) import Data.CaseInsensitive (original) import Data.Maybe (catMaybes, fromMaybe)@@ -133,7 +133,7 @@ writeJSON obj = do modifyResponse $ setContentType "application/json"- writeLBS . (<> "\n") . encodePretty' (Config 2 compare) . object $ obj+ writeLBS . (<> "\n") . encodePretty' defConfig { confIndent = Spaces 2, confCompare = compare } . object $ obj respond act = do req <- getRequest@@ -149,7 +149,7 @@ "http://" <> host <> rqURI req)] writeJSON =<< act ([ ("args", toJSON params) , ("headers", toJSON hdrs)- , ("origin", toJSON . decodeUtf8 . rqRemoteAddr $ req)+ , ("origin", toJSON . decodeUtf8 . rqClientAddr $ req) ] <> url) meths ms h = methods ms (path "" h)
tests/UnitTests.hs view
@@ -5,21 +5,22 @@ module UnitTests (testWith) where +import Control.Arrow (first) import Control.Applicative ((<$>)) import Control.Concurrent (forkIO, killThread) import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)-import Control.Exception (Exception, toException)-import Control.Lens ((^.), (^?), (.~), (?~), (&))+import Control.Exception (Exception, throwIO)+import Control.Lens ((^.), (^?), (.~), (?~), (&), iso, ix, Traversal') import Control.Monad (unless, void) import Data.Aeson-import Data.Aeson.Lens (key)+import Data.Aeson.Lens (key, AsValue, _Object) import Data.ByteString (ByteString) import Data.Char (toUpper) import Data.Maybe (isJust) import Data.Monoid ((<>)) import HttpBin.Server (serve)-import Network.HTTP.Client (HttpException(..))-import Network.HTTP.Types.Status (Status(Status), status200, status401)+import Network.HTTP.Client (HttpException(..), HttpExceptionContent(..))+import Network.HTTP.Types.Status (status200, status401) import Network.HTTP.Types.Version (http11) import Network.Wreq hiding (get, post, head_, put, options, delete,@@ -33,6 +34,8 @@ import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (assertBool, assertEqual, assertFailure) import qualified Control.Exception as E+import qualified Data.CaseInsensitive as CI+import qualified Data.HashMap.Strict as HMap import qualified Data.Text as T import qualified Network.Wreq.Session as Session import qualified Data.ByteString.Lazy as L@@ -41,13 +44,13 @@ data Verb = Verb { get :: String -> IO (Response L.ByteString) , getWith :: Options -> String -> IO (Response L.ByteString)- , post :: Postable a => String -> a -> IO (Response L.ByteString)- , postWith :: Postable a => Options -> String -> a+ , post :: forall a. Postable a => String -> a -> IO (Response L.ByteString)+ , postWith :: forall a. Postable a => Options -> String -> a -> IO (Response L.ByteString) , head_ :: String -> IO (Response ()) , headWith :: Options -> String -> IO (Response ())- , put :: Putable a => String -> a -> IO (Response L.ByteString)- , putWith :: Putable a => Options -> String -> a -> IO (Response L.ByteString)+ , put :: forall a. Putable a => String -> a -> IO (Response L.ByteString)+ , putWith :: forall a. Putable a => Options -> String -> a -> IO (Response L.ByteString) , options :: String -> IO (Response ()) , optionsWith :: Options -> String -> IO (Response ()) , delete :: String -> IO (Response L.ByteString)@@ -76,10 +79,20 @@ , delete = Session.delete s , deleteWith = flip Session.deleteWith s } +-- Helper aeson lens for case insensitive keys+-- The test 'snap' server unfortunately lowercases all headers, we have to be case-insensitive+-- when checking the returned header list.+cikey :: AsValue t => T.Text -> Traversal' t Value+cikey i = _Object . toInsensitive . ix (CI.mk i)+ where+ toInsensitive = iso toCi fromCi+ toCi = HMap.fromList . map (first CI.mk) . HMap.toList+ fromCi = HMap.fromList . map (first CI.original) . HMap.toList+ basicGet Verb{..} site = do r <- get (site "/get") assertBool "GET request has User-Agent header" $- isJust (r ^. responseBody ^? key "headers" . key "User-Agent")+ isJust (r ^. responseBody ^? key "headers" . cikey "User-Agent") -- test the various lenses assertEqual "GET succeeds" status200 (r ^. responseStatus) assertEqual "GET succeeds 200" 200 (r ^. responseStatus . statusCode)@@ -96,7 +109,7 @@ assertEqual "POST succeeds" status200 (r ^. responseStatus) assertEqual "POST echoes input" (Just "wibble") (body ^? key "data") assertEqual "POST is binary" (Just "application/octet-stream")- (body ^? key "headers" . key "Content-Type")+ (body ^? key "headers" . cikey "Content-Type") multipartPost Verb{..} site = withSystemTempFile "foo.html" $ \name handle -> do@@ -139,14 +152,14 @@ r <- put (site "/put") $ toJSON solrAdd assertEqual "toJSON PUT request has correct Content-Type header" (Just "application/json")- (r ^. responseBody ^? key "headers" . key "Content-Type")+ (r ^. responseBody ^? key "headers" . cikey "Content-Type") byteStringPut Verb{..} site = do let opts = defaults & header "Content-Type" .~ ["application/json"] r <- putWith opts (site "/put") $ encode solrAdd assertEqual "ByteString PUT request has correct Content-Type header" (Just "application/json")- (r ^. responseBody ^? key "headers" . key "Content-Type")+ (r ^. responseBody ^? key "headers" . cikey "Content-Type") basicDelete Verb{..} site = do r <- delete (site "/delete")@@ -155,18 +168,21 @@ throwsStatusCode Verb{..} site = assertThrows "404 causes exception to be thrown" inspect $ head_ (site "/status/404")- where inspect e = case e of- StatusCodeException _ _ _ -> return ()+ where inspect (HttpExceptionRequest _ e) = case e of+ StatusCodeException _ _ -> return () _ -> assertFailure "unexpected exception thrown"+ inspect _ = assertFailure "unexpected exception thrown" getBasicAuth Verb{..} site = do let opts = defaults & auth ?~ basicAuth "user" "passwd" r <- getWith opts (site "/basic-auth/user/passwd") assertEqual "basic auth GET succeeds" status200 (r ^. responseStatus)- let inspect e = case e of- StatusCodeException status _ _ ->+ let inspect (HttpExceptionRequest _ e) = case e of+ StatusCodeException resp _ -> assertEqual "basic auth failed GET gives 401"- status401 status+ status401 (resp ^. responseStatus)+ inspect _ = assertFailure "unexpected exception thrown"+ assertThrows "basic auth GET fails if password is bad" inspect $ getWith opts (site "/basic-auth/user/asswd") @@ -175,10 +191,11 @@ r <- getWith opts (site $ "/oauth2/" <> kind <> "/token1234") assertEqual ("oauth2 " <> kind <> " GET succeeds") status200 (r ^. responseStatus)- let inspect e = case e of- StatusCodeException status _ _ ->+ let inspect (HttpExceptionRequest _ e) = case e of+ StatusCodeException resp _ -> assertEqual ("oauth2 " <> kind <> " failed GET gives 401")- status401 status+ status401 (resp ^. responseStatus)+ inspect _ = assertFailure "unexpected exception thrown" assertThrows ("oauth2 " <> kind <> " GET fails if token is bad") inspect $ getWith opts (site $ "/oauth2/" <> kind <> "/token123") @@ -209,10 +226,10 @@ r <- getWith opts (site "/get") assertEqual "extra header set correctly" (Just "bar")- (r ^. responseBody ^? key "headers" . key "X-Wibble")+ (r ^. responseBody ^? key "headers" . cikey "X-Wibble") getCheckStatus Verb {..} site = do- let opts = defaults & checkStatus .~ (Just customCs)+ let opts = defaults & checkResponse .~ Just customRc r <- getWith opts (site "/status/404") assertThrows "Non 404 throws error" inspect $ getWith opts (site "/get")@@ -220,36 +237,43 @@ 404 (r ^. responseStatus . statusCode) where- customCs (Status 404 _) _ _ = Nothing- customCs s h cj = Just . toException . StatusCodeException s h $ cj+ customRc :: ResponseChecker+ customRc _ resp+ | resp ^. responseStatus . statusCode == 404 = return ()+ customRc req resp = throwIO $ HttpExceptionRequest req (StatusCodeException (void resp) "") - inspect e = case e of- (StatusCodeException (Status sc _) _ _) ->- assertEqual "200 Status Error" sc 200+ inspect (HttpExceptionRequest _ e) = case e of+ (StatusCodeException resp _) ->+ assertEqual "200 Status Error" (resp ^. responseStatus) status200+ inspect _ = assertFailure "unexpected exception thrown" + getGzip Verb{..} site = do r <- get (site "/gzip") assertEqual "gzip decoded for us" (Just (Bool True)) (r ^. responseBody ^? key "gzipped") -headRedirect Verb{..} site =+headRedirect Verb{..} site = do assertThrows "HEAD of redirect throws exception" inspect $ head_ (site "/redirect/3")- where inspect e = case e of- StatusCodeException status _ _ ->- let code = status ^. statusCode+ where inspect (HttpExceptionRequest _ e) = case e of+ StatusCodeException resp _ ->+ let code = resp ^. responseStatus . statusCode in assertBool "code is redirect" (code >= 300 && code < 400)+ inspect _ = assertFailure "unexpected exception thrown" + redirectOverflow Verb{..} site = assertThrows "GET with too many redirects throws exception" inspect $ getWith (defaults & redirects .~ 3) (site "/redirect/5")- where inspect e = case e of TooManyRedirects _ -> return ()+ where inspect (HttpExceptionRequest _ e) = case e of TooManyRedirects _ -> return ()+ inspect _ = assertFailure "unexpected exception thrown" invalidURL Verb{..} _site = do let noProto (InvalidUrlException _ _) = return () assertThrows "exception if no protocol" noProto (get "wheeee")- let noHost (InvalidDestinationHost _) = return ()+ let noHost (HttpExceptionRequest _ (InvalidDestinationHost _)) = return () assertThrows "exception if no host" noHost (get "http://") funkyScheme Verb{..} site = do
wreq.cabal view
@@ -1,5 +1,5 @@ name: wreq-version: 0.4.1.0+version: 0.5.0.0 synopsis: An easy-to-use HTTP client library. description: .@@ -97,7 +97,7 @@ psqueues >= 0.2, aeson >= 0.7.0.3, attoparsec >= 0.11.1.0,- authenticate-oauth == 1.5.*,+ authenticate-oauth >= 1.5, base >= 4.5 && < 5, base16-bytestring, byteable,@@ -108,8 +108,8 @@ exceptions >= 0.5, ghc-prim, hashable,- http-client >= 0.4.6,- http-client-tls >= 0.2,+ http-client >= 0.5.3.2,+ http-client-tls >= 0.3.3, http-types >= 0.8, lens >= 4.5, lens-aeson,@@ -135,13 +135,13 @@ else build-depends: aeson >= 0.7,- aeson-pretty >= 0.7.1,+ aeson-pretty >= 0.8.0, base >= 4.5 && < 5, base64-bytestring, bytestring, case-insensitive, containers,- snap-core,+ snap-core >= 1.0.0.0, snap-server >= 0.9.4.4, text, time,@@ -160,6 +160,7 @@ other-modules: Properties.Store UnitTests+ HttpBin.Server if flag(aws) cpp-options: -DAWS_TESTS@@ -178,7 +179,7 @@ HUnit, QuickCheck >= 2.7, aeson,- aeson-pretty >= 0.7.1,+ aeson-pretty >= 0.8.0, base >= 4.5 && < 5, base64-bytestring, bytestring,@@ -190,7 +191,7 @@ lens, lens-aeson, network-info,- snap-core,+ snap-core >= 1.0.0.0, snap-server >= 0.9.4.4, temporary, test-framework,@@ -199,6 +200,7 @@ text, time, transformers,+ unordered-containers, unix-compat, uuid, vector,