diff --git a/Network/Wreq.hs b/Network/Wreq.hs --- a/Network/Wreq.hs +++ b/Network/Wreq.hs @@ -63,6 +63,9 @@ -- ** Custom Method , customMethod , customMethodWith + -- ** Custom Payload Method + , customPayloadMethod + , customPayloadMethodWith -- * Incremental consumption of responses -- ** GET , foldGet @@ -87,6 +90,7 @@ , AWSAuthVersion(..) , Lens.auth , basicAuth + , oauth1Auth , oauth2Bearer , oauth2Token , awsAuth @@ -216,8 +220,8 @@ -- @ -- -- >>> 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])) +-- >>> r ^? responseBody . key "json" . nth 2 +-- Just (Number 3.0) post :: Postable a => String -> a -> IO (Response L.ByteString) post url payload = postWith defaults url payload @@ -359,6 +363,22 @@ where methodBS = BC8.pack method +-- | Issue a custom-method request with a payload +customPayloadMethod :: Postable a => String -> String -> a + -> IO (Response L.ByteString) + +customPayloadMethod method url payload = + customPayloadMethodWith method defaults url payload + +-- | Issue a custom-method request with a payload, using the supplied 'Options'. +customPayloadMethodWith :: Postable a => String -> Options -> String -> a + -> IO (Response L.ByteString) + +customPayloadMethodWith method opts url payload = + runRead =<< preparePayloadMethod methodBS opts url payload + where + methodBS = BC8.pack method + foldGet :: (a -> S.ByteString -> IO a) -> a -> String -> IO a foldGet f z url = foldGetWith defaults f z url @@ -459,6 +479,16 @@ -> S.ByteString -- ^ Password. -> Auth basicAuth = BasicAuth + +-- | OAuth1 authentication. This consists of a consumer token, +-- a consumer secret, a token and a token secret +oauth1Auth :: S.ByteString -- ^ Consumer token + -> S.ByteString -- ^ Consumer secret + -> S.ByteString -- ^ OAuth token + -> S.ByteString -- ^ OAuth token secret + -> Auth +oauth1Auth = OAuth1 + -- | An OAuth2 bearer token. This is treated by many services as the -- equivalent of a username and password. diff --git a/Network/Wreq/Cache.hs b/Network/Wreq/Cache.hs --- a/Network/Wreq/Cache.hs +++ b/Network/Wreq/Cache.hs @@ -23,6 +23,7 @@ import Data.Monoid (First(..), mconcat) import Data.Time.Clock (UTCTime, addUTCTime, getCurrentTime) import Data.Time.Format (parseTime) +import Data.Time.Locale.Compat (defaultTimeLocale) import Data.Typeable (Typeable) import GHC.Generics (Generic) import Network.HTTP.Types (HeaderName, Method) @@ -33,12 +34,6 @@ import qualified Data.HashSet as HashSet import qualified Data.IntSet as IntSet import qualified Network.Wreq.Cache.Store as Store - -#if MIN_VERSION_time(1,5,0) -import Data.Time.Format (defaultTimeLocale) -#else -import System.Locale (defaultTimeLocale) -#endif #if MIN_VERSION_base(4,6,0) import Data.IORef (atomicModifyIORef') diff --git a/Network/Wreq/Internal.hs b/Network/Wreq/Internal.hs --- a/Network/Wreq/Internal.hs +++ b/Network/Wreq/Internal.hs @@ -18,6 +18,7 @@ , preparePut , prepareDelete , prepareMethod + , preparePayloadMethod ) where import Control.Applicative ((<$>)) @@ -40,6 +41,7 @@ import qualified Network.HTTP.Types as HTTP import qualified Network.Wreq.Internal.Lens as Lens import qualified Network.Wreq.Internal.AWS as AWS (signRequest) +import qualified Network.Wreq.Internal.OAuth1 as OAuth1 (signRequest) import qualified Network.Wreq.Lens as Lens hiding (checkStatus) -- This mess allows this module to continue to load during interactive @@ -117,8 +119,10 @@ signRequest = maybe return f $ auth opts where f (AWSAuth versn key secret) = AWS.signRequest versn key secret + f (OAuth1 consumerToken consumerSecret token secret) = OAuth1.signRequest consumerToken consumerSecret token secret f _ = return + setQuery :: Options -> Request -> Request setQuery opts = case params opts of @@ -136,6 +140,7 @@ f (OAuth2Token token) = setHeader "Authorization" ("token " <> token) -- for AWS request signature, see Internal/AWS f (AWSAuth _ _ _) = id + f (OAuth1 _ _ _ _) = id setProxy :: Options -> Request -> Request setProxy = maybe id f . proxy @@ -158,6 +163,12 @@ prepareMethod :: HTTP.Method -> Options -> String -> IO Req prepareMethod method opts url = Req (manager opts) <$> prepare (return . (Lens.method .~ method)) opts url + +preparePayloadMethod :: Postable a => HTTP.Method -> Options -> String -> a + -> IO Req + +preparePayloadMethod method opts url payload = Req (manager opts) <$> + prepare (postPayload payload . (Lens.method .~ method)) opts url prepareHead :: Options -> String -> IO Req prepareHead = prepareMethod HTTP.methodHead diff --git a/Network/Wreq/Internal/AWS.hs b/Network/Wreq/Internal/AWS.hs --- a/Network/Wreq/Internal/AWS.hs +++ b/Network/Wreq/Internal/AWS.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, OverloadedStrings, BangPatterns #-} +{-# LANGUAGE OverloadedStrings, BangPatterns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Network.Wreq.Internal.AWS @@ -16,6 +16,7 @@ import Data.Monoid ((<>)) import Data.Time.Clock (getCurrentTime) import Data.Time.Format (formatTime) +import Data.Time.Locale.Compat (defaultTimeLocale) import Data.Time.LocalTime (utc, utcToLocalTime) import Network.HTTP.Types (parseSimpleQuery, urlEncode) import Network.Wreq.Internal.Lens @@ -26,12 +27,6 @@ import qualified Data.CaseInsensitive as CI (original) import qualified Data.HashSet as HashSet import qualified Network.HTTP.Client as HTTP - -#if MIN_VERSION_time(1,5,0) -import Data.Time.Format (defaultTimeLocale) -#else -import System.Locale (defaultTimeLocale) -#endif -- Sign requests following the AWS v4 request signing specification: -- http://docs.aws.amazon.com/general/latest/gr/sigv4-create-canonical-request.html diff --git a/Network/Wreq/Internal/OAuth1.hs b/Network/Wreq/Internal/OAuth1.hs new file mode 100644 --- /dev/null +++ b/Network/Wreq/Internal/OAuth1.hs @@ -0,0 +1,12 @@ +module Network.Wreq.Internal.OAuth1 (signRequest) where + +import Network.HTTP.Client (Request(..)) +import Web.Authenticate.OAuth ( signOAuth, newOAuth, oauthConsumerKey + , oauthConsumerSecret, newCredential) +import qualified Data.ByteString as S + +signRequest :: S.ByteString -> S.ByteString -> S.ByteString -> S.ByteString -> Request -> IO Request +signRequest consumerToken consumerSecret token tokenSecret = signOAuth app creds + where + app = newOAuth { oauthConsumerKey = consumerToken, oauthConsumerSecret = consumerSecret } + creds = newCredential token tokenSecret diff --git a/Network/Wreq/Internal/Types.hs b/Network/Wreq/Internal/Types.hs --- a/Network/Wreq/Internal/Types.hs +++ b/Network/Wreq/Internal/Types.hs @@ -183,6 +183,9 @@ | AWSAuth AWSAuthVersion S.ByteString S.ByteString -- ^ Amazon Web Services request signing -- AWSAuthVersion key secret + | OAuth1 S.ByteString S.ByteString S.ByteString S.ByteString + -- ^ OAuth1 request signing + -- OAuth1 consumerToken consumerSecret token secret deriving (Eq, Show, Typeable) data AWSAuthVersion = AWSv4 diff --git a/wreq.cabal b/wreq.cabal --- a/wreq.cabal +++ b/wreq.cabal @@ -1,5 +1,5 @@ name: wreq -version: 0.4.0.0 +version: 0.4.1.0 synopsis: An easy-to-use HTTP client library. description: . @@ -72,6 +72,8 @@ library ghc-options: -Wall -fwarn-tabs -funbox-strict-fields + if flag(developer) + ghc-options: -Werror default-language: Haskell98 exposed-modules: @@ -86,6 +88,7 @@ Network.Wreq.Internal.AWS Network.Wreq.Internal.Lens Network.Wreq.Internal.Link + Network.Wreq.Internal.OAuth1 Network.Wreq.Internal.Types Network.Wreq.Lens.Machinery Network.Wreq.Lens.TH @@ -94,6 +97,7 @@ psqueues >= 0.2, aeson >= 0.7.0.3, attoparsec >= 0.11.1.0, + authenticate-oauth == 1.5.*, base >= 4.5 && < 5, base16-bytestring, byteable, @@ -110,7 +114,7 @@ lens >= 4.5, lens-aeson, mime-types, - old-locale, + time-locale-compat, template-haskell, text, time, @@ -120,6 +124,8 @@ executable httpbin hs-source-dirs: httpbin ghc-options: -Wall -fwarn-tabs -threaded -rtsopts + if flag(developer) + ghc-options: -Werror default-language: Haskell98 main-is: HttpBin.hs other-modules: HttpBin.Server @@ -148,6 +154,8 @@ hs-source-dirs: httpbin tests main-is: Tests.hs ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -threaded -rtsopts + if flag(developer) + ghc-options: -Werror default-language: Haskell98 other-modules: Properties.Store @@ -201,6 +209,8 @@ hs-source-dirs: tests main-is: DocTests.hs ghc-options: -Wall -fwarn-tabs -threaded + if flag(developer) + ghc-options: -Werror default-language: Haskell98 if !flag(doctest)