f14b3b6 · gogol · git.iko.soy

git.iko.soy/gogol

on develop help sign in

Merge pull request #66 from rueshyna/develop

f14b3b6Brendan Hay10 years ago

gogol/src/Network/Google/Auth.hs+23

compare with develop

unifiedsplit

@@ -22,6 +22,8 @@ module Network.Google.Auth

22 , getApplicationDefault

23 , fromWellKnownPath

24 , fromFilePath

25+ , saveAuthorizedUserToWellKnownPath

26+ , saveAuthorizedUser

26 -- ** Installed Application Credentials

28 -- ** Installed Application Credentials

27 , installedApplication

29 , installedApplication

@@ -33,8 +35,10 @@ module Network.Google.Auth

33 -- ** Thread-safe Storage

35 -- ** Thread-safe Storage

34 , Store

36 , Store

35 , initStore

37 , initStore

38+ , retrieveAuthFromStore

37 , Auth (..)

40 , Auth (..)

41+ , authToAuthorizedUser

38 , exchange

42 , exchange

39 , refresh

43 , refresh

@@ -81,6 +85,19 @@ import Network.HTTP.Conduit (Manager)

81import qualified Network.HTTP.Conduit as Client

85import qualified Network.HTTP.Conduit as Client

82import Network.HTTP.Types (hAuthorization)

86import Network.HTTP.Types (hAuthorization)

88+-- | 'authToAuthorizedUser' converts 'Auth' into an 'AuthorizedUser'

89+-- by returning 'Right' if there is a 'FromClient'-constructed

90+-- Credentials and a refreshed token; otherwise, returning

91+-- 'Left' with error message.

92+authToAuthorizedUser :: AllowScopes s => Auth s -> Either Text AuthorizedUser

93+authToAuthorizedUser a = AuthorizedUser

94+ <$> (_clientId <$> getClient)

95+ <*> maybe (Left "no refresh token") Right (_tokenRefresh (_token a))

96+ <*> (_clientSecret <$> getClient)

97+ where getClient = case _credentials a of

98+ FromClient c _ -> Right c

99+ _ -> Left "not FromClient"

100+

84-- | An 'OAuthToken' that can potentially be expired, with the original

101-- | An 'OAuthToken' that can potentially be expired, with the original

85-- credentials that can be used to perform a refresh.

102-- credentials that can be used to perform a refresh.

86data Auth (s :: [Symbol]) = Auth

103data Auth (s :: [Symbol]) = Auth

@@ -110,6 +127,12 @@ initStore :: (MonadIO m, MonadCatch m, AllowScopes s)

110 -> m (Store s)

127 -> m (Store s)

111initStore c l m = exchange c l m >>= fmap Store . liftIO . newMVar

128initStore c l m = exchange c l m >>= fmap Store . liftIO . newMVar

112

129

130+-- | Retrieve auth from storage

131+retrieveAuthFromStore :: (MonadIO m, MonadCatch m, AllowScopes s)

132+ => Store s

133+ -> m (Auth s)

134+retrieveAuthFromStore (Store s) = liftIO (readMVar s)

135+

113-- | Concurrently read the current token, and if expired, then

136-- | Concurrently read the current token, and if expired, then

114-- safely perform a single serial refresh.

137-- safely perform a single serial refresh.

115getToken :: (MonadIO m, MonadCatch m, AllowScopes s)

138getToken :: (MonadIO m, MonadCatch m, AllowScopes s)

gogol/src/Network/Google/Auth/ApplicationDefault.hs+28−3

@@ -20,20 +20,21 @@ module Network.Google.Auth.ApplicationDefault where

21import Control.Applicative

22import Control.Exception.Lens (catching, throwingM)

23−import Control.Monad (unless)

23+import Control.Monad (unless, when)

24import Control.Monad.Catch

25import Control.Monad.IO.Class (MonadIO (..))

26import Data.Aeson

27import Data.Aeson.Types (parseEither)

28import qualified Data.ByteString.Lazy as LBS

29+import Data.Maybe (maybe)

29import qualified Data.Text as Text

30import qualified Data.Text as Text

30import Network.Google.Compute.Metadata (isGCE)

31import Network.Google.Compute.Metadata (isGCE)

31import Network.Google.Internal.Auth

32import Network.Google.Internal.Auth

33import Network.HTTP.Conduit (Manager)

34import Network.HTTP.Conduit (Manager)

34−import System.Directory (doesFileExist, getHomeDirectory)

35+import System.Directory (doesFileExist, getHomeDirectory, createDirectoryIfMissing)

35import System.Environment (lookupEnv)

36import System.Environment (lookupEnv)

36−import System.FilePath ((</>))

37+import System.FilePath ((</>), takeDirectory)

37import System.Info (os)

38import System.Info (os)

39-- | The environment variable name which is used to specify the directory

40-- | The environment variable name which is used to specify the directory

@@ -126,6 +127,30 @@ fromFilePath f = do

126 either (throwM . InvalidFileError f . Text.pack) pure

127 either (throwM . InvalidFileError f . Text.pack) pure

127 (fromJSONCredentials bs)

128 (fromJSONCredentials bs)

128

129

130+-- | Save 'AuthorizedUser'

131+-- /See:/ 'cloudSDKConfigPath', 'defaultCredentialsPath'.

132+saveAuthorizedUserToWellKnownPath :: (MonadIO m, MonadCatch m)

133+ => Bool -- ^ Force to save if True

134+ -> AuthorizedUser

135+ -> m ()

136+saveAuthorizedUserToWellKnownPath b a = do

137+ d <- defaultCredentialsPath

138+ f <- maybe cloudSDKConfigPath pure d

139+ liftIO $ createDirectoryIfMissing True $ takeDirectory f

140+ saveAuthorizedUser f b a

141+

142+-- | Save 'AuthorizedUser'

143+saveAuthorizedUser :: (MonadIO m, MonadCatch m)

144+ => FilePath

145+ -> Bool -- ^ Force to save if True

146+ -> AuthorizedUser

147+ -> m ()

148+saveAuthorizedUser f b a = do

149+ p <- liftIO (doesFileExist f)

150+ when (p && not b) $

151+ throwM (FileExistError f)

152+ liftIO (LBS.writeFile f $ encode a)

153+

129-- | Attempt to parse either a @service_account@ or @authorized_user@ formatted

154-- | Attempt to parse either a @service_account@ or @authorized_user@ formatted

130-- JSON value to obtain credentials.

155-- JSON value to obtain credentials.

131fromJSONCredentials :: LBS.ByteString -> Either String (Credentials s)

156fromJSONCredentials :: LBS.ByteString -> Either String (Credentials s)

gogol/src/Network/Google/Auth/InstalledApplication.hs+20

@@ -22,9 +22,12 @@ module Network.Google.Auth.InstalledApplication

22 ( installedApplication

24 -- * Forming the URL

25+ , AccessType (..)

25 , redirectURI

26 , redirectURI

26 , formURL

27 , formURL

28+ , formAccessTypeURL

27 , formURLWith

29 , formURLWith

30+ , formAccessTypeURLWith

29 -- * Internal Exchange and Refresh

32 -- * Internal Exchange and Refresh

30 , exchangeCode

33 , exchangeCode

@@ -33,6 +36,7 @@ module Network.Google.Auth.InstalledApplication

34import Control.Monad.Catch (MonadCatch)

37import Control.Monad.Catch (MonadCatch)

35import Control.Monad.IO.Class (MonadIO)

38import Control.Monad.IO.Class (MonadIO)

39+import qualified Data.Text as Text

36import qualified Data.Text.Encoding as Text

40import qualified Data.Text.Encoding as Text

37import GHC.TypeLits (Symbol)

41import GHC.TypeLits (Symbol)

38import Network.Google.Auth.Scope (AllowScopes (..),

42import Network.Google.Auth.Scope (AllowScopes (..),

@@ -77,6 +81,9 @@ import qualified Network.HTTP.Conduit as Client

77installedApplication :: OAuthClient -> OAuthCode s -> Credentials s

81installedApplication :: OAuthClient -> OAuthCode s -> Credentials s

78installedApplication = FromClient

82installedApplication = FromClient

84+-- /See:/ <https://developers.google.com/identity/protocols/OAuth2WebServer#offline>

85+data AccessType = Online | Offline deriving (Show, Eq)

86+

80-- | The redirection URI used in 'formURL': @urn:ietf:wg:oauth:2.0:oob@.

87-- | The redirection URI used in 'formURL': @urn:ietf:wg:oauth:2.0:oob@.

81redirectURI :: Text

88redirectURI :: Text

82redirectURI = "urn:ietf:wg:oauth:2.0:oob"

89redirectURI = "urn:ietf:wg:oauth:2.0:oob"

@@ -88,6 +95,12 @@ redirectURI = "urn:ietf:wg:oauth:2.0:oob"

88formURL :: AllowScopes (s :: [Symbol]) => OAuthClient -> proxy s -> Text

95formURL :: AllowScopes (s :: [Symbol]) => OAuthClient -> proxy s -> Text

89formURL c = formURLWith c . allowScopes

96formURL c = formURLWith c . allowScopes

98+-- | 'formURL' for 'AccessType'

99+--

100+-- /See:/ 'formUrl'.

101+formAccessTypeURL :: AllowScopes (s :: [Symbol]) => OAuthClient -> AccessType -> proxy s -> Text

102+formAccessTypeURL c a = formAccessTypeURLWith c a . allowScopes

103+

91-- | Form a URL using 'OAuthScope' values.

104-- | Form a URL using 'OAuthScope' values.

92--

105--

93-- /See:/ 'formURL'.

106-- /See:/ 'formURL'.

@@ -98,6 +111,13 @@ formURLWith c ss = accountsURL

98 <> "&redirect_uri=" <> redirectURI

111 <> "&redirect_uri=" <> redirectURI

99 <> "&scope=" <> Text.decodeUtf8 (queryEncodeScopes ss)

112 <> "&scope=" <> Text.decodeUtf8 (queryEncodeScopes ss)

100

113

114+-- | 'formURLWith' for 'AccessType'

115+--

116+-- /See:/ 'formURLWith'.

117+formAccessTypeURLWith :: OAuthClient -> AccessType -> [OAuthScope] -> Text

118+formAccessTypeURLWith c a ss = formURLWith c ss

119+ <> "&access_type=" <> (Text.toLower . Text.pack $ show a)

120+

101-- | Exchange 'OAuthClient' details and the received 'OAuthCode' for a new

121-- | Exchange 'OAuthClient' details and the received 'OAuthCode' for a new

102-- 'OAuthToken'.

122-- 'OAuthToken'.

103--

123--

gogol/src/Network/Google/Internal/Auth.hs+9−1

@@ -129,6 +129,13 @@ data AuthorizedUser = AuthorizedUser

129 , _userSecret :: !Secret

130 } deriving (Eq, Show)

131

132+instance ToJSON AuthorizedUser where

133+ toJSON (AuthorizedUser i r s) =

134+ object [ "client_id" .= i

135+ , "refresh_token" .= r

136+ , "client_secret" .= s

137+ ]

138+

132instance FromJSON AuthorizedUser where

139instance FromJSON AuthorizedUser where

133 parseJSON = withObject "authorized_user" $ \o -> AuthorizedUser

140 parseJSON = withObject "authorized_user" $ \o -> AuthorizedUser

134 <$> o .: "client_id"

141 <$> o .: "client_id"

@@ -175,12 +182,13 @@ instance ToHttpApiData (OAuthCode s) where

175 toQueryParam (OAuthCode c) = c

182 toQueryParam (OAuthCode c) = c

176 toHeader (OAuthCode c) = Text.encodeUtf8 c

183 toHeader (OAuthCode c) = Text.encodeUtf8 c

177

184

178−-- | An error thrown when attempting to read AuthN/AuthZ information.

185+-- | An error thrown when attempting to read/write AuthN/AuthZ information.

179data AuthError

186data AuthError

180 = RetrievalError HttpException

187 = RetrievalError HttpException

181 | MissingFileError FilePath

188 | MissingFileError FilePath

182 | InvalidFileError FilePath Text

189 | InvalidFileError FilePath Text

183 | TokenRefreshError Status Text (Maybe Text)

190 | TokenRefreshError Status Text (Maybe Text)

191+ | FileExistError FilePath

184 deriving (Show, Typeable)

192 deriving (Show, Typeable)

185

193

186instance Exception AuthError

194instance Exception AuthError