diff --git a/server/lib/api-tests/api-tests.cabal b/server/lib/api-tests/api-tests.cabal index e6693f6a908..a6defb8953e 100644 --- a/server/lib/api-tests/api-tests.cabal +++ b/server/lib/api-tests/api-tests.cabal @@ -204,6 +204,7 @@ library Test.Regression.StreamConflictSpec Test.Regression.UsingTheSameFunctionForRootFieldAndComputedField8643Spec Test.Regression.SqlServerIdentifierQuotingSpec + Test.ScheduledEvents.ScheduledEventsInvalidEnvVarSpec Test.Schema.ComputedFields.ScalarSpec Test.Schema.ComputedFields.TableSpec Test.Schema.ConflictsSpec diff --git a/server/lib/api-tests/src/Test/ScheduledEvents/ScheduledEventsInvalidEnvVarSpec.hs b/server/lib/api-tests/src/Test/ScheduledEvents/ScheduledEventsInvalidEnvVarSpec.hs new file mode 100644 index 00000000000..57430b67976 --- /dev/null +++ b/server/lib/api-tests/src/Test/ScheduledEvents/ScheduledEventsInvalidEnvVarSpec.hs @@ -0,0 +1,131 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ViewPatterns #-} + +-- | Test that scheduled triggers with invalid/missing env vars adds (errored) invocation logs +module Test.ScheduledEvents.ScheduledEventsInvalidEnvVarSpec (spec) where + +import Control.Concurrent.Extended (sleep) +import Data.Aeson +import Data.Aeson.KeyMap qualified as KM +import Data.List.NonEmpty qualified as NE +import Harness.Backend.Postgres qualified as Postgres +import Harness.GraphqlEngine qualified as GraphqlEngine +import Harness.Quoter.Yaml +import Harness.Test.Fixture qualified as Fixture +import Harness.Test.Schema (Table (..), table) +import Harness.Test.Schema qualified as Schema +import Harness.Test.SetupAction (SetupAction (..), permitTeardownFail) +import Harness.TestEnvironment (GlobalTestEnvironment, TestEnvironment) +import Harness.Webhook qualified as Webhook +import Harness.Yaml (fromObject) +import Hasura.Prelude +import Test.Hspec (SpecWith, describe, it, shouldBe) + +-------------------------------------------------------------------------------- +-- Preamble + +spec :: SpecWith GlobalTestEnvironment +spec = + Fixture.runWithLocalTestEnvironment + ( NE.fromList + [ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata) + { -- setup the webhook server as the local test environment, + -- so that the server can be referenced while testing + Fixture.mkLocalTestEnvironment = const Webhook.run, + Fixture.setupTeardown = \(testEnvironment, (webhookServer, _)) -> + [ permitTeardownFail (setupTableAction' testEnvironment), + Fixture.SetupAction + { Fixture.setupAction = postgresSetup testEnvironment webhookServer, + Fixture.teardownAction = \_ -> pure () + } + ] + } + ] + ) + tests + where + setupTableAction' testEnvironment = + -- setup a source named "default" and create and then track the "authors" + -- table in it. + SetupAction + ( do + GraphqlEngine.setSource testEnvironment (Postgres.defaultNamedSourceMetadata testEnvironment) Nothing + Postgres.createTable testEnvironment (authorsTable "authors") + Schema.trackTable "default" (authorsTable "authors") testEnvironment + ) + (const $ GraphqlEngine.setSources testEnvironment mempty Nothing) + +-------------------------------------------------------------------------------- + +-- * Backend + +authorsTable :: Text -> Schema.Table +authorsTable tableName = + (table tableName) + { tableColumns = + [ Schema.column "id" Schema.TInt, + Schema.column "name" Schema.TStr + ], + tablePrimaryKey = ["id"], + tableData = + [ [Schema.VInt 1, Schema.VStr "Author 1"], + [Schema.VInt 2, Schema.VStr "Author 2"] + ] + } + +-------------------------------------------------------------------------------- +-- Tests + +tests :: Fixture.Options -> SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue)) +tests _opts = do + scheduledEventsWithInvalidEnvVar + +scheduledEventsWithInvalidEnvVar :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue)) +scheduledEventsWithInvalidEnvVar = + describe "creating a scheduled event with invalid env var should add a failed invocation log" do + it "check the invocation log requests added for failed request corresponding to invalid header" $ + \(testEnvironment, (_, _)) -> do + -- get all the scheduled event invocations + let getScheduledEventInvocationsQuery = + [yaml| + type: get_scheduled_event_invocations + args: + type: one_off + |] + + -- wait for all scheduled event retries to complete + sleep $ seconds 20 + + apiRes <- GraphqlEngine.postMetadata testEnvironment getScheduledEventInvocationsQuery + + -- get the number of invocations present + let resArray = KM.lookup "invocations" $ fromObject apiRes + resLength = case resArray of + Just (Array arr) -> length arr + _ -> 0 + + -- a scheduled event with 1 retry (and invalid header) should add 2 invocation logs + resLength `shouldBe` 2 + +-------------------------------------------------------------------------------- + +-- ** Setup override + +postgresSetup :: TestEnvironment -> GraphqlEngine.Server -> IO () +postgresSetup testEnvironment webhookServer = do + let webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo" + GraphqlEngine.postMetadata_ testEnvironment $ + [interpolateYaml| + type: create_scheduled_event + args: + webhook: #{webhookServerEchoEndpoint} + schedule_at: '2023-03-06T13:36:00Z' + payload: + test: 1 + headers: + - name: test_header + value_from_env: invalid_envvar3 + retry_conf: + num_retries: 1 + retry_interval_seconds: 5 + |] diff --git a/server/src-lib/Data/URL/Template.hs b/server/src-lib/Data/URL/Template.hs index 64156e7870b..1223b253ff0 100644 --- a/server/src-lib/Data/URL/Template.hs +++ b/server/src-lib/Data/URL/Template.hs @@ -66,15 +66,11 @@ parseURLTemplate t = parseOnly parseTemplate t parseVariable = string "{{" *> (Variable . T.pack <$> manyTill anyChar (string "}}")) -renderURLTemplate :: Env.Environment -> URLTemplate -> Either String Text +renderURLTemplate :: Env.Environment -> URLTemplate -> Either Text Text renderURLTemplate env template = case errorVariables of [] -> Right $ T.concat $ rights eitherResults - _ -> - Left $ - T.unpack $ - "Value for environment variables not found: " - <> commaSeparated errorVariables + _ -> Left (commaSeparated errorVariables) where eitherResults = map renderTemplateItem $ unURLTemplate template errorVariables = lefts eitherResults diff --git a/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs b/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs index 03edf1eb81b..749ed370e95 100644 --- a/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs +++ b/server/src-lib/Hasura/Eventing/ScheduledTrigger.hs @@ -132,7 +132,9 @@ import Data.Int (Int64) import Data.List.NonEmpty qualified as NE import Data.SerializableBlob qualified as SB import Data.Set qualified as Set -import Data.Text.Extended ((<<>)) +import Data.Text qualified as T +import Data.Text.Extended (ToTxt (..), (<<>)) +import Data.These import Data.Time.Clock import Data.URL.Template (printURLTemplate) import Database.PG.Query qualified as PG @@ -147,7 +149,7 @@ import Hasura.HTTP (getHTTPExceptionStatus) import Hasura.Logging qualified as L import Hasura.Metadata.Class import Hasura.Prelude -import Hasura.RQL.DDL.EventTrigger (getHeaderInfosFromConf) +import Hasura.RQL.DDL.EventTrigger (ResolveHeaderError, getHeaderInfosFromConfEither) import Hasura.RQL.DDL.Headers import Hasura.RQL.DDL.Webhook.Transform import Hasura.RQL.Types.Common @@ -305,9 +307,6 @@ processOneOffScheduledEvents saveLockedEvents (map _ooseId oneOffEvents) lockedOneOffScheduledEvents for_ oneOffEvents $ \OneOffScheduledEvent {..} -> do (either logInternalError pure) =<< runExceptT do - webhookInfo <- resolveWebhook env _ooseWebhookConf - headerInfo <- getHeaderInfosFromConf env _ooseHeaderConf - let payload = ScheduledEventWebhookPayload _ooseId @@ -319,13 +318,43 @@ processOneOffScheduledEvents _ooseRequestTransform _ooseResponseTransform retryCtx = RetryContext _ooseTries _ooseRetryConf - webhookEnvRecord = EnvRecord (getTemplateFromUrl _ooseWebhookConf) webhookInfo - flip runReaderT (logger, httpMgr) $ - processScheduledEvent prometheusMetrics _ooseId headerInfo retryCtx payload webhookEnvRecord OneOff - removeEventFromLockedEvents _ooseId lockedOneOffScheduledEvents + resolvedWebhookInfoEither = resolveWebhookEither env _ooseWebhookConf + resolvedHeaderInfoEither = getHeaderInfosFromConfEither env _ooseHeaderConf + -- `webhookAndHeaderInfo` returns webhook and header info (and errors) + webhookAndHeaderInfo = case (resolvedWebhookInfoEither, resolvedHeaderInfoEither) of + (Right resolvedEventWebhookInfo, Right resolvedEventHeaderInfo) -> do + let resolvedWebhookEnvRecord = EnvRecord (getTemplateFromUrl _ooseWebhookConf) resolvedEventWebhookInfo + Right (resolvedWebhookEnvRecord, resolvedEventHeaderInfo) + (Left eventWebhookErrorVars, Right _) -> Left $ This eventWebhookErrorVars + (Right _, Left eventHeaderErrorVars) -> Left $ That eventHeaderErrorVars + (Left eventWebhookErrors, Left eventHeaderErrorVars) -> Left $ These eventWebhookErrors eventHeaderErrorVars + case webhookAndHeaderInfo of + Right (webhookEnvRecord, eventHeaderInfo) -> do + flip runReaderT (logger, httpMgr) $ + processScheduledEvent prometheusMetrics _ooseId eventHeaderInfo retryCtx payload webhookEnvRecord OneOff + removeEventFromLockedEvents _ooseId lockedOneOffScheduledEvents + Left envVarError -> + processError + _ooseId + retryCtx + [] + OneOff + (mkErrorObject $ mkInvalidEnvVarErrMsg envVarError) + (HOther $ T.unpack $ qeError (err400 NotFound (mkInvalidEnvVarErrMsg envVarError))) where logInternalError err = liftIO . L.unLogger logger $ ScheduledTriggerInternalErr err getTemplateFromUrl url = printURLTemplate $ unInputWebhook url + mkInvalidEnvVarErrMsg envVarErrorValues = "The value for environment variables not found: " <> (getInvalidEnvVarText envVarErrorValues) + mkErrorObject envVarNameText = + J.object + [ "error" + J..= ( "Error creating the request. " <> envVarNameText + ) + ] + getInvalidEnvVarText :: These ResolveWebhookError ResolveHeaderError -> Text + getInvalidEnvVarText (This a) = toTxt a + getInvalidEnvVarText (That b) = toTxt b + getInvalidEnvVarText (These a b) = toTxt a <> ", " <> toTxt b processScheduledTriggers :: ( MonadIO m, diff --git a/server/src-lib/Hasura/RQL/DDL/EventTrigger.hs b/server/src-lib/Hasura/RQL/DDL/EventTrigger.hs index 1c72397812a..e6e435e5794 100644 --- a/server/src-lib/Hasura/RQL/DDL/EventTrigger.hs +++ b/server/src-lib/Hasura/RQL/DDL/EventTrigger.hs @@ -11,7 +11,9 @@ module Hasura.RQL.DDL.EventTrigger InvokeEventTriggerQuery, runInvokeEventTrigger, -- TODO(from master): review + ResolveHeaderError (..), getHeaderInfosFromConf, + getHeaderInfosFromConfEither, getWebhookInfoFromConf, buildEventTriggerInfo, getSourceTableAndTriggers, @@ -46,6 +48,7 @@ where import Control.Lens (ifor_, makeLenses, (.~)) import Data.Aeson +import Data.Either.Combinators import Data.Environment qualified as Env import Data.Has (Has) import Data.HashMap.Strict qualified as HM @@ -452,6 +455,12 @@ askEventTriggerInfo sourceName triggerName = do maxTriggerNameLength :: Int maxTriggerNameLength = 42 +-- Consists of a list of environment variables with invalid/missing values +newtype ResolveHeaderError = ResolveHeaderError {unResolveHeaderError :: [Text]} deriving (Show) + +instance ToTxt ResolveHeaderError where + toTxt = commaSeparated . unResolveHeaderError + getHeaderInfosFromConf :: QErrM m => Env.Environment -> @@ -466,6 +475,24 @@ getHeaderInfosFromConf env = mapM getHeader envVal <- getEnv env val return $ EventHeaderInfo hconf envVal +-- This is similar to `getHeaderInfosFromConf` but it doesn't fail when an env var is invalid +getHeaderInfosFromConfEither :: + Env.Environment -> + [HeaderConf] -> + Either ResolveHeaderError [EventHeaderInfo] +getHeaderInfosFromConfEither env hConfList = + if isHeaderError + then Left (ResolveHeaderError $ lefts headerInfoList) + else Right (rights headerInfoList) + where + isHeaderError = any isLeft headerInfoList + headerInfoList = map getHeader hConfList + getHeader :: HeaderConf -> Either Text EventHeaderInfo + getHeader hconf = case hconf of + (HeaderConf _ (HVValue val)) -> Right $ EventHeaderInfo hconf val + (HeaderConf _ (HVEnv val)) -> + (Right . EventHeaderInfo hconf) =<< getEnvEither env val + getWebhookInfoFromConf :: QErrM m => Env.Environment -> diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index af46fa7259a..ca4046b97b6 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -19,12 +19,15 @@ module Hasura.RQL.Types.Common failureMsg, InputWebhook (..), ResolvedWebhook (..), + ResolveWebhookError (..), resolveWebhook, + resolveWebhookEither, Timeout (..), defaultActionTimeoutSecs, UrlConf (..), resolveUrlConf, getEnv, + getEnvEither, SourceName (..), defaultSource, sourceNameToText, @@ -341,13 +344,20 @@ instance PG.FromCol InputWebhook where urlTemplate <- parseURLTemplate <$> PG.fromCol bs bimap (\e -> "Parsing URL template failed: " <> T.pack e) InputWebhook urlTemplate +-- Consists of the environment variable name with missing/invalid value +newtype ResolveWebhookError = ResolveWebhookError {unResolveWebhookError :: Text} deriving (Show, ToTxt) + resolveWebhook :: QErrM m => Env.Environment -> InputWebhook -> m ResolvedWebhook -resolveWebhook env (InputWebhook urlTemplate) = do - let eitherRenderedTemplate = renderURLTemplate env urlTemplate - either - (throw400 Unexpected . T.pack) - (pure . ResolvedWebhook) +resolveWebhook env inputWebhook = do + let eitherRenderedTemplate = resolveWebhookEither env inputWebhook + onLeft eitherRenderedTemplate + (throw400 Unexpected . ("Value for environment variables not found: " <>) . unResolveWebhookError) + +-- This is similar to `resolveWebhook` but it doesn't fail when an env var is invalid +resolveWebhookEither :: Env.Environment -> InputWebhook -> Either ResolveWebhookError ResolvedWebhook +resolveWebhookEither env (InputWebhook urlTemplate) = + bimap ResolveWebhookError ResolvedWebhook (renderURLTemplate env urlTemplate) newtype Timeout = Timeout {unTimeout :: Int} deriving (Show, Eq, ToJSON, Generic, NFData) @@ -546,10 +556,17 @@ resolveUrlConf env = \case getEnv :: QErrM m => Env.Environment -> Text -> m Text getEnv env k = do - let mEnv = Env.lookupEnv env (T.unpack k) - case mEnv of - Nothing -> throw400 NotFound $ "environment variable '" <> k <> "' not set" - Just envVal -> return (T.pack envVal) + let eitherEnv = getEnvEither env k + onLeft + eitherEnv + (\_ -> throw400 NotFound $ "environment variable '" <> k <> "' not set") + +-- This is similar to `getEnv` but it doesn't fail when the env var is invalid +getEnvEither :: Env.Environment -> Text -> Either Text Text +getEnvEither env k = + case Env.lookupEnv env (T.unpack k) of + Nothing -> Left k + Just envVal -> Right (T.pack envVal) -- | Various user-controlled configuration for metrics used by Pro data MetricsConfig = MetricsConfig