9a6e8fa · gogol · git.iko.soy

git.iko.soy/gogol

Adding authorization header with bearer token to all requests

commit9a6e8fabfdfa48d3e4dfb3098fd4d00db96f63b6 authorBrendan Hay <brendan.g.hay@gmail.com> dateSat 17 Oct 2015, 17:54 (11 years ago) parent3b4095f

4 files changed+44−34

compare with develop

unifiedsplit

core/src/Network/Google/Types.hs+4−6 gogol/gogol.cabal+3−3 gogol/src/Network/Google/Auth.hs+2−5 gogol/src/Network/Google/Internal/HTTP.hs+35−20

core/src/Network/Google/Types.hs+4−6

@@ -69,16 +69,14 @@ instance ToText AltMedia where

6969newtype AuthKey = AuthKey Text

7070 deriving (Eq, Ord, Show, Read, Generic, Typeable, ToText, FromJSON, ToJSON)

7171

72−newtype OAuthToken = OAuthToken { tokenToText :: Text }

73− deriving (Eq, Ord, Show, Read, IsString, Generic, Typeable, ToText, FromJSON, ToJSON)

74−

7572newtype OAuthScope = OAuthScope { scopeToText :: Text }

7673 deriving (Eq, Ord, Show, Read, IsString, Generic, Typeable, ToText, FromJSON, ToJSON)

7774

78−newtype Bearer a = Bearer a

75+newtype OAuthToken = OAuthToken { tokenToText :: ByteString }

76+ deriving (Eq, Ord, Show, Read, IsString, Generic, Typeable)

7977

80−instance ToText a => ToText (Bearer a) where

81− toText = mappend "Bearer " . toText

78+instance FromJSON OAuthToken where

79+ parseJSON = withText "oauth_token" (pure . OAuthToken . Text.encodeUtf8)

8280

8381newtype MediaDownload a = MediaDownload a

8482

gogol/gogol.cabal+3−3

@@ -39,11 +39,13 @@ library

3939 aeson >= 0.8

4040 , base >= 4.7 && < 5

4141 , bytestring >= 0.9

42+ , case-insensitive >= 1.2

4243 , data-default-class >= 0.0.1

4344 , directory >= 1.2

4445 , exceptions >= 0.6

4546 , filepath >= 1.2

4647 , gogol-core == 0.0.1.*

48+ , http-client >= 0.4.4

4749 , http-conduit >= 2.1.4

4850 , http-media >= 0.6

4951 , http-types >= 0.8.6

@@ -55,6 +57,4 @@ library

5557 , time >= 1.2

5658 , transformers >= 0.2

5759 , transformers-base >= 0.4

58− , unordered-containers >= 0.2.5

59− , http-client

60− , case-insensitive

60+ , unordered-containers >= 0.2.5

gogol/src/Network/Google/Auth.hs+2−5

@@ -178,12 +178,9 @@ data Auth where

178178 Tok :: OAuthToken -> Auth

179179 Ref :: RefreshToken a => Manager -> MVar (Refresh a) -> Auth

180180

181−withToken :: MonadIO m => Auth -> (OAuthToken -> m a) -> m a

182−withToken x f = liftIO (refreshToken x) >>= f

183−

184−refreshToken :: Auth -> IO OAuthToken

181+refreshToken :: MonadIO m => Auth -> m OAuthToken

185182refreshToken (Tok t) = pure t

186−refreshToken (Ref m r) = do

183+refreshToken (Ref m r) = liftIO $ do

187184 x <- readMVar r

188185 xv <- isValid x

189186 if xv

gogol/src/Network/Google/Internal/HTTP.hs+35−20

@@ -1,6 +1,8 @@

1−{-# LANGUAGE FlexibleContexts #-}

2−{-# LANGUAGE RecordWildCards #-}

3−{-# LANGUAGE TypeFamilies #-}

1+{-# LANGUAGE FlexibleContexts #-}

2+{-# LANGUAGE LambdaCase #-}

3+{-# LANGUAGE OverloadedStrings #-}

4+{-# LANGUAGE RecordWildCards #-}

5+{-# LANGUAGE TypeFamilies #-}

57-- |

68-- Module : Network.Google.Internal.HTTP

@@ -12,8 +14,10 @@

1214--

1315module Network.Google.Internal.HTTP where

1416

17+

1518import Control.Lens

1619import Control.Monad.Catch

20+import Control.Monad.IO.Class

1721import Control.Monad.Trans.Resource

1822import Data.Default.Class

1923import Data.Monoid

@@ -21,6 +25,7 @@ import qualified Data.Text.Encoding as Text

2125import qualified Data.Text.Lazy as LText

2226import qualified Data.Text.Lazy.Builder as Build

2327import GHC.Exts (toList)

28+import Network.Google.Auth (Auth, refreshToken)

2429import Network.Google.Env (Env (..))

2530import Network.Google.Internal.Multipart

2631import Network.Google.Types

@@ -54,8 +59,9 @@ perform Env{..} x = catches go handlers

5459 & clientService %~ appEndo (getDual _envOverride)

5560

5661 go = liftResourceT $ do

57− (ct, b) <- content

58− rs <- http (rq ct b) _envManager

62+ (ct, b) <- getContent _rqBody

63+ auth <- getAuthorisation _envAuth

64+ rs <- http (rq auth ct b) _envManager

5965 r <- _cliResponse (responseBody rs)

6066 pure $! case r of

6167 Right y -> Right y

@@ -66,7 +72,7 @@ perform Env{..} x = catches go handlers

6672 , _serializeMessage = e

6773 }

6874

69− rq ct b = def

75+ rq auth ct b = def

7076 { Client.host = _svcHost

7177 , Client.port = _svcPort

7278 , Client.secure = _svcSecure

@@ -75,7 +81,7 @@ perform Env{..} x = catches go handlers

7581 , Client.method = _cliMethod

7682 , Client.path = path

7783 , Client.queryString = renderQuery True (toList _rqQuery)

78− , Client.requestHeaders = accept (ct (toList _rqHeaders))

84+ , Client.requestHeaders = auth : accept (ct (toList _rqHeaders))

7985 , Client.requestBody = b

8086 }

8187

@@ -83,19 +89,6 @@ perform Env{..} x = catches go handlers

8389 | Just t <- _cliAccept = ((hAccept, renderHeader t) :)

8490 | otherwise = id

8591

86− content =

87− case _rqBody of

88− Nothing -> pure (id, mempty)

89− Just (Body t s) -> pure

90− ( ((hContentType, renderHeader t) :)

91− , Client.requestBodySourceChunked s

92− )

93− Just (Related ps) -> do

94− b <- genBoundary

95− pure ( (multipartHeader b :)

96− , renderParts b ps

97− )

98−

9992 path = Text.encodeUtf8

10093 . LText.toStrict

10194 $ Build.toLazyText (_svcPath <> _rqPath)

@@ -117,3 +110,25 @@ perform Env{..} x = catches go handlers

117110 ]

118111 where

119112 err e = return (Left e)

113+

114+getAuthorisation :: MonadIO m => Auth -> m Header

115+getAuthorisation a = do

116+ OAuthToken t <- refreshToken a

117+ pure ( hAuthorization

118+ , "Bearer " <> t

119+ )

120+

121+getContent :: MonadIO m

122+ => Maybe Payload

123+ -> m ([Header] -> [Header], RequestBody)

124+getContent = \case

125+ Nothing -> pure (id, mempty)

126+ Just (Body t s) -> pure

127+ ( ((hContentType, renderHeader t) :)

128+ , Client.requestBodySourceChunked s

129+ )

130+ Just (Related ps) -> do

131+ b <- genBoundary

132+ pure ( (multipartHeader b :)

133+ , renderParts b ps

134+ )