diff --git a/lib/mobility-core/src/Kernel/External/MasterCloudForward.hs b/lib/mobility-core/src/Kernel/External/MasterCloudForward.hs index e8adc4e31..5356094a3 100644 --- a/lib/mobility-core/src/Kernel/External/MasterCloudForward.hs +++ b/lib/mobility-core/src/Kernel/External/MasterCloudForward.hs @@ -26,6 +26,7 @@ module Kernel.External.MasterCloudForward ForwardAPI, forwardAPI, runThroughMasterCloud, + shouldForwardToCloud, getRunApiInMasterCloud, forwardEgressApp, ) @@ -48,6 +49,8 @@ import qualified Kernel.Tools.Metrics.CoreMetrics as Metrics import Kernel.Types.Common import Kernel.Types.Error.BaseError import Kernel.Types.Error.BaseError.HTTPError +import Kernel.Types.Version (CloudType (..)) +import Kernel.Utils.App (lookupCloudType) import Kernel.Utils.Dhall (FromDhall) import qualified Kernel.Utils.IOLogging as IOLog import Kernel.Utils.Logging @@ -134,9 +137,16 @@ getRunApiInMasterCloud = do envVal <- lookupEnv "RUN_API_IN_MASTER_CLOUD" pure (fromMaybe False (readMaybe =<< envVal)) --- Drop-in replacement for @callAPI@. Quad-gated: caller flag on + --- masterUrl set + masterSecret set → forwarded. Anything else → direct call. --- flag is for city specific forwarder. +-- | Forward iff a target cloud is configured and differs from this pod's own +-- cloud. A 'Nothing' target (or a target of 'UNAVAILABLE') never forwards. +shouldForwardToCloud :: CloudType -> Maybe CloudType -> Bool +shouldForwardToCloud currentCloud targetCloud = case targetCloud of + Just target -> target /= UNAVAILABLE && currentCloud /= target + Nothing -> False + +-- Drop-in replacement for @callAPI@. Triple-gated: caller's target cloud +-- differs from this pod's cloud + masterUrl set + masterSecret set → +-- forwarded. Anything else → direct call. runThroughMasterCloud :: ( HasMasterCloudForwarder r, MonadReader r m, @@ -145,16 +155,17 @@ runThroughMasterCloud :: Metrics.CoreMetrics m, HasRequestId r ) => + Maybe CloudType -> BaseUrl -> ET.EulerClient a -> Text -> - Bool -> m (Either ClientError a) -runThroughMasterCloud origBaseUrl eClient desc shouldForward = do +runThroughMasterCloud runInCloud origBaseUrl eClient desc = do + currentCloud <- liftIO lookupCloudType cfg <- asks masterCloudProxyConfig - case (shouldForward, cfg.masterUrl, cfg.masterSecret) of + case (shouldForwardToCloud currentCloud runInCloud, cfg.masterUrl, cfg.masterSecret) of (True, Just fwdUrl, Just secret) -> do - logDebug $ "MASTER_CLOUD_FORWARD: forwarding " <> desc <> " via " <> showBaseUrlText fwdUrl + logDebug $ "MASTER_CLOUD_FORWARD: forwarding " <> desc <> " to " <> show runInCloud <> " via " <> showBaseUrlText fwdUrl interpretWithForwarder origBaseUrl fwdUrl secret eClient _ -> do logDebug $ "MASTER_CLOUD_FORWARD: direct call for " <> desc diff --git a/lib/mobility-core/test-integration/Main.hs b/lib/mobility-core/test-integration/Main.hs index 7ef90422e..0fde41346 100644 --- a/lib/mobility-core/test-integration/Main.hs +++ b/lib/mobility-core/test-integration/Main.hs @@ -49,6 +49,7 @@ import qualified Kernel.Streaming.Kafka.Producer.Types as Kafka import qualified Kernel.Tools.Metrics.CoreMetrics.Types as Metrics import qualified Kernel.Types.Flow as KFlow import Kernel.Types.Logging (LogLevel (..), LoggerConfig (..)) +import Kernel.Types.Version (CloudType (..)) import qualified Kernel.Utils.IOLogging as IOLogging import Kernel.Utils.Servant.Client (callAPI) import qualified Network.HTTP.Client as Http @@ -193,7 +194,7 @@ main = do setEnv "RUN_API_IN_MASTER_CLOUD" "True" rForwarded <- KFlow.runFlowR flowRt env $ - runThroughMasterCloud todoBaseUrl (getTodoClient 1) "getTodo-forwarded" True + runThroughMasterCloud (Just AWS) todoBaseUrl (getTodoClient 1) "getTodo-forwarded" -- Compare. case (rDirect, rForwarded) of