wreq (empty) → 0.1.0.0

raw patch · 26 files changed

+3490/−0 lines, 26 filesdep +HUnitdep +aesondep +aeson-prettybuild-type:Customsetup-changed

Dependencies added: HUnit, aeson, aeson-pretty, attoparsec, base, base64-bytestring, bytestring, case-insensitive, containers, directory, doctest, exceptions, filepath, http-client, http-client-tls, http-types, lens, mime-types, snap-core, snap-server, template-haskell, temporary, test-framework, test-framework-hunit, text, time, wreq

Files

• LICENSE.md +29/−0
• Network/Wreq.hs +522/−0
• Network/Wreq/Internal.hs +123/−0
• Network/Wreq/Internal/Lens.hs +52/−0
• Network/Wreq/Internal/Link.hs +61/−0
• Network/Wreq/Internal/Types.hs +220/−0
• Network/Wreq/Lens.hs +428/−0
• Network/Wreq/Lens/Machinery.hs +20/−0
• Network/Wreq/Lens/TH.hs +108/−0
• Network/Wreq/Session.hs +97/−0
• Network/Wreq/Types.hs +139/−0
• README.md +29/−0
• Setup.hs +64/−0
• TODO.md +19/−0
• changelog +1/−0
• examples/JsonResponse.hs +122/−0
• examples/UploadPaste.hs +166/−0
• examples/wreq-examples.cabal +51/−0
• httpbin/HttpBin.hs +124/−0
• tests/DocTests.hs +47/−0
• tests/Tests.hs +207/−0
• wreq.cabal +157/−0
• www/Makefile +21/−0
• www/bootstrap-custom.css +59/−0
• www/index.md +134/−0
• www/tutorial.md +490/−0

@@ -0,0 +1,29 @@+Copyright © 2014, Bryan O'Sullivan.++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright+  notice, this list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions and the following disclaimer in the+  documentation and/or other materials provided with the distribution.++* Neither the name of nor the names of other contributors may be used+  to endorse or promote products derived from this software without+  specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,522 @@+{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}++-- |+-- Module      : Network.Wreq+-- Copyright   : (c) 2014 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- A library for client-side HTTP requests, focused on ease of use.+--+-- When reading the examples in this module, you should assume the+-- following environment:+--+-- @+-- \-\- Make it easy to write literal 'S.ByteString' and 'Text' values.+-- \{\-\# LANGUAGE OverloadedStrings \#\-\}+--+-- \-\- Our handy module.+-- import "Network.Wreq"+--+-- \-\- Operators such as ('&') and ('.~').+-- import "Control.Lens"+--+-- \-\- Conversion of Haskell values to JSON.+-- import "Data.Aeson" ('Data.Aeson.toJSON')+--+-- \-\- Easy traversal of JSON data.+-- import "Data.Aeson.Lens" ('Data.Aeson.Lens.key', 'Data.Aeson.Lens.nth')+-- @+--+-- There exist some less frequently used lenses that are not exported+-- from this module; these can be found in "Network.Wreq.Lens".++module Network.Wreq+    (+    -- * HTTP verbs+    -- ** GET+      get+    , getWith+    -- ** POST+    -- $postable+    , post+    , postWith+    -- ** HEAD+    , head_+    , headWith+    -- ** OPTIONS+    , options+    , optionsWith+    -- ** PUT+    , put+    , putWith+    -- ** DELETE+    , delete+    , deleteWith+    -- * Incremental consumption of responses+    -- ** GET+    , foldGet+    , foldGetWith++    -- * Configuration+    , Options+    , defaults+    , Lens.manager+    , Lens.header+    , Lens.param+    , Lens.redirects+    , Lens.headers+    , Lens.params+    , Lens.cookie+    , Lens.cookies+    -- ** Authentication+    -- $auth+    , Auth+    , Lens.auth+    , basicAuth+    , oauth2Bearer+    , oauth2Token+    -- ** Proxy settings+    , Proxy(Proxy)+    , Lens.proxy+    , httpProxy+    -- ** Using a manager with defaults+    , withManager++    -- * Payloads for POST and PUT+    , Payload(..)+    -- ** URL-encoded form data+    , FormParam(..)+    , FormValue+    -- ** Multipart form data+    , Form.Part+    , Lens.partName+    , Lens.partFileName+    , Lens.partContentType+    , Lens.partGetBody+    -- *** Smart constructors+    , Form.partBS+    , Form.partLBS+    , partText+    , partString+    , Form.partFile+    , Form.partFileSource++    -- * Responses+    , Response+    , Lens.responseBody+    , Lens.responseHeader+    , Lens.responseLink+    , Lens.responseCookie+    , Lens.responseHeaders+    , Lens.responseCookieJar+    , Lens.responseStatus+    , Lens.Status+    , Lens.statusCode+    -- ** Link headers+    , Lens.Link+    , Lens.linkURL+    , Lens.linkParams+    -- ** Decoding responses+    , JSONError(..)+    , asJSON+    , asValue++    -- * Cookies+    -- $cookielenses+    , Lens.Cookie+    , Lens.cookieName+    , Lens.cookieValue+    , Lens.cookieExpiryTime+    , Lens.cookieDomain+    , Lens.cookiePath++    -- * Parsing responses+    , Lens.atto+    ) where++import Control.Lens ((.~), (&))+import Control.Monad (unless)+import Control.Monad.Catch (MonadThrow(throwM))+import Data.Aeson (FromJSON)+import Data.ByteString.Char8 ()+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8)+import Network.HTTP.Client.Internal (Proxy(..), Response)+import Network.Wreq.Internal+import Network.Wreq.Types (Options)+import Network.Wreq.Types hiding (Options(..))+import Prelude hiding (head)+import qualified Data.Aeson as Aeson+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Client.MultipartFormData as Form+import qualified Network.HTTP.Types as HTTP+import qualified Network.Wreq.Internal.Lens as Int+import qualified Network.Wreq.Lens as Lens+import qualified Network.Wreq.Types as Wreq++-- | Issue a GET request.+--+-- Example:+--+-- @+--'get' \"http:\/\/httpbin.org\/get\"+-- @+--+-- >>> r <- get "http://httpbin.org/get"+-- >>> r ^. responseStatus . statusCode+-- 200+get :: String -> IO (Response L.ByteString)+get url = getWith defaults url++withManager :: (Options -> IO a) -> IO a+withManager act = HTTP.withManager defaultManagerSettings $ \mgr ->+  act defaults { Wreq.manager = Right mgr }++-- | Issue a GET request, using the supplied 'Options'.+--+-- Example:+--+-- @+--let opts = 'defaults' '&' 'Lens.param' \"foo\" '.~' [\"bar\"]+--'getWith' opts \"http:\/\/httpbin.org\/get\"+-- @+--+-- >>> let opts = defaults & param "foo" .~ ["bar"]+-- >>> r <- getWith opts "http://httpbin.org/get"+-- >>> r ^? responseBody . key "url"+-- Just (String "http://httpbin.org/get?foo=bar")+getWith :: Options -> String -> IO (Response L.ByteString)+getWith opts url = request id opts url readResponse++-- | Issue a POST request.+--+-- Example:+--+-- @+--'post' \"http:\/\/httpbin.org\/post\" ('Aeson.toJSON' [1,2,3])+-- @+--+-- >>> r <- post "http://httpbin.org/post" (toJSON [1,2,3])+-- >>> r ^? responseBody . key "json"+-- Just (Array (fromList [Number 1.0,Number 2.0,Number 3.0]))+post :: Postable a => String -> a -> IO (Response L.ByteString)+post url payload = postWith defaults url payload++-- | Issue a POST request, using the supplied 'Options'.+--+-- Example:+--+-- @+--let opts = 'defaults' '&' 'Lens.param' \"foo\" '.~' [\"bar\"]+--'postWith' opts \"http:\/\/httpbin.org\/post\" ('Aeson.toJSON' [1,2,3])+-- @+--+-- >>> let opts = defaults & param "foo" .~ ["bar"]+-- >>> r <- postWith opts "http://httpbin.org/post" (toJSON [1,2,3])+-- >>> r ^? responseBody . key "url"+-- Just (String "http://httpbin.org/post?foo=bar")+postWith :: Postable a => Options -> String -> a -> IO (Response L.ByteString)+postWith opts url payload =+  requestIO (postPayload payload . (Int.method .~ HTTP.methodPost)) opts url+    readResponse++-- | Issue a HEAD request.+--+-- Example:+--+-- @+--'head_' \"http:\/\/httpbin.org\/get\"+-- @+--+-- >>> r <- head_ "http://httpbin.org/get"+-- >>> r ^? responseHeader "Content-Type"+-- Just "application/json"+head_ :: String -> IO (Response ())+head_ = headWith (defaults & Lens.redirects .~ 0)++-- | Issue a HEAD request, using the supplied 'Options'.+--+-- Example:+--+-- @+--let opts = 'defaults' '&' 'Lens.param' \"foo\" '.~' [\"bar\"]+--'headWith' opts \"http:\/\/httpbin.org\/get\"+-- @+--+-- >>> let opts = defaults & param "foo" .~ ["bar"]+-- >>> r <- headWith opts "http://httpbin.org/get"+-- >>> r ^? responseHeader "Connection"+-- Just "keep-alive"+headWith :: Options -> String -> IO (Response ())+headWith = emptyMethodWith HTTP.methodHead++-- | Issue a PUT request.+put :: Putable a => String -> a -> IO (Response L.ByteString)+put url payload = putWith defaults url payload++-- | Issue a PUT request, using the supplied 'Options'.+putWith :: Putable a => Options -> String -> a -> IO (Response L.ByteString)+putWith opts url payload =+  requestIO (putPayload payload . (Int.method .~ HTTP.methodPut)) opts url+    readResponse++-- | Issue an OPTIONS request.+--+-- Example:+--+-- @+--'options' \"http:\/\/httpbin.org\/get\"+-- @+--+-- See 'Lens.atto' for a more complex worked example.+options :: String -> IO (Response ())+options = optionsWith defaults++-- | Issue an OPTIONS request, using the supplied 'Options'.+--+-- Example:+--+-- @+--let opts = 'defaults' '&' 'Lens.param' \"foo\" '.~' [\"bar\"]+--'optionsWith' opts \"http:\/\/httpbin.org\/get\"+-- @+optionsWith :: Options -> String -> IO (Response ())+optionsWith = emptyMethodWith HTTP.methodOptions++-- | Issue a DELETE request.+--+-- Example:+--+-- @+--'delete' \"http:\/\/httpbin.org\/delete\"+-- @+--+-- >>> r <- delete "http://httpbin.org/delete"+-- >>> r ^. responseStatus . statusCode+-- 200+delete :: String -> IO (Response ())+delete = deleteWith defaults++-- | Issue a DELETE request, using the supplied 'Options'.+--+-- Example:+--+-- @+--let opts = 'defaults' '&' 'Lens.redirects' '.~' 0+--'deleteWith' opts \"http:\/\/httpbin.org\/delete\"+-- @+--+-- >>> let opts = defaults & redirects .~ 0+-- >>> r <- deleteWith opts "http://httpbin.org/delete"+-- >>> r ^. responseStatus . statusCode+-- 200+deleteWith :: Options -> String -> IO (Response ())+deleteWith = emptyMethodWith HTTP.methodDelete++foldGet :: (a -> S.ByteString -> IO a) -> a -> String -> IO a+foldGet f z url = foldGetWith defaults f z url++foldGetWith :: Options -> (a -> S.ByteString -> IO a) -> a -> String -> IO a+foldGetWith opts f z0 url = request id opts url (foldResponseBody f z0)++-- | Convert the body of an HTTP response from JSON to a suitable+-- Haskell type.+--+-- In this example, we use 'asJSON' in the @IO@ monad, where it will+-- throw a 'JSONError' exception if conversion to the desired type+-- fails.+--+-- @+-- \{-\# LANGUAGE DeriveGeneric \#-\}+--import "GHC.Generics" ('GHC.Generics.Generic')+--+-- \{- This Haskell type corresponds to the structure of a+--   response body from httpbin.org. -\}+--+--data GetBody = GetBody {+--    headers :: 'Data.Map.Map' 'Data.Text.Text' 'Data.Text.Text'+--  , args :: 'Data.Map.Map' 'Data.Text.Text' 'Data.Text.Text'+--  , origin :: 'Data.Text.Text'+--  , url :: 'Data.Text.Text'+--  } deriving (Show, 'GHC.Generics.Generic')+--+-- \-\- Get GHC to derive a 'FromJSON' instance for us.+--instance 'FromJSON' GetBody+--+-- \{- The fact that we want a GetBody below will be inferred by our+--   use of the \"headers\" accessor function. -\}+--+--foo = do+--  r <- 'asJSON' =<< 'get' \"http:\/\/httpbin.org\/get\"+--  print (headers (r 'Control.Lens.^.' 'responseBody'))+-- @+--+-- If we use 'asJSON' in the 'Either' monad, it will return 'Left'+-- with a 'JSONError' payload if conversion fails, and 'Right' with a+-- 'Response' whose 'responseBody' is the converted value on success.++asJSON :: (MonadThrow m, FromJSON a) =>+          Response L.ByteString -> m (Response a)+{-# SPECIALIZE asJSON :: (FromJSON a) =>+                         Response L.ByteString -> IO (Response a) #-}+{-# SPECIALIZE asJSON :: Response L.ByteString -> IO (Response Aeson.Value) #-}+asJSON resp = do+  let contentType = fst . S.break (==59) . fromMaybe "unknown" .+                    lookup "Content-Type" . HTTP.responseHeaders $ resp+  unless ("application/json" `S.isPrefixOf` contentType) $+    throwM . JSONError $ "content type of response is " ++ show contentType+  case Aeson.eitherDecode' (HTTP.responseBody resp) of+    Left err  -> throwM (JSONError err)+    Right val -> return (fmap (const val) resp)+++-- | Convert the body of an HTTP response from JSON to a 'Value'.+--+-- In this example, we use 'asValue' in the @IO@ monad, where it will+-- throw a 'JSONError' exception if the conversion to 'Value' fails.+--+-- @+--foo = do+--  r <- 'asValue' =<< 'get' \"http:\/\/httpbin.org\/get\"+--  print (r 'Control.Lens.^?' 'responseBody' . key \"headers\" . key \"User-Agent\")+-- @+asValue :: (MonadThrow m) => Response L.ByteString -> m (Response Aeson.Value)+{-# SPECIALIZE asValue :: Response L.ByteString+                       -> IO (Response Aeson.Value) #-}+asValue = asJSON++-- $auth+--+-- Do not use HTTP authentication unless you are using TLS encryption.+-- These authentication tokens can easily be captured and reused by an+-- attacker if transmitted in the clear.++-- | Basic authentication. This consists of a plain username and+-- password.+--+-- Example (note the use of TLS):+--+-- @+--let opts = 'defaults' '&' 'Lens.auth' '.~' 'basicAuth' \"user\" \"pass\"+--'getWith' opts \"https:\/\/httpbin.org\/basic-auth\/user\/pass\"+-- @+--+-- >>> let opts = defaults & auth .~ basicAuth "user" "pass"+-- >>> r <- getWith opts "https://httpbin.org/basic-auth/user/pass"+-- >>> r ^? responseBody . key "authenticated"+-- Just (Bool True)+basicAuth :: S.ByteString       -- ^ Username.+          -> S.ByteString       -- ^ Password.+          -> Maybe Auth+basicAuth user pass = Just (BasicAuth user pass)++-- | An OAuth2 bearer token. This is treated by many services as the+-- equivalent of a username and password.+--+-- Example (note the use of TLS):+--+-- @+--let opts = 'defaults' '&' 'Lens.auth' '.~' 'oauth2Bearer' \"1234abcd\"+--'getWith' opts \"https:\/\/public-api.wordpress.com\/rest\/v1\/me\/\"+-- @+oauth2Bearer :: S.ByteString -> Maybe Auth+oauth2Bearer token = Just (OAuth2Bearer token)++-- | A not-quite-standard OAuth2 bearer token (that seems to be used+-- only by GitHub). This will be treated by whatever services accept+-- it as the equivalent of a username and password.+--+-- Example (note the use of TLS):+--+-- @+--let opts = 'defaults' '&' 'Lens.auth' '.~' 'oauth2Token' \"abcd1234\"+--'getWith' opts \"https:\/\/api.github.com\/user\"+-- @+oauth2Token :: S.ByteString -> Maybe Auth+oauth2Token token = Just (OAuth2Token token)++-- | Proxy configuration.+--+-- Example:+--+-- @+--let opts = 'defaults' '&' 'Lens.proxy' '.~' 'httpProxy' \"localhost\" 8000+--'getWith' opts \"http:\/\/httpbin.org\/get\"+-- @+httpProxy :: S.ByteString -> Int -> Maybe Proxy+httpProxy host port = Just (Proxy host port)++-- | Make a 'Part' whose content is a strict 'T.Text', encoded as+-- UTF-8.+--+-- The 'Part' does not have a file name or content type associated+-- with it.+partText :: Text             -- ^ Name of the corresponding \<input\>.+         -> Text             -- ^ The body for this 'Form.Part'.+         -> Form.Part+partText name value = Form.partBS name (encodeUtf8 value)++-- | Make a 'Part' whose content is a 'String', encoded as UTF-8.+--+-- The 'Part' does not have a file name or content type associated+-- with it.+partString :: Text           -- ^ Name of the corresponding \<input\>.+           -> String         -- ^ The body for this 'Form.Part'.+           -> Form.Part+partString name value = Form.partBS name (encodeUtf8 (T.pack value))++-- $cookielenses+--+-- These are only the most frequently-used cookie-related lenses.  See+-- "Network.Wreq.Lens" for the full accounting of them all.++-- $postable+--+-- The 'Postable' class determines which Haskell types can be used as+-- POST payloads.+--+-- 'Form.Part' and ['Form.Part'] give a request body with a+-- @Content-Type@ of @multipart/form-data@.  Constructor functions+-- include 'partText' and 'Form.partFile'.+--+-- >>> r <- post "http://httpbin.org/post" (partText "hello" "world")+-- >>> r ^? responseBody . key "form" . key "hello"+-- Just (String "world")+--+-- ('S.ByteString', 'S.ByteString') and 'FormParam' (and lists of+-- each) give a request body with a @Content-Type@ of+-- @application/x-www-form-urlencoded@. The easiest way to use this is+-- via the (':=') constructor.+--+-- >>> r <- post "http://httpbin.org/post" ["num" := 31337, "str" := "foo"]+-- >>> r ^? responseBody . key "form" . key "num"+-- Just (String "31337")+--+-- The \"magical\" type conversion on the right-hand side of ':='+-- above is due to the 'FormValue' class. This package provides+-- sensible instances for the standard string and number types.+--+-- The 'Aeson.Value' type gives a JSON request body with a+-- @Content-Type@ of @application/json@. Any instance of+-- 'Aeson.ToJSON' can of course be converted to a 'Aeson.Value' using+-- 'Aeson.toJSON'.+--+-- >>> r <- post "http://httpbin.org/post" (toJSON [1,2,3])+-- >>> r ^? responseBody . key "json" . nth 0+-- Just (Number 1.0)++-- $setup+--+-- >>> :set -XOverloadedStrings+-- >>> import Control.Lens+-- >>> import Data.Aeson (toJSON)+-- >>> import Data.Aeson.Lens (key, nth)+-- >>> import Network.Wreq

@@ -0,0 +1,123 @@+{-# LANGUAGE CPP, GADTs, OverloadedStrings #-}++module Network.Wreq.Internal+    (+      defaults+    , defaultManagerSettings+    , emptyMethodWith+    , foldResponseBody+    , ignoreResponse+    , readResponse+    , request+    , requestIO+    ) where++import Control.Applicative ((<$>))+import Control.Arrow ((***))+import Control.Lens ((&), (.~), (%~))+import Data.Monoid ((<>))+import Data.Text.Encoding (encodeUtf8)+import Data.Version (showVersion)+import Network.HTTP.Client (BodyReader)+import Network.HTTP.Client.Internal (Proxy(..), Request, Response(..), addProxy)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.Wreq.Internal.Lens (setHeader)+import Network.Wreq.Types (Auth(..), Options(..))+import Prelude hiding (head)+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as Char8+import qualified Data.ByteString.Lazy as L+import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Types as HTTP+import qualified Network.Wreq.Internal.Lens as Lens+import qualified Network.Wreq.Lens as Lens++-- This mess allows this module to continue to load during interactive+-- development in ghci :-(+#if defined(VERSION_base)+import Paths_wreq (version)+#else+import Data.Version (Version(..))+version = Version [0] ["wip"]+#endif++defaultManagerSettings :: HTTP.ManagerSettings+defaultManagerSettings = tlsManagerSettings++defaults :: Options+defaults = Options {+    manager   = Left defaultManagerSettings+  , proxy     = Nothing+  , auth      = Nothing+  , headers   = [("User-Agent", userAgent)]+  , params    = []+  , redirects = 10+  , cookies   = HTTP.createCookieJar []+  }+  where userAgent = "haskell wreq-" <> Char8.pack (showVersion version)++setRedirects :: Options -> Request -> Request+setRedirects opts req+  | redirects opts == HTTP.redirectCount req = req+  | otherwise = req { HTTP.redirectCount = redirects opts }++emptyMethodWith :: HTTP.Method -> Options -> String -> IO (Response ())+emptyMethodWith method opts url =+  request (Lens.method .~ method) opts url ignoreResponse++ignoreResponse :: Response BodyReader -> IO (Response ())+ignoreResponse resp = (Lens.responseBody .~ ()) <$> readResponse resp++readResponse :: Response BodyReader -> IO (Response L.ByteString)+readResponse resp = do+  chunks <- HTTP.brConsume (HTTP.responseBody resp)+  return resp { responseBody = L.fromChunks chunks }++foldResponseBody :: (a -> S.ByteString -> IO a) -> a+                 -> Response BodyReader -> IO a+foldResponseBody f z0 resp = go z0+  where go z = do+          bs <- HTTP.brRead (HTTP.responseBody resp)+          if S.null bs+            then return z+            else f z bs >>= go++requestIO :: (Request -> IO Request) -> Options -> String+          -> (Response BodyReader -> IO a) -> IO a+requestIO modify opts url body =+    either (flip HTTP.withManager go) go (manager opts)+  where+    go mgr = do+      let frob req = req+                   & Lens.requestHeaders %~ (headers opts ++)+                   & setQuery opts+                   & setAuth opts+                   & setProxy opts+                   & setRedirects opts+                   & Lens.cookieJar .~ Just (cookies opts)+      req <- modify =<< (frob <$> HTTP.parseUrl url)+      HTTP.withResponse req mgr body++request :: (Request -> Request) -> Options -> String+        -> (Response BodyReader -> IO a) -> IO a+request f = requestIO (return . f)++setQuery :: Options -> Request -> Request+setQuery opts =+  case params opts of+    [] -> id+    ps -> Lens.queryString %~ \qs ->+          let n = S.length qs in+          qs <> (if n > 1 then "&" else "") <> HTTP.renderSimpleQuery (n==0)+          (map (encodeUtf8 *** encodeUtf8) ps)++setAuth :: Options -> Request -> Request+setAuth = maybe id f . auth+  where+    f (BasicAuth user pass) = HTTP.applyBasicAuth user pass+    f (OAuth2Bearer token)  = setHeader "Authorization" ("Bearer " <> token)+    f (OAuth2Token token)   = setHeader "Authorization" ("token " <> token)++setProxy :: Options -> Request -> Request+setProxy = maybe id f . proxy+  where f (Proxy host port) = addProxy host port

@@ -0,0 +1,52 @@+{-# LANGUAGE RankNTypes, TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module Network.Wreq.Internal.Lens+    (+      HTTP.Request+    , method+    , secure+    , host+    , port+    , path+    , queryString+    , requestHeaders+    , requestBody+    , proxy+    , hostAddress+    , rawBody+    , decompress+    , redirectCount+    , responseTimeout+    , checkStatus+    , getConnectionWrapper+    , cookieJar+    -- * Useful functions+    , assoc+    , assoc2+    , setHeader+    ) where++import Control.Lens hiding (makeLenses)+import Data.List (partition)+import Network.HTTP.Client (Request)+import Network.HTTP.Types (HeaderName)+import Network.Wreq.Lens.Machinery (makeLenses)+import qualified Data.ByteString as S+import qualified Network.HTTP.Client as HTTP++makeLenses ''HTTP.Request++assoc :: (Eq k) => k -> IndexedTraversal' k [(k, a)] a+assoc i = traverse . itraversed . index i++assoc2 :: Eq k => k -> Lens' [(k,a)] [a]+-- This is only a lens up to the ordering of the list (which changes+-- when we modify the list).+-- assoc2 :: (Eq b, Functor f) => b -> ([a] -> f [a]) -> [(b, a)] -> f [(b, a)]+assoc2 k f = fmap (uncurry ((++) . fmap ((,) k))) .+             _1 (f . fmap snd) . partition ((==k) . fst)++setHeader :: HeaderName -> S.ByteString -> Request -> Request+setHeader name value = requestHeaders %~ ((name,value) :) .+                       filter ((/= name) . fst)

@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Wreq.Internal.Link+       (+         links+       ) where++import Control.Applicative ((<$>), (<*>), (*>), (<*), many)+import Data.Attoparsec.ByteString.Char8 as A8+import Data.ByteString (ByteString)+import Network.Wreq.Types (Link(..))+import qualified Data.Attoparsec.ByteString as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8++links :: B.ByteString -> [Link]+links hdr = case parseOnly f hdr of+              Left _   -> []+              Right xs -> xs+  where f = sepBy1 (link <* skipSpace) (char8 ',' *> skipSpace) <* endOfInput++link :: Parser Link+link = Link <$> url <*> many (char8 ';' *> skipSpace *> param)+  where url = char8 '<' *> A8.takeTill (=='>') <* char8 '>' <* skipSpace++param :: Parser (ByteString, ByteString)+param = do+  name <- paramName+  skipSpace *> "=" *> skipSpace+  c <- peekChar'+  let isTokenChar = A.inClass "!#$%&'()*+./0-9:<=>?@a-zA-Z[]^_`{|}~-"+  val <- case c of+           '"' -> quotedString+           _   -> A.takeWhile isTokenChar+  skipSpace+  return (name, val)++data Quot = Literal | Backslash++quotedString :: Parser ByteString+quotedString = char '"' *> (fixup <$> body) <* char '"'+  where body = A8.scan Literal $ \s c ->+          case (s,c) of+            (Literal,  '\\') -> backslash+            (Literal,  '"')  -> Nothing+            _                -> literal+        literal   = Just Literal+        backslash = Just Backslash+        fixup = B8.pack . go . B8.unpack+          where go ('\\' : x@'\\' : xs) = x : go xs+                go ('\\' : x@'"' : xs)  = x : go xs+                go (x : xs)             = x : go xs+                go xs                   = xs++paramName :: Parser ByteString+paramName = do+  name <- A.takeWhile1 $ A.inClass "a-zA-Z0-9!#$&+-.^_`|~"+  c <- peekChar+  return $ case c of+             Just '*' -> B8.snoc name '*'+             _        -> name

@@ -0,0 +1,220 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, GADTs, RecordWildCards #-}++-- |+-- Module      : Network.Wreq.Internal.Types+-- Copyright   : (c) 2014 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- HTTP client types.++module Network.Wreq.Internal.Types+    (+    -- * Client configuration+      Options(..)+    , Auth(..)+    -- * Request payloads+    , Payload(..)+    , Postable(..)+    , Putable(..)+    -- ** URL-encoded forms+    , FormParam(..)+    , FormValue(..)+    -- * Headers+    , ContentType+    , Link(..)+    -- * Errors+    , JSONError(..)+    ) where++import Control.Exception (Exception)+import Data.Text (Text)+import Data.Typeable (Typeable)+import Network.HTTP.Client (CookieJar, Manager, ManagerSettings, Request,+                            RequestBody, destroyCookieJar)+import Network.HTTP.Client.Internal (Proxy)+import Network.HTTP.Types (Header)+import Prelude hiding (head)+import qualified Data.ByteString as S++-- | A MIME content type, e.g. @\"application/octet-stream\"@.+type ContentType = S.ByteString++-- | Options for configuring a client.+data Options = Options {+    manager :: Either ManagerSettings Manager+  -- ^ Either configuration for a 'Manager', or an actual 'Manager'.+  --+  -- If only 'ManagerSettings' are provided, then by default a new+  -- 'Manager' will be created for each request.+  --+  -- /Note/: when issuing HTTP requests using 'Options'-based+  -- functions from the the "Network.Wreq.Session" module+  -- ('Network.Wreq.Session.getWith', 'Network.Wreq.Session.putWith',+  -- etc.), this field will be ignored.+  --+  -- An example of using a specific manager:+  --+  -- @+  --import "Network.HTTP.Client" ('Network.HTTP.Client.withManager')+  --+  --'Network.HTTP.Client.withManager' $ \\mgr -> do+  --  let opts = 'Network.Wreq.defaults' { 'manager' = Right mgr }+  --  'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"+  -- @+  --+  -- An example of changing settings (this will use a separate+  -- 'Manager' for every request, so make sense only if you're issuing+  -- a tiny handful of requets):+  --+  -- @+  --import "Network.HTTP.Client" ('Network.HTTP.Client.defaultManagerSettings')+  --+  --let settings = 'Network.HTTP.Client.defaultManagerSettings' { managerConnCount = 5 }+  --    opts = 'Network.Wreq.defaults' { 'manager' = Left settings }+  --'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"+  -- @+  , proxy :: Maybe Proxy+  -- ^ Host name and port for a proxy to use, if any.+  , auth :: Maybe Auth+  -- ^ Authentication information.+  --+  -- Example (note the use of TLS):+  --+  -- @+  --let opts = 'Network.Wreq.defaults' { 'auth' = 'Network.Wreq.basicAuth' \"user\" \"pass\" }+  --'Network.Wreq.getWith' opts \"https:\/\/httpbin.org\/basic-auth\/user\/pass\"+  -- @+  , headers :: [Header]+  -- ^ Additional headers to send with each request.+  --+  -- @+  --let opts = 'Network.Wreq.defaults' { 'headers' = [(\"Accept\", \"*\/*\")] }+  --'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"+  -- @+  , params :: [(Text, Text)]+  -- ^ Key-value pairs to assemble into a query string to add to the+  -- end of a URL.+  --+  -- For example, given:+  --+  -- @+  --let opts = 'Network.Wreq.defaults' { params = [(\"sort\", \"ascending\"), (\"key\", \"name\")] }+  --'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"+  -- @+  --+  -- This will generate a URL of the form:+  --+  -- >http://httpbin.org/get?sort=ascending&key=name+  , redirects :: Int+  -- ^ The maximum number of HTTP redirects to follow before giving up+  -- and throwing an exception.+  --+  -- In this example, a 'Network.HTTP.Client.HttpException' will be+  -- thrown with a 'Network.HTTP.Client.TooManyRedirects' constructor,+  -- because the maximum number of redirects allowed will be exceeded:+  --+  -- @+  --let opts = 'Network.Wreq.defaults' { 'redirects' = 3 }+  --'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/redirect/5\"+  -- @+  , cookies :: CookieJar+  -- ^ Cookies to set when issuing requests.+  --+  -- /Note/: when issuing HTTP requests using 'Options'-based+  -- functions from the the "Network.Wreq.Session" module+  -- ('Network.Wreq.Session.getWith', 'Network.Wreq.Session.putWith',+  -- 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.+  } deriving (Typeable)++-- | Supported authentication types.+--+-- Do not use HTTP authentication unless you are using TLS encryption.+-- These authentication tokens can easily be captured and reused by an+-- attacker if transmitted in the clear.+data Auth = BasicAuth S.ByteString S.ByteString+            -- ^ Basic authentication. This consists of a plain+            -- username and password.+          | OAuth2Bearer S.ByteString+            -- ^ An OAuth2 bearer token. This is treated by many+            -- services as the equivalent of a username and password.+          | OAuth2Token S.ByteString+            -- ^ A not-quite-standard OAuth2 bearer token (that seems+            -- to be used only by GitHub). This is treated by whoever+            -- accepts it as the equivalent of a username and+            -- password.+          deriving (Eq, Show, Typeable)++instance Show Options where+  show (Options{..}) = concat ["Options { "+                              , "manager = ", case manager of+                                                Left _  -> "Left _"+                                                Right _ -> "Right _"+                              , ", proxy = ", show proxy+                              , ", auth = ", show auth+                              , ", headers = ", show headers+                              , ", params = ", show params+                              , ", redirects = ", show redirects+                              , ", cookies = ", show (destroyCookieJar cookies)+                              , " }"+                              ]++-- | A type that can be converted into a POST request payload.+class Postable a where+    postPayload :: a -> Request -> IO Request+    -- ^ Represent a value in the request body (and perhaps the+    -- headers) of a POST request.++-- | A type that can be converted into a PUT request payload.+class Putable a where+    putPayload :: a -> Request -> IO Request+    -- ^ Represent a value in the request body (and perhaps the+    -- headers) of a PUT request.++-- | A product type for representing more complex payload types.+data Payload where+    Raw  :: ContentType -> RequestBody -> Payload+  deriving (Typeable)++-- | A type that can be rendered as the value portion of a key\/value+-- pair for use in an @application\/x-www-form-urlencoded@ POST+-- body. Intended for use with the 'FormParam' type.+--+-- The instances for 'String', strict 'Data.Text.Text', and lazy+-- 'Data.Text.Lazy.Text' are all encoded using UTF-8 before being+-- URL-encoded.+--+-- The instance for 'Maybe' gives an empty string on 'Nothing',+-- and otherwise uses the contained type's instance.+class FormValue a where+    renderFormValue :: a -> S.ByteString+    -- ^ Render the given value.++-- | A key\/value pair for an @application\/x-www-form-urlencoded@+-- POST request body.+data FormParam where+    (:=) :: (FormValue v) => S.ByteString -> v -> FormParam++instance Show FormParam where+    show (a := b) = show a ++ " := " ++ show (renderFormValue b)++infixr 3 :=++-- | The error type used by 'Network.Wreq.asJSON' and+-- 'Network.Wreq.asValue' if a failure occurs when parsing a response+-- body as JSON.+data JSONError = JSONError String+               deriving (Show, Typeable)++instance Exception JSONError++-- | An element of a @Link@ header.+data Link = Link {+      linkURL :: S.ByteString+    , linkParams :: [(S.ByteString, S.ByteString)]+    } deriving (Eq, Show, Typeable)

@@ -0,0 +1,428 @@+{-# LANGUAGE RankNTypes #-}++-- |+-- Module      : Network.Wreq.Lens+-- Copyright   : (c) 2014 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- HTTP client lens machinery.+--+-- When reading the examples in this module, you should assume the+-- following environment:+--+-- @+-- \-\- Make it easy to write literal 'S.ByteString' and 'Text' values.+-- \{\-\# LANGUAGE OverloadedStrings \#\-\}+--+-- \-\- Our handy module.+-- import "Network.Wreq"+--+-- \-\- Operators such as ('&') and ('.~').+-- import "Control.Lens"+--+-- \-\- Conversion of Haskell values to JSON.+-- import "Data.Aeson" ('Data.Aeson.toJSON')+--+-- \-\- Easy traversal of JSON data.+-- import "Data.Aeson.Lens" ('Data.Aeson.Lens.key', 'Data.Aeson.Lens.nth')+-- @++module Network.Wreq.Lens+    (+    -- * Configuration+      Options+    , manager+    , proxy+    , auth+    , header+    , param+    , redirects+    , headers+    , params+    , cookie+    , cookies++    -- ** Proxy setup+    , Proxy+    , proxyHost+    , proxyPort++    -- * Cookie+    , Cookie+    , cookieName+    , cookieValue+    , cookieExpiryTime+    , cookieDomain+    , cookiePath+    , cookieCreationTime+    , cookieLastAccessTime+    , cookiePersistent+    , cookieHostOnly+    , cookieSecureOnly+    , cookieHttpOnly++    -- * Response+    , Response+    , responseBody+    , responseHeader+    , responseLink+    , responseCookie+    , responseHeaders+    , responseCookieJar+    , responseStatus+    , responseVersion++    -- ** Status+    , Status+    , statusCode+    , statusMessage++    -- * Link header+    , Link+    , linkURL+    , linkParams++    -- * POST body part+    , Part+    , partName+    , partFileName+    , partContentType+    , partGetBody++    -- * Parsing+    , atto+    ) where++import Control.Lens (Fold, Lens, Lens', Traversal', folding)+import Data.Attoparsec (Parser, parseOnly)+import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Time.Clock (UTCTime)+import Network.HTTP.Client (Cookie, CookieJar, Manager, ManagerSettings, Proxy)+import Network.HTTP.Client (RequestBody, Response)+import Network.HTTP.Client.MultipartFormData (Part)+import Network.HTTP.Types.Header (Header, HeaderName, ResponseHeaders)+import Network.HTTP.Types.Status (Status)+import Network.HTTP.Types.Version (HttpVersion)+import Network.Mime (MimeType)+import Network.Wreq.Types (Auth, Link, Options)+import qualified Network.Wreq.Lens.TH as TH++-- | A lens onto configuration of the connection manager provided by+-- the http-client package.+--+-- In this example, we enable the use of OpenSSL for (hopefully)+-- secure connections:+--+-- @+--import "OpenSSL.Session" ('OpenSSL.Session.context')+--import "Network.HTTP.Client.OpenSSL"+--+--let opts = 'Network.Wreq.defaults' 'Control.Lens.&' 'manager' 'Control.Lens..~' Left ('Network.HTTP.Client.OpenSSL.opensslManagerSettings' 'OpenSSL.Session.context')+--'Network.HTTP.Client.OpenSSL.withOpenSSL' $+--  'Network.Wreq.getWith' opts \"https:\/\/httpbin.org\/get\"+-- @+manager :: Lens' Options (Either ManagerSettings Manager)+manager = TH.manager++-- | A lens onto proxy configuration.+--+-- Example:+--+-- @+--let opts = 'Network.Wreq.defaults' 'Control.Lens.&' 'proxy' 'Control.Lens..~' 'Network.Wreq.httpProxy' \"localhost\" 8000+--'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"+-- @+proxy :: Lens' Options (Maybe Proxy)+proxy = TH.proxy++-- | A lens onto request authentication.+--+-- Example (note the use of TLS):+--+-- @+--let opts = 'Network.Wreq.defaults' 'Control.Lens.&' 'Lens.auth' 'Control.Lens..~' 'Network.Wreq.basicAuth' \"user\" \"pass\"+--'Network.Wreq.getWith' opts \"https:\/\/httpbin.org\/basic-auth\/user\/pass\"+-- @+auth :: Lens' Options (Maybe Auth)+auth = TH.auth++-- | A lens onto all headers with the given name (there can+-- legitimately be zero or more).+--+-- Example:+--+-- @+--let opts = 'Network.Wreq.defaults' 'Control.Lens.&' 'header' \"Accept\" 'Control.Lens..~' [\"*\/*\"]+--'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"+-- @+header :: HeaderName -> Lens' Options [ByteString]+header = TH.header++-- | A lens onto all headers (there can legitimately be zero or more).+--+-- In this example, we print all the headers sent by default with+-- every request.+--+-- @+--print ('Network.Wreq.defaults' 'Control.Lens.^.' 'headers')+-- @+headers :: Lens' Options [Header]+headers = TH.headers++-- | A lens onto all query parameters with the given name (there can+-- legitimately be zero or more).+--+-- In this example, we construct the query URL+-- \"@http:\/\/httpbin.org\/get?foo=bar&foo=quux@\".+--+-- @+--let opts = 'Network.Wreq.defaults' 'Control.Lens.&' 'param' \"foo\" 'Control.Lens..~' [\"bar\", \"quux\"]+--'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/get\"+-- @+param :: Text -> Lens' Options [Text]+param = TH.param++-- | A lens onto all query parameters.+params :: Lens' Options [(Text, Text)]+params = TH.params++-- | A lens onto the maximum number of redirects that will be followed+-- before an exception is thrown.+--+-- In this example, a 'Network.HTTP.Client.HttpException' will be+-- thrown with a 'Network.HTTP.Client.TooManyRedirects' constructor,+-- because the maximum number of redirects allowed will be exceeded.+--+-- @+--let opts = 'Network.Wreq.defaults' 'Control.Lens.&' 'redirects' 'Control.Lens..~' 3+--'Network.Wreq.getWith' opts \"http:\/\/httpbin.org\/redirect\/5\"+-- @+redirects :: Lens' Options Int+redirects = TH.redirects++-- | A traversal onto the cookie with the given name, if one exists.+cookie :: ByteString -> Traversal' Options Cookie+cookie = TH.cookie++-- | A lens onto all cookies.+cookies :: Lens' Options CookieJar+cookies = TH.cookies++-- | A lens onto the name of a cookie.+cookieName :: Lens' Cookie ByteString+cookieName = TH.cookieName++-- | A lens onto the value of a cookie.+cookieValue :: Lens' Cookie ByteString+cookieValue = TH.cookieValue++-- | A lens onto the expiry time of a cookie.+cookieExpiryTime :: Lens' Cookie UTCTime+cookieExpiryTime = TH.cookieExpiryTime++-- | A lens onto the domain of a cookie.+cookieDomain :: Lens' Cookie ByteString+cookieDomain = TH.cookieDomain++-- | A lens onto the path of a cookie.+cookiePath :: Lens' Cookie ByteString+cookiePath = TH.cookiePath++-- | A lens onto the creation time of a cookie.+cookieCreationTime :: Lens' Cookie UTCTime+cookieCreationTime = TH.cookieCreationTime++-- | A lens onto the last access time of a cookie.+cookieLastAccessTime :: Lens' Cookie UTCTime+cookieLastAccessTime = TH.cookieLastAccessTime++-- | A lens onto whether a cookie is persistent across sessions (also+-- known as a \"tracking cookie\").+cookiePersistent :: Lens' Cookie Bool+cookiePersistent = TH.cookiePersistent++-- | A lens onto whether a cookie is host-only.+cookieHostOnly :: Lens' Cookie Bool+cookieHostOnly = TH.cookieHostOnly++-- | A lens onto whether a cookie is secure-only, such that it will+-- only be used over TLS.+cookieSecureOnly :: Lens' Cookie Bool+cookieSecureOnly = TH.cookieSecureOnly++-- | A lens onto whether a cookie is \"HTTP-only\".+--+-- Such cookies should be used only by browsers when transmitting HTTP+-- requests.  They must be unavailable in non-browser environments,+-- such as when executing JavaScript scripts.+cookieHttpOnly :: Lens' Cookie Bool+cookieHttpOnly = TH.cookieHttpOnly++-- | A lens onto the hostname portion of a proxy configuration.+proxyHost :: Lens' Proxy ByteString+proxyHost = TH.proxyHost++-- | A lens onto the TCP port number of a proxy configuration.+proxyPort :: Lens' Proxy Int+proxyPort = TH.proxyPort++-- | A lens onto the status of an HTTP response.+responseStatus :: Lens' (Response body) Status+responseStatus = TH.responseStatus++-- | A lens onto the version of an HTTP response.+responseVersion :: Lens' (Response body) HttpVersion+responseVersion = TH.responseVersion++-- | A lens onto all matching named headers in an HTTP response.+--+-- To access exactly one header (the result will be the empty string if+-- there is no match), use the ('Control.Lens.^.') operator.+--+-- @+--r <- 'Network.Wreq.get' \"http:\/\/httpbin.org\/get\"+--print (r 'Control.Lens.^.' 'responseHeader' \"Content-Type\")+-- @+--+-- To access at most one header (the result will be 'Nothing' if there+-- is no match), use the ('Control.Lens.^?') operator.+--+-- @+--r <- 'Network.Wreq.get' \"http:\/\/httpbin.org\/get\"+--print (r 'Control.Lens.^?' 'responseHeader' \"Content-Transfer-Encoding\")+-- @+--+-- To access all (zero or more) matching headers, use the+-- ('Control.Lens.^..') operator.+--+-- @+--r <- 'Network.Wreq.get' \"http:\/\/httpbin.org\/get\"+--print (r 'Control.Lens.^..' 'responseHeader' \"Set-Cookie\")+-- @+responseHeader :: HeaderName+               -- ^ Header name to match.+               -> Traversal' (Response body) ByteString+responseHeader = TH.responseHeader++-- | A lens onto all headers in an HTTP response.+responseHeaders :: Lens' (Response body) ResponseHeaders+responseHeaders = TH.responseHeaders++-- | A fold over @Link@ headers, matching on both parameter name+-- and value.+--+-- For example, here is a @Link@ header returned by the GitHub search API.+--+-- > Link:+-- >   <https://api.github.com/search/code?q=addClass+user%3Amozilla&page=2>; rel="next",+-- >   <https://api.github.com/search/code?q=addClass+user%3Amozilla&page=34>; rel="last"+--+-- And here is an example of how we can retrieve the URL for the @next@ link+-- programatically.+--+-- @+--r <- 'Network.Wreq.get' \"https:\/\/api.github.com\/search\/code?q=addClass+user:mozilla\"+--print (r 'Control.Lens.^?' 'responseLink' \"rel\" \"next\" . 'linkURL')+-- @+responseLink :: ByteString+             -- ^ Parameter name to match.+             -> ByteString+             -- ^ Parameter value to match.+             -> Fold (Response body) Link+responseLink = TH.responseLink++-- | A lens onto the body of a response.+--+-- @+--r <- 'Network.Wreq.get' \"http:\/\/httpbin.org\/get\"+--print (r 'Control.Lens.^.' 'responseBody')+-- @+responseBody :: Lens (Response body0) (Response body1) body0 body1+responseBody = TH.responseBody++-- | A fold over any cookies that match the given name.+--+-- @+--r <- 'Network.Wreq.get' \"http:\/\/www.nytimes.com\/\"+--print (r 'Control.Lens.^?' responseCookie \"RMID\")+-- @+responseCookie :: ByteString+               -- ^ Name of cookie to match.+               -> Fold (Response body) Cookie+responseCookie = TH.responseCookie++-- | A lens onto all cookies set in the response.+responseCookieJar :: Lens' (Response body) CookieJar+responseCookieJar = TH.responseCookieJar++-- | A lens onto the numeric identifier of an HTTP status.+statusCode :: Lens' Status Int+statusCode = TH.statusCode++-- | A lens onto the textual description of an HTTP status.+statusMessage :: Lens' Status ByteString+statusMessage = TH.statusMessage++-- | A lens onto the URL portion of a @Link@ element.+linkURL :: Lens' Link ByteString+linkURL = TH.linkURL++-- | A lens onto the parameters of a @Link@ element.+linkParams :: Lens' Link [(ByteString, ByteString)]+linkParams = TH.linkParams++-- | A lens onto the name of the @<input>@ element associated with+-- part of a multipart form upload.+partName :: Lens' Part Text+partName = TH.partName++-- | A lens onto the filename associated with part of a multipart form+-- upload.+partFileName :: Lens' Part (Maybe String)+partFileName = TH.partFilename++-- | A lens onto the content-type associated with part of a multipart+-- form upload.+partContentType :: Traversal' Part (Maybe MimeType)+partContentType = TH.partContentType++-- | A lens onto the code that fetches the data associated with part+-- of a multipart form upload.+partGetBody :: Lens' Part (IO RequestBody)+partGetBody = TH.partGetBody++-- | Turn an attoparsec 'Parser' into a 'Fold'.+--+-- Both headers and bodies can contain complicated data that we may+-- need to parse.+--+-- Example: when responding to an OPTIONS request, a server may return+-- the list of verbs it supports in any order, up to and including+-- changing the order on every request (which httpbin.org /actually+-- does/!).  To deal with this possibility, we parse the list, then+-- sort it.+--+-- >>> import Data.Attoparsec.ByteString.Char8 as A+-- >>> import Data.List (sort)+-- >>>+-- >>> let comma = skipSpace >> "," >> skipSpace+-- >>> let verbs = A.takeWhile isAlpha_ascii `sepBy` comma+-- >>>+-- >>> r <- options "http://httpbin.org/get"+-- >>> r ^. responseHeader "Allow" . atto verbs . to sort+-- ["GET","HEAD","OPTIONS"]+atto :: Parser a -> Fold ByteString a+atto = folding . parseOnly++-- $setup+--+-- >>> :set -XOverloadedStrings+-- >>> import Control.Lens+-- >>> import Data.Aeson (toJSON)+-- >>> import Data.Aeson.Lens (key, nth)+-- >>> import Network.Wreq

@@ -0,0 +1,20 @@+module Network.Wreq.Lens.Machinery+    (+      makeLenses+    , toCamelCase+    ) where++import Control.Lens ((&), (.~))+import Control.Lens.TH (defaultRules, lensField, makeLensesWith)+import Data.Char (toUpper)+import Language.Haskell.TH.Syntax (Dec, Name, Q)++makeLenses :: Name -> Q [Dec]+makeLenses = makeLensesWith (defaultRules & lensField .~ Just)++toCamelCase :: String -> String+toCamelCase (x0:x0s)  = x0 : go x0s+  where go ('_':x:xs) = toUpper x : go xs+        go (x:xs)     = x : go xs+        go []         = []+toCamelCase []        = []

@@ -0,0 +1,108 @@+{-# LANGUAGE FlexibleContexts, OverloadedStrings, RankNTypes,+    TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++module Network.Wreq.Lens.TH+    (+      Types.Options+    , manager+    , proxy+    , auth+    , header+    , headers+    , param+    , params+    , redirects+    , cookie+    , cookies++    , HTTP.Cookie+    , cookieName+    , cookieValue+    , cookieExpiryTime+    , cookieDomain+    , cookiePath+    , cookieCreationTime+    , cookieLastAccessTime+    , cookiePersistent+    , cookieHostOnly+    , cookieSecureOnly+    , cookieHttpOnly++    , HTTP.Proxy+    , proxyHost+    , proxyPort++    , HTTP.Response+    , responseStatus+    , responseVersion+    , responseHeader+    , responseHeaders+    , responseLink+    , responseBody+    , responseCookie+    , responseCookieJar+    , responseClose'++    , HTTP.Status+    , statusCode+    , statusMessage++    , Types.Link+    , linkURL+    , linkParams++    , Form.Part+    , partName+    , partFilename+    , partContentType+    , partGetBody+    ) where++import Control.Lens hiding (makeLenses)+import Control.Lens.TH (defaultRules, lensField, makeLensesWith)+import Data.ByteString (ByteString)+import Data.Text (Text)+import Network.Wreq.Internal.Lens (assoc, assoc2)+import Network.Wreq.Lens.Machinery (makeLenses, toCamelCase)+import qualified Network.HTTP.Client as HTTP+import qualified Network.HTTP.Client.MultipartFormData as Form+import qualified Network.HTTP.Types.Header as HTTP+import qualified Network.HTTP.Types.Status as HTTP+import qualified Network.Wreq.Types as Types+import Network.Wreq.Internal.Link++makeLenses ''Types.Options+makeLensesWith (defaultRules & lensField .~ Just . toCamelCase) ''HTTP.Cookie+makeLenses ''HTTP.Proxy+makeLenses ''HTTP.Response+makeLenses ''HTTP.Status+makeLenses ''Types.Link+makeLenses ''Form.Part++responseHeader :: HTTP.HeaderName -> Traversal' (HTTP.Response body) ByteString+responseHeader n = responseHeaders . assoc n++param :: Text -> Lens' Types.Options [Text]+param n = params . assoc2 n++header :: HTTP.HeaderName -> Lens' Types.Options [ByteString]+header n = headers . assoc2 n++_CookieJar :: Iso' HTTP.CookieJar [HTTP.Cookie]+_CookieJar = iso HTTP.destroyCookieJar HTTP.createCookieJar++-- N.B. This is an "illegal" traversal because we can change its cookie_name.+cookie :: ByteString -> Traversal' Types.Options HTTP.Cookie+cookie name = cookies . _CookieJar . traverse . filtered+              (\c -> HTTP.cookie_name c == name)++responseCookie :: ByteString -> Fold (HTTP.Response body) HTTP.Cookie+responseCookie name =+  responseCookieJar . folding HTTP.destroyCookieJar . filtered+  ((==name) . HTTP.cookie_name)++responseLink :: ByteString -> ByteString -> Fold (HTTP.Response body) Types.Link+responseLink name val =+  responseHeader "Link" . folding links .+  filtered (has (linkParams . folded . filtered (== (name,val))))

@@ -0,0 +1,97 @@+{-# LANGUAGE RecordWildCards #-}++module Network.Wreq.Session+    (+      Session+    , withSession+    -- * HTTP verbs+    , get+    , post+    , head_+    , options+    , put+    , delete+    -- ** Configurable verbs+    , getWith+    , postWith+    , headWith+    , optionsWith+    , putWith+    , deleteWith+    ) where++import Control.Concurrent.MVar (MVar, modifyMVar, newMVar)+import Control.Lens ((&), (.~), (^.))+import Network.Wreq (Options, Response, defaults)+import Network.Wreq.Internal (defaultManagerSettings)+import Network.Wreq.Types (Postable, Putable)+import Prelude hiding (head)+import qualified Data.ByteString.Lazy as L+import qualified Network.HTTP.Client as HTTP+import qualified Network.Wreq as Wreq++data Session = Session {+      seshCookies :: MVar HTTP.CookieJar+    , seshManager :: HTTP.Manager+    }++instance Show Session where+    show _ = "Session"++withSession :: (Session -> IO a) -> IO a+withSession act = do+  mv <- newMVar $ HTTP.createCookieJar []+  HTTP.withManager defaultManagerSettings $ \mgr ->+    act Session { seshCookies = mv, seshManager = mgr }++get :: Session -> String -> IO (Response L.ByteString)+get = getWith defaults++post :: Postable a => Session -> String -> a -> IO (Response L.ByteString)+post = postWith defaults++head_ :: Session -> String -> IO (Response ())+head_ = headWith defaults++options :: Session -> String -> IO (Response ())+options = optionsWith defaults++put :: Putable a => Session -> String -> a -> IO (Response L.ByteString)+put = putWith defaults++delete :: Session -> String -> IO (Response ())+delete = deleteWith defaults++getWith :: Options -> Session -> String -> IO (Response L.ByteString)+getWith opts sesh url =+  override opts sesh $ \opts' -> Wreq.getWith opts' url++postWith :: Postable a => Options -> Session -> String -> a+         -> IO (Response L.ByteString)+postWith opts sesh url payload =+  override opts sesh $ \opts' -> Wreq.postWith opts' url payload++headWith :: Options -> Session -> String -> IO (Response ())+headWith opts sesh url =+  override opts sesh $ \opts' -> Wreq.headWith opts' url++optionsWith :: Options -> Session -> String -> IO (Response ())+optionsWith opts sesh url =+  override opts sesh $ \opts' -> Wreq.optionsWith opts' url++putWith :: Putable a => Options -> Session -> String -> a+        -> IO (Response L.ByteString)+putWith opts sesh url payload =+  override opts sesh $ \opts' -> Wreq.putWith opts' url payload++deleteWith :: Options -> Session -> String -> IO (Response ())+deleteWith opts sesh url =+  override opts sesh $ \opts' -> Wreq.deleteWith opts' url++override :: Options -> Session -> (Options -> IO (Response body))+         -> IO (Response body)+override opts Session{..} act =+  modifyMVar seshCookies $ \cj -> do+    resp <- act $ opts & Wreq.cookies .~ cj &+                         Wreq.manager .~ Right seshManager+    return (resp ^. Wreq.responseCookieJar, resp)

@@ -0,0 +1,139 @@+{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module      : Network.Wreq.Types+-- Copyright   : (c) 2014 Bryan O'Sullivan+--+-- License     : BSD-style+-- Maintainer  : bos@serpentine.com+-- Stability   : experimental+-- Portability : GHC+--+-- HTTP client types.++module Network.Wreq.Types+    (+    -- * Client configuration+      Options(..)+    , Auth(..)+    -- * Request payloads+    , Payload(..)+    , Postable(..)+    , Putable(..)+    -- ** URL-encoded forms+    , FormParam(..)+    , FormValue(..)+    -- * Headers+    , ContentType+    , Link(..)+    -- * Errors+    , JSONError(..)+    ) where++import Control.Lens ((&), (.~))+import Data.Aeson (Value, encode)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word, Word8, Word16, Word32, Word64)+import Network.HTTP.Client (Request)+import Network.HTTP.Client.MultipartFormData (Part, formDataBody)+import Network.Wreq.Internal.Types+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TL+import qualified Network.HTTP.Client as HTTP+import qualified Network.Wreq.Internal.Lens as Lens++instance Postable Part where+    postPayload a = postPayload [a]++instance Postable [Part] where+    postPayload = formDataBody++instance Postable [(S.ByteString, S.ByteString)] where+    postPayload ps req = return $ HTTP.urlEncodedBody ps req++instance Postable (S.ByteString, S.ByteString) where+    postPayload p = postPayload [p]++instance Postable [FormParam] where+    postPayload ps = postPayload (map f ps)+      where f (a := b) = (a, renderFormValue b)++instance Postable FormParam where+    postPayload p = postPayload [p]++instance Postable Payload where+    postPayload = putPayload++instance Postable S.ByteString where+    postPayload = putPayload++instance Postable L.ByteString where+    postPayload = putPayload++instance Postable Value where+    postPayload = putPayload+++instance Putable Payload where+    putPayload pl =+      case pl of+        Raw ct rb -> payload ct rb++instance Putable S.ByteString where+    putPayload = payload "application/octet-stream" . HTTP.RequestBodyBS++instance Putable L.ByteString where+    putPayload = payload "application/octet-stream" . HTTP.RequestBodyLBS++instance Putable Value where+    putPayload = payload "application/json" . HTTP.RequestBodyLBS . encode+++instance FormValue T.Text where+    renderFormValue = T.encodeUtf8++instance FormValue TL.Text where+    renderFormValue = T.encodeUtf8 . TL.toStrict++instance FormValue TL.Builder where+    renderFormValue = T.encodeUtf8 . TL.toStrict . TL.toLazyText++instance FormValue String where+    renderFormValue = T.encodeUtf8 . T.pack++instance FormValue S.ByteString where+    renderFormValue = id++instance FormValue L.ByteString where+    renderFormValue = S.concat . L.toChunks++instance FormValue Int where renderFormValue = renderFormValue . show+instance FormValue Int8 where renderFormValue = renderFormValue . show+instance FormValue Int16 where renderFormValue = renderFormValue . show+instance FormValue Int32 where renderFormValue = renderFormValue . show+instance FormValue Int64 where renderFormValue = renderFormValue . show+instance FormValue Integer where renderFormValue = renderFormValue . show++instance FormValue Word where renderFormValue = renderFormValue . show+instance FormValue Word8 where renderFormValue = renderFormValue . show+instance FormValue Word16 where renderFormValue = renderFormValue . show+instance FormValue Word32 where renderFormValue = renderFormValue . show+instance FormValue Word64 where renderFormValue = renderFormValue . show++instance FormValue Float where renderFormValue = renderFormValue . show+instance FormValue Double where renderFormValue = renderFormValue . show++instance FormValue () where renderFormValue _ = ""++instance (FormValue a) => FormValue (Maybe a) where+    renderFormValue (Just a) = renderFormValue a+    renderFormValue Nothing  = ""++payload :: ContentType -> HTTP.RequestBody -> Request -> IO Request+payload ct body req = return $ req & Lens.setHeader "Content-Type" ct &+                      Lens.requestBody .~ body

@@ -0,0 +1,29 @@+# wreq: a Haskell web client library++`wreq` is a library that makes HTTP client programming in Haskell+easy.+++# Features++* Simple but powerful `lens`-based API++* Over 100 tests, and built on reliable libraries like [`http-client`](http://hackage.haskell.org/package/http-client/)+  and [`lens`](https://lens.github.io/)++* Session handling includes connection keep-alive and pooling, and+  cookie persistence++* Automatic decompression++* Powerful multipart form and file upload handling++* Support for JSON requests and responses, including navigation of+  schema-less responses++* Basic and OAuth2 bearer authentication+++# Is it done?++No!  See [`TODO.md`](TODO.md) for a rather long list of ideas.

@@ -0,0 +1,64 @@+-- I don't know who originally wrote this, but I picked it up from+-- Edward Kmett's folds package.++{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List (nub)+import Data.Version (showVersion)+import Distribution.Package+  (PackageName(PackageName), Package, PackageId, InstalledPackageId,+   packageVersion, packageName)+import Distribution.PackageDescription (PackageDescription(), TestSuite(..))+import Distribution.Simple+  (defaultMainWithHooks, UserHooks(..), simpleUserHooks)+import Distribution.Simple.BuildPaths (autogenModulesDir)+import Distribution.Simple.LocalBuildInfo+  (withLibLBI, withTestLBI, LocalBuildInfo(),+   ComponentLocalBuildInfo(componentPackageDeps))+import Distribution.Simple.Setup+  (BuildFlags(buildVerbosity), Flag(..), fromFlag,+   HaddockFlags(haddockDistPref))+import Distribution.Simple.Utils+  (rewriteFile, createDirectoryIfMissingVerbose, copyFiles)+import Distribution.Text (display)+import Distribution.Verbosity (Verbosity, normal)+import System.FilePath ((</>))++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  , postHaddock = \args flags pkg lbi -> do+     copyFiles normal (haddockOutputDir flags pkg) []+     postHaddock simpleUserHooks args flags pkg lbi+  }++haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath+haddockOutputDir flags pkg = destDir where+  baseDir = case haddockDistPref flags of+    NoFlag -> "."+    Flag x -> x+  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo+                    -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo+         -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys

@@ -0,0 +1,19 @@+# Work yet to be done++* More advanced tutorial-style documentation++* TLS server certificate verification++* An example that spiders a Haddock package's docs to validate its+  internal and external links++* Integration with tagsoup (see+  [the mess in `UploadPaste.hs`](https://github.com/bos/wreq/blob/master/examples/UploadPaste.hs#L137))++* International domain support?++* Better authentication support, including session-long memory of+  which URLs do and don't need authentication++* Some poor sod needs to add digest authentication to `http-client` so+  we can use it

@@ -0,0 +1,1 @@+.

@@ -0,0 +1,122 @@+-- Examples of handling for JSON responses+--+-- This library provides several ways to handle JSON responses++{-# LANGUAGE DeriveGeneric, OverloadedStrings, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-unused-binds #-}++import Control.Lens ((&), (^.), (^?), (.~))+import Data.Aeson (FromJSON)+import Data.Aeson.Lens (key)+import Data.Map (Map)+import Data.Text (Text)+import GHC.Generics (Generic)+import qualified Control.Exception as E++import Network.Wreq+++-- This Haskell type corresponds to the structure of a response body+-- from httpbin.org.++data GetBody = GetBody {+    headers :: Map Text Text+  , args :: Map Text Text+  , origin :: Text+  , url :: Text+  } deriving (Show, Generic)++-- Get GHC to derive a FromJSON instance for us.++instance FromJSON GetBody++++-- We expect this to succeed.++basic_asJSON :: IO ()+basic_asJSON = do+  let opts = defaults & param "foo" .~ ["bar"]+  r <- asJSON =<< getWith opts "http://httpbin.org/get"++  -- The fact that we want a GetBody here will be inferred by our use+  -- of the "headers" accessor function.++  putStrLn $ "args: " ++ show (args (r ^. responseBody))++++-- The response we expect here is valid JSON, but cannot be converted+-- to an [Int], so this will throw a JSONError.++failing_asJSON :: IO ()+failing_asJSON = do+  (r :: Response [Int]) <- asJSON =<< get "http://httpbin.org/get"+  putStrLn $ "response: " ++ show (r ^. responseBody)++++-- This demonstrates how to catch a JSONError.++failing_asJSON_catch :: IO ()+failing_asJSON_catch =+  failing_asJSON `E.catch` \(e :: JSONError) -> print e++++-- Because asJSON is parameterized over MonadThrow, we can use it with+-- other instances.+--+-- Here, instead of throwing an exception in the IO monad, we instead+-- evaluate the result as an Either:+--+-- * if the conversion fails, the Left constructor will contain+--   whatever exception describes the error+--+-- * if the conversion succeeds, the Right constructor will contain+--   the converted response++either_asJSON :: IO ()+either_asJSON = do+  r <- get "http://httpbin.org/get"++  -- This first conversion attempt will fail, but because we're using+  -- Either, it will not throw an exception that kills execution.+  let failing = asJSON r :: Either E.SomeException (Response [Int])+  print failing++  -- Our second conversion attempt will succeed.+  let succeeding = asJSON r :: Either E.SomeException (Response GetBody)+  print succeeding++++-- The lens package defines some handy combinators for use with the+-- aeson package, with which we can easily traverse parts of a JSON+-- response.++lens_aeson :: IO ()+lens_aeson = do+  r <- get "http://httpbin.org/get"+  print $ r ^? responseBody . key "headers" . key "User-Agent"++  -- If we maintain the ResponseBody as a ByteString, the lens+  -- combinators will have to convert the body to a Value every time+  -- we start a new traversal.++  -- When we need to poke at several parts of a response, it's more+  -- efficient to use asValue to perform the conversion to a Value+  -- once.++  let opts = defaults & param "baz" .~ ["quux"]+  v <- asValue =<< getWith opts "http://httpbin.org/get"+  print $ v ^? responseBody . key "args" . key "baz"++++main :: IO ()+main = do+  basic_asJSON+  failing_asJSON_catch+  either_asJSON+  lens_aeson

@@ -0,0 +1,166 @@+-- upload a paste to lpaste.net+--+-- This example is pretty beefy, as it does double duty.+--+-- Perhaps the majority of it shows off some complex uses of the+-- optparse-applicative package.+--+-- The POST portion is in the function named upload below.  It uploads+-- an application/x-www-urlencoded form that creates a paste on the+-- Haskell community pastebin at <http://lpaste.net/>.++{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}+{-# OPTIONS_GHC -Wall #-}++import Control.Applicative+import Control.Lens+import Data.Char (toLower)+import Data.Maybe (listToMaybe)+import Data.Monoid (mempty)+import Network.Wreq (FormParam((:=)), post, responseBody)+import Network.Wreq.Types (FormValue(..))+import Options.Applicative as Opts hiding ((&), header)+import System.FilePath (takeExtension, takeFileName)+import Text.HTML.TagSoup+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as L++-- A post to lpaste.net can either be private or public (visible in an+-- index).+data Visibility = Private | Public+                deriving (Show)++-- Wreq supports uploading an application/x-www-urlencoded form (see+-- uses of the := operator in the upload function below), so we tell+-- it how to render a value of a custom datatype.+instance FormValue Visibility where+  renderFormValue = renderFormValue . show++-- The languages that lpaste.net supports. It just so happens that if+-- we convert one of these constructor names to a lower-case string,+-- it exactly matches what lpaste.net needs in its upload form.+data Language =+  Haskell | Agda | Assembly | Bash | C | Coq | Cpp | Cs | Diff | Elm | ELisp |+  Erlang | Go | Idris | Java | JavaScript | LiterateHaskell | Lisp |+  Lua | OCaml | ObjectiveC | Perl | Prolog | Python | Ruby | SQL | Scala |+  Scheme | Smalltalk | TeX+  deriving (Eq, Show)++instance FormValue Language where+  renderFormValue = renderFormValue . fmap toLower . show++-- An association between filename suffixes and our Language type.+languages :: [([String], Language)]+languages = [+  ([".hs"], Haskell), ([".agda"], Agda), ([".el"], ELisp), ([".ocaml"], OCaml),+  ([".cl"], Lisp), ([".erl"], Erlang), ([".lhs"], LiterateHaskell),+  ([".scala"], Scala), ([".go"], Go), ([".py"], Python), ([".rb"], Ruby),+  ([".elm"], Elm), ([".idris"], Idris), ([".prl"], Prolog), ([".scm"], Scheme),+  ([".coq"], Coq), ([".s", ".asm"], Assembly), ([".sh"], Bash),+  ([".c", ".h"], C), ([".cs"], Cs), ([".tex"], TeX), ([".lua"], Lua),+  ([".cxx", ".cpp", ".cc", ".hxx", ".hpp", ".hh"], Cpp), ([".pl", ".pm"], Perl),+  ([".diff", ".patch"], Diff), ([".java"], Java), ([".js"], JavaScript),+  ([".m"], ObjectiveC), ([".smalltalk"], Smalltalk), ([".sql"], SQL)+  ]++-- An IRC channel to which an announcement of a paste can be posted.+-- We wrap this in a newtype so we can control how it is rendered in a+-- form.+newtype Channel = Channel { fromChannel :: String }+                deriving (Eq, Show)++-- If a user forgot to supply a leading '#' for a channel name, we add+-- it here.+instance FormValue Channel where+  renderFormValue = renderFormValue . checkHash . fromChannel+    where checkHash cs@('#':_) = cs+          checkHash cs@(_:_)   = '#' : cs+          checkHash cs         = cs++-- This type plays two roles.  It describes the command line options+-- we accept, and also the contents of the form we'll upload to create+-- a new paste.+--+-- We've parameterised the type so that the payload field can either+-- be a filename or the actual contents of the file.+data Paste a = Paste {+    _private :: Visibility+  , _title :: Maybe String+  , _author :: Maybe String+  , _channel :: Maybe Channel+  , _language :: Maybe Language+  , _payload :: a+  , _email :: () -- used by lpaste.net for spam protection+  } deriving (Show)++makeLenses ''Paste++-- Try to match a user-supplied name to a Language type, looking at+-- both full names and filename extensions.+readLanguage :: Monad m => String -> m Language+readLanguage l = do+  let ll = toLower <$> l+      ms = [lang | (suffixes, lang) <- languages,+            ll == (toLower <$> show lang) || ll `elem` (tail <$> suffixes)]+  case ms of+    [m] -> return m+    _   -> fail $ "unsupported language " ++ show l++-- Figure out the language to specify for a file, either explicitly as+-- specified by the user, or implicitly from the filename extension.+guessLanguage :: FilePath -> Paste a -> Maybe Language+guessLanguage filename p =+    (p ^. language) <|>+    listToMaybe [lang | (suffixes, lang) <- languages, sfx `elem` suffixes]+  where sfx = toLower <$> takeExtension filename++upload :: Paste FilePath -> IO ()+upload p0 = do+  let path = p0 ^. payload+  body <- B.readFile path+  -- Transform command line options into form contents.+  let p = p0 & payload .~ body+             & title .~ (p0 ^. title <|> Just (takeFileName path))+             & language .~ guessLanguage path p0+  -- The := operator defines a key/value pair for a form.+  resp <- post "http://lpaste.net/new" [+            "private" := p ^. private+          , "title" := p ^. title+          , "author" := p ^. author+          , "channel" := p ^. channel+          , "language" := p ^. language+          , "paste" := p ^. payload+          , "email" := p ^. email+          ]+  -- Since lpaste.net doesn't provide an API and just spits HTML back+  -- at us, we use tagsoup to look through the tags for the permalink+  -- of the paste we just uploaded.+  let findURI (TagOpen "strong" [] : TagText "Paste:" : TagClose "strong" :+               TagOpen "a" [("href",uri)] : _) = Just uri+      findURI (_:xs) = findURI xs+      findURI _      = Nothing+  case findURI (parseTagsOptions parseOptionsFast (resp ^. responseBody)) of+    Just uri -> L.putStrLn $ "http://lpaste.net" <> uri+    Nothing  -> putStrLn "no uri in response!?"++main :: IO ()+main = upload =<< execParser opts+  where opts = info (helper <*> optionParser) mempty+        optionParser = Paste <$>+          (flag Private Public $ long "public" <>+                                 help "display in index of pastes") <*>+          (optional . strOption $+           long "title" <> short 't' <> metavar "TITLE" <>+           help "title to use for paste") <*>+          (optional . strOption $+           long "author" <> short 'a' <> metavar "AUTHOR" <>+           help "author to display for paste") <*>+          (optional . fmap Channel . strOption $+           long "channel" <> short 'c' <> metavar "CHANNEL" <>+           help "name of IRC channel to announce") <*>+          (optional . nullOption $+           long "language" <> short 'l' <> metavar "LANG" <>+           help "language to use" <> reader readLanguage) <*>+          (Opts.argument str $ metavar "PATH" <>+                               help "file to upload") <*>+          (pure ())

@@ -0,0 +1,51 @@+name:                wreq-examples+version:             0+synopsis:            wreq examples, not for installing+description:+homepage:            https://github.com/bos/wreq+bug-reports:         https://github.com/bos/wreq/issues+license:             BSD3+license-file:        ../LICENSE.md+maintainer:          bos@serpentine.com+category:            Web+build-type:          Simple+cabal-version:       >=1.10++executable wreq-example-json-response+  main-is:        JsonResponse.hs+  ghc-options:    -Wall -fwarn-tabs -threaded+  default-language: Haskell98++  build-depends:+    aeson,+    base >= 4.5 && < 5,+    containers,+    ghc-prim,+    lens,+    text,+    wreq++executable upload-paste+  main-is:          UploadPaste.hs+  ghc-options:      -Wall -fwarn-tabs -threaded+  default-language: Haskell98++  build-depends:+    aeson >= 0.7.0.3,+    ansi-wl-pprint >= 0.6.6,+    base >= 4.5 && < 5,+    bytestring,+    filepath,+    lens,+    optparse-applicative,+    tagsoup,+    text,+    wreq++source-repository head+  type:     git+  location: https://github.com/bos/wreq++source-repository head+  type:     mercurial+  location: https://bitbucket.org/bos/wreq

@@ -0,0 +1,124 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++-- TBD: basic-auth, gzip++module Main (main) where++import Control.Applicative ((<$>))+import Data.Aeson (Value(..), eitherDecode, object, toJSON)+import Data.Aeson.Encode.Pretty (Config(..), encodePretty')+import qualified Data.ByteString.Base64 as B64+import Data.ByteString.Char8 (pack)+import Data.CaseInsensitive (original)+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>))+import Data.Text.Encoding (decodeUtf8)+import Data.Text.Read (decimal)+import Snap.Core+import Snap.Http.Server+import Snap.Util.GZip (withCompression)+import qualified Data.ByteString.Char8 as B+import qualified Data.Map as Map+import qualified Data.Text.Lazy.Encoding as Lazy++get = respond return++post = respond $ \obj -> do+  body <- readRequestBody 65536+  return $ obj <> [("data", toJSON (Lazy.decodeUtf8 body))] <>+           case eitherDecode body of+             Left _    -> [("json", Null)]+             Right val -> [("json", val)]++put = post++delete = respond return++status = do+  val <- (fromMaybe 200 . rqIntParam "val") <$> getRequest+  let code | val >= 200 && val <= 505 = val+           | otherwise                = 400+  modifyResponse $ setResponseCode code++gzip =+  localRequest (setHeader "Accept-Encoding" "gzip") . withCompression .+  respond $ \obj -> return $ obj <> [("gzipped", Bool True)]++setCookies = do+  params <- rqQueryParams <$> getRequest+  modifyResponse . foldr (.) id . map addResponseCookie $+    [Cookie k v Nothing Nothing (Just "/") False False+     | (k,vs) <- Map.toList params, v <- vs]+  redirect "/cookies"++redirect_ = do+  req <- getRequest+  let n   = fromMaybe (-1::Int) . rqIntParam "n" $ req+      prefix = B.reverse . B.dropWhile (/='/') . B.reverse . rqURI $ req+  case undefined of+    _| n > 1     -> redirect $ prefix <> pack (show (n-1))+     | n == 1    -> redirect "/get"+     | otherwise -> modifyResponse $ setResponseCode 400++basicAuth = do+  req <- getRequest+  let unauthorized = modifyResponse $+                     setHeader "WWW-Authenticate" "Basic realm=\"Fake Realm\"" .+                     setResponseCode 401+  case (rqParam "user" req, rqParam "pass" req) of+    (Just [user], Just [passwd]) | not (':' `B.elem` user) ->+      case getHeader "Authorization" (headers req) of+        Nothing -> unauthorized+        Just auth -> do+          let expected = "Basic " <> B64.encode (user <> ":" <> passwd)+          if auth /= expected+            then unauthorized+            else writeJSON [ ("user", toJSON (B.unpack user))+                           , ("authenticated", Bool True) ]+    _ -> modifyResponse $ setResponseCode 400++rqIntParam name req =+  case rqParam name req of+    Just (str:_) -> case decimal (decodeUtf8 str) of+                      Right (n, "") -> Just n+                      _             -> Nothing+    _            -> Nothing++writeJSON obj = do+  modifyResponse $ setContentType "application/json"+  writeLBS . (<> "\n") . encodePretty' (Config 2 compare) . object $ obj++respond act = do+  req <- getRequest+  let step m k v = Map.insert (decodeUtf8 k) (decodeUtf8 (head v)) m+      params = Map.foldlWithKey' step Map.empty .+               rqQueryParams $ req+      wibble (k,v) = (decodeUtf8 (original k), decodeUtf8 v)+      rqHeaders = headers req+      hdrs = Map.fromList . map wibble . listHeaders $ rqHeaders+      url = case getHeader "Host" rqHeaders of+              Nothing   -> []+              Just host -> [("url", toJSON . decodeUtf8 $+                                    "http://" <> host <> rqURI req)]+  writeJSON =<< act ([ ("args", toJSON params)+                     , ("headers", toJSON hdrs)+                     , ("origin", toJSON . decodeUtf8 . rqRemoteAddr $ req)+                     ] <> url)++main = do+  cfg <- commandLineConfig+       . setAccessLog ConfigNoLog+       . setErrorLog ConfigNoLog+       $ defaultConfig+  httpServe cfg $ route [+      ("/get", methods [GET,HEAD] get)+    , ("/post", method POST post)+    , ("/put", method PUT put)+    , ("/delete", method DELETE delete)+    , ("/redirect/:n", redirect_)+    , ("/status/:val", status)+    , ("/gzip", methods [GET,HEAD] gzip)+    , ("/cookies/set", methods [GET,HEAD] setCookies)+    , ("/basic-auth/:user/:pass", methods [GET,HEAD] basicAuth)+    ]

@@ -0,0 +1,47 @@+-- I don't know who originally wrote this, but I picked it up from+-- Edward Kmett's folds package, and subsequently modified it.++module Main where++import Build_doctest (deps)+import Control.Applicative ((<$>), (<*>))+import Control.Monad (filterM)+import Data.List (isPrefixOf, isSuffixOf)+import System.Directory+-- import System.Environment (getArgs)+import System.FilePath ((</>))+import Test.DocTest (doctest)++main :: IO ()+main = do+  -- doctest chokes on the command line args that cabal test passes in+  -- args <- getArgs+  let args = []+  srcs <- getSources+  dist <- getDistDir+  doctest $ args ++ [ "-i."+            , "-i" ++ dist ++ "/build/autogen"+            , "-optP-include"+            , "-optP" ++ dist ++ "/build/autogen/cabal_macros.h"+            , "-hide-all-packages"+            ] ++ map ("-package="++) deps ++ srcs++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "Network"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$>+       getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c++getDistDir :: IO FilePath+getDistDir = do+  names <- getDirectoryContents "dist"+  return $ case filter ("dist-sandbox-" `isPrefixOf`) names of+             (d:_) -> "dist/" ++ d+             _     -> "dist"

@@ -0,0 +1,207 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns -fno-warn-missing-signatures+    -fno-warn-unused-binds #-}++module Main (main) where++import Control.Applicative ((<$>))+import Control.Exception (Exception)+import Control.Lens ((^.), (^?), (.~), (&))+import Control.Monad (unless, void)+import Data.Aeson (Value(..), object)+import Data.Aeson.Lens (key)+import Data.ByteString (ByteString)+import Data.Char (toUpper)+import Data.Maybe (isJust)+import Data.Monoid ((<>))+import Data.Text (pack)+import Network.HTTP.Client (HttpException(..))+import Network.HTTP.Types.Status (status200, status401)+import Network.HTTP.Types.Version (http11)+import Network.Wreq+import Network.Wreq.Lens+import qualified Network.Wreq.Session as Session+import System.IO (hClose, hPutStr)+import System.IO.Temp (withSystemTempFile)+import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (assertBool, assertEqual, assertFailure)+import qualified Control.Exception as E+import qualified Data.Text as T++basicGet site = do+  r <- get (site "/get")+  assertBool "GET request has User-Agent header" $+    isJust (r ^. responseBody ^? key "headers" . key "User-Agent")+  -- test the various lenses+  assertEqual "GET succeeds" status200 (r ^. responseStatus)+  assertEqual "GET succeeds 200" 200 (r ^. responseStatus . statusCode)+  assertEqual "GET succeeds OK" "OK" (r ^. responseStatus . statusMessage)+  assertEqual "GET response has HTTP/1.1 version" http11 (r ^. responseVersion)+  assertBool "GET response has Content-Type header" $+    isJust (r ^? responseHeader "Content-Type")+  assertBool "GET response has Date header" $+    isJust (lookup "Date" <$> r ^? responseHeaders)++basicPost site = do+  r <- post (site "/post") ("wibble" :: ByteString) >>= asValue+  let body = r ^. responseBody+  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")++multipartPost site =+  withSystemTempFile "foo.html" $ \name handle -> do+    hPutStr handle "<!DOCTYPE html><html></html"+    hClose handle+    r <- post (site "/post") (partFile "html" name)+    assertEqual "POST succeeds" status200 (r ^. responseStatus)++basicHead site = do+  r <- head_ (site "/get")+  assertEqual "HEAD succeeds" status200 (r ^. responseStatus)++basicPut site = do+  r <- put (site "/put") ("wibble" :: ByteString)+  assertEqual "PUT succeeds" status200 (r ^. responseStatus)++basicDelete site = do+  r <- delete (site "/delete")+  assertEqual "DELETE succeeds" status200 (r ^. responseStatus)++throwsStatusCode site =+    assertThrows "404 causes exception to be thrown" inspect $+    head_ (site "/status/404")+  where inspect e = case e of+                      StatusCodeException _ _ _ -> return ()+                      _ -> assertFailure "unexpected exception thrown"++getBasicAuth 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 _ _ ->+                      assertEqual "failed basic auth failed GET gives 401"+                        status401 status+  assertThrows "basic auth GET fails if password is bad" inspect $+    getWith opts (site "/basic-auth/user/asswd")++getRedirect site = do+  r <- get (site "/redirect/3")+  let stripProto = T.dropWhile (/=':')+      smap f (String s) = String (f s)+  assertEqual "redirect goes to /get"+    (Just . String . stripProto . pack . site $ "/get")+    (smap stripProto <$> (r ^. responseBody ^? key "url"))++getParams site = do+  let opts1 = defaults & param "foo" .~ ["bar"]+  r1 <- getWith opts1 (site "/get")+  assertEqual "params set correctly 1" (Just (object [("foo","bar")]))+    (r1 ^. responseBody ^? key "args")+  let opts2 = defaults & params .~ [("quux","baz")]+  r2 <- getWith opts2 (site "/get")+  assertEqual "params set correctly 2" (Just (object [("quux","baz")]))+    (r2 ^. responseBody ^? key "args")+  r3 <- getWith opts2 (site "/get?whee=wat")+  assertEqual "correctly handle mix of params from URI and Options"+    (Just (object [("quux","baz"),("whee","wat")]))+    (r3 ^. responseBody ^? key "args")++getHeaders site = do+  let opts = defaults & header "X-Wibble" .~ ["bar"]+  r <- getWith opts (site "/get")+  assertEqual "extra header set correctly"+    (Just "bar")+    (r ^. responseBody ^? key "headers" . key "X-Wibble")++getGzip site = do+  r <- get (site "/gzip")+  assertEqual "gzip decoded for us" (Just (Bool True))+    (r ^. responseBody ^? key "gzipped")++headRedirect site =+  assertThrows "HEAD of redirect throws exception" inspect $+    head_ (site "/redirect/3")+  where inspect e = case e of+                      StatusCodeException status _ _ ->+                        let code = status ^. statusCode+                        in assertBool "code is redirect"+                           (code >= 300 && code < 400)++redirectOverflow 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 ()++invalidURL _site = do+  let noProto (InvalidUrlException _ _) = return ()+  assertThrows "exception if no protocol" noProto (get "wheeee")+  let noHost (InvalidDestinationHost _) = return ()+  assertThrows "exception if no host" noHost (get "http://")++funkyScheme site = do+  -- schemes are case insensitive, per RFC 3986 section 3.1+  let (scheme, rest) = break (==':') $ site "/get"+  void . get $ map toUpper scheme <> rest++cookiesSet site = do+  r <- get (site "/cookies/set?x=y")+  assertEqual "cookies are set correctly" (Just "y")+    (r ^? responseCookie "x" . cookieValue)++cookieSession site = Session.withSession $ \s -> do+  void $ Session.get s (site "/cookies/set?foo=bar")+  r <- Session.get s (site "/cookies")+  assertEqual "cookies are set correctly" (Just "bar")+    (r ^? responseCookie "foo" . cookieValue)+  assertEqual "whee" (Just "bar")+    (r ^. responseBody ^? key "cookies" . key "foo")++getWithManager site = withManager $ \opts -> do+  void $ getWith opts (site "/get?a=b")+  void $ getWith opts (site "/get?b=c")++assertThrows :: (Show e, Exception e) => String -> (e -> IO ()) -> IO a -> IO ()+assertThrows desc inspect act = do+  let myInspect e = inspect e `E.catch` \(ee :: E.PatternMatchFail) ->+        assertFailure (desc <> ": unexpected exception (" <>+                       show e <> "): " <> show ee)+  caught <- (act >> return False) `E.catch` \e -> myInspect e >> return True+  unless caught (assertFailure desc)++testsWith site = [+    testGroup "basic" [+      testCase "get" $ basicGet site+    , testCase "post" $ basicPost site+    , testCase "head" $ basicHead site+    , testCase "put" $ basicPut site+    , testCase "delete" $ basicDelete site+    , testCase "404" $ throwsStatusCode site+    , testCase "headRedirect" $ headRedirect site+    , testCase "redirectOverflow" $ redirectOverflow site+    , testCase "invalidURL" $ invalidURL site+    , testCase "funkyScheme" $ funkyScheme site+    ]+  , testGroup "fancy" [+      testCase "basic auth" $ getBasicAuth site+    , testCase "redirect" $ getRedirect site+    , testCase "params" $ getParams site+    , testCase "headers" $ getHeaders site+    , testCase "gzip" $ getGzip site+    , testCase "cookiesSet" $ cookiesSet site+    , testCase "cookieSession" $ cookieSession site+    , testCase "getWithManager" $ getWithManager site+    ]+  ]++tests = [+    testGroup "http" $ testsWith ("http://httpbin.org" <>)+  , testGroup "https" $ testsWith ("https://httpbin.org" <>)+  ]++main = defaultMain tests++localtest = defaultMain (testsWith ("http://localhost:8000" <>))

@@ -0,0 +1,157 @@+name:                wreq+version:             0.1.0.0+synopsis:            An easy-to-use HTTP client library.+description:+  .+  A web client library that is designed for ease of use.+  .+  Tutorial: <http://www.serpentine.com/wreq/tutorial.html>+  .+  Features include:+  .+  * Simple but powerful `lens`-based API+  .+  * A solid test suite, and built on reliable libraries like+    http-client and lens+  .+  * Session handling includes connection keep-alive and pooling, and+    cookie persistence+  .+  * Automatic response body decompression+  .+  * Powerful multipart form and file upload handling+  .+  * Support for JSON requests and responses, including navigation of+    schema-less responses+  .+  * Basic and OAuth2 bearer authentication+  .+  * Early TLS support via the tls package+homepage:            http://www.serpentine.com/wreq+bug-reports:         https://github.com/bos/wreq/issues+license:             BSD3+license-file:        LICENSE.md+author:              Bryan O'Sullivan <bos@serpentine.com>+maintainer:          bos@serpentine.com+copyright:           2014 Bryan O'Sullivan+category:            Web+build-type:          Custom+cabal-version:       >=1.10+extra-source-files:+  README.md+  TODO.md+  changelog+  examples/*.cabal+  examples/*.hs+  www/*.css+  www/*.md+  www/Makefile++-- disable doctests with -f-doctest+flag doctest+  default: True+  manual: True++-- enable httpbin with -fhttpbin+flag httpbin+  default: False+  manual: True++library+  ghc-options: -Wall -fwarn-tabs -funbox-strict-fields+  default-language: Haskell98++  exposed-modules:+    Network.Wreq+    Network.Wreq.Lens+    Network.Wreq.Session+    Network.Wreq.Types+  other-modules:+    Network.Wreq.Internal+    Network.Wreq.Internal.Lens+    Network.Wreq.Internal.Link+    Network.Wreq.Internal.Types+    Network.Wreq.Lens.TH+    Network.Wreq.Lens.Machinery+    Paths_wreq+  build-depends:+    aeson >= 0.7.0.3,+    attoparsec,+    base >= 4.5 && < 5,+    bytestring >= 0.9,+    exceptions >= 0.5,+    http-client >= 0.3.1.1,+    http-client-tls >= 0.2,+    http-types >= 0.8,+    lens >= 4.1,+    mime-types,+    template-haskell,+    text,+    time++-- A convenient server for testing locally, or if httpbin.org is down.+executable httpbin+  hs-source-dirs: httpbin+  main-is:        HttpBin.hs+  ghc-options:    -Wall -fwarn-tabs -threaded+  default-language: Haskell98++  if !flag(httpbin)+    buildable: False+  else+    build-depends:+      aeson >= 0.7,+      aeson-pretty >= 0.7.1,+      base >= 4.5 && < 5,+      base64-bytestring,+      bytestring,+      case-insensitive,+      containers,+      snap-core,+      snap-server >= 0.9.4.2,+      text++test-suite tests+  type:           exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is:        Tests.hs+  ghc-options:    -Wall -fwarn-tabs -funbox-strict-fields -threaded+  default-language: Haskell98++  build-depends:+    HUnit,+    aeson,+    base >= 4.5 && < 5,+    bytestring,+    http-client,+    http-types,+    lens >= 4.1,+    temporary,+    test-framework,+    test-framework-hunit,+    text,+    wreq++test-suite doctest+  type:           exitcode-stdio-1.0+  hs-source-dirs: tests+  main-is:        DocTests.hs+  ghc-options:    -Wall -fwarn-tabs -threaded+  default-language: Haskell98++  if !flag(doctest)+    buildable: False+  else+    build-depends:+      base >= 4.5 && < 5,+      directory,+      doctest,+      filepath++source-repository head+  type:     git+  location: https://github.com/bos/wreq++source-repository head+  type:     mercurial+  location: https://bitbucket.org/bos/wreq

@@ -0,0 +1,21 @@+bootstrap := bootstrap-3.1.1-dist++files := index.html tutorial.html+deps = bootstrap-custom.css background.jpg+install := $(files) $(deps)++all: $(files)++install: $(files)+	-mkdir -p $(HOME)/public_html/wreq+	cp -a $(install) $(HOME)/public_html/wreq+	cp -a $(bootstrap) $(HOME)/public_html/wreq++%.html: %.md template.html $(deps)+	pandoc $< -o $@ --smart --template template.html \+	  --css $(bootstrap)/css/bootstrap.css \+	  --css bootstrap-custom.css \+	  --toc --toc-depth 2++clean:+	-rm -f $(files)

@@ -0,0 +1,59 @@+html {+    position: relative;+    min-height: 100%;+}+body {+    /* Margin bottom by footer height */+    margin-bottom: 80px;+}+#footer {+    position: absolute;+    bottom: 0;+    width: 100%;+    /* Set the fixed height of the footer here */+    height: 80px;+    background-color: #f5f5f5;+}++a > code { color: #02d; }+a > code:hover { color: #44f; }+div.nav.bs-docs-sidenav > ul { list-style-type: none; }+div.nav.bs-docs-sidenav > ul > li > ul { list-style-type: none; }++h1, h2, h3, h4 {+    font-family: 'Roboto', 'sans-serif';+    margin-top: 40px;+}+p, div {+    font-family: 'Roboto Slab', 'sans-serif';+}++.container .text-muted {+    margin: 10px 0;+}++.jumboback > .navbar {+     background: rgba(0,0,0,0.4);+     margin-bottom: 0;+     text-shadow: none;+     border: 0;+     border-radius: 0;+}++.jumboback > .navbar > a, .jumboback > .navbar > ul > li > a {+    color: white;+}++.jumboback > .jumbotron {+    background: transparent;+}++.jumboback {+    background-image: url(background.jpg);+    margin-bottom: 20px;+    background-position: -20% 25%;+    background-size: cover;+    background-repeat: no-repeat;+    color: white;+    text-shadow: black 0em 0em 0.8em;+}

@@ -0,0 +1,134 @@+% wreq: a Haskell web client library+% HTTP made easy for Haskell.+  <a href="tutorial.html" class="btn btn-primary btn-lg" role="button">Tutorial</a>++++`wreq` is a library that makes HTTP client programming in Haskell+easy.+++# Features++* Simple but powerful `lens`-based API++* Over 100 tests, and built on reliable libraries like [`http-client`](http://hackage.haskell.org/package/http-client/)+  and [`lens`](https://lens.github.io/)++* Session handling includes connection keep-alive and pooling, and+  cookie persistence++* Automatic decompression++* Powerful multipart form and file upload handling++* Support for JSON requests and responses, including navigation of+  schema-less responses++* Basic and OAuth2 bearer authentication+++# Whirlwind tour++~~~~ {.haskell}+ghci> import Network.Wreq+ghci> r <- get "http://httpbin.org/get"+~~~~++Its `lens`-based API is easy to learn (the tutorial walks you through+the [basics of lenses](tutorial.html#a-quick-lens-backgrounder) and+powerful to work with.++~~~~ {.haskell}+ghci> import Control.Lens+ghci> r ^. responseHeader "Content-Type"+"application/json"+~~~~++Safely and sanely add query parameters to URLs. Let's find the most+popular implementations of Tetris in Haskell.++~~~~ {.haskell}+ghci> let opts = defaults & param "q" .~ ["tetris"]+                          & param "language" .~ ["haskell"]+ghci> r <- getWith opts "https://api.github.com/search/code"+~~~~++Haskell-to-JSON interoperation is seamless.++~~~~ {.haskell}+ghci> import GHC.Generics+ghci> import Data.Aeson+ghci> :set -XDeriveGeneric++ghci> data Addr = Addr Int String deriving (Generic)+ghci> instance ToJSON Addr++ghci> let addr = Addr 1600 "Pennsylvania"+ghci> post "http://httpbin.org/post" (toJSON addr)+~~~~+++Work easily with schemaless JSON APIs.  This traverses the complex+JSON search result we just received from GitHub above, and pulls out+the authors of our popular Tetris clones.++~~~~ {.haskell}+ghci> r ^.. responseBody . key "items" . values .+            key "owner" . key "login" . _String+["steffi2392","rmies","Spacejoker","walpen",{-...-}+~~~~++Easily write+[`attoparsec`](http://hackage.haskell.org/package/attoparsec) parsers+on the spot, to safely and reliably deal with complicated headers and+bodies.++~~~~ {.haskell}+ghci> import Data.Attoparsec.ByteString.Char8 as A+ghci> import Data.List (sort)++ghci> let comma = skipSpace >> "," >> skipSpace+ghci> let verbs = A.takeWhile isAlpha_ascii `sepBy` comma++ghci> r <- options "http://httpbin.org/get"+ghci> r ^. responseHeader "Allow" . atto verbs . to sort+ghci> ["GET","HEAD","OPTIONS"]+~~~~++There's a lot more, but why not jump in and start coding. In fact, if+you'd like to add new features, that would be great! We love pull+requests.+++<div class="jumbotron" style="margin-top: 40px;">+<h2 style="margin-top: 20px;">Ready to jump in?</h2>++We've worked hard to make `wreq` quick to learn.++<a href="tutorial.html" class="btn btn-success btn-lg" role="button">Tutorial</a>++We're proud of the example-filled docs.++<a href="http://hackage.haskell.org/package/wreq" class="btn btn-info btn-lg" role="button">Documentation</a>++If you run into problems, let us know.++<a href="https://github.com/bos/wreq" class="btn btn-warning btn-lg" role="button">Issues</a>++</div>+++# Acknowledgments++I'd like to thank Edward Kmett and Shachaf Ben-Kiki for tirelessly+answering my never-ending stream of+[lens](https://lens.github.io/)-related questions in `#haskell-lens#`.++I also want to thank Michael Snoyman for being so quick with helpful+responses to bug reports and pull requests against his excellent+[http-client](http://hackage.haskell.org/package/http-client) package.++Finally, thanks to Kenneth Reitz for building the indispensable+[httpbin.org](http://httpbin.org/) HTTP testing service, and of course+for his [requests library](http://docs.python-requests.org/en/latest/).

@@ -0,0 +1,490 @@+% A wreq tutorial+% Learn how to write web clients. We start easy, then ramp up the power.++# Installation++To use the `wreq` package, simply use `cabal`, the standard Haskell+package management command.++~~~~+cabal update+cabal install -j --disable-tests wreq+~~~~++Depending on how many prerequisites you already have installed, and+what your Cabal configuration looks like, the build may take a few+minutes: a few seconds for `wreq`, and the rest for its dependencies.+++# Interactive usage++We'll run our examples interactively via the `ghci` shell.++~~~~+$ ghci+~~~~++To start using `wreq`, we import the+[`Network.Wreq`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html)+module.++~~~~ {.haskell}+ghci> import Network.Wreq+ghci> r <- get "http://httpbin.org/get"+ghci> :type r+r :: Response ByteString+~~~~++The variable `r` above is the+[`Response`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#t:Response)+from the server.+++## Working with string-like types++Complex Haskell libraries and applications have to deal fluently with+Haskell's three main string types: `String` ("legacy"), `Text`, and+`ByteString` (mostly used for binary data, sometimes ASCII).++To write string literals without having to always provide a conversion+function, we use the `OverloadedStrings` language extension.++Throughout the rest of this tutorial, we'll assume that you have+enabled `OverloadedStrings` in `ghci`:++~~~~ {.haskell}+ghci> :set -XOverloadedStrings+~~~~++If you're using `wreq` from a Haskell source file, put a pragma at the+top of your file:++~~~~ {.haskell}+{-# LANGUAGE OverloadedStrings #-}+~~~~+++# A quick lens backgrounder++The `wreq` package makes heavy use of Edward Kmett's+[`lens`](https://lens.github.io/) package to provide a clean,+consistent API.++~~~~ {.haskell}+ghci> import Control.Lens+~~~~++While `lens` has a vast surface area, the portion that you must+understand in order to productively use `wreq` is tiny.++A lens provides a way to focus on a portion of a Haskell value. For+example, the `Response` type has a+[`responseStatus`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:responseStatus)+lens, which focuses on the status information returned by the server.++~~~~ {.haskell}+ghci> r ^. responseStatus+Status {statusCode = 200, statusMessage = "OK"}+~~~~++The+[`^.`](http://hackage.haskell.org/package/lens/docs/Control-Lens-Getter.html#v:-94-.)+operator takes a value as its first argument, a lens as its second,+and returns the portion of the value focused on by the lens.++We compose lenses using function composition, which allows us to+easily focus on part of a deeply nested structure.++~~~~ {.haskell}+ghci> r ^. responseStatus . statusCode+200+~~~~++We'll have more to say about lenses as this tutorial proceeds.+++# Changing default behaviours++While+[`get`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:get)+ is convenient and easy to use, there's a lot more power+available to us.++For example, if we want to add parameters to the query string of a+URL, we will use the+[`getWith`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:getWith)+function.  The `*With` family of functions all accept an+[`Options`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#t:Options)+parameter that allow changes from the library's default behaviours.++~~~~ {.haskell}+ghci> import Data.Aeson.Lens (_String, key)+ghci> let opts = defaults & param "foo" .~ ["bar", "quux"]+ghci> r <- getWith opts "http://httpbin.org"+ghci> r ^. responseBody . key "url" . _String+"http://httpbin.org/get?foo=bar&foo=quux"+~~~~++(We'll talk more about `key` and `_String` below.)++The default parameters for all queries is represented by the variable+[`defaults`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:defaults).+(In fact, `get` is defined simply as `getWith defaults`.)++Here's where we get to learn a little more about lenses.++In addition to *getting* a value from a nested structure, we can also+*set* (edit) a value within a nested structure, which makes an+identical copy of the structure except for the portion we want to+modify.++The `&` operator is just function application with its operands+reversed, so the function is on the right and its parameter is on the+left.++~~~~ {.haskell}+parameter & functionToApply+~~~~++The+[`.~`](http://hackage.haskell.org/package/lens/docs/Control-Lens-Setter.html#v:.-126-)+ operator turns a lens into a setter function, with the lens+on the left and the new value on the right.++~~~~ {.haskell}+param "foo" .~ ["bar", "quux"]+~~~~++<a id="param">The+[`param`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:param)+lens</a> focuses on the values associated with the given key in the+query string.++~~~~ {.haskell}+param :: Text -> Lens' Options [Text]+~~~~++The reason we allow for a list of values instead of just a single+value is simply that this is completely legitimate. For instance, in+our example above we generate the query string `foo=bar&foo=quux`.++If you use non-ASCII characters in a `param` key or value, they will+be encoded as UTF-8 before being URL-encoded, so that they can be+safely transmitted over the wire.+++# Accessing the body of a response++The+[`responseBody`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:responseBody)+lens gives us access to the body of a response.++~~~~ {.haskell}+ghci> r <- get "http://httpbin.org/get"+ghci> r ^. responseBody+"{\n  \"headers\": {\n    \"Accept-Encoding\": \"gzip"{-...-}+~~~~++The response body is a raw lazy+[`ByteString`](http://hackage.haskell.org/package/bytestring/docs/Data-ByteString-Lazy.html#t:ByteString).+++## JSON responses++We can use the+[`asJSON`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:asJSON)+function to convert a response body to a Haskell value that implements+the+[`FromJSON`](http://hackage.haskell.org/package/aeson/docs/Data-Aeson-Types.html#t:FromJSON)+class.++~~~~ {.haskell}+ghci> import Data.Map as Map+ghci> import Data.Aeson (Value)+ghci> type Resp = Response (Map String Value)+ghci> r <- asJSON =<< get "http://httpbin.org/get" :: IO Resp+ghci> Map.size (r ^. responseBody)+4+~~~~++<div class="alert alert-info">+In this example, we have to tell `ghci` exactly what target type we+are expecting. In a real Haskell program, the correct return type will+usually be inferred automatically, making an explicit type signature+unnecessary in most cases.+</div>++If the response is not `application/json`, or we try to convert to an+incompatible Haskell type, a+[`JSONError`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#t:JSONError)+exception will be thrown.++~~~~ {.haskell}+ghci> type Resp = Response [Int]+ghci> r <- asJSON =<< get "http://httpbin.org/get" :: IO Resp+*** Exception: JSONError "when expecting a [a], encountered Object instead"+~~~~+++## Convenient JSON traversal++The `lens` package provides some extremely useful functions for+traversing JSON structures without having to either build a+corresponding Haskell type or traverse a `Value` by hand.++The first of these is+[`key`](http://hackage.haskell.org/package/lens/docs/Data-Aeson-Lens.html#v:key),+which traverses to the named key in a JSON object.++~~~~ {.haskell}+ghci> import Data.Aeson.Lens (key)+ghci> r <- get "http://httpbin.org/get"+ghci> r ^? responseBody . key "url"+Just (String "http://httpbin.org/get")+~~~~++<div class="alert alert-info">+Notice our use of the+[`^?`](http://hackage.haskell.org/package/lens-4.1.2/docs/Control-Lens-Fold.html#v:-94--63-)+operator here. This is like `^.`, but it allows for the possibility+that an access might fail---and of course there may not be a key named+`"url"` in our object.+</div>++That said, our result above has the type `Maybe Value`, so it's quite+annoying to work with. This is where the `_String` lens comes in.++~~~~ {.haskell}+ghci> import Data.Aeson.Lens (_String, key)+ghci> r <- get "http://httpbin.org/get"+ghci> r ^. responseBody . key "url" . _String+"http://httpbin.org/get"+~~~~++If the key exists, and is a `Value` with a `String` constructor,+`_String` gives us back a regular `Text` value with all the wrappers+removed; otherwise it gives an empty value. Notice what happens as we+switch between `^?` and `^.` in these examples.++~~~~ {.haskell}+ghci> r ^. responseBody . key "fnord" . _String+""+ghci> r ^? responseBody . key "fnord" . _String+Nothing+ghci> r ^? responseBody . key "url" . _String+Just "http://httpbin.org/get"+~~~~+++# Working with headers++To add headers to a request, we use the+[`header`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:header)+lens.++~~~~ {.haskell}+ghci> let opts = defaults & header "Accept" .~ ["application/json"]+ghci> getWith opts "http://httpbin.org/get"+~~~~++As with the [`param`](#param) lens, if we provide more than one value to go+with a single key, this will expand to several headers.++~~~~ {.haskell}+header :: HeaderName -> Lens' Options [ByteString]+~~~~++When we want to inspect the headers of a response, we use the+[`responseHeader`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:responseHeader)+lens.++~~~~ {.haskell}+ghci> r <- get "http://httpbin.org/get"+ghci> r ^. responseHeader "content-type"+"application/json"+~~~~++<div class="alert alert-info">+Header names are case insensitive.+</div>++If a header is not present in a response, then `^.` will give an empty+string, while `^?` will give `Nothing`.++~~~~ {.haskell}+ghci> r ^. responseHeader "X-Nonesuch"+""+ghci> r ^? responseHeader "X-Nonesuch"+Nothing+~~~~+++# Uploading data via POST++We use the [`post`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:post)+ and+ [`postWith`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:postWith)+ functions to issue POST requests.++~~~~ {.haskell}+ghci> r <- post "http://httpbin.org/post" ["num" := 3, "str" := "wat"]+ghci> r ^? responseBody . key "form"+Just (Object fromList [("num",String "3"),("str",String "wat")])+~~~~++The [httpbin.org](http://httpbin.org/) server conveniently echoes our+request headers back at us, so we can see what kind of body we POSTed.++~~~~ {.haskell}+ghci> r ^. responseBody . key "headers" . key "Content-Type" . _String+"application/x-www-form-urlencoded"+~~~~++The+[`:=`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v::-61-)+operator is the constructor for the+[`FormParam`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#t:FormParam)+type, which `wreq` uses as a key/value pair to generate an+`application/x-www-form-urlencoded` form body to upload.++A class named+[`FormValue`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#t:FormValue)+determines how the operand on the right-hand side of `:=` is encoded,+with sensible default behaviours for strings and numbers.++The slightly more modern way to upload POST data is via a+`multipart/form-data` payload, for which `wreq` provides the+[`Part`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#t:Part)+type.++~~~~ {.haskell}+ghci> r <- post "http://httpbin.org/post" [partText "button" "o hai"]+ghci> r ^. responseBody . key "headers" . key "Content-Type" . _String+"multipart/form-data; boundary=----WebKitFormBoundaryJsEZfuj89uj"+~~~~++The first argument to these `part*` functions is the label of the+`<input>` element in the form being uploaded.++Let's inspect httpbin.org's response to see what we uploaded.  When we+think there could be more than one value associated with a lens, we+use the+[`^..`](http://hackage.haskell.org/package/lens-4.1.2/docs/Control-Lens-Fold.html#v:-94-..)+operator, which returns a list.++~~~~ {.haskell}+ghci> r ^.. responseBody . key "form"+[Object fromList [("button",String "o hai")]]+~~~~+++## Uploading file contents++To upload a file as part of a `multipart/form-data` POST, we use+[`partFile`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#t:partFile),+or if the file is large enough that we want to stream its contents,+[`partFileSource`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#t:partFileSource).++~~~~ {.haskell}+ghci> r <- post "http://httpbin.org/post" (partFile "file" "hello.hs")+ghci> r ^.. responseBody . key "files" . members . _String+["main = putStrLn \"hello\"\n"]+~~~~++Both `partFile` and `partFileSource` will set the filename of a part+to whatever name they are given (including any leading path components+such as `/tmp/confidential`), and guess its content-type based on the+file name extension.  Here's an example of how we can upload a file+without revealing its name.++~~~~ {.haskell}+ghci> partFile "label" "foo.hs" & partFileName .~ Nothing+Part "label" Nothing (Just "text/plain") <m (RequestBody m)>+~~~~+++# Cookies++To see how easily we can work with cookies, let's can ask the+ever-valuable httpbin.org to set a cookie in a response.++~~~~ {.haskell}+ghci> r <- get "http://httpbin.org/cookies/set?foo=bar"+ghci> r ^. responseCookie "foo" . cookieValue+"bar"+~~~~+++# Authentication++The `wreq` library supports both basic authentication and OAuth2+bearer authentication.++<div class="alert alert-danger">+**Note:** the security of these mechanisms is _absolutely dependent on+your use of TLS_, as the credentials can easily be stolen and reused+if transmitted unencrypted.+</div>++If we try to access a service that requires authentication, `wreq`+will throw a+[`HttpException`](http://hackage.haskell.org/package/http-client/docs/Network-HTTP-Client.html#t:HttpException).++~~~~ {.haskell}+ghci> r <- get "http://httpbin.org/basic-auth/user/pass+*** Exception: StatusCodeException (Status {statusCode = 401, {-...-}+~~~~++If we then supply a username and password, our request will succeed.+(Notice that we follow our own advice: we switch to `https` for our+retry.)++~~~~ {.haskell}+ghci> let opts = defaults & auth .~ basicAuth "user" "pass"+ghci> r <- getWith opts "https://httpbin.org/basic-auth/user/pass"+ghci> r ^. responseBody+"{\n  \"authenticated\": true,\n  \"user\": \"user\"\n}"+~~~~++For OAuth2 bearer authentication, `wreq` supports two flavours:+[`oauth2Bearer`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:oauth2Bearer)+is the standard bearer token, while+[`oauth2Token`](http://hackage.haskell.org/package/wreq/docs/Network-Wreq.html#v:oauth2Token)+is GitHub's variant.  These tokens are equivalent in value to a+username and password.+++# Error handling++Most of the time when an error occurs or a request fails, `wreq` will+throw a `HttpException`.++~~~~ {.haskell}+h> r <- get "http://httpbin.org/wibblesticks"+*** Exception: StatusCodeException (Status {statusCode = 404, {-...-}+~~~~++Here's a simple example of how we can respond to one kind of error: a+`get`-like function that retries with authentication if an+unauthenticated request fails.++~~~~ {.haskell}+import Control.Exception as E+import Control.Lens+import Network.HTTP.Client+import Network.Wreq++getAuth url myauth = get url `E.catch` handler+  where+    handler e@(StatusCodeException s _ _)+      | s ^. statusCode == 401 = getWith authopts authurl+      | otherwise              = throwIO e+      where authopts = defaults & auth .~ myauth+            -- switch to TLS when we use auth+            authurl = "https" ++ dropWhile (/=':') url+~~~~++(A "real world" version would remember which URLs required+authentication during a session, to avoid the need for an+unauthenticated failure followed by an authenticated success if we+visit the same endpoint repeatedly.)