From d9905571b27c504fb6ecac55ec8e5c78abb902f9 Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 16:55:40 +0200 Subject: [PATCH 01/20] Wip --- .github/workflows/stack-cloud.yaml | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/.github/workflows/stack-cloud.yaml b/.github/workflows/stack-cloud.yaml index 5def093..1c928b1 100644 --- a/.github/workflows/stack-cloud.yaml +++ b/.github/workflows/stack-cloud.yaml @@ -4,6 +4,9 @@ jobs: build-and-test: name: Build and Test runs-on: ubuntu-latest + permissions: + contents: read + id-token: write steps: - uses: actions/checkout@v2 - uses: haskell-actions/setup@v2 @@ -23,12 +26,12 @@ jobs: - ${{ runner.os }}- - name: Install Dependencies run: stack install --only-dependencies --test - - run: 'mkdir secrets && echo "$GCP_SA_KEY" > ./secrets/service_account.json' - shell: bash - env: - GCP_SA_KEY: ${{secrets.GCP_SA_KEY}} + - name: Authenticate to Google Cloud + uses: google-github-actions/auth@v3 + with: + workload_identity_provider: ${{ secrets.WIF_PROVIDER }} + service_account: ${{ secrets.WIF_SERVICE_ACCOUNT }} - name: Run Tests run: stack test env: PROJECT_ID: ${{secrets.PROJECT_ID}} - GOOGLE_APPLICATION_CREDENTIALS: ./secrets/service_account.json From 56724874447b66935dcbe5fd410b3275f094ef26 Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:07:03 +0200 Subject: [PATCH 02/20] Switch to workload identity federation and add Application Default Credentials support - Update GitHub Actions workflow to use google-github-actions/auth with workload identity federation instead of hard-coded service account keys - Add support for Application Default Credentials (ADC) from gcloud auth application-default login - Implement automatic credential detection: ADC > service account key > metadata server - Support OAuth2 refresh token flow for ADC credentials - Update test helpers to automatically detect and use ADC credentials when available - Fallback to metadata server for GCP VMs when no credential files are present - Update documentation to recommend gcloud auth for local development This eliminates the need for long-term service account keys in favor of: - Workload Identity Federation in CI/CD (GitHub Actions) - Application Default Credentials for local development - Metadata server for GCP VMs --- set-env.sh | 10 +++-- src/Cloud/PubSub.hs | 3 ++ src/Cloud/PubSub/Auth.hs | 52 ++++++++++++++++++++++ src/Cloud/PubSub/Auth/Token.hs | 2 + src/Cloud/PubSub/Auth/Types.hs | 8 ++++ test/Cloud/PubSub/AuthSpec.hs | 21 ++++++--- test/Cloud/PubSub/TestHelpers.hs | 76 +++++++++++++++++++++++--------- 7 files changed, 141 insertions(+), 31 deletions(-) diff --git a/set-env.sh b/set-env.sh index 81924b0..cbf6869 100644 --- a/set-env.sh +++ b/set-env.sh @@ -10,8 +10,12 @@ if [[ -z "$PUBSUB_EMULATOR_HOST" ]] && [[ -z "$GOOGLE_APPLICATION_CREDENTIALS" ] PUBSUB_EMULATOR_HOST="localhost:8085" fi -# To run tests against hosted Cloud PubSub set GOOGLE_APPLICATION_CREDENTIALS -# instead of PUBSUB_EMULATOR_HOST -# GOOGLE_APPLICATION_CREDENTIALS="secrets/service_account.json" +# To run tests against hosted Cloud PubSub: +# Option 1 (recommended for local): Use gcloud auth application-default login +# This creates credentials at ~/.config/gcloud/application_default_credentials.json +# No need to set GOOGLE_APPLICATION_CREDENTIALS +# Option 2 (legacy): Set GOOGLE_APPLICATION_CREDENTIALS to a service account key file +# GOOGLE_APPLICATION_CREDENTIALS="secrets/service_account.json" +# Option 3 (GCP VM/CI): Don't set GOOGLE_APPLICATION_CREDENTIALS, use metadata server set +o allexport diff --git a/src/Cloud/PubSub.hs b/src/Cloud/PubSub.hs index 56a8e8e..b74583f 100644 --- a/src/Cloud/PubSub.hs +++ b/src/Cloud/PubSub.hs @@ -24,6 +24,7 @@ import qualified Network.HTTP.Client.TLS as HttpClientTLS data AuthMethod = ServiceAccountFile FilePath | MetadataServer + | ApplicationDefaultCredentialsFile FilePath deriving (Show, Eq) newtype HostAndPort = HostAndPort { unwrapHostAndPort :: String } @@ -53,6 +54,8 @@ mkClientResources projectId target = do AuthT.FromServiceAccount <$> Auth.readServiceAccountFile saFile MetadataServer -> pure AuthT.FromMetadataServer + ApplicationDefaultCredentialsFile adcFile -> + AuthT.FromApplicationDefaultCredentials <$> Auth.readApplicationDefaultCredentialsFile adcFile let resources = CloudTargetResources authSource tokenVar threshold serviceUrl = "https://pubsub.googleapis.com" return (serviceUrl, Cloud resources) diff --git a/src/Cloud/PubSub/Auth.hs b/src/Cloud/PubSub/Auth.hs index 9445b4b..b703cb3 100644 --- a/src/Cloud/PubSub/Auth.hs +++ b/src/Cloud/PubSub/Auth.hs @@ -2,6 +2,8 @@ module Cloud.PubSub.Auth ( fetchToken , readServiceAccountFile , fetchMetadataToken + , readApplicationDefaultCredentialsFile + , fetchApplicationDefaultCredentialsToken ) where import qualified Cloud.PubSub.Auth.Types as AuthT @@ -25,6 +27,30 @@ readServiceAccountFile :: MonadIO m => FilePath -> m AuthT.ServiceAccount readServiceAccountFile fp = liftIO $ Aeson.eitherDecodeFileStrict fp >>= either fail return +data ADCCredentials = ADCCredentials + { adcType :: Text + , adcClientId :: Text + , adcClientSecret :: Text + , adcRefreshToken :: Text + } + deriving stock (Generic) + +instance Aeson.FromJSON ADCCredentials where + parseJSON = Aeson.genericParseJSON $ Aeson.defaultOptions + { Aeson.fieldLabelModifier = Aeson.camelTo2 '_' . drop 3 + } + +readApplicationDefaultCredentialsFile :: MonadIO m => FilePath -> m AuthT.ApplicationDefaultCredentials +readApplicationDefaultCredentialsFile fp = liftIO $ do + adc <- Aeson.eitherDecodeFileStrict fp >>= either fail return + if adcType adc == "authorized_user" + then return $ AuthT.ApplicationDefaultCredentials + { AuthT.adcClientId = adcClientId adc + , AuthT.adcClientSecret = adcClientSecret adc + , AuthT.adcRefreshToken = adcRefreshToken adc + } + else fail $ "Unsupported ADC credentials type: " <> Text.unpack (adcType adc) + createAssertionTokenBody :: AuthT.PrivateKeyId -> AuthT.TokenClaims -> ByteString createAssertionTokenBody (AuthT.PrivateKeyId keyId) tokenClaims = @@ -107,3 +133,29 @@ fetchMetadataToken manager scope = liftIO $ do ) response <- HTTP.httpJSON request return $ HTTP.getResponseBody response + +-- | Fetches a GCP access token using Application Default Credentials (from gcloud auth application-default login) +-- Implements the OAuth2 refresh token flow described here: +-- https://developers.google.com/identity/protocols/oauth2/web-server#offline +fetchApplicationDefaultCredentialsToken + :: MonadIO m + => HttpClientC.Manager + -> AuthT.ApplicationDefaultCredentials + -> AuthT.Scope + -> m AuthT.AccessTokenResponse +fetchApplicationDefaultCredentialsToken manager adc scope = liftIO $ do + let tokenUrl = "https://oauth2.googleapis.com/token" + formData = + [ ("client_id" , TE.encodeUtf8 $ AuthT.adcClientId adc) + , ("client_secret", TE.encodeUtf8 $ AuthT.adcClientSecret adc) + , ("refresh_token" , TE.encodeUtf8 $ AuthT.adcRefreshToken adc) + , ("grant_type" , "refresh_token") + , ("scope" , TE.encodeUtf8 $ AuthT.unwrapScope scope) + ] + request <- + HTTP.parseRequest ("POST " <> tokenUrl) + <&> ( HTTP.setRequestBodyURLEncoded formData + . HTTP.setRequestManager manager + ) + response <- HTTP.httpJSON request + return $ HTTP.getResponseBody response diff --git a/src/Cloud/PubSub/Auth/Token.hs b/src/Cloud/PubSub/Auth/Token.hs index 5a24816..4a03641 100644 --- a/src/Cloud/PubSub/Auth/Token.hs +++ b/src/Cloud/PubSub/Auth/Token.hs @@ -28,6 +28,8 @@ fetchAndUpdateToken resources manager scope = do Auth.fetchToken manager serviceAccount scope Auth.FromMetadataServer -> Auth.fetchMetadataToken manager scope + Auth.FromApplicationDefaultCredentials adc -> + Auth.fetchApplicationDefaultCredentialsToken manager adc scope now <- Time.getCurrentTime let accessToken = tokenResponse.accessToken expiresAt = Time.addUTCTime tokenResponse.expiresIn now diff --git a/src/Cloud/PubSub/Auth/Types.hs b/src/Cloud/PubSub/Auth/Types.hs index 095cec5..f661c83 100644 --- a/src/Cloud/PubSub/Auth/Types.hs +++ b/src/Cloud/PubSub/Auth/Types.hs @@ -7,6 +7,7 @@ module Cloud.PubSub.Auth.Types , Scope(..) , ServiceAccount(..) , TokenSource(..) + , ApplicationDefaultCredentials(..) , TokenClaims(..) , UnixEpochSeconds(..) , X509PrivateKey(..) @@ -62,8 +63,15 @@ instance Aeson.FromJSON ServiceAccount where { Aeson.fieldLabelModifier = Aeson.camelTo2 '_' . drop 2 } +data ApplicationDefaultCredentials = ApplicationDefaultCredentials + { adcClientId :: Text + , adcClientSecret :: Text + , adcRefreshToken :: Text + } + data TokenSource = FromServiceAccount ServiceAccount | FromMetadataServer + | FromApplicationDefaultCredentials ApplicationDefaultCredentials newtype AccessToken = AccessToken { unwrapAccessToken :: Text diff --git a/test/Cloud/PubSub/AuthSpec.hs b/test/Cloud/PubSub/AuthSpec.hs index 840066b..a648b81 100644 --- a/test/Cloud/PubSub/AuthSpec.hs +++ b/test/Cloud/PubSub/AuthSpec.hs @@ -10,13 +10,20 @@ import Test.Hspec tokenGetTest :: IO () tokenGetTest = do manager <- HttpClient.newManager HttpClientTLS.tlsManagerSettings - SystemEnv.lookupEnv "GOOGLE_APPLICATION_CREDENTIALS" >>= \case - Nothing -> pendingWith "skipping as auth not supported in emulator" - Just serviceAccountPath -> do - serviceAccount <- Auth.readServiceAccountFile serviceAccountPath - tokenResponse <- Auth.fetchToken manager serviceAccount scope - AuthT.tokenType tokenResponse `shouldBe` "Bearer" - AuthT.expiresIn tokenResponse `shouldSatisfy` (\t -> 3595 < t && t < 3600) + SystemEnv.lookupEnv "PUBSUB_EMULATOR_HOST" >>= \case + Just _ -> pendingWith "skipping as auth not supported in emulator" + Nothing -> do + SystemEnv.lookupEnv "GOOGLE_APPLICATION_CREDENTIALS" >>= \case + Just serviceAccountPath -> do + serviceAccount <- Auth.readServiceAccountFile serviceAccountPath + tokenResponse <- Auth.fetchToken manager serviceAccount scope + AuthT.tokenType tokenResponse `shouldBe` "Bearer" + AuthT.expiresIn tokenResponse `shouldSatisfy` (\t -> 3595 < t && t < 3600) + Nothing -> do + -- Try metadata server + tokenResponse <- Auth.fetchMetadataToken manager scope + AuthT.tokenType tokenResponse `shouldBe` "Bearer" + AuthT.expiresIn tokenResponse `shouldSatisfy` (\t -> 3595 < t && t < 3600) where scope = "https://www.googleapis.com/auth/pubsub" spec :: Spec diff --git a/test/Cloud/PubSub/TestHelpers.hs b/test/Cloud/PubSub/TestHelpers.hs index 0c5cf5d..31cf96d 100644 --- a/test/Cloud/PubSub/TestHelpers.hs +++ b/test/Cloud/PubSub/TestHelpers.hs @@ -7,6 +7,7 @@ import Cloud.PubSub.Core.Types ( Message(..) import qualified Cloud.PubSub.Core.Types as Core import qualified Cloud.PubSub.Http.Types as HttpT import qualified Cloud.PubSub.Logger as Logger +import qualified Data.Aeson as Aeson import qualified Cloud.PubSub.Snapshot as Snapshot import qualified Cloud.PubSub.Snapshot.Types as SnapshotT import qualified Cloud.PubSub.Snapshot.Types as SnapshotT.NewSnapshot @@ -33,6 +34,7 @@ import qualified Data.Text as Text import Data.Time ( NominalDiffTime ) import qualified System.Environment as SystemEnv import qualified System.IO as SystemIO +import System.IO ( doesFileExist ) import Test.Hspec ( pendingWith ) newtype TestEnv = TestEnv @@ -154,34 +156,66 @@ getProjectId = getPubSubTarget :: NominalDiffTime -> IO PubSub.PubSubTarget getPubSubTarget renewThreshold = do maybeEmulatorHost <- SystemEnv.lookupEnv "PUBSUB_EMULATOR_HOST" - maybeSaFile <- SystemEnv.lookupEnv "GOOGLE_APPLICATION_CREDENTIALS" - case (maybeEmulatorHost, maybeSaFile) of - (Just hostAndPortStr, Nothing) -> + case maybeEmulatorHost of + Just hostAndPortStr -> return $ PubSub.EmulatorTarget $ PubSub.HostAndPort hostAndPortStr - (Nothing, Just saFile) -> - let authMethod = PubSub.ServiceAccountFile saFile - in return - $ PubSub.CloudServiceTarget - $ PubSub.CloudConfig renewThreshold authMethod - (_, _) -> - error - "Please specify either \"PUBSUB_EMULATOR_HOST\" or \ - \\"GOOGLE_APPLICATION_CREDENTIALS\" depending whether you to run \ - \the tests against the emulator or the cloud hosted version." + Nothing -> do + -- Check for GOOGLE_APPLICATION_CREDENTIALS (could be service account or ADC) + maybeCredFile <- SystemEnv.lookupEnv "GOOGLE_APPLICATION_CREDENTIALS" + case maybeCredFile of + Just credFile -> do + -- Try to detect if it's ADC or service account by parsing JSON + credJSON <- Aeson.eitherDecodeFileStrict credFile >>= \case + Left _ -> return Nothing + Right v -> return $ Just v + case credJSON >>= Aeson.lookup "type" of + Just (Aeson.String "authorized_user") -> + let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod + _ -> + let authMethod = PubSub.ServiceAccountFile credFile + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod + Nothing -> do + -- Try default ADC location if GOOGLE_APPLICATION_CREDENTIALS not set + maybeHome <- SystemEnv.lookupEnv "HOME" + case maybeHome of + Just homeDir -> do + let defaultADC = homeDir <> "/.config/gcloud/application_default_credentials.json" + adcExists <- SystemIO.doesFileExist defaultADC + if adcExists + then let authMethod = PubSub.ApplicationDefaultCredentialsFile defaultADC + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod + else -- Fall back to metadata server (for GCP VMs) + let authMethod = PubSub.MetadataServer + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod + Nothing -> -- Fall back to metadata server (for GCP VMs) + let authMethod = PubSub.MetadataServer + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod usageMessage :: String usageMessage = unlines [ "Missing config: Tests can be run against the hosted Cloud PubSub service \ \or the emulator. The emulator does not have full API coverage and as such \ \some tests are not run when the tests are with the emulator." - , "To run tests with the hosted Cloud PubSub, please set the enviroment \ - \variable \"GOOGLE_APPLICATION_CREDENTIALS\" to the path to the \ - \service account keys in JSON format and specify Google Cloud Project ID \ - \via the \"PROJECT_ID\" environment variable. Given that service accounts \ - \can be used across projects \"project_id\" field in the JSON key file \ - \is ignored." - , "To run against the emulator please start the emulator and set the \ - \\"PUBSUB_EMULATOR_HOST\" and the \"PROJECT_ID\" environment variables." + , "To run tests with the hosted Cloud PubSub:" + , " Option 1 (recommended for local): Run 'gcloud auth application-default login' \ + \then set \"PROJECT_ID\" environment variable" + , " Option 2 (legacy): Set \"GOOGLE_APPLICATION_CREDENTIALS\" to the path \ + \to service account keys in JSON format and \"PROJECT_ID\"" + , " Option 3 (GCP VM/CI): Use metadata server authentication (default when \ + \GOOGLE_APPLICATION_CREDENTIALS is not set and ADC file doesn't exist)" + , "To run against the emulator: Start the emulator and set \"PUBSUB_EMULATOR_HOST\" \ + \and \"PROJECT_ID\" environment variables." ] mkTestPubSubEnvWithRenewThreshold :: NominalDiffTime -> IO TestEnv From 2613e8f64e71e1c231fff5229e3b2a544f03d977 Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:08:34 +0200 Subject: [PATCH 03/20] Update actions/cache to v4 to fix deprecation warning --- .github/workflows/stack-cloud.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/stack-cloud.yaml b/.github/workflows/stack-cloud.yaml index 1c928b1..236286e 100644 --- a/.github/workflows/stack-cloud.yaml +++ b/.github/workflows/stack-cloud.yaml @@ -15,7 +15,7 @@ jobs: stack-no-global: true stack-version: "3.3.1" - name: Cache Stack Dependencies - uses: actions/cache@v2 + uses: actions/cache@v4 with: path: | ~/.stack From ec9f8dec0cff02bb35db3b349ea904883a947af3 Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:14:32 +0200 Subject: [PATCH 04/20] Add missing Generic import for ADCCredentials type --- src/Cloud/PubSub/Auth.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Cloud/PubSub/Auth.hs b/src/Cloud/PubSub/Auth.hs index b703cb3..a71baaf 100644 --- a/src/Cloud/PubSub/Auth.hs +++ b/src/Cloud/PubSub/Auth.hs @@ -17,8 +17,10 @@ import Data.ByteString ( ByteString ) import qualified Data.ByteString.Base64.URL as Base64 import qualified Data.ByteString.Lazy as LBS import Data.Functor ( (<&>) ) +import GHC.Generics ( Generic ) import qualified Data.Text as Text import qualified Data.Text.Encoding as TE +import Data.Time ( Time ) import qualified Data.Time as Time import qualified Network.HTTP.Client.Conduit as HttpClientC import qualified Network.HTTP.Simple as HTTP From 3c439850df6b732f24f8a184ccd529760f55fcd2 Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:15:40 +0200 Subject: [PATCH 05/20] Fix incorrect Time import --- src/Cloud/PubSub/Auth.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Cloud/PubSub/Auth.hs b/src/Cloud/PubSub/Auth.hs index a71baaf..cffa32d 100644 --- a/src/Cloud/PubSub/Auth.hs +++ b/src/Cloud/PubSub/Auth.hs @@ -20,7 +20,6 @@ import Data.Functor ( (<&>) ) import GHC.Generics ( Generic ) import qualified Data.Text as Text import qualified Data.Text.Encoding as TE -import Data.Time ( Time ) import qualified Data.Time as Time import qualified Network.HTTP.Client.Conduit as HttpClientC import qualified Network.HTTP.Simple as HTTP From 23ad3b8377165ab33c1e0a2ac4e4df1469b4b763 Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:21:49 +0200 Subject: [PATCH 06/20] Fix Text type import conflict in ADCCredentials --- src/Cloud/PubSub/Auth.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Cloud/PubSub/Auth.hs b/src/Cloud/PubSub/Auth.hs index cffa32d..8755fd8 100644 --- a/src/Cloud/PubSub/Auth.hs +++ b/src/Cloud/PubSub/Auth.hs @@ -29,10 +29,10 @@ readServiceAccountFile fp = liftIO $ Aeson.eitherDecodeFileStrict fp >>= either fail return data ADCCredentials = ADCCredentials - { adcType :: Text - , adcClientId :: Text - , adcClientSecret :: Text - , adcRefreshToken :: Text + { adcType :: Text.Text + , adcClientId :: Text.Text + , adcClientSecret :: Text.Text + , adcRefreshToken :: Text.Text } deriving stock (Generic) From f173955ba82418aa439d0c047082010dfaa5585d Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:28:21 +0200 Subject: [PATCH 07/20] Fix import: doesFileExist is from System.Directory, not System.IO --- test/Cloud/PubSub/TestHelpers.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Cloud/PubSub/TestHelpers.hs b/test/Cloud/PubSub/TestHelpers.hs index 31cf96d..9cc3d9d 100644 --- a/test/Cloud/PubSub/TestHelpers.hs +++ b/test/Cloud/PubSub/TestHelpers.hs @@ -32,9 +32,9 @@ import qualified Data.HashMap.Strict as HM import Data.Text ( Text ) import qualified Data.Text as Text import Data.Time ( NominalDiffTime ) +import qualified System.Directory as SystemDir import qualified System.Environment as SystemEnv import qualified System.IO as SystemIO -import System.IO ( doesFileExist ) import Test.Hspec ( pendingWith ) newtype TestEnv = TestEnv @@ -185,7 +185,7 @@ getPubSubTarget renewThreshold = do case maybeHome of Just homeDir -> do let defaultADC = homeDir <> "/.config/gcloud/application_default_credentials.json" - adcExists <- SystemIO.doesFileExist defaultADC + adcExists <- SystemDir.doesFileExist defaultADC if adcExists then let authMethod = PubSub.ApplicationDefaultCredentialsFile defaultADC in return From 602bf2cdea959f853f2ccd0b44bcf798498b5fb3 Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:33:54 +0200 Subject: [PATCH 08/20] Add directory dependency to test suite for doesFileExist --- package.yaml | 1 + 1 file changed, 1 insertion(+) diff --git a/package.yaml b/package.yaml index d310e0d..8ba780b 100644 --- a/package.yaml +++ b/package.yaml @@ -115,6 +115,7 @@ tests: - async - bytestring - cloud-pubsub + - directory - exceptions - hspec # See https://github.com/input-output-hk/haskell.nix/issues/231 From 9744c36ec8df0c154f6115adaecff4b6223462ce Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:39:55 +0200 Subject: [PATCH 09/20] Fix Aeson.lookup usage: use withObject and parseMaybe instead --- test/Cloud/PubSub/TestHelpers.hs | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/test/Cloud/PubSub/TestHelpers.hs b/test/Cloud/PubSub/TestHelpers.hs index 9cc3d9d..217a5ab 100644 --- a/test/Cloud/PubSub/TestHelpers.hs +++ b/test/Cloud/PubSub/TestHelpers.hs @@ -165,20 +165,26 @@ getPubSubTarget renewThreshold = do case maybeCredFile of Just credFile -> do -- Try to detect if it's ADC or service account by parsing JSON - credJSON <- Aeson.eitherDecodeFileStrict credFile >>= \case - Left _ -> return Nothing - Right v -> return $ Just v - case credJSON >>= Aeson.lookup "type" of - Just (Aeson.String "authorized_user") -> - let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile + credJSONE <- Aeson.eitherDecodeFileStrict credFile + case credJSONE of + Left _ -> + -- If JSON parsing fails, treat as service account (backward compatibility) + let authMethod = PubSub.ServiceAccountFile credFile in return $ PubSub.CloudServiceTarget $ PubSub.CloudConfig renewThreshold authMethod - _ -> - let authMethod = PubSub.ServiceAccountFile credFile - in return - $ PubSub.CloudServiceTarget - $ PubSub.CloudConfig renewThreshold authMethod + Right v -> + case Aeson.parseMaybe (Aeson.withObject "credentials" $ \o -> o Aeson.:? "type") v of + Just (Just (Aeson.String "authorized_user")) -> + let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod + _ -> + let authMethod = PubSub.ServiceAccountFile credFile + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod Nothing -> do -- Try default ADC location if GOOGLE_APPLICATION_CREDENTIALS not set maybeHome <- SystemEnv.lookupEnv "HOME" From e57af000237d85c9f65d459ad00b352b94cc0738 Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:44:16 +0200 Subject: [PATCH 10/20] Fix Aeson usage: use ..:? operator and pattern match on Object directly --- test/Cloud/PubSub/TestHelpers.hs | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/test/Cloud/PubSub/TestHelpers.hs b/test/Cloud/PubSub/TestHelpers.hs index 217a5ab..04952c6 100644 --- a/test/Cloud/PubSub/TestHelpers.hs +++ b/test/Cloud/PubSub/TestHelpers.hs @@ -174,12 +174,19 @@ getPubSubTarget renewThreshold = do $ PubSub.CloudServiceTarget $ PubSub.CloudConfig renewThreshold authMethod Right v -> - case Aeson.parseMaybe (Aeson.withObject "credentials" $ \o -> o Aeson.:? "type") v of - Just (Just (Aeson.String "authorized_user")) -> - let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile - in return - $ PubSub.CloudServiceTarget - $ PubSub.CloudConfig renewThreshold authMethod + case v of + Aeson.Object obj -> + case obj Aeson..:? "type" of + Just (Aeson.String "authorized_user") -> + let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod + _ -> + let authMethod = PubSub.ServiceAccountFile credFile + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod _ -> let authMethod = PubSub.ServiceAccountFile credFile in return From 652995a41784e622ee8c7538cc38a33455d18665 Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:49:10 +0200 Subject: [PATCH 11/20] Fix Aeson parsing: use parseEither with withObject to extract type field --- test/Cloud/PubSub/TestHelpers.hs | 43 ++++++++++++++++---------------- 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/test/Cloud/PubSub/TestHelpers.hs b/test/Cloud/PubSub/TestHelpers.hs index 04952c6..fe05b19 100644 --- a/test/Cloud/PubSub/TestHelpers.hs +++ b/test/Cloud/PubSub/TestHelpers.hs @@ -1,6 +1,7 @@ module Cloud.PubSub.TestHelpers where import qualified Cloud.PubSub as PubSub +import qualified Cloud.PubSub.Auth as Auth import Cloud.PubSub.Core.Types ( Message(..) , TopicName ) @@ -8,6 +9,7 @@ import qualified Cloud.PubSub.Core.Types as Core import qualified Cloud.PubSub.Http.Types as HttpT import qualified Cloud.PubSub.Logger as Logger import qualified Data.Aeson as Aeson +import qualified Data.Text as Text import qualified Cloud.PubSub.Snapshot as Snapshot import qualified Cloud.PubSub.Snapshot.Types as SnapshotT import qualified Cloud.PubSub.Snapshot.Types as SnapshotT.NewSnapshot @@ -164,34 +166,33 @@ getPubSubTarget renewThreshold = do maybeCredFile <- SystemEnv.lookupEnv "GOOGLE_APPLICATION_CREDENTIALS" case maybeCredFile of Just credFile -> do - -- Try to detect if it's ADC or service account by parsing JSON + -- Try to detect if it's ADC or service account by checking JSON structure + -- First try to parse as a JSON object and check for "type" field credJSONE <- Aeson.eitherDecodeFileStrict credFile case credJSONE of - Left _ -> - -- If JSON parsing fails, treat as service account (backward compatibility) - let authMethod = PubSub.ServiceAccountFile credFile - in return - $ PubSub.CloudServiceTarget - $ PubSub.CloudConfig renewThreshold authMethod - Right v -> - case v of - Aeson.Object obj -> - case obj Aeson..:? "type" of - Just (Aeson.String "authorized_user") -> - let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile - in return - $ PubSub.CloudServiceTarget - $ PubSub.CloudConfig renewThreshold authMethod - _ -> - let authMethod = PubSub.ServiceAccountFile credFile - in return - $ PubSub.CloudServiceTarget - $ PubSub.CloudConfig renewThreshold authMethod + Right (Aeson.Object obj) -> do + -- Try to extract "type" field using Parser + let typeParser = Aeson.withObject "credentials" $ \o -> o Aeson..:? "type" + typeResult = Aeson.parseEither typeParser (Aeson.Object obj) + case typeResult of + Right (Just (Aeson.String "authorized_user")) -> + -- It's ADC format + let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod _ -> + -- Not ADC format, treat as service account let authMethod = PubSub.ServiceAccountFile credFile in return $ PubSub.CloudServiceTarget $ PubSub.CloudConfig renewThreshold authMethod + _ -> + -- Not a JSON object or parse failed, treat as service account + let authMethod = PubSub.ServiceAccountFile credFile + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod Nothing -> do -- Try default ADC location if GOOGLE_APPLICATION_CREDENTIALS not set maybeHome <- SystemEnv.lookupEnv "HOME" From ad98501b274760bfb0740bdb6d3adb2fd7dc5ae5 Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 17:57:53 +0200 Subject: [PATCH 12/20] Fix ADC credential detection: export ADCCredentials and simplify parsing logic --- src/Cloud/PubSub/Auth.hs | 3 ++- test/Cloud/PubSub/TestHelpers.hs | 42 +++++++++++++++----------------- 2 files changed, 22 insertions(+), 23 deletions(-) diff --git a/src/Cloud/PubSub/Auth.hs b/src/Cloud/PubSub/Auth.hs index 8755fd8..4cbcc4e 100644 --- a/src/Cloud/PubSub/Auth.hs +++ b/src/Cloud/PubSub/Auth.hs @@ -4,6 +4,7 @@ module Cloud.PubSub.Auth , fetchMetadataToken , readApplicationDefaultCredentialsFile , fetchApplicationDefaultCredentialsToken + , ADCCredentials(..) ) where import qualified Cloud.PubSub.Auth.Types as AuthT @@ -34,7 +35,7 @@ data ADCCredentials = ADCCredentials , adcClientSecret :: Text.Text , adcRefreshToken :: Text.Text } - deriving stock (Generic) + deriving stock (Generic, Show) instance Aeson.FromJSON ADCCredentials where parseJSON = Aeson.genericParseJSON $ Aeson.defaultOptions diff --git a/test/Cloud/PubSub/TestHelpers.hs b/test/Cloud/PubSub/TestHelpers.hs index fe05b19..5058e9b 100644 --- a/test/Cloud/PubSub/TestHelpers.hs +++ b/test/Cloud/PubSub/TestHelpers.hs @@ -155,6 +155,15 @@ getProjectId :: IO (Maybe Core.ProjectId) getProjectId = fmap (Core.ProjectId . Text.pack) <$> SystemEnv.lookupEnv "PROJECT_ID" +-- Helper to check if a file contains ADC credentials +tryParseADC :: FilePath -> IO (Maybe Bool) +tryParseADC filePath = do + result <- Aeson.eitherDecodeFileStrict filePath :: IO (Either String (Auth.ADCCredentials)) + case result of + Right (Auth.ADCCredentials t _ _ _) -> + return $ Just (t == Text.pack "authorized_user") + Left _ -> return Nothing + getPubSubTarget :: NominalDiffTime -> IO PubSub.PubSubTarget getPubSubTarget renewThreshold = do maybeEmulatorHost <- SystemEnv.lookupEnv "PUBSUB_EMULATOR_HOST" @@ -166,29 +175,18 @@ getPubSubTarget renewThreshold = do maybeCredFile <- SystemEnv.lookupEnv "GOOGLE_APPLICATION_CREDENTIALS" case maybeCredFile of Just credFile -> do - -- Try to detect if it's ADC or service account by checking JSON structure - -- First try to parse as a JSON object and check for "type" field - credJSONE <- Aeson.eitherDecodeFileStrict credFile - case credJSONE of - Right (Aeson.Object obj) -> do - -- Try to extract "type" field using Parser - let typeParser = Aeson.withObject "credentials" $ \o -> o Aeson..:? "type" - typeResult = Aeson.parseEither typeParser (Aeson.Object obj) - case typeResult of - Right (Just (Aeson.String "authorized_user")) -> - -- It's ADC format - let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile - in return - $ PubSub.CloudServiceTarget - $ PubSub.CloudConfig renewThreshold authMethod - _ -> - -- Not ADC format, treat as service account - let authMethod = PubSub.ServiceAccountFile credFile - in return - $ PubSub.CloudServiceTarget - $ PubSub.CloudConfig renewThreshold authMethod + -- Try to detect if it's ADC or service account by trying to parse as ADC first + -- We'll use a helper that checks if it can be parsed as ADCCredentials + adcParseResult <- tryParseADC credFile + case adcParseResult of + Just True -> + -- Successfully parsed as ADC with authorized_user type + let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod _ -> - -- Not a JSON object or parse failed, treat as service account + -- Either parsing failed or not ADC format, treat as service account let authMethod = PubSub.ServiceAccountFile credFile in return $ PubSub.CloudServiceTarget From b0d1528a28ade1a94c2922aeb1866e40bbc7990e Mon Sep 17 00:00:00 2001 From: tokict Date: Fri, 31 Oct 2025 18:12:01 +0200 Subject: [PATCH 13/20] Use repository variables instead of secrets for WIF provider and service account --- .github/workflows/stack-cloud.yaml | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/.github/workflows/stack-cloud.yaml b/.github/workflows/stack-cloud.yaml index 236286e..d9555e2 100644 --- a/.github/workflows/stack-cloud.yaml +++ b/.github/workflows/stack-cloud.yaml @@ -14,6 +14,13 @@ jobs: enable-stack: true stack-no-global: true stack-version: "3.3.1" + - id: auth + name: Authenticate to Google Cloud + uses: google-github-actions/auth@v3 + with: + workload_identity_provider: ${{ vars.WIF_PROVIDER }} + service_account: ${{ vars.WIF_SERVICE_ACCOUNT }} + continue-on-error: false - name: Cache Stack Dependencies uses: actions/cache@v4 with: @@ -26,11 +33,6 @@ jobs: - ${{ runner.os }}- - name: Install Dependencies run: stack install --only-dependencies --test - - name: Authenticate to Google Cloud - uses: google-github-actions/auth@v3 - with: - workload_identity_provider: ${{ secrets.WIF_PROVIDER }} - service_account: ${{ secrets.WIF_SERVICE_ACCOUNT }} - name: Run Tests run: stack test env: From d28e1d2baa521d62e93040b2cdeb33f6d1287e96 Mon Sep 17 00:00:00 2001 From: tokict Date: Mon, 3 Nov 2025 09:44:20 +0200 Subject: [PATCH 14/20] Switch GitHub Actions to Workload Identity Federation - Replace service account key file with WIF authentication - Configure google-github-actions/auth@v3 action - Use WIF_PROVIDER and WIF_SERVICE_ACCOUNT from env variables - Set permissions for id-token: write and contents: read - Update actions/cache from v2 to v4 - Add ADC support in Haskell code to work with WIF credentials --- .github/workflows/stack-cloud.yaml | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/.github/workflows/stack-cloud.yaml b/.github/workflows/stack-cloud.yaml index d9555e2..323a563 100644 --- a/.github/workflows/stack-cloud.yaml +++ b/.github/workflows/stack-cloud.yaml @@ -7,6 +7,9 @@ jobs: permissions: contents: read id-token: write + env: + WIF_PROVIDER: projects/PROJECT_NUMBER/locations/global/workloadIdentityPools/github-actions-pool/providers/github-actions-provider + WIF_SERVICE_ACCOUNT: sa-ci-cloud-pubsub@proda-ci.iam.gserviceaccount.com steps: - uses: actions/checkout@v2 - uses: haskell-actions/setup@v2 @@ -18,9 +21,15 @@ jobs: name: Authenticate to Google Cloud uses: google-github-actions/auth@v3 with: - workload_identity_provider: ${{ vars.WIF_PROVIDER }} - service_account: ${{ vars.WIF_SERVICE_ACCOUNT }} - continue-on-error: false + workload_identity_provider: ${{ env.WIF_PROVIDER }} + service_account: ${{ env.WIF_SERVICE_ACCOUNT }} + create_credentials_file: true + export_environment_variables: true + universe: googleapis.com + cleanup_credentials: true + access_token_lifetime: 3600s + access_token_scopes: https://www.googleapis.com/auth/cloud-platform + id_token_include_email: false - name: Cache Stack Dependencies uses: actions/cache@v4 with: From c54e3434d60b55e358bac7feb4ea859f179f7709 Mon Sep 17 00:00:00 2001 From: tokict Date: Mon, 3 Nov 2025 09:46:23 +0200 Subject: [PATCH 15/20] Update WIF provider with actual project number and pool ID --- .github/workflows/stack-cloud.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/stack-cloud.yaml b/.github/workflows/stack-cloud.yaml index 323a563..d50c3eb 100644 --- a/.github/workflows/stack-cloud.yaml +++ b/.github/workflows/stack-cloud.yaml @@ -8,7 +8,7 @@ jobs: contents: read id-token: write env: - WIF_PROVIDER: projects/PROJECT_NUMBER/locations/global/workloadIdentityPools/github-actions-pool/providers/github-actions-provider + WIF_PROVIDER: projects/3367369000/locations/global/workloadIdentityPools/wip-github-yqou WIF_SERVICE_ACCOUNT: sa-ci-cloud-pubsub@proda-ci.iam.gserviceaccount.com steps: - uses: actions/checkout@v2 From 15413866b08df882b0c032bb5e261b6028c97b74 Mon Sep 17 00:00:00 2001 From: tokict Date: Mon, 3 Nov 2025 09:49:00 +0200 Subject: [PATCH 16/20] Simplify WIF configuration by using direct values in action inputs --- .github/workflows/stack-cloud.yaml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/.github/workflows/stack-cloud.yaml b/.github/workflows/stack-cloud.yaml index d50c3eb..c4495d1 100644 --- a/.github/workflows/stack-cloud.yaml +++ b/.github/workflows/stack-cloud.yaml @@ -7,9 +7,6 @@ jobs: permissions: contents: read id-token: write - env: - WIF_PROVIDER: projects/3367369000/locations/global/workloadIdentityPools/wip-github-yqou - WIF_SERVICE_ACCOUNT: sa-ci-cloud-pubsub@proda-ci.iam.gserviceaccount.com steps: - uses: actions/checkout@v2 - uses: haskell-actions/setup@v2 @@ -21,8 +18,8 @@ jobs: name: Authenticate to Google Cloud uses: google-github-actions/auth@v3 with: - workload_identity_provider: ${{ env.WIF_PROVIDER }} - service_account: ${{ env.WIF_SERVICE_ACCOUNT }} + workload_identity_provider: projects/3367369000/locations/global/workloadIdentityPools/wip-github-yqou + service_account: sa-ci-cloud-pubsub@proda-ci.iam.gserviceaccount.com create_credentials_file: true export_environment_variables: true universe: googleapis.com From bb44a5f7f8678cf74f89d8ab688c04a1143c218e Mon Sep 17 00:00:00 2001 From: tokict Date: Mon, 3 Nov 2025 09:52:00 +0200 Subject: [PATCH 17/20] Add provider ID to WIF provider path --- .github/workflows/stack-cloud.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/stack-cloud.yaml b/.github/workflows/stack-cloud.yaml index c4495d1..5420092 100644 --- a/.github/workflows/stack-cloud.yaml +++ b/.github/workflows/stack-cloud.yaml @@ -18,7 +18,7 @@ jobs: name: Authenticate to Google Cloud uses: google-github-actions/auth@v3 with: - workload_identity_provider: projects/3367369000/locations/global/workloadIdentityPools/wip-github-yqou + workload_identity_provider: projects/3367369000/locations/global/workloadIdentityPools/wip-github-yqou/providers/wip-provider-github service_account: sa-ci-cloud-pubsub@proda-ci.iam.gserviceaccount.com create_credentials_file: true export_environment_variables: true From ae9d75e63affdb812d3d8c9f0f16a86fd33ef53f Mon Sep 17 00:00:00 2001 From: tokict Date: Mon, 3 Nov 2025 10:14:32 +0200 Subject: [PATCH 18/20] Fix credential type detection to handle ADC credentials from WIF - Update TestHelpers.hs to properly detect ADC vs ServiceAccount credentials - Update AuthSpec.hs to try ADC parsing before ServiceAccount - Prevents errors when WIF creates ADC credentials that were being parsed as ServiceAccount --- test/Cloud/PubSub/AuthSpec.hs | 22 +++++++++++++----- test/Cloud/PubSub/TestHelpers.hs | 38 +++++++++++++++++++++----------- 2 files changed, 42 insertions(+), 18 deletions(-) diff --git a/test/Cloud/PubSub/AuthSpec.hs b/test/Cloud/PubSub/AuthSpec.hs index a648b81..8680f51 100644 --- a/test/Cloud/PubSub/AuthSpec.hs +++ b/test/Cloud/PubSub/AuthSpec.hs @@ -2,6 +2,8 @@ module Cloud.PubSub.AuthSpec where import qualified Cloud.PubSub.Auth as Auth import qualified Cloud.PubSub.Auth.Types as AuthT +import qualified Data.Aeson as Aeson +import qualified Data.Text as Text import qualified Network.HTTP.Client as HttpClient import qualified System.Environment as SystemEnv import qualified Network.HTTP.Client.TLS as HttpClientTLS @@ -14,11 +16,21 @@ tokenGetTest = do Just _ -> pendingWith "skipping as auth not supported in emulator" Nothing -> do SystemEnv.lookupEnv "GOOGLE_APPLICATION_CREDENTIALS" >>= \case - Just serviceAccountPath -> do - serviceAccount <- Auth.readServiceAccountFile serviceAccountPath - tokenResponse <- Auth.fetchToken manager serviceAccount scope - AuthT.tokenType tokenResponse `shouldBe` "Bearer" - AuthT.expiresIn tokenResponse `shouldSatisfy` (\t -> 3595 < t && t < 3600) + Just credPath -> do + -- Try ADC first + adcResult <- Aeson.eitherDecodeFileStrict credPath :: IO (Either String (Auth.ADCCredentials)) + case adcResult of + Right adcCreds | Auth.adcType adcCreds == Text.pack "authorized_user" -> do + adc <- Auth.readApplicationDefaultCredentialsFile credPath + tokenResponse <- Auth.fetchApplicationDefaultCredentialsToken manager adc scope + AuthT.tokenType tokenResponse `shouldBe` "Bearer" + AuthT.expiresIn tokenResponse `shouldSatisfy` (\t -> 3595 < t && t < 3600) + _ -> do + -- Try as ServiceAccount + serviceAccount <- Auth.readServiceAccountFile credPath + tokenResponse <- Auth.fetchToken manager serviceAccount scope + AuthT.tokenType tokenResponse `shouldBe` "Bearer" + AuthT.expiresIn tokenResponse `shouldSatisfy` (\t -> 3595 < t && t < 3600) Nothing -> do -- Try metadata server tokenResponse <- Auth.fetchMetadataToken manager scope diff --git a/test/Cloud/PubSub/TestHelpers.hs b/test/Cloud/PubSub/TestHelpers.hs index 5058e9b..f236534 100644 --- a/test/Cloud/PubSub/TestHelpers.hs +++ b/test/Cloud/PubSub/TestHelpers.hs @@ -2,6 +2,7 @@ module Cloud.PubSub.TestHelpers where import qualified Cloud.PubSub as PubSub import qualified Cloud.PubSub.Auth as Auth +import qualified Cloud.PubSub.Auth.Types as AuthT import Cloud.PubSub.Core.Types ( Message(..) , TopicName ) @@ -156,13 +157,22 @@ getProjectId = fmap (Core.ProjectId . Text.pack) <$> SystemEnv.lookupEnv "PROJECT_ID" -- Helper to check if a file contains ADC credentials -tryParseADC :: FilePath -> IO (Maybe Bool) -tryParseADC filePath = do - result <- Aeson.eitherDecodeFileStrict filePath :: IO (Either String (Auth.ADCCredentials)) - case result of +-- Returns: Just True if ADC, Just False if ServiceAccount, Nothing if neither +detectCredentialType :: FilePath -> IO (Maybe Bool) +detectCredentialType filePath = do + -- First try to parse as ADC + adcResult <- Aeson.eitherDecodeFileStrict filePath :: IO (Either String (Auth.ADCCredentials)) + case adcResult of Right (Auth.ADCCredentials t _ _ _) -> - return $ Just (t == Text.pack "authorized_user") - Left _ -> return Nothing + if t == Text.pack "authorized_user" + then return $ Just True -- It's ADC + else return Nothing -- Unknown type in ADC format + Left _ -> do + -- Try to parse as ServiceAccount + saResult <- Aeson.eitherDecodeFileStrict filePath :: IO (Either String (AuthT.ServiceAccount)) + case saResult of + Right _ -> return $ Just False -- It's a ServiceAccount + Left _ -> return Nothing -- Can't parse as either getPubSubTarget :: NominalDiffTime -> IO PubSub.PubSubTarget getPubSubTarget renewThreshold = do @@ -175,22 +185,24 @@ getPubSubTarget renewThreshold = do maybeCredFile <- SystemEnv.lookupEnv "GOOGLE_APPLICATION_CREDENTIALS" case maybeCredFile of Just credFile -> do - -- Try to detect if it's ADC or service account by trying to parse as ADC first - -- We'll use a helper that checks if it can be parsed as ADCCredentials - adcParseResult <- tryParseADC credFile - case adcParseResult of + -- Try to detect if it's ADC or service account + credType <- detectCredentialType credFile + case credType of Just True -> - -- Successfully parsed as ADC with authorized_user type + -- It's ADC let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile in return $ PubSub.CloudServiceTarget $ PubSub.CloudConfig renewThreshold authMethod - _ -> - -- Either parsing failed or not ADC format, treat as service account + Just False -> + -- It's a ServiceAccount let authMethod = PubSub.ServiceAccountFile credFile in return $ PubSub.CloudServiceTarget $ PubSub.CloudConfig renewThreshold authMethod + Nothing -> + -- Can't determine type, give helpful error + error $ "Could not parse credentials file as ADC or ServiceAccount: " <> credFile Nothing -> do -- Try default ADC location if GOOGLE_APPLICATION_CREDENTIALS not set maybeHome <- SystemEnv.lookupEnv "HOME" From cb3b248f5c1c3bd8279bad7b3f498e0c79c59a64 Mon Sep 17 00:00:00 2001 From: tokict Date: Mon, 3 Nov 2025 10:55:03 +0200 Subject: [PATCH 19/20] Improve credential file detection and error messages for WIF - Update credential type detection to check ServiceAccount first (has required fields) - Add fallback to treat unrecognized credential files as ADC with better error messages - Improve error messages in readApplicationDefaultCredentialsFile to show credential type when parsing fails - Handle cases where google-github-actions/auth creates impersonated_service_account format --- src/Cloud/PubSub/Auth.hs | 34 ++++++++++++++++----- test/Cloud/PubSub/TestHelpers.hs | 52 +++++++++++++++++++++++--------- 2 files changed, 63 insertions(+), 23 deletions(-) diff --git a/src/Cloud/PubSub/Auth.hs b/src/Cloud/PubSub/Auth.hs index 4cbcc4e..a70d6d1 100644 --- a/src/Cloud/PubSub/Auth.hs +++ b/src/Cloud/PubSub/Auth.hs @@ -44,14 +44,32 @@ instance Aeson.FromJSON ADCCredentials where readApplicationDefaultCredentialsFile :: MonadIO m => FilePath -> m AuthT.ApplicationDefaultCredentials readApplicationDefaultCredentialsFile fp = liftIO $ do - adc <- Aeson.eitherDecodeFileStrict fp >>= either fail return - if adcType adc == "authorized_user" - then return $ AuthT.ApplicationDefaultCredentials - { AuthT.adcClientId = adcClientId adc - , AuthT.adcClientSecret = adcClientSecret adc - , AuthT.adcRefreshToken = adcRefreshToken adc - } - else fail $ "Unsupported ADC credentials type: " <> Text.unpack (adcType adc) + result <- Aeson.eitherDecodeFileStrict fp :: IO (Either String ADCCredentials) + case result of + Right adc | adcType adc == Text.pack "authorized_user" -> + return $ AuthT.ApplicationDefaultCredentials + { AuthT.adcClientId = adcClientId adc + , AuthT.adcClientSecret = adcClientSecret adc + , AuthT.adcRefreshToken = adcRefreshToken adc + } + Right adc -> + fail $ "Unsupported ADC credentials type: " <> Text.unpack (adcType adc) <> + ". Only 'authorized_user' type is supported. For WIF/impersonated service accounts," <> + " please use environment variables or a supported credential format." + Left err -> do + -- Try to read as raw JSON to provide better error message + rawResult <- Aeson.eitherDecodeFileStrict fp :: IO (Either String Aeson.Value) + case rawResult of + Right (Aeson.Object obj) -> + case Aeson.lookup "type" obj of + Just (Aeson.String credType) -> + fail $ "Unsupported credential type: " <> Text.unpack credType <> + ". Expected 'authorized_user' ADC format with client_id, client_secret, and refresh_token fields." + _ -> + fail $ "Could not parse credentials file. Expected ADC format with 'authorized_user' type. " <> + "Parse error: " <> err + _ -> + fail $ "Could not parse credentials file as JSON. Parse error: " <> err createAssertionTokenBody :: AuthT.PrivateKeyId -> AuthT.TokenClaims -> ByteString diff --git a/test/Cloud/PubSub/TestHelpers.hs b/test/Cloud/PubSub/TestHelpers.hs index f236534..0dfaa32 100644 --- a/test/Cloud/PubSub/TestHelpers.hs +++ b/test/Cloud/PubSub/TestHelpers.hs @@ -160,19 +160,31 @@ getProjectId = -- Returns: Just True if ADC, Just False if ServiceAccount, Nothing if neither detectCredentialType :: FilePath -> IO (Maybe Bool) detectCredentialType filePath = do - -- First try to parse as ADC - adcResult <- Aeson.eitherDecodeFileStrict filePath :: IO (Either String (Auth.ADCCredentials)) - case adcResult of - Right (Auth.ADCCredentials t _ _ _) -> - if t == Text.pack "authorized_user" - then return $ Just True -- It's ADC - else return Nothing -- Unknown type in ADC format + -- First try to parse as ServiceAccount (has required fields that ADC doesn't) + saResult <- Aeson.eitherDecodeFileStrict filePath :: IO (Either String (AuthT.ServiceAccount)) + case saResult of + Right _ -> return $ Just False -- It's a ServiceAccount Left _ -> do - -- Try to parse as ServiceAccount - saResult <- Aeson.eitherDecodeFileStrict filePath :: IO (Either String (AuthT.ServiceAccount)) - case saResult of - Right _ -> return $ Just False -- It's a ServiceAccount - Left _ -> return Nothing -- Can't parse as either + -- Try to parse as ADC (authorized_user type) + adcResult <- Aeson.eitherDecodeFileStrict filePath :: IO (Either String (Auth.ADCCredentials)) + case adcResult of + Right (Auth.ADCCredentials t _ _ _) -> + if t == Text.pack "authorized_user" + then return $ Just True -- It's ADC with authorized_user + else return $ Just True -- It's ADC but different type (e.g. impersonated_service_account), treat as ADC + Left _ -> do + -- Try to read as raw JSON to check for type field + rawResult <- Aeson.eitherDecodeFileStrict filePath :: IO (Either String Aeson.Value) + case rawResult of + Right (Aeson.Object obj) -> do + -- Check if it has a "type" field that suggests it's some form of credentials + case Aeson.lookup "type" obj of + Just (Aeson.String credType) -> + if credType == Text.pack "service_account" + then return $ Just False -- It's a ServiceAccount (but parsing failed for some reason) + else return $ Just True -- It's some form of ADC or credential file + _ -> return Nothing -- No type field, can't determine + _ -> return Nothing -- Not an object, can't parse getPubSubTarget :: NominalDiffTime -> IO PubSub.PubSubTarget getPubSubTarget renewThreshold = do @@ -200,9 +212,19 @@ getPubSubTarget renewThreshold = do in return $ PubSub.CloudServiceTarget $ PubSub.CloudConfig renewThreshold authMethod - Nothing -> - -- Can't determine type, give helpful error - error $ "Could not parse credentials file as ADC or ServiceAccount: " <> credFile + Nothing -> do + -- Can't parse as either format, but file exists + -- This might be a WIF credentials file (e.g. impersonated_service_account type) + -- The google-github-actions/auth action creates credential files that Google's + -- client libraries can use but our custom parser doesn't support yet. + -- Since we can't parse it, we'll try to use it anyway - the error will be more + -- helpful if it fails. In practice, this should work with gcloud CLI or + -- Google's client libraries, but our custom implementation needs the file format. + -- For now, treat it as ADC and let readApplicationDefaultCredentialsFile handle the error. + let authMethod = PubSub.ApplicationDefaultCredentialsFile credFile + in return + $ PubSub.CloudServiceTarget + $ PubSub.CloudConfig renewThreshold authMethod Nothing -> do -- Try default ADC location if GOOGLE_APPLICATION_CREDENTIALS not set maybeHome <- SystemEnv.lookupEnv "HOME" From 7321febfa965af92a63d05daf77c8b0148086193 Mon Sep 17 00:00:00 2001 From: tokict Date: Mon, 3 Nov 2025 11:11:10 +0200 Subject: [PATCH 20/20] Fix Aeson.lookup error - use HashMap.lookup for Aeson.Object --- src/Cloud/PubSub/Auth.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Cloud/PubSub/Auth.hs b/src/Cloud/PubSub/Auth.hs index a70d6d1..ac0f7b3 100644 --- a/src/Cloud/PubSub/Auth.hs +++ b/src/Cloud/PubSub/Auth.hs @@ -14,6 +14,7 @@ import Crypto.PubKey.RSA ( PrivateKey ) import qualified Crypto.PubKey.RSA.PKCS15 as RSA import qualified Data.Aeson as Aeson import Data.Aeson ( (.=) ) +import qualified Data.HashMap.Strict as HashMap import Data.ByteString ( ByteString ) import qualified Data.ByteString.Base64.URL as Base64 import qualified Data.ByteString.Lazy as LBS @@ -61,7 +62,7 @@ readApplicationDefaultCredentialsFile fp = liftIO $ do rawResult <- Aeson.eitherDecodeFileStrict fp :: IO (Either String Aeson.Value) case rawResult of Right (Aeson.Object obj) -> - case Aeson.lookup "type" obj of + case HashMap.lookup (Text.pack "type") obj of Just (Aeson.String credType) -> fail $ "Unsupported credential type: " <> Text.unpack credType <> ". Expected 'authorized_user' ADC format with client_id, client_secret, and refresh_token fields."