DUX-3102: expose more validation error content

CHANGELOG.md

@@ -1,11 +1,14 @@
 # 2.1.0.0 (2025-03-06)
 * [#138](https://github.com/MercuryTechnologies/slack-web/pull/138)
   Implement `views.publish` method and App Home tab events.
-* [#139](https://github.com/MercuryTechnologies/slack-web/pull/138)
+* [#140](https://github.com/MercuryTechnologies/slack-web/pull/140)
   Implement `reactions.add` method.
 
   Breaking change: various places in the API using emoji now use an Emoji
   newtype.
+* [#141](https://github.com/MercuryTechnologies/slack-web/pull/141)
+  Include `response_metadata` in errors.
+  This is a breaking change since it changes the type of `ResponseSlackError` and friends to add that field.
 
 # 2.0.1.0 (2025-01-09)
 * [#136](https://github.com/MercuryTechnologies/slack-web/pull/136)

slack-web.cabal

@@ -33,6 +33,8 @@ extra-source-files:
   tests/golden/SlackView/*.golden
   tests/golden/PublishResp/*.json
   tests/golden/PublishResp/*.golden
+  tests/golden/ResponseJSON/*.json
+  tests/golden/ResponseJSON/*.golden
 
 category: Web
 
@@ -189,6 +191,7 @@ test-suite tests
       Web.Slack.ConversationSpec
       Web.Slack.ChatSpec
       Web.Slack.Files.TypesSpec
+      Web.Slack.InternalSpec
       Web.Slack.UsersConversationsSpec
       Web.Slack.Experimental.RequestVerificationSpec
       Web.Slack.Experimental.Events.TypesSpec

src/Web/Slack/Common.hs

@@ -27,6 +27,7 @@ module Web.Slack.Common (
   Message (..),
   MessageType (..),
   SlackClientError (..),
+  ResponseSlackError (..),
   SlackMessageText (..),
 ) where
 
@@ -84,13 +85,28 @@ instance NFData Message
 
 $(deriveJSON (jsonOpts "message") ''Message)
 
+-- | Contains errors that can be returned by the slack API.
+-- constrast with 'SlackClientError' which additionally
+-- contains errors which occured during the network communication.
+--
+-- Includes an Object correponding to the @response_metadata@ field.
+--
+-- @since 2.1.0.0
+data ResponseSlackError = ResponseSlackError
+  { errorText :: Text
+  , responseMetadata :: Object
+  }
+  deriving stock (Eq, Show, Generic)
+
+instance NFData ResponseSlackError
+
 -- |
 -- Errors that can be triggered by a slack request.
 data SlackClientError
   = -- | errors from the network connection
     ServantError ClientError
   | -- | errors returned by the slack API
-    SlackError Text
+    SlackError ResponseSlackError
   deriving stock (Eq, Generic, Show)
 
 instance NFData SlackClientError

src/Web/Slack/Internal.hs

@@ -2,10 +2,11 @@
 module Web.Slack.Internal where
 
 import Data.Aeson (Value (..))
-import Network.HTTP.Client (Manager)
-import Servant.API hiding (addHeader)
 -- import Servant.Client.Core
 
+import Data.Aeson.KeyMap qualified as KM
+import Network.HTTP.Client (Manager)
+import Servant.API hiding (addHeader)
 import Servant.Client (BaseUrl (..), ClientError, ClientM, Scheme (..), mkClientEnv, runClientM)
 import Servant.Client.Core (AuthClientData, AuthenticatedRequest, Request, addHeader, mkAuthenticatedRequest)
 import Web.Slack.Common qualified as Common
@@ -17,28 +18,26 @@
   , slackConfigToken :: Text
   }
 
--- contains errors that can be returned by the slack API.
--- constrast with 'SlackClientError' which additionally
--- contains errors which occured during the network communication.
-data ResponseSlackError = ResponseSlackError Text
-  deriving stock (Eq, Show)
-
 -- |
 -- Internal type!
-newtype ResponseJSON a = ResponseJSON (Either ResponseSlackError a)
+newtype ResponseJSON a = ResponseJSON (Either Common.ResponseSlackError a)
+  deriving stock (Show)
 
 instance (FromJSON a) => FromJSON (ResponseJSON a) where
   parseJSON = withObject "Response" $ \o -> do
     ok <- o .: "ok"
     ResponseJSON
       <$> if ok
         then Right <$> parseJSON (Object o)
-        else Left . ResponseSlackError <$> o .: "error"
+        else do
+          err <- o .: "error"
+          meta <- o .:? "response_metadata"
+          pure $ Left $ Common.ResponseSlackError {errorText = err, responseMetadata = (fromMaybe KM.empty meta)}
 
 mkSlackAuthenticateReq :: SlackConfig -> AuthenticatedRequest (AuthProtect "token")
 mkSlackAuthenticateReq = (`mkAuthenticatedRequest` authenticateReq) . slackConfigToken
 
 type instance
   AuthClientData (AuthProtect "token") =
     Text
 
@@ -59,6 +58,6 @@
 
 unnestErrors :: Either ClientError (ResponseJSON a) -> Response a
 unnestErrors (Right (ResponseJSON (Right a))) = Right a
-unnestErrors (Right (ResponseJSON (Left (ResponseSlackError serv)))) =
-  Left (Common.SlackError serv)
+unnestErrors (Right (ResponseJSON (Left err))) =
+  Left (Common.SlackError err)
 unnestErrors (Left slackErr) = Left (Common.ServantError slackErr)

tests/Web/Slack/InternalSpec.hs

@@ -0,0 +1,20 @@
+module Web.Slack.InternalSpec where
+
+import JSONGolden
+import TestImport
+import Web.Slack.Internal
+
+-- | Parses nothing and succeeds!
+data NoJSONExpectations = NoJSONExpectations
+  deriving stock (Show)
+
+instance FromJSON NoJSONExpectations where
+  parseJSON _ = pure NoJSONExpectations
+
+spec :: Spec
+spec = describe "Common infrastructure" do
+  describe "Response parsing" do
+    -- FIXME(jadel): discards warnings for successful responses! seems like we
+    -- need to improve this API
+    oneGoldenTestDecode @(ResponseJSON NoJSONExpectations) "metadata_example"
+    oneGoldenTestDecode @(ResponseJSON NoJSONExpectations) "failed_view_publish"

tests/golden/ResponseJSON/failed_view_publish.golden

@@ -0,0 +1,17 @@
+ResponseJSON
+    ( Left
+        ( ResponseSlackError
+            { errorText = "invalid_arguments"
+            , responseMetadata = fromList
+                [
+                    ( "messages"
+                    , Array
+                        [ String "[ERROR] failed to match all allowed schemas [json-pointer:/view]"
+                        , String "[ERROR] must provide an object [json-pointer:/view]"
+                        , String "[ERROR] must provide an object [json-pointer:/view]"
+                        ]
+                    )
+                ]
+            }
+        )
+    )

tests/golden/ResponseJSON/failed_view_publish.json

@@ -0,0 +1,11 @@
+{
+    "ok": false,
+    "error": "invalid_arguments",
+    "response_metadata": {
+        "messages": [
+            "[ERROR] failed to match all allowed schemas [json-pointer:/view]",
+            "[ERROR] must provide an object [json-pointer:/view]",
+            "[ERROR] must provide an object [json-pointer:/view]"
+        ]
+    }
+}

tests/golden/ResponseJSON/metadata_example.golden

@@ -0,0 +1 @@
+ResponseJSON ( Right NoJSONExpectations )

tests/golden/ResponseJSON/metadata_example.json

@@ -0,0 +1,14 @@
+{
+    "ok": true,
+    "warnings": [
+        "missing_charset"
+    ],
+    "response_metadata": {
+        "warnings": [
+            "missing_charset"
+        ],
+        "messages": [
+            "[WARN] A Content-Type HTTP header was presented but did not declare a charset, such as a 'utf-8'"
+        ]
+    }
+}