on master help sign in
Better integrate signing authentication options
commit624c42e31f3010e1cf2c3a1127e8f72816205f01 authormrkkrp <markkarpov@opmbx.org> dateFri 28 Oct 2016, 21:40 (10 years ago) parent2febecd
3 files changed+63−12
Network/HTTP/Req.hs+32−9 Network/HTTP/Req/AWS.hs+16−2 Network/HTTP/Req/OAuth1.hs+15−1
Network/HTTP/Req.hs+32−9
@@ -146,6 +146,7 @@ module Network.HTTP.Req
146146 , Scheme (..) )
147147where
148148
149+import Control.Applicative ((<|>))
149150import Control.Arrow (first, second)
150151import Control.Exception (try)
151152import Control.Monad.IO.Class
@@ -172,6 +173,8 @@ import qualified Network.Connection as NC
172173import qualified Network.HTTP.Client as L
173174import qualified Network.HTTP.Client.Internal as LI
174175import 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
175178import qualified Network.HTTP.Types as Y
176179
177180----------------------------------------------------------------------------
@@ -537,29 +540,45 @@ instance HttpBody b => RequestComponent (Womb "body" b) where
537540
538541-- TODO We need examples here.
539542
540−newtype Option (scheme :: Scheme) = Option (Endo (Y.QueryText, L.Request))
543+data Option (scheme :: Scheme) =
544+ Option (Endo (Y.QueryText, L.Request)) (Maybe (Endo L.Request))
541545 -- NOTE 'QueryText' is just [(Text, Maybe Text)], we keep it along with
542546 -- Request to avoid appending to existing query string in request every
543− -- time new parameter is added.
544− deriving (Semigroup, Monoid)
547+ -- time new parameter is added. Additional Maybe (Endo Request) is a
548+ -- finalizer that will be applied after all over options. This is for
549+ -- authentication methods that sign requests based on data in Request.
550+
551+instance Semigroup (Option scheme) where
552+ Option er0 mr0 <> Option er1 mr1 = Option
553+ (er0 <> er1) (mr0 <|> mr1)
554+
555+instance Monoid (Option scheme) where
556+ mempty = Option mempty Nothing
557+ mappend = (<>)
545558
546559-- | A helper to create an 'Option' that modifies only collection of query
547560-- parameters. This helper is not a part of public API.
548561
549562withQueryParams :: (Y.QueryText -> Y.QueryText) -> Option scheme
550−withQueryParams = Option . Endo . first
563+withQueryParams f = Option (Endo (first f)) Nothing
551564
552565-- | A helper to create an 'Option' that modifies only 'L.Request'. This
553566-- helper is not a part of public API.
554567
555568withRequest :: (L.Request -> L.Request) -> Option scheme
556−withRequest = Option . Endo . second
569+withRequest f = Option (Endo (second f)) Nothing
570+
571+-- | A helper to create an 'Option' that adds a finalier (request
572+-- endomorphism that is run after all other modifications).
573+
574+withFinalizer :: (L.Request -> L.Request) -> Option scheme
575+withFinalizer f = Option mempty (Just (Endo f))
557576
558577instance RequestComponent (Option scheme) where
559− getRequestMod (Option f) = Endo $ \x ->
578+ getRequestMod (Option f finalizer) = Endo $ \x ->
560579 let (qparams, x') = appEndo f ([], x)
561580 query = Y.renderQuery True (Y.queryTextToQuery qparams)
562− in x' { L.queryString = query }
581+ in maybe id appEndo finalizer x' { L.queryString = query }
563582
564583----------------------------------------------------------------------------
565584-- Request — Optional parameters — Query Parameters
@@ -631,13 +650,16 @@ header name value = withRequest $ \x ->
631650-- manual construction of headers, etc., because it's a better style and
632651-- provides additional type safety that prevents leaking of credentials.
633652
653+-- | OAuth 1 authentication 'Option'.
654+
634655oAuth1
635656 :: ByteString -- ^ Consumer token
636657 -> ByteString -- ^ Consumer secret
637658 -> ByteString -- ^ OAuth token
638659 -> ByteString -- ^ OAuth token secret
639660 -> Option scheme
640−oAuth1 = undefined -- TODO
661+oAuth1 ctoken csecret otoken osecret = withFinalizer
662+ (OAuth1.signRequest ctoken csecret otoken osecret)
641663
642664-- | The 'Option' adds basic authentication. The 'Text' values will be UTF-8
643665-- encoded.
@@ -682,7 +704,8 @@ awsAuth
682704 :: ByteString -- ^ AWS access key
683705 -> ByteString -- ^ AWS secret access key
684706 -> Option 'Https -- ^ Auth 'Option'
685−awsAuth accessKey secretKey = undefined -- TODO
707+awsAuth accessKey secretKey = withFinalizer
708+ (AWS.signRequest accessKey secretKey)
686709
687710----------------------------------------------------------------------------
688711-- Request — Optional parameters — Other
Network/HTTP/Req/AWS.hs+16−2
@@ -7,8 +7,22 @@
77-- Stability : experimental
88-- Portability : portable
99--
10−-- Implementation of AWS request signature.
10+-- Implementation of AWS v4 request signature.
1111
1212module Network.HTTP.Req.AWS
13− ( )
13+ ( signRequest )
1414where
15+
16+import Data.ByteString (ByteString)
17+import Network.HTTP.Client
18+
19+-- | Sign a given request following AWS v4 request signing specification:
20+--
21+-- See also: <https://docs.aws.amazon.com/general/latest/gr/sigv4-create-canonical-request.html>
22+
23+signRequest
24+ :: ByteString -- ^ AWS access key
25+ -> ByteString -- ^ AWS secret access key
26+ -> Request -- ^ 'Request' to sign
27+ -> Request -- ^ Resulting request
28+signRequest = undefined -- TODO
Network/HTTP/Req/OAuth1.hs+15−1
@@ -10,5 +10,19 @@
1010-- Implementation of OAuth 1.0 signing.
1111
1212module Network.HTTP.Req.OAuth1
13− ( )
13+ ( signRequest )
1414where
15+
16+import Data.ByteString (ByteString)
17+import Network.HTTP.Client
18+
19+-- | Sign a given request using OAuth 1.0 signing algorithm.
20+
21+signRequest
22+ :: ByteString -- ^ Consumer token
23+ -> ByteString -- ^ Consumer secret
24+ -> ByteString -- ^ OAuth token
25+ -> ByteString -- ^ OAuth token secret
26+ -> Request -- ^ 'Request' to sign
27+ -> Request -- ^ Resulting request
28+signRequest = undefined -- TODO