@@ -146,6 +146,7 @@ module Network.HTTP.Req
146 , Scheme (..) )
146 , Scheme (..) )
149+import Control.Applicative ((<|>))
149import Control.Arrow (first, second)
150import Control.Arrow (first, second)
150import Control.Exception (try)
151import Control.Exception (try)
151import Control.Monad.IO.Class
152import Control.Monad.IO.Class
@@ -172,6 +173,8 @@ import qualified Network.Connection as NC
172import qualified Network.HTTP.Client as L
173import qualified Network.HTTP.Client as L
173import qualified Network.HTTP.Client.Internal as LI
174import qualified Network.HTTP.Client.Internal as LI
174import qualified Network.HTTP.Client.TLS as L
175import qualified Network.HTTP.Client.TLS as L
176+import qualified Network.HTTP.Req.AWS as AWS
177+import qualified Network.HTTP.Req.OAuth1 as OAuth1
175import qualified Network.HTTP.Types as Y
178import qualified Network.HTTP.Types as Y
177----------------------------------------------------------------------------
180----------------------------------------------------------------------------
@@ -537,29 +540,45 @@ instance HttpBody b => RequestComponent (Womb "body" b) where
538-- TODO We need examples here.
541-- TODO We need examples here.
543+data Option (scheme :: Scheme) =
540−newtype Option (scheme :: Scheme) = Option (Endo (Y.QueryText, L.Request))
544+ Option (Endo (Y.QueryText, L.Request)) (Maybe (Endo L.Request))
541 -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
545 -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
542 -- Request to avoid appending to existing query string in request every
546 -- Request to avoid appending to existing query string in request every
543− -- time new parameter is added.
547+ -- time new parameter is added. Additional Maybe (Endo Request) is a
544− deriving (Semigroup, Monoid)
548+ -- finalizer that will be applied after all over options. This is for
549+ -- authentication methods that sign requests based on data in Request.
551+instance Semigroup (Option scheme) where
552+ Option er0 mr0 <> Option er1 mr1 = Option
553+ (er0 <> er1) (mr0 <|> mr1)
555+instance Monoid (Option scheme) where
556+ mempty = Option mempty Nothing
546-- | A helper to create an 'Option' that modifies only collection of query
559-- | A helper to create an 'Option' that modifies only collection of query
547-- parameters. This helper is not a part of public API.
560-- parameters. This helper is not a part of public API.
549withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
562withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
550−withQueryParams = Option . Endo . first
563+withQueryParams f = Option (Endo (first f)) Nothing
552-- | A helper to create an 'Option' that modifies only 'L.Request'. This
565-- | A helper to create an 'Option' that modifies only 'L.Request'. This
553-- helper is not a part of public API.
566-- helper is not a part of public API.
555withRequest :: (L.Request -> L.Request) -> Option scheme
568withRequest :: (L.Request -> L.Request) -> Option scheme
556−withRequest = Option . Endo . second
569+withRequest f = Option (Endo (second f)) Nothing
571+-- | A helper to create an 'Option' that adds a finalier (request
572+-- endomorphism that is run after all other modifications).
574+withFinalizer :: (L.Request -> L.Request) -> Option scheme
575+withFinalizer f = Option mempty (Just (Endo f))
558instance RequestComponent (Option scheme) where
577instance RequestComponent (Option scheme) where
559− getRequestMod (Option f) = Endo $ \x ->
578+ getRequestMod (Option f finalizer) = Endo $ \x ->
560 let (qparams, x') = appEndo f ([], x)
579 let (qparams, x') = appEndo f ([], x)
561 query = Y.renderQuery True (Y.queryTextToQuery qparams)
580 query = Y.renderQuery True (Y.queryTextToQuery qparams)
562− in x' { L.queryString = query }
581+ in maybe id appEndo finalizer x' { L.queryString = query }
564----------------------------------------------------------------------------
583----------------------------------------------------------------------------
565-- Request — Optional parameters — Query Parameters
584-- Request — Optional parameters — Query Parameters
@@ -631,13 +650,16 @@ header name value = withRequest $ \x ->
631-- manual construction of headers, etc., because it's a better style and
650-- manual construction of headers, etc., because it's a better style and
632-- provides additional type safety that prevents leaking of credentials.
651-- provides additional type safety that prevents leaking of credentials.
653+-- | OAuth 1 authentication 'Option'.
635 :: ByteString -- ^ Consumer token
656 :: ByteString -- ^ Consumer token
636 -> ByteString -- ^ Consumer secret
657 -> ByteString -- ^ Consumer secret
637 -> ByteString -- ^ OAuth token
658 -> ByteString -- ^ OAuth token
638 -> ByteString -- ^ OAuth token secret
659 -> ByteString -- ^ OAuth token secret
639 -> Option scheme
660 -> Option scheme
640−oAuth1 = undefined -- TODO
661+oAuth1 ctoken csecret otoken osecret = withFinalizer
662+ (OAuth1.signRequest ctoken csecret otoken osecret)
642-- | The 'Option' adds basic authentication. The 'Text' values will be UTF-8
664-- | The 'Option' adds basic authentication. The 'Text' values will be UTF-8
643-- encoded.
665-- encoded.
@@ -682,7 +704,8 @@ awsAuth
682 :: ByteString -- ^ AWS access key
704 :: ByteString -- ^ AWS access key
683 -> ByteString -- ^ AWS secret access key
705 -> ByteString -- ^ AWS secret access key
684 -> Option 'Https -- ^ Auth 'Option'
706 -> Option 'Https -- ^ Auth 'Option'
685−awsAuth accessKey secretKey = undefined -- TODO
707+awsAuth accessKey secretKey = withFinalizer
708+ (AWS.signRequest accessKey secretKey)
687----------------------------------------------------------------------------
710----------------------------------------------------------------------------
688-- Request — Optional parameters — Other
711-- Request — Optional parameters — Other