@@ -170,6 +170,7 @@ module Network.HTTP.Req
170170 -- *** Authentication
171171 -- $authentication
172172 , basicAuth
173+ , oAuth1
173174 , oAuth2Bearer
174175 , oAuth2Token
175176 -- *** Other
@@ -218,6 +219,7 @@ import Data.Function (on)
218219import Data.IORef
219220import Data.List (nubBy)
220221import Data.List.NonEmpty (NonEmpty (..))
222+import Data.Maybe (fromMaybe)
221223import Data.Proxy
222224import Data.Semigroup hiding (Option, option)
223225import Data.Typeable (Typeable)
@@ -239,6 +241,7 @@ import qualified Network.HTTP.Client.Internal as LI
239241import qualified Network.HTTP.Client.MultipartFormData as LM
240242import qualified Network.HTTP.Client.TLS as L
241243import qualified Network.HTTP.Types as Y
244+import qualified Web.Authenticate.OAuth as OAuth
242245
243246#if MIN_VERSION_base(4,9,0)
244247import Data.Kind (Constraint)
@@ -395,7 +398,7 @@ req method url body Proxy options = do
395398 -- “overwrite” headers when we construct a request by cons-ing.
396399 nubHeaders = Endo $ \x ->
397400 x { L.requestHeaders = nubBy ((==) `on` fst) (L.requestHeaders x) }
398− request = flip appEndo L.defaultRequest $
401+ request' = flip appEndo L.defaultRequest $
399402 -- NOTE Order of 'mappend's matters, here method is overwritten first
400403 -- and 'options' take effect last. In particular, this means that
401404 -- 'options' can overwrite things set by other request components,
@@ -408,6 +411,7 @@ req method url body Proxy options = do
408411 getRequestMod url <>
409412 getRequestMod (Womb method :: Womb "method" method)
410413 wrappingVanilla m = catch m (throwIO . VanillaHttpException)
414+ request <- finalizeRequest options request'
411415 (liftIO . try . wrappingVanilla) (getHttpResponse request manager)
412416 >>= either handleHttpException return
413417
@@ -928,7 +932,7 @@ instance HttpBody body => RequestComponent (Womb "body" body) where
928932-- to learn which 'Option' primitives are available.
929933
930934data Option (scheme :: Scheme) =
931− Option (Endo (Y.QueryText, L.Request)) (Maybe (Endo L.Request))
935+ Option (Endo (Y.QueryText, L.Request)) (Maybe (L.Request -> IO L.Request))
932936 -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
933937 -- Request to avoid appending to existing query string in request every
934938 -- time new parameter is added. Additional Maybe (Endo Request) is a
@@ -958,14 +962,20 @@ withRequest f = Option (Endo (second f)) Nothing
958962-- | A helper to create an 'Option' that adds a finalizer (request
959963-- endomorphism that is run after all other modifications).
960964
961−asFinalizer :: (L.Request -> L.Request) -> Option scheme
962−asFinalizer f = Option mempty (Just (Endo f))
965+asFinalizer :: (L.Request -> IO L.Request) -> Option scheme
966+asFinalizer = Option mempty . pure
963967
964968instance RequestComponent (Option scheme) where
965− getRequestMod (Option f finalizer) = Endo $ \x ->
969+ getRequestMod (Option f _) = Endo $ \x ->
966970 let (qparams, x') = appEndo f ([], x)
967971 query = Y.renderQuery True (Y.queryTextToQuery qparams)
968− in maybe id appEndo finalizer x' { L.queryString = query }
972+ in x' { L.queryString = query }
973+
974+-- | Finalize given 'L.Request' by applying a finalizer from given 'Option'
975+-- (if it has any).
976+
977+finalizeRequest :: MonadIO m => Option scheme -> L.Request -> m L.Request
978+finalizeRequest (Option _ mfinalizer) = liftIO . fromMaybe pure mfinalizer
969979
970980----------------------------------------------------------------------------
971981-- Request — Optional parameters — Query Parameters
@@ -1076,7 +1086,25 @@ basicAuth
10761086 -> ByteString -- ^ Password
10771087 -> Option 'Https -- ^ Auth 'Option'
10781088basicAuth username password = asFinalizer
1079− (L.applyBasicAuth username password)
1089+ (pure . L.applyBasicAuth username password)
1090+
1091+-- | The 'Option' adds OAuth1 authentication.
1092+--
1093+-- @since 0.2.0
1094+
1095+oAuth1
1096+ :: ByteString -- ^ Consumer token
1097+ -> ByteString -- ^ Consumer secret
1098+ -> ByteString -- ^ OAuth token
1099+ -> ByteString -- ^ OAuth token secret
1100+ -> Option scheme -- ^ Auth 'Option'
1101+oAuth1 consumerToken consumerSecret token tokenSecret =
1102+ asFinalizer (OAuth.signOAuth app creds)
1103+ where
1104+ app = OAuth.newOAuth
1105+ { OAuth.oauthConsumerKey = consumerToken
1106+ , OAuth.oauthConsumerSecret = consumerSecret }
1107+ creds = OAuth.newCredential token tokenSecret
10801108
10811109-- | The 'Option' adds an OAuth2 bearer token. This is treated by many
10821110-- services as the equivalent of a username and password.
@@ -1091,7 +1119,7 @@ oAuth2Bearer
10911119 :: ByteString -- ^ Token
10921120 -> Option 'Https -- ^ Auth 'Option'
10931121oAuth2Bearer token = asFinalizer
1094− (attachHeader "Authorization" ("Bearer " <> token))
1122+ (pure . attachHeader "Authorization" ("Bearer " <> token))
10951123
10961124-- | The 'Option' adds a not-quite-standard OAuth2 bearer token (that seems
10971125-- to be used only by GitHub). This will be treated by whatever services
@@ -1107,7 +1135,7 @@ oAuth2Token
11071135 :: ByteString -- ^ Token
11081136 -> Option 'Https -- ^ Auth 'Option'
11091137oAuth2Token token = asFinalizer
1110− (attachHeader "Authorization" ("token " <> token))
1138+ (pure . attachHeader "Authorization" ("token " <> token))
11111139
11121140----------------------------------------------------------------------------
11131141-- Request — Optional parameters — Other