Allows for mock env vars in test-webhook-transform endpoint

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/3097
Co-authored-by: Lyndon Maydwell <92299+sordina@users.noreply.github.com>
GitOrigin-RevId: f0cd00b8f972a1b96213bd098ea09d72b3aba723

CHANGELOG.md

@@ -3,8 +3,8 @@
 ## Next release
 (Add highlights/major features below)
 
+- server: allows the use of mock env vars in the `test_webhook_transform` metadata API action
 - server: fix event invocation logs to include transformed request bodies (fix #2983)
-- server: allows the use of env vars in the `test_webhook_transform` metadata API action
 - server: fix aggregate queries with nodes field in selection set for sql server (fix #7871)
 - server: fix permissions are not respected for aggregations in sql server (fix #7773)
 - server: the syntax for remote relationships in metadata is changed to be

server/src-lib/Data/Environment.hs

@@ -16,7 +16,7 @@ import Hasura.Prelude
 import System.Environment qualified
 
 -- | Server process environment variables
-newtype Environment = Environment (M.Map String String) deriving (Eq, Show, Generic)
+newtype Environment = Environment (M.Map String String) deriving (Eq, Show, Generic, ToJSON, Semigroup, Monoid)
 
 instance FromJSON Environment
 

server/src-lib/Hasura/RQL/DDL/Metadata.hs

@@ -20,6 +20,8 @@ where
 import Control.Lens ((.~), (^.), (^?))
 import Data.Aeson qualified as J
 import Data.Aeson.Ordered qualified as AO
+import Data.Bifunctor (bimap, first)
+import Data.ByteString.Lazy qualified as BL
 import Data.CaseInsensitive qualified as CI
 import Data.Environment qualified as Env
 import Data.Has (Has, getter)
@@ -29,12 +31,13 @@ import Data.HashSet qualified as HS
 import Data.List qualified as L
 import Data.TByteString qualified as TBS
 import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
 import Data.Text.Extended ((<<>))
 import Hasura.Base.Error
 import Hasura.EncJSON
 import Hasura.Logging qualified as HL
 import Hasura.Metadata.Class
-import Hasura.Prelude
+import Hasura.Prelude hiding (first)
 import Hasura.RQL.DDL.Action
 import Hasura.RQL.DDL.ComputedField
 import Hasura.RQL.DDL.CustomTypes
@@ -53,6 +56,7 @@ import Hasura.RQL.DDL.Schema
 import Hasura.RQL.Types
 import Hasura.RQL.Types.Eventing.Backend (BackendEventTrigger (..))
 import Hasura.SQL.AnyBackend qualified as AB
+import Kriti qualified as K
 import Network.HTTP.Client.Transformable qualified as HTTP
 
 runClearMetadata ::
@@ -470,39 +474,50 @@ runRemoveMetricsConfig = do
         metaMetricsConfig .~ emptyMetricsConfig
   pure successMsg
 
+data TestTransformError
+  = UrlInterpError K.RenderedError
+  | RequestInitializationError HTTP.HttpException
+  | RequestTransformationError HTTP.Request TransformErrorBundle
+
 runTestWebhookTransform ::
-  forall m.
-  ( QErrM m,
-    MonadIO m
-  ) =>
-  Env.Environment ->
+  (QErrM m) =>
   TestWebhookTransform ->
   m EncJSON
-runTestWebhookTransform env (TestWebhookTransform urlE payload mt sv) = do
+runTestWebhookTransform (TestWebhookTransform env urlE payload mt sv) = do
   url <- case urlE of
     URL url' -> pure url'
-    EnvVar var -> maybe (throwError $ err400 NotFound "Missing Env Var") (pure . T.pack) $ Env.lookupEnv env var
-  initReq <- liftIO $ HTTP.mkRequestThrow url
-  let req = initReq & HTTP.body .~ pure (J.encode payload)
-      dataTransform = mkRequestTransform mt
-      transformedE = applyRequestTransform url dataTransform req sv
+    EnvVar var ->
+      let err = throwError $ err400 NotFound "Missing Env Var"
+       in maybe err (pure . T.pack) $ Env.lookupEnv env var
 
-  case transformedE of
+  result <- runExceptT $ do
+    let env' = bimap T.pack (J.String . T.pack) <$> Env.toList env
+        decodeKritiResult = TE.decodeUtf8 . BL.toStrict . J.encode
+
+    kritiUrlResult <- hoistEither $ first UrlInterpError $ decodeKritiResult <$> K.runKriti url env'
+
+    let unwrappedUrl = T.drop 1 $ T.dropEnd 1 kritiUrlResult
+    initReq <- hoistEither $ first RequestInitializationError $ HTTP.mkRequestEither unwrappedUrl
+
+    let req = initReq & HTTP.body .~ pure (J.encode payload)
+        dataTransform = mkRequestTransform mt
+    hoistEither $ first (RequestTransformationError req) $ applyRequestTransform unwrappedUrl dataTransform req sv
+
+  case result of
     Right transformed ->
-      pure $
-        encJFromJValue $
-          J.object
-            [ "webhook_url" J..= (transformed ^. HTTP.url),
-              "method" J..= (transformed ^. HTTP.method),
-              "headers" J..= (first CI.foldedCase <$> (transformed ^. HTTP.headers)),
-              "body" J..= (J.decode @J.Value =<< (transformed ^. HTTP.body))
-            ]
-    Left err ->
-      pure $
-        encJFromJValue $
-          J.object
-            [ "webhook_url" J..= (req ^. HTTP.url),
-              "method" J..= (req ^. HTTP.method),
-              "headers" J..= (first CI.foldedCase <$> (req ^. HTTP.headers)),
-              "body" J..= J.toJSON err
-            ]
+      let body = J.toJSON $ J.decode @J.Value =<< (transformed ^. HTTP.body)
+       in pure $ packTransformResult transformed body
+    Left (RequestTransformationError req err) -> pure $ packTransformResult req (J.toJSON err)
+    -- NOTE: In the following two cases we have failed before producing a valid request.
+    Left (UrlInterpError err) -> pure $ encJFromJValue $ J.toJSON err
+    Left (RequestInitializationError err) -> pure $ encJFromJValue $ J.String $ "Error: " <> tshow err
+
+packTransformResult :: HTTP.Request -> J.Value -> EncJSON
+packTransformResult req body =
+  encJFromJValue $
+    J.object
+      [ "webhook_url" J..= (req ^. HTTP.url),
+        "method" J..= (req ^. HTTP.method),
+        "headers" J..= (first CI.foldedCase <$> (req ^. HTTP.headers)),
+        "body" J..= body
+      ]

server/src-lib/Hasura/RQL/DDL/Metadata/Types.hs

@@ -20,6 +20,7 @@ where
 
 import Data.Aeson
 import Data.Aeson.TH
+import Data.Environment qualified as Env
 import Data.HashMap.Strict qualified as H
 import Data.Text qualified as T
 import Hasura.Prelude
@@ -193,15 +194,16 @@ instance FromJSON WebHookUrl where
   parseJSON (Object o) = do
     var <- o .: "from_env"
     pure $ EnvVar var
-  parseJSON (String str) = pure $ URL str
+  parseJSON (String str) = pure $ URL $ "\"" <> str <> "\""
   parseJSON _ = empty
 
 instance ToJSON WebHookUrl where
   toJSON (EnvVar var) = object ["from_env" .= var]
-  toJSON (URL url) = String url
+  toJSON (URL url) = toJSON url
 
 data TestWebhookTransform = TestWebhookTransform
-  { _twtWebhookUrl :: WebHookUrl,
+  { _twtEnv :: Env.Environment,
+    _twtWebhookUrl :: WebHookUrl,
     _twtPayload :: Value,
     _twtTransformer :: MetadataTransform,
     _twtSessionVariables :: Maybe SessionVariables
@@ -210,16 +212,19 @@ data TestWebhookTransform = TestWebhookTransform
 
 instance FromJSON TestWebhookTransform where
   parseJSON = withObject "TestWebhookTransform" $ \o -> do
+    env' <- o .:? "env"
+    let env = fromMaybe mempty env'
     url <- o .: "webhook_url"
     payload <- o .: "body"
     transformer <- o .: "request_transform"
     sessionVars <- o .:? "session_variables"
-    pure $ TestWebhookTransform url payload transformer sessionVars
+    pure $ TestWebhookTransform env url payload transformer sessionVars
 
 instance ToJSON TestWebhookTransform where
-  toJSON (TestWebhookTransform url payload mt sv) =
+  toJSON (TestWebhookTransform env url payload mt sv) =
     object
-      [ "webhook_url" .= url,
+      [ "env" .= env,
+        "webhook_url" .= url,
         "body" .= payload,
         "request_transform" .= mt,
         "session_variables" .= sv

server/src-lib/Hasura/Server/API/Metadata.hs

@@ -473,7 +473,7 @@ runMetadataQueryV1M env currentResourceVersion = \case
   RMDumpInternalState q -> runDumpInternalState q
   RMGetCatalogState q -> runGetCatalogState q
   RMSetCatalogState q -> runSetCatalogState q
-  RMTestWebhookTransform q -> runTestWebhookTransform env q
+  RMTestWebhookTransform q -> runTestWebhookTransform q
   RMSetQueryTagsConfig q -> runSetQueryTagsConfig q
   RMBulk q -> encJFromList <$> indexedMapM (runMetadataQueryM env currentResourceVersion) q
   where