8ba6f86 · gogol · git.iko.soy

git.iko.soy/gogol

added offline mode and save/refresh FromClient-constructed Credentials functions

commit8ba6f8616c34346ab62f14c1e6f780dc89acf426 authorRueshyna <rueshyna@gmail.com> dateMon 6 Mar 2017, 22:35 (10 years ago) parentd61c7f5

4 files changed+103−5

compare with develop

unifiedsplit

gogol/src/Network/Google/Auth.hs+45 gogol/src/Network/Google/Auth/ApplicationDefault.hs+28−3 gogol/src/Network/Google/Auth/InstalledApplication.hs+20 gogol/src/Network/Google/Internal/Auth.hs+10−2

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

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

2222 , getApplicationDefault

2323 , fromWellKnownPath

2424 , fromFilePath

25+ , saveAuthorizedUserToWellKnownPath

26+ , saveAuthorizedUser

2527

2628 -- ** Installed Application Credentials

2729 , installedApplication

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

3335 -- ** Thread-safe Storage

3436 , Store

3537 , initStore

38+ , refreshStore

39+ , retrieveAuthFromStore

3640

3741 , Auth (..)

42+ , authToAuthorizedUser

3843 , exchange

3944 , refresh

4045

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

8186import qualified Network.HTTP.Conduit as Client

8287import Network.HTTP.Types (hAuthorization)

8388

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

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

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

92+-- 'Left' with error message.

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

94+authToAuthorizedUser a = AuthorizedUser

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

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

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

98+ where getClient = case _credentials a of

99+ FromClient c _ -> Right c

100+ _ -> Left "not FromClient"

101+

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

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

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

@@ -110,6 +128,33 @@ initStore :: (MonadIO m, MonadCatch m, AllowScopes s)

110128 -> m (Store s)

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

112130

131+-- | Refresh an 'OAuthToken' if it was expired.

132+-- Otherwise, keep original one.

133+refreshStore :: (MonadIO m, MonadCatch m, AllowScopes s)

134+ => Store s

135+ -> Logger

136+ -> Manager

137+ -> m (Store s)

138+refreshStore ss@(Store s) l m = do

139+ x <- retrieveAuthFromStore ss

140+ mx <- validate x

141+ if mx

142+ then pure ss

143+ else liftIO . modifyMVar s $ \y -> do

144+ my <- validate y

145+ if my

146+ then pure (y, ss)

147+ else do

148+ z <- refresh y l m

149+ tt <- fmap Store . liftIO . newMVar $ z

150+ pure (z, tt)

151+

152+-- | Retrieve auth from storage

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

154+ => Store s

155+ -> m (Auth s)

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

157+

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

114159-- safely perform a single serial refresh.

115160getToken :: (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

2020

2121import Control.Applicative

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

23−import Control.Monad (unless)

23+import Control.Monad (unless, when)

2424import Control.Monad.Catch

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

2626import Data.Aeson

2727import Data.Aeson.Types (parseEither)

2828import qualified Data.ByteString.Lazy as LBS

29+import Data.Maybe (maybe)

2930import qualified Data.Text as Text

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

3132import Network.Google.Internal.Auth

3233

3334import Network.HTTP.Conduit (Manager)

34−import System.Directory (doesFileExist, getHomeDirectory)

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

3536import System.Environment (lookupEnv)

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

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

3738import System.Info (os)

3839

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

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

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

127128 (fromJSONCredentials bs)

128129

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+

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

130155-- JSON value to obtain credentials.

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

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

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

2222 ( installedApplication

2323

2424 -- * Forming the URL

25+ , AccessType (..)

2526 , redirectURI

2627 , formURL

28+ , formAccessTypeURL

2729 , formURLWith

30+ , formAccessTypeURLWith

2831

2932 -- * Internal Exchange and Refresh

3033 , exchangeCode

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

3336

3437import Control.Monad.Catch (MonadCatch)

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

39+import qualified Data.Text as Text

3640import qualified Data.Text.Encoding as Text

3741import GHC.TypeLits (Symbol)

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

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

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

7882installedApplication = FromClient

7983

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

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

86+

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

8188redirectURI :: Text

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

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

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

8996formURL c = formURLWith c . allowScopes

9097

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+

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

92105--

93106-- /See:/ 'formURL'.

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

98111 <> "&redirect_uri=" <> redirectURI

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

100113

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+

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

102122-- 'OAuthToken'.

103123--

gogol/src/Network/Google/Internal/Auth.hs+10−2

@@ -127,7 +127,14 @@ data AuthorizedUser = AuthorizedUser

127127 { _userId :: !ClientId

128128 , _userRefresh :: !RefreshToken

129129 , _userSecret :: !Secret

130− } deriving (Eq, Show)

130+ } deriving (Eq, Show, Generic)

131+

132+instance ToJSON AuthorizedUser where

133+ toEncoding (AuthorizedUser i r s) =

134+ pairs ( "client_id" .= i

135+ <> "refresh_token" .= r

136+ <> "client_secret" .= s

137+ )

131138

132139instance FromJSON AuthorizedUser where

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

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

175182 toQueryParam (OAuthCode c) = c

176183 toHeader (OAuthCode c) = Text.encodeUtf8 c

177184

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

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

179186data AuthError

180187 = RetrievalError HttpException

181188 | MissingFileError FilePath

182189 | InvalidFileError FilePath Text

183190 | TokenRefreshError Status Text (Maybe Text)

191+ | FileExistError FilePath

184192 deriving (Show, Typeable)

185193

186194instance Exception AuthError