Merge pull request #66 from rueshyna/develop

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

gogol/src/Network/Google/Auth.hs

@@ -22,6 +22,8 @@ module Network.Google.Auth
     , getApplicationDefault
     , fromWellKnownPath
     , fromFilePath
+    , saveAuthorizedUserToWellKnownPath
+    , saveAuthorizedUser
 
     -- ** Installed Application Credentials
     , installedApplication
@@ -33,8 +35,10 @@ module Network.Google.Auth
     -- ** Thread-safe Storage
     , Store
     , initStore
+    , retrieveAuthFromStore
 
     , Auth           (..)
+    , authToAuthorizedUser
     , exchange
     , refresh
 
@@ -81,6 +85,19 @@ import           Network.HTTP.Conduit                     (Manager)
 import qualified Network.HTTP.Conduit                     as Client
 import           Network.HTTP.Types                       (hAuthorization)
 
+-- | 'authToAuthorizedUser' converts 'Auth' into an 'AuthorizedUser'
+--  by returning 'Right' if there is a 'FromClient'-constructed
+--  Credentials and a refreshed token; otherwise, returning
+--  'Left' with error message.
+authToAuthorizedUser :: AllowScopes s => Auth s -> Either Text AuthorizedUser
+authToAuthorizedUser a = AuthorizedUser
+                   <$>  (_clientId <$> getClient)
+                   <*>  maybe (Left "no refresh token") Right (_tokenRefresh (_token a))
+                   <*>  (_clientSecret <$> getClient)
+                        where getClient = case _credentials a of
+                                            FromClient c _ -> Right c
+                                            _ -> Left "not FromClient"
+
 -- | An 'OAuthToken' that can potentially be expired, with the original
 -- credentials that can be used to perform a refresh.
 data Auth (s :: [Symbol]) = Auth
@@ -110,6 +127,12 @@ initStore :: (MonadIO m, MonadCatch m, AllowScopes s)
           -> m (Store s)
 initStore c l m = exchange c l m >>= fmap Store . liftIO . newMVar
 
+-- | Retrieve auth from storage
+retrieveAuthFromStore :: (MonadIO m, MonadCatch m, AllowScopes s)
+             => Store s
+             -> m (Auth s)
+retrieveAuthFromStore (Store s) = liftIO (readMVar s)
+
 -- | Concurrently read the current token, and if expired, then
 -- safely perform a single serial refresh.
 getToken :: (MonadIO m, MonadCatch m, AllowScopes s)

gogol/src/Network/Google/Auth/ApplicationDefault.hs

@@ -20,20 +20,21 @@ module Network.Google.Auth.ApplicationDefault where
 
 import           Control.Applicative
 import           Control.Exception.Lens          (catching, throwingM)
-import           Control.Monad                   (unless)
+import           Control.Monad                   (unless, when)
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class          (MonadIO (..))
 import           Data.Aeson
 import           Data.Aeson.Types                (parseEither)
 import qualified Data.ByteString.Lazy            as LBS
+import           Data.Maybe                      (maybe)
 import qualified Data.Text                       as Text
 import           Network.Google.Compute.Metadata (isGCE)
 import           Network.Google.Internal.Auth
 
 import Network.HTTP.Conduit (Manager)
-import System.Directory     (doesFileExist, getHomeDirectory)
+import System.Directory     (doesFileExist, getHomeDirectory, createDirectoryIfMissing)
 import System.Environment   (lookupEnv)
-import System.FilePath      ((</>))
+import System.FilePath      ((</>), takeDirectory)
 import System.Info          (os)
 
 -- | The environment variable name which is used to specify the directory
@@ -126,6 +127,30 @@ fromFilePath f = do
     either (throwM . InvalidFileError f . Text.pack) pure
            (fromJSONCredentials bs)
 
+-- | Save 'AuthorizedUser'
+-- /See:/ 'cloudSDKConfigPath', 'defaultCredentialsPath'.
+saveAuthorizedUserToWellKnownPath :: (MonadIO m, MonadCatch m)
+                                  => Bool            -- ^ Force to save if True
+                                  -> AuthorizedUser
+                                  -> m ()
+saveAuthorizedUserToWellKnownPath b a = do
+    d <- defaultCredentialsPath
+    f <- maybe cloudSDKConfigPath pure d
+    liftIO $ createDirectoryIfMissing True $ takeDirectory f
+    saveAuthorizedUser f b a
+
+-- | Save 'AuthorizedUser'
+saveAuthorizedUser :: (MonadIO m, MonadCatch m)
+                   => FilePath
+                   -> Bool            -- ^ Force to save if True
+                   -> AuthorizedUser
+                   -> m ()
+saveAuthorizedUser f b a = do
+    p  <- liftIO (doesFileExist f)
+    when (p && not b) $
+        throwM (FileExistError f)
+    liftIO (LBS.writeFile f $ encode a)
+
 -- | Attempt to parse either a @service_account@ or @authorized_user@ formatted
 -- JSON value to obtain credentials.
 fromJSONCredentials :: LBS.ByteString -> Either String (Credentials s)

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

@@ -22,9 +22,12 @@ module Network.Google.Auth.InstalledApplication
     ( installedApplication
 
     -- * Forming the URL
+    , AccessType (..)
     , redirectURI
     , formURL
+    , formAccessTypeURL
     , formURLWith
+    , formAccessTypeURLWith
 
     -- * Internal Exchange and Refresh
     , exchangeCode
@@ -33,6 +36,7 @@ module Network.Google.Auth.InstalledApplication
 
 import           Control.Monad.Catch            (MonadCatch)
 import           Control.Monad.IO.Class         (MonadIO)
+import qualified Data.Text                      as Text
 import qualified Data.Text.Encoding             as Text
 import           GHC.TypeLits                   (Symbol)
 import           Network.Google.Auth.Scope      (AllowScopes (..),
@@ -77,6 +81,9 @@ import qualified Network.HTTP.Conduit           as Client
 installedApplication :: OAuthClient -> OAuthCode s -> Credentials s
 installedApplication = FromClient
 
+-- /See:/ <https://developers.google.com/identity/protocols/OAuth2WebServer#offline>
+data AccessType = Online | Offline deriving (Show, Eq)
+
 -- | The redirection URI used in 'formURL': @urn:ietf:wg:oauth:2.0:oob@.
 redirectURI :: Text
 redirectURI = "urn:ietf:wg:oauth:2.0:oob"
@@ -88,6 +95,12 @@ redirectURI = "urn:ietf:wg:oauth:2.0:oob"
 formURL :: AllowScopes (s :: [Symbol]) => OAuthClient -> proxy s -> Text
 formURL c = formURLWith c . allowScopes
 
+-- | 'formURL' for 'AccessType'
+--
+-- /See:/ 'formUrl'.
+formAccessTypeURL :: AllowScopes (s :: [Symbol]) => OAuthClient -> AccessType -> proxy s -> Text
+formAccessTypeURL c a = formAccessTypeURLWith c a . allowScopes
+
 -- | Form a URL using 'OAuthScope' values.
 --
 -- /See:/ 'formURL'.
@@ -98,6 +111,13 @@ formURLWith c ss = accountsURL
     <> "&redirect_uri=" <> redirectURI
     <> "&scope="        <> Text.decodeUtf8 (queryEncodeScopes ss)
 
+-- | 'formURLWith' for 'AccessType'
+--
+-- /See:/ 'formURLWith'.
+formAccessTypeURLWith :: OAuthClient -> AccessType -> [OAuthScope] -> Text
+formAccessTypeURLWith c a ss = formURLWith c ss
+    <> "&access_type="  <> (Text.toLower . Text.pack $ show a)
+
 -- | Exchange 'OAuthClient' details and the received 'OAuthCode' for a new
 -- 'OAuthToken'.
 --

gogol/src/Network/Google/Internal/Auth.hs

@@ -129,6 +129,13 @@ data AuthorizedUser = AuthorizedUser
     , _userSecret  :: !Secret
     } deriving (Eq, Show)
 
+instance ToJSON AuthorizedUser where
+    toJSON (AuthorizedUser i r s) =
+        object [ "client_id"     .= i
+               , "refresh_token" .= r
+               , "client_secret" .= s
+               ]
+
 instance FromJSON AuthorizedUser where
     parseJSON = withObject "authorized_user" $ \o -> AuthorizedUser
         <$> o .: "client_id"
@@ -175,12 +182,13 @@ instance ToHttpApiData (OAuthCode s) where
     toQueryParam (OAuthCode c) = c
     toHeader     (OAuthCode c) = Text.encodeUtf8 c
 
--- | An error thrown when attempting to read AuthN/AuthZ information.
+-- | An error thrown when attempting to read/write AuthN/AuthZ information.
 data AuthError
     = RetrievalError    HttpException
     | MissingFileError  FilePath
     | InvalidFileError  FilePath Text
     | TokenRefreshError Status Text (Maybe Text)
+    | FileExistError    FilePath
       deriving (Show, Typeable)
 
 instance Exception AuthError