add content-length header.

## Description

Adds a content-length response header to all endpoints. This PR tests this feature by checking the content-length of every request we send in the tests.

## Changelog ✍️

__Component__ : server

__Type__: enhancement

__Product__: community-edition

### Short Changelog

add a content-length response header to all endpoints

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7444
Co-authored-by: Manas Agarwal <5352361+manasag@users.noreply.github.com>
GitOrigin-RevId: a0a811852053c5dde4b11b71ba11a7d456c84d76

cli/internal/hasura/catalogstate/catalogstate_test.go

@@ -72,7 +72,7 @@ func TestClientCatalogState_Set(t *testing.T) {
 				require.IsType(t, &errors.Error{}, err)
 				require.Equal(t, errors.Op("catalogstate.ClientCatalogState.Set"), err.(*errors.Error).Op)
 				require.Equal(t, errors.KindHasuraAPI.String(), errors.GetKind(err).String())
-				require.Equal(t, err.(*errors.Error).Err.Error(), `{
+				require.JSONEq(t, err.(*errors.Error).Err.Error(), `{
   "code": "parse-failed",
   "error": "When parsing Hasura.RQL.Types.Metadata.Common.CatalogStateType expected a String with the tag of a constructor but got some_state.",
   "path": "$.args.type"

cli/internal/hasura/v2query/v2_query_test.go

@@ -170,7 +170,7 @@ func TestClient_Bulk(t *testing.T) {
 				require.IsType(tt, &errors.Error{}, err)
 				require.Equal(tt, errors.KindHasuraAPI.String(), errors.GetKind(err).String())
 				require.Equal(tt, errors.Op("v2query.Client.Bulk"), err.(*errors.Error).Op)
-				require.Equal(tt, err.(*errors.Error).Err.Error(), `{
+				require.JSONEq(tt, err.(*errors.Error).Err.Error(), `{
   "code": "not-exists",
   "error": "source with name \"default\" does not exist",
   "path": "$.args[0].args"

server/lib/api-tests/api-tests.cabal

@@ -91,6 +91,7 @@ library
     SpecHook
     Test.API.ConcurrentBulkSpec
     Test.API.ExplainSpec
+    Test.API.GraphQL.ContentLengthSpec
     Test.API.Metadata.ComputedFieldsSpec
     Test.API.Metadata.InconsistentSpec
     Test.API.Metadata.NativeQuerySpec

server/lib/api-tests/src/Test/API/GraphQL/ContentLengthSpec.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+-- | Tests that the /graphql API correctly sets the Content-Length header.
+--
+-- Importantly, we DO NOT check that the length is correct! That's because the
+-- library we use for http calls actually *does* check that the Content-Length
+-- header is correct *if it's present*, meaning that all other tests already
+-- ensure its correctness. However, that library doesn't enforce that the header
+-- is present in the first place, which is what that this test is for.
+module Test.API.GraphQL.ContentLengthSpec (spec) where
+
+import Data.Aeson (Value, object, (.=))
+import Data.List.NonEmpty qualified as NE
+import Harness.Backend.Postgres qualified as Postgres
+import Harness.Http qualified as Http
+import Harness.Quoter.Graphql (graphql)
+import Harness.Test.Fixture qualified as Fixture
+import Harness.Test.Schema (Table (..), table)
+import Harness.Test.Schema qualified as Schema
+import Harness.TestEnvironment (GlobalTestEnvironment, TestEnvironment (..), getServer, serverUrl)
+import Hasura.Prelude
+import Network.HTTP.Simple qualified as Http
+import Test.Hspec (SpecWith, describe, it, shouldSatisfy)
+
+--------------------------------------------------------------------------------
+-- Preamble
+
+spec :: SpecWith GlobalTestEnvironment
+spec = do
+  Fixture.run
+    ( NE.fromList
+        [ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata)
+            { Fixture.setupTeardown = \(testEnv, _) ->
+                [ Postgres.setupTablesAction schema testEnv
+                ]
+            }
+        ]
+    )
+    tests
+
+--------------------------------------------------------------------------------
+-- Schema
+
+schema :: [Schema.Table]
+schema =
+  [ (table "author")
+      { tableColumns =
+          [ Schema.column "id" Schema.TInt,
+            Schema.column "name" Schema.TStr
+          ],
+        tablePrimaryKey = ["id"],
+        tableData = []
+      }
+  ]
+
+--------------------------------------------------------------------------------
+-- Tests
+
+tests :: Fixture.Options -> SpecWith TestEnvironment
+tests _opts = do
+  describe "GraphQL query contains a Content-Length response header" do
+    it "checks for the header in a valid GraphQL query" \testEnvironment -> do
+      let schemaName :: Schema.SchemaName
+          schemaName = Schema.getSchemaName testEnvironment
+          queryGQL :: Value
+          queryGQL =
+            [graphql|
+              query {
+                #{schemaName}_author {
+                  id
+                  name
+                }
+              }
+            |]
+          url :: String
+          url = serverUrl (getServer testEnvironment) ++ "/v1/graphql"
+      response <- Http.post url mempty $ object ["query" .= queryGQL]
+      let contentLengthHeaders = Http.getResponseHeader "Content-Length" response
+      contentLengthHeaders `shouldSatisfy` ((== 1) . length)
+
+  describe "GraphQL query contains a Content-Length response header" do
+    it "checks for the header in an invalid GraphQL query" \testEnvironment -> do
+      let schemaName :: Schema.SchemaName
+          schemaName = Schema.getSchemaName testEnvironment
+          queryGQL :: Value
+          queryGQL =
+            [graphql|
+              query {
+                #{schemaName}_artist {
+                  favouriteVideoGame
+                }
+              }
+            |]
+          url :: String
+          url = serverUrl (getServer testEnvironment) ++ "/v1/graphql"
+      response <- Http.post url mempty $ object ["query" .= queryGQL]
+      let contentLengthHeaders = Http.getResponseHeader "Content-Length" response
+      contentLengthHeaders `shouldSatisfy` ((== 1) . length)

server/lib/test-harness/src/Harness/GraphqlEngine.hs

@@ -46,7 +46,6 @@ where
 
 import Control.Concurrent.Async qualified as Async
 import Control.Monad.Trans.Managed (ManagedT (..), lowerManagedT)
--- import Hasura.RQL.Types.Metadata (emptyMetadataDefaults)
 import Data.Aeson (Value, fromJSON, object, (.=))
 import Data.Aeson.Encode.Pretty as AP
 import Data.Aeson.Types (Pair)

server/src-lib/Hasura/Server/App.hs

@@ -33,6 +33,7 @@ import Data.Aeson qualified as J
 import Data.Aeson.Key qualified as K
 import Data.Aeson.KeyMap qualified as KM
 import Data.Aeson.Types qualified as J
+import Data.ByteString.Builder qualified as BB
 import Data.ByteString.Char8 qualified as B8
 import Data.ByteString.Lazy qualified as BL
 import Data.CaseInsensitive qualified as CI
@@ -233,7 +234,7 @@ onlyAdmin = do
   unless (uRole == adminRoleName) $
     throw400 AccessDenied "You have to be an admin to access this endpoint"
 
-setHeader :: MonadIO m => HTTP.Header -> Spock.ActionT m ()
+setHeader :: MonadIO m => HTTP.Header -> Spock.ActionCtxT ctx m ()
 setHeader (headerName, headerValue) =
   Spock.setHeader (bsToTxt $ CI.original headerName) (bsToTxt headerValue)
 
@@ -397,9 +398,12 @@ mkSpockAction serverCtx@ServerCtx {..} qErrEncoder qErrModifier apiHandler = do
       Spock.ActionCtxT ctx m3 a3
     logErrorAndResp userInfo reqId waiReq req includeInternal headers extraUserInfo qErr = do
       let httpLogMetadata = buildHttpLogMetadata @m3 emptyHttpLogGraphQLInfo extraUserInfo
+          jsonResponse = J.encode $ qErrEncoder includeInternal qErr
+          contentLength = ("Content-Length", B8.toStrict $ BB.toLazyByteString $ BB.int64Dec $ BL.length jsonResponse)
       lift $ logHttpError (_lsLogger scLoggers) scLoggingSettings userInfo reqId waiReq req qErr headers httpLogMetadata
+      setHeader contentLength
       Spock.setStatus $ qeStatus qErr
-      Spock.json $ qErrEncoder includeInternal qErr
+      Spock.lazyBytes jsonResponse
 
     logSuccessAndResp userInfo reqId waiReq req result qTime reqHeaders authHdrs httpLoggingMetadata = do
       let (respBytes, respHeaders) = case result of
@@ -408,7 +412,8 @@ mkSpockAction serverCtx@ServerCtx {..} qErrEncoder qErrModifier apiHandler = do
           (compressedResp, encodingType) = compressResponse (Wai.requestHeaders waiReq) respBytes
           encodingHeader = maybeToList (contentEncodingHeader <$> encodingType)
           reqIdHeader = (requestIdHeader, txtToBs $ unRequestId reqId)
-          allRespHeaders = pure reqIdHeader <> encodingHeader <> respHeaders <> authHdrs
+          contentLength = ("Content-Length", B8.toStrict $ BB.toLazyByteString $ BB.int64Dec $ BL.length compressedResp)
+          allRespHeaders = [reqIdHeader, contentLength] <> encodingHeader <> respHeaders <> authHdrs
       lift $ logHttpSuccess (_lsLogger scLoggers) scLoggingSettings userInfo reqId waiReq req respBytes compressedResp qTime encodingType reqHeaders httpLoggingMetadata
       mapM_ setHeader allRespHeaders
       Spock.lazyBytes compressedResp