@@ -14,116 +14,156 @@ module Network.Google.Auth.ApplicationDefaultCredentials where
1414import Control.Applicative
1515import Control.Concurrent
1616import Control.Exception.Lens
17−import Control.Lens hiding (coerce, (.=))
17+import Control.Lens hiding (coerce, (.=))
1818import Control.Monad
1919import Control.Monad.Catch
2020import Control.Monad.IO.Class
21−import Crypto.Hash.Algorithms (SHA256 (..))
22−import Crypto.PubKey.RSA.PKCS15 (signSafer)
23−import Crypto.PubKey.RSA.Types (PrivateKey)
21+import Crypto.Hash.Algorithms (SHA256 (..))
22+import Crypto.PubKey.RSA.PKCS15 (signSafer)
23+import Crypto.PubKey.RSA.Types (PrivateKey)
2424import Data.Aeson
2525import Data.Aeson.Types
2626import Data.ByteArray
2727import Data.ByteArray.Encoding
28−import Data.ByteString (ByteString)
29−import Data.ByteString.Builder (Builder)
30−import qualified Data.ByteString.Builder as Build
31−import qualified Data.ByteString.Char8 as BS8
32−import qualified Data.ByteString.Lazy as LBS
28+import Data.ByteString (ByteString)
29+import Data.ByteString.Builder (Builder)
30+import qualified Data.ByteString.Builder as Build
31+import qualified Data.ByteString.Char8 as BS8
32+import qualified Data.ByteString.Lazy as LBS
3333import Data.Coerce
34−import Data.Default.Class (def)
35−import Data.List (intersperse)
34+import Data.Default.Class (def)
35+import Data.List (intersperse)
3636import Data.String
37−import qualified Data.Text as Text
38−import qualified Data.Text.Encoding as Text
39−import qualified Data.Text.Lazy as LText
40−import qualified Data.Text.Lazy.Builder as TBuild
41−import qualified Data.Text.Lazy.Encoding as LText
37+import qualified Data.Text as Text
38+import qualified Data.Text.Encoding as Text
39+import qualified Data.Text.Lazy as LText
40+import qualified Data.Text.Lazy.Builder as TBuild
41+import qualified Data.Text.Lazy.Encoding as LText
4242import Data.Time
4343import Data.Time.Clock.POSIX
4444import Data.Typeable
4545import Data.X509
4646import Data.X509.Memory
47+import Network.Google.Auth.ServiceAccount
4748import Network.Google.Compute.Metadata
4849import Network.Google.Internal.Auth
4950import Network.Google.Internal.Logger
50−import Network.Google.Prelude hiding (buildText)
51−import Network.HTTP.Conduit hiding (Request)
52−import qualified Network.HTTP.Conduit as Client
51+import Network.Google.Prelude hiding (buildText)
52+import Network.HTTP.Conduit hiding (Request)
53+import qualified Network.HTTP.Conduit as Client
5354import Network.HTTP.Types
54−import System.Directory (doesFileExist,
55− getHomeDirectory)
56−import System.Environment (lookupEnv)
57−import System.FilePath ((</>))
58−import System.Info (os)
55+import System.Directory (doesFileExist,
56+ getHomeDirectory)
57+import System.Environment (lookupEnv)
58+import System.FilePath ((</>))
59+import System.Info (os)
5960
6061-- | The environment variable name which is used to specify the directory
6162-- containing the @application_default_credentials.json@ generated by @gcloud init@.
6263cloudSDKConfigDir :: String
6364cloudSDKConfigDir = "CLOUDSDK_CONFIG"
6465
66+-- | Return the filepath to the Cloud SDK well known file location such as
67+-- @~\/.config\/gcloud\/application_default_credentials.json@.
68+cloudSDKConfigPath :: MonadIO m => m FilePath
69+cloudSDKConfigPath = do
70+ m <- liftIO (lookupEnv cloudSDKConfigDir)
71+ case m of
72+ Just d -> pure $! d </> "application_default_credentials.json"
73+ Nothing -> do
74+ d <- getConfigDirectory
75+ pure $! d </> "gcloud/application_default_credentials.json"
76+
6577-- | The environment variable pointing the file with local
6678-- Application Default Credentials.
6779defaultCredentialsFile :: String
6880defaultCredentialsFile = "GOOGLE_APPLICATION_CREDENTIALS"
6981
70−{-| Authorized User credentials which are typically generated by the Cloud SDK
71−Tools such as @gcloud init@, of the following form:
72−
73−@
74−{
75− \"type\": \"authorized_user\",
76− \"client_id\": \"32555940559.apps.googleusercontent.com\",
77− \"client_secret\": \"Zms2qjJy2998hD4CTg2ejr2\",
78− \"refresh_token\": \"1/B3gM1x35v.VtqffS1n5w-rSJ\"
79−}
80−@
81−
82−The secret and refresh token are used to obtain a valid 'OAuthToken' from
83−'accountsURL' using grant_type @refresh_token@.
84−-}
85−data AuthorizedUser = AuthorizedUser
86− { _userId :: !ClientId
87− , _userRefresh :: !RefreshToken
88− , _userSecret :: !Secret
89− } deriving (Eq, Show)
90−
91−instance FromJSON AuthorizedUser where
92− parseJSON = withObject "authorized_user" $ \o -> AuthorizedUser
93− <$> o .: "client_id"
94− <*> o .: "refresh_token"
95− <*> o .: "client_secret"
96−
97−authorizedUserToken :: (MonadIO m, MonadCatch m)
98− => AuthorizedUser
99− -> Maybe RefreshToken
100− -> Logger
101− -> Manager
102− -> m OAuthToken
103−authorizedUserToken u r = refreshRequest $
104− accountsRequest
105− { Client.requestBody = textBody $
106− "grant_type=refresh_token"
107− <> "&client_id=" <> toText (_userId u)
108− <> "&client_secret=" <> toText (_userSecret u)
109− <> "&refresh_token=" <> toText (fromMaybe (_userRefresh u) r)
110− }
111−
11282-- | Lookup the @GOOGLE_APPLICATION_CREDENTIALS@ environment variable for the
11383-- default application credentials filepath.
11484defaultCredentialsPath :: MonadIO m => m (Maybe FilePath)
11585defaultCredentialsPath = liftIO (lookupEnv defaultCredentialsFile)
11686
117−-- | Return the filepath to the Cloud SDK well known file location such as
118−-- @~\/.config\/gcloud\/application_default_credentials.json@.
119−cloudSDKConfigPath :: MonadIO m => m FilePath
120−cloudSDKConfigPath = do
121− m <- liftIO (lookupEnv cloudSDKConfigDir)
122− case m of
123− Just d -> pure $! d </> "application_default_credentials.json"
87+-- | Attempt credentials discovery via the following steps:
88+--
89+-- * Read the default credentials from a file specified by
90+-- the environment variable @GOOGLE_APPLICATION_CREDENTIALS@ if it exists.
91+--
92+-- * Read the platform equivalent of @~\/.config\/gcloud\/application_default_credentials.json@ if it exists.
93+-- The @~/.config@ component of the path can be overriden by the environment
94+-- variable @CLOUDSDK_CONFIG@ if it exists.
95+--
96+-- * Retrieve the default service account application credentials if
97+-- running on GCE. The environment variable @NO_GCE_CHECK@ can be used to
98+-- skip this check if set to a truthy value such as @1@ or @true@.
99+--
100+-- The specified 'Scope's are used to authorize any @service_account@ that is
101+-- found with the appropriate scopes, otherwise they are not used. See the
102+-- top-level module of each individual @gogol-*@ library for a list of available
103+-- scopes, such as @Network.Google.Compute.computeScope@.
104+getApplicationDefault :: (MonadIO m, MonadCatch m)
105+ => [OAuthScope]
106+ -> Manager
107+ -> m Credentials
108+getApplicationDefault ss m =
109+ catching _MissingFileError (fromWellKnownPath ss) $ \f -> do
110+ p <- isGCE m
111+ unless p $
112+ throwingM _MissingFileError f
113+ pure $! FromMetadata "default"
114+
115+-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
116+-- file to obtain the credentials neccessary to perform a token refresh.
117+--
118+-- The specified 'Scope's are used to authorize any @service_account@ that is
119+-- found with the appropriate scopes, otherwise they are not used. See the
120+-- top-level module of each individual @gogol-*@ library for a list of available
121+-- scopes, such as @Network.Google.Compute.computeScope@.
122+--
123+-- /See:/ 'cloudSDKConfigPath', 'defaultCredentialsPath'.
124+fromWellKnownPath :: (MonadIO m, MonadCatch m) => [OAuthScope] -> m Credentials
125+fromWellKnownPath ss = do
126+ f <- defaultCredentialsPath
127+ case f of
128+ Just x -> fromFilePath ss x
124129 Nothing -> do
125− d <- getConfigDirectory
126− pure $! d </> "gcloud/application_default_credentials.json"
130+ x <- cloudSDKConfigPath
131+ fromFilePath ss x
132+
133+-- | Attempt to load either a @service_account@ or @authorized_user@ formatted
134+-- file to obtain the credentials neccessary to perform a token refresh from
135+-- the specified file.
136+--
137+-- The specified 'Scope's are used to authorize any @service_account@ that is
138+-- found with the appropriate scopes, otherwise they are not used. See the
139+-- top-level module of each individual @gogol-*@ library for a list of available
140+-- scopes, such as @Network.Google.Compute.computeScope@.
141+fromFilePath :: (MonadIO m, MonadCatch m)
142+ => [OAuthScope]
143+ -> FilePath
144+ -> m Credentials
145+fromFilePath ss f = do
146+ p <- liftIO (doesFileExist f)
147+ unless p $
148+ throwM (MissingFileError f)
149+ bs <- liftIO (LBS.readFile f)
150+ either (throwM . InvalidFileError f . Text.pack) pure
151+ (fromJSONCredentials ss bs)
152+
153+-- | Attempt to parse either a @service_account@ or @authorized_user@ formatted
154+-- JSON value to obtain credentials.
155+fromJSONCredentials :: [OAuthScope]
156+ -> LBS.ByteString
157+ -> Either String Credentials
158+fromJSONCredentials ss bs = do
159+ v <- eitherDecode' bs
160+ let x = (`FromAccount` ss) <$> parseEither parseJSON v
161+ y = FromUser <$> parseEither parseJSON v
162+ case (x, y) of
163+ (Left xe, Left ye) -> Left $
164+ "Failed parsing service_account: " ++ xe ++
165+ ", Failed parsing authorized_user: " ++ ye
166+ _ -> x <|> y
127167
128168getConfigDirectory :: MonadIO m => m FilePath
129169getConfigDirectory = do