hasura/graphql-engine
1
0
Fork 0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-04 20:06:35 +03:00
Code Issues Projects Releases Wiki Activity

Upgrade Ormolu to 0.7.0.0

Browse Source 
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/9284
GitOrigin-RevId: 2f2cf2ad01900a54e4bdb970205ac0ef313c7e00
This commit is contained in:
Tom Harding 2023-05-24 14:51:56 +01:00 committed by hasura-bot
parent e3df24507d
commit e0c0043e76
598 changed files with 14470 additions and 12790 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
server/VERSIONS.json
View File

@ -2,5 +2,5 @@
"cabal-install": "3.10.1.0",
"ghc": "9.2.5",
"hlint": "3.4.1",
"ormolu": "0.5.0.1"
"ormolu": "0.7.0.0"
}

2
server/lib/aeson-ordered/src/Data/Aeson/Ordered.hs
View File

@ -211,7 +211,7 @@ fromOrderedObject obj =
map (bimap K.fromText fromOrdered) $
Data.Aeson.Ordered.toList obj
asObject :: IsString s => Value -> Either s Object
asObject :: (IsString s) => Value -> Either s Object
asObject = \case
Object o -> Right o
_ -> Left "expecting ordered object"

11
server/lib/api-tests/src/SpecHook.hs
View File

@ -113,11 +113,12 @@ setupTestingMode = do
environment <- getEnvironment
lookupTestingMode environment `onLeft` error
hook :: HasCallStack => SpecWith GlobalTestEnvironment -> Spec
hook :: (HasCallStack) => SpecWith GlobalTestEnvironment -> Spec
hook specs = do
(testingMode, (logger, _cleanupLogger)) <-
runIO $
readIORef globalConfigRef `onNothingM` do
runIO
$ readIORef globalConfigRef
`onNothingM` do
testingMode <- setupTestingMode
(logger, cleanupLogger) <- setupLogger
setupGlobalConfig testingMode (logger, cleanupLogger)
@ -134,8 +135,8 @@ hook specs = do
TestNoBackends -> True -- this is for catching "everything else"
TestNewPostgresVariant {} -> "Postgres" `elem` labels
aroundAllWith (const . bracket (setupTestEnvironment testingMode logger) teardownTestEnvironment) $
mapSpecForest (filterForestWithLabels shouldRunTest) (contextualizeLogger specs)
aroundAllWith (const . bracket (setupTestEnvironment testingMode logger) teardownTestEnvironment)
$ mapSpecForest (filterForestWithLabels shouldRunTest) (contextualizeLogger specs)
{-# NOINLINE globalConfigRef #-}
globalConfigRef :: IORef (Maybe (TestingMode, (Logger, IO ())))

8
server/lib/api-tests/src/Test/API/ConcurrentBulkSpec.hs
View File

@ -90,8 +90,8 @@ postgresRunSqlQuery testEnvironment bulkType = do
let backendTypeMetadata = fromMaybe (error "Expected a backend type but got nothing") $ getBackendTypeConfig testEnvironment
sourceName = BackendType.backendSourceName backendTypeMetadata
backendPrefix = BackendType.backendTypeString backendTypeMetadata
postV2Query 200 testEnvironment $
[interpolateYaml|
postV2Query 200 testEnvironment
$ [interpolateYaml|
type: #{bulkType}
args:
- type: #{backendPrefix}_run_sql
@ -153,8 +153,8 @@ mssqlRunSqlQuery testEnvironment bulkType = do
let backendTypeMetadata = fromMaybe (error "Expected a backend type but got nothing") $ getBackendTypeConfig testEnvironment
sourceName = BackendType.backendSourceName backendTypeMetadata
backendPrefix = BackendType.backendTypeString backendTypeMetadata
postV2Query 200 testEnvironment $
[interpolateYaml|
postV2Query 200 testEnvironment
$ [interpolateYaml|
type: #{bulkType}
args:
- type: #{backendPrefix}_run_sql

40
server/lib/api-tests/src/Test/API/Metadata/ComputedFieldsSpec.hs
View File

@ -68,11 +68,11 @@ setupFunctions :: TestEnvironment -> [Fixture.SetupAction]
setupFunctions testEnv =
let schemaName = Schema.getSchemaName testEnv
articleTableSQL = unSchemaName schemaName <> ".article"
in [ SetupAction.noTeardown $
BigQuery.run_ $
T.unpack $
T.unwords $
[ "CREATE TABLE FUNCTION ",
in [ SetupAction.noTeardown
$ BigQuery.run_
$ T.unpack
$ T.unwords
$ [ "CREATE TABLE FUNCTION ",
fetch_articles_returns_table schemaName,
"(a_id INT64, search STRING)",
"RETURNS TABLE<id INT64, title STRING, content STRING>",
@ -82,11 +82,11 @@ setupFunctions testEnv =
"AS t WHERE t.author_id = a_id and (t.title LIKE `search` OR t.content LIKE `search`)",
");"
],
SetupAction.noTeardown $
BigQuery.run_ $
T.unpack $
T.unwords $
[ "CREATE TABLE FUNCTION ",
SetupAction.noTeardown
$ BigQuery.run_
$ T.unpack
$ T.unwords
$ [ "CREATE TABLE FUNCTION ",
fetch_articles schemaName,
"(a_id INT64, search STRING)",
"AS (",
@ -95,22 +95,22 @@ setupFunctions testEnv =
"AS t WHERE t.author_id = a_id and (t.title LIKE `search` OR t.content LIKE `search`)",
");"
],
SetupAction.noTeardown $
BigQuery.run_ $
T.unpack $
T.unwords $
[ "CREATE TABLE FUNCTION ",
SetupAction.noTeardown
$ BigQuery.run_
$ T.unpack
$ T.unwords
$ [ "CREATE TABLE FUNCTION ",
function_no_args schemaName <> "()",
"AS (",
"SELECT t.* FROM",
articleTableSQL,
"AS t);"
],
SetupAction.noTeardown $
BigQuery.run_ $
T.unpack $
T.unwords $
[ "CREATE FUNCTION ",
SetupAction.noTeardown
$ BigQuery.run_
$ T.unpack
$ T.unwords
$ [ "CREATE FUNCTION ",
add_int schemaName <> "(a INT64, b INT64)",
"RETURNS INT64 AS (a + b);"
]

13
server/lib/api-tests/src/Test/API/Metadata/TablesSpec.hs
View File

@ -49,8 +49,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnvironment
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},
@ -205,8 +205,9 @@ tests = do
|]
_ -> error "Unimplemented"
when (backendType == "sqlite") $
actual >>= \result -> result `shouldAtLeastBe` expected
when (backendType == "sqlite")
$ actual
>>= \result -> result `shouldAtLeastBe` expected
it "Returns null for an invalid table" \testEnvironment -> do
let backendTypeMetadata = fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnvironment
@ -227,5 +228,5 @@ tests = do
- made_up_table
|]
when (backendType == "sqlite") $
shouldReturnYaml testEnvironment actual Null
when (backendType == "sqlite")
$ shouldReturnYaml testEnvironment actual Null

6
server/lib/api-tests/src/Test/API/Metadata/TransparentDefaultsSpec.hs
View File

@ -48,7 +48,8 @@ tests = do
it "does not include defaults on stand alone export" \testEnvironment -> do
response <- postMetadata testEnvironment exportMetadata
let response' = Object $ response CL.^. AL.key "metadata" . AL._Object & CL.sans "sources"
expected = [yaml| version: 3 |] -- Doesn't include defaults
expected = [yaml| version: 3 |]
-- Doesn't include defaults
response' `shouldBe` expected
describe "with metadata modifications" do
@ -58,7 +59,8 @@ tests = do
response <- postMetadata testEnvironment exportMetadata
let response' = Object $ response CL.^. AL.key "metadata" . AL._Object & CL.sans "sources"
expected = [yaml| version: 3 |] -- Shouldn't include defaults
expected = [yaml| version: 3 |]
-- Shouldn't include defaults
response' `shouldBe` expected
exportMetadata :: Value

4
server/lib/api-tests/src/Test/Auth/Authorization/DisableRootFields/DefaultRootFieldsSpec.hs
View File

@ -36,8 +36,8 @@ spec =
setupPermissionsAction permissions testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

27
server/lib/api-tests/src/Test/DataConnector/MetadataApiSpec.hs
View File

@ -223,7 +223,8 @@ schemaInspectionTests = describe "Schema and Source Inspection" $ do
args:
name: *backendString
|]
) -- Note: These fields are backend specific so we ignore their values and just verify their shapes:
)
-- Note: These fields are backend specific so we ignore their values and just verify their shapes:
<&> Lens.set (key "config_schema_response" . key "other_schemas") J.Null
<&> Lens.set (key "config_schema_response" . key "config_schema") J.Null
<&> Lens.set (key "capabilities" . _Object . Lens.at "datasets") Nothing
@ -403,10 +404,10 @@ schemaCrudTests = describe "A series of actions to setup and teardown a source w
let capabilities = getBackendTypeConfig testEnvironment >>= BackendType.parseCapabilities
let foreignKeySupport = fromMaybe False $ capabilities ^? _Just . API.cDataSchema . API.dscSupportsForeignKeys
let relationshipsSupport = isJust $ capabilities ^? _Just . API.cRelationships . _Just
unless relationshipsSupport $
pendingWith "Backend does not support local relationships"
unless foreignKeySupport $
pendingWith "Backend does not support Foreign Key constraints"
unless relationshipsSupport
$ pendingWith "Backend does not support local relationships"
unless foreignKeySupport
$ pendingWith "Backend does not support Foreign Key constraints"
case (backendTypeString &&& backendSourceName) <$> getBackendTypeConfig testEnvironment of
Nothing -> pendingWith "Backend Type not found in testEnvironment"
@ -439,10 +440,10 @@ schemaCrudTests = describe "A series of actions to setup and teardown a source w
let capabilities = getBackendTypeConfig testEnvironment >>= BackendType.parseCapabilities
let foreignKeySupport = fromMaybe False $ capabilities ^? _Just . API.cDataSchema . API.dscSupportsForeignKeys
let relationshipsSupport = isJust $ capabilities ^? _Just . API.cRelationships . _Just
unless relationshipsSupport $
pendingWith "Backend does not support local relationships"
unless foreignKeySupport $
pendingWith "Backend does not support Foreign Key constraints"
unless relationshipsSupport
$ pendingWith "Backend does not support local relationships"
unless foreignKeySupport
$ pendingWith "Backend does not support Foreign Key constraints"
case (backendTypeString &&& backendSourceName) <$> TestEnvironment.getBackendTypeConfig testEnvironment of
Nothing -> pendingWith "Backend Type not found in testEnvironment"
@ -539,10 +540,10 @@ schemaCrudTests = describe "A series of actions to setup and teardown a source w
let capabilities = getBackendTypeConfig testEnvironment >>= BackendType.parseCapabilities
let foreignKeySupport = fromMaybe False $ capabilities ^? _Just . API.cDataSchema . API.dscSupportsForeignKeys
let relationshipsSupport = isJust $ capabilities ^? _Just . API.cRelationships . _Just
unless relationshipsSupport $
pendingWith "Backend does not support local relationships"
unless foreignKeySupport $
pendingWith "Backend does not support Foreign Key constraints"
unless relationshipsSupport
$ pendingWith "Backend does not support local relationships"
unless foreignKeySupport
$ pendingWith "Backend does not support Foreign Key constraints"
case (backendTypeString &&& backendSourceName) <$> TestEnvironment.getBackendTypeConfig testEnvironment of
Nothing -> pendingWith "Backend Type not found in testEnvironment"

32
server/lib/api-tests/src/Test/DataConnector/MockAgent/AggregateQuerySpec.hs
View File

@ -115,8 +115,8 @@ tests = describe "Aggregate Query Tests" $ do
[ [ ("ArtistIds_Id", API.mkColumnFieldValue $ J.Number 1),
("ArtistNames_Name", API.mkColumnFieldValue $ J.String "AC/DC"),
( "nodes_Albums",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [("nodes_Title", API.mkColumnFieldValue $ J.String "For Those About To Rock We Salute You")],
[("nodes_Title", API.mkColumnFieldValue $ J.String "Let There Be Rock")]
]
@ -144,8 +144,8 @@ tests = describe "Aggregate Query Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Artist")
( emptyQuery
& API.qFields
@ -157,12 +157,14 @@ tests = describe "Aggregate Query Tests" $ do
( API.RelationshipField
(API.RelationshipName "Albums")
( emptyQuery
& API.qFields ?~ mkFieldsMap [("nodes_Title", API.ColumnField (API.ColumnName "Title") (API.ScalarType "string"))]
& API.qFields
?~ mkFieldsMap [("nodes_Title", API.ColumnField (API.ColumnName "Title") (API.ScalarType "string"))]
)
)
)
]
& API.qLimit ?~ 1
& API.qLimit
?~ 1
)
& API.qrRelationships
.~ Set.fromList
@ -219,15 +221,15 @@ tests = describe "Aggregate Query Tests" $ do
]
rows =
[ [ ( "nodes_Lines",
API.mkRelationshipFieldValue $
mkAggregatesQueryResponse
API.mkRelationshipFieldValue
$ mkAggregatesQueryResponse
[ ("aggregate_count", J.Number 2)
]
)
],
[ ( "nodes_Lines",
API.mkRelationshipFieldValue $
mkAggregatesQueryResponse
API.mkRelationshipFieldValue
$ mkAggregatesQueryResponse
[ ("aggregate_count", J.Number 4)
]
)
@ -260,8 +262,8 @@ tests = describe "Aggregate Query Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Invoice")
( emptyQuery
& API.qFields
@ -282,8 +284,10 @@ tests = describe "Aggregate Query Tests" $ do
("ids_minimum_Id", API.SingleColumn (singleColumnAggregateMin (API.ColumnName "InvoiceId") (API.ScalarType "number"))),
("ids_max_InvoiceId", API.SingleColumn (singleColumnAggregateMax (API.ColumnName "InvoiceId") (API.ScalarType "number")))
]
& API.qLimit ?~ 2
& API.qAggregatesLimit ?~ 2
& API.qLimit
?~ 2
& API.qAggregatesLimit
?~ 2
)
& API.qrRelationships
.~ Set.fromList

18
server/lib/api-tests/src/Test/DataConnector/MockAgent/BasicQuerySpec.hs
View File

@ -138,8 +138,8 @@ tests = describe "Basic Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Album")
( emptyQuery
& API.qFields
@ -147,7 +147,8 @@ tests = describe "Basic Tests" $ do
[ ("id", API.ColumnField (API.ColumnName "AlbumId") (API.ScalarType "number")),
("title", API.ColumnField (API.ColumnName "Title") (API.ScalarType "string"))
]
& API.qLimit ?~ 1
& API.qLimit
?~ 1
)
)
@ -192,8 +193,8 @@ tests = describe "Basic Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Artist")
( emptyQuery
& API.qFields
@ -201,7 +202,8 @@ tests = describe "Basic Tests" $ do
[ ("id", API.ColumnField (API.ColumnName "ArtistId") $ API.ScalarType "number"),
("name", API.ColumnField (API.ColumnName "Name") $ API.ScalarType "string")
]
& API.qLimit ?~ 3 -- The permissions limit is smaller than the query limit, so it is used
& API.qLimit
?~ 3 -- The permissions limit is smaller than the query limit, so it is used
)
)
@ -242,8 +244,8 @@ tests = describe "Basic Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Customer")
( emptyQuery
& API.qFields

14
server/lib/api-tests/src/Test/DataConnector/MockAgent/CustomScalarsSpec.hs
View File

@ -87,8 +87,8 @@ tests = describe "Custom scalar parsing tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "MyCustomScalarsTable")
( emptyQuery
& API.qFields
@ -100,7 +100,8 @@ tests = describe "Custom scalar parsing tests" $ do
("MyIDColumn", API.ColumnField (API.ColumnName "MyIDColumn") $ API.ScalarType "MyID"),
("MyAnythingColumn", API.ColumnField (API.ColumnName "MyAnythingColumn") $ API.ScalarType "MyAnything")
]
& API.qLimit ?~ 1
& API.qLimit
?~ 1
)
)
@ -144,8 +145,8 @@ tests = describe "Custom scalar parsing tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "MyCustomScalarsTable")
( emptyQuery
& API.qFields
@ -157,7 +158,8 @@ tests = describe "Custom scalar parsing tests" $ do
("MyIDColumn", API.ColumnField (API.ColumnName "MyIDColumn") $ API.ScalarType "MyID"),
("MyAnythingColumn", API.ColumnField (API.ColumnName "MyAnythingColumn") $ API.ScalarType "MyAnything")
]
& API.qLimit ?~ 1
& API.qLimit
?~ 1
& API.qWhere
?~ And
( Set.fromList

34
server/lib/api-tests/src/Test/DataConnector/MockAgent/DeleteMutationsSpec.hs
View File

@ -114,8 +114,8 @@ tests = do
[ ("deletedRows_AlbumId", API.mkColumnFieldValue $ J.Number 112),
("deletedRows_Title", API.mkColumnFieldValue $ J.String "The Number of The Beast"),
( "deletedRows_Artist",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("ArtistId", API.mkColumnFieldValue $ J.Number 90),
("Name", API.mkColumnFieldValue $ J.String "Iron Maiden")
]
@ -126,8 +126,8 @@ tests = do
[ ("deletedRows_AlbumId", API.mkColumnFieldValue $ J.Number 113),
("deletedRows_Title", API.mkColumnFieldValue $ J.String "The X Factor"),
( "deletedRows_Artist",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("ArtistId", API.mkColumnFieldValue $ J.Number 90),
("Name", API.mkColumnFieldValue $ J.String "Iron Maiden")
]
@ -138,8 +138,8 @@ tests = do
[ ("deletedRows_AlbumId", API.mkColumnFieldValue $ J.Number 114),
("deletedRows_Title", API.mkColumnFieldValue $ J.String "Virtual XI"),
( "deletedRows_Artist",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("ArtistId", API.mkColumnFieldValue $ J.Number 90),
("Name", API.mkColumnFieldValue $ J.String "Iron Maiden")
]
@ -195,12 +195,13 @@ tests = do
}
]
& API.mrOperations
.~ [ API.DeleteOperation $
API.DeleteMutationOperation
.~ [ API.DeleteOperation
$ API.DeleteMutationOperation
{ API._dmoTable = mkTableName "Album",
API._dmoWhere =
Just . API.And $
Set.fromList
Just
. API.And
$ Set.fromList
[ API.ApplyBinaryComparisonOperator
API.Equal
(API.ComparisonColumn API.CurrentTable (API.ColumnName "ArtistId") $ API.ScalarType "number")
@ -257,8 +258,8 @@ tests = do
[ ("AlbumId", API.mkColumnFieldValue $ J.Number 112),
("Title", API.mkColumnFieldValue $ J.String "The Number of The Beast"),
( "Artist",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("ArtistId", API.mkColumnFieldValue $ J.Number 90),
("Name", API.mkColumnFieldValue $ J.String "Iron Maiden")
]
@ -302,12 +303,13 @@ tests = do
}
]
& API.mrOperations
.~ [ API.DeleteOperation $
API.DeleteMutationOperation
.~ [ API.DeleteOperation
$ API.DeleteMutationOperation
{ API._dmoTable = mkTableName "Album",
API._dmoWhere =
Just . API.And $
Set.fromList
Just
. API.And
$ Set.fromList
[ API.ApplyBinaryComparisonOperator
API.Equal
(API.ComparisonColumn API.CurrentTable (API.ColumnName "ArtistId") $ API.ScalarType "number")

7
server/lib/api-tests/src/Test/DataConnector/MockAgent/ErrorSpec.hs
View File

@ -94,8 +94,8 @@ tests = describe "Error Protocol Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Album")
( emptyQuery
& API.qFields
@ -103,7 +103,8 @@ tests = describe "Error Protocol Tests" $ do
[ ("id", API.ColumnField (API.ColumnName "AlbumId") $ API.ScalarType "number"),
("title", API.ColumnField (API.ColumnName "Title") $ API.ScalarType "string")
]
& API.qLimit ?~ 1
& API.qLimit
?~ 1
)
)

24
server/lib/api-tests/src/Test/DataConnector/MockAgent/InsertMutationsSpec.hs
View File

@ -123,8 +123,8 @@ tests = do
[ ("insertedRows_AlbumId", API.mkColumnFieldValue $ J.Number 9001),
("insertedRows_Title", API.mkColumnFieldValue $ J.String "Super Mega Rock"),
( "insertedRows_Artist",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("ArtistId", API.mkColumnFieldValue $ J.Number 2),
("Name", API.mkColumnFieldValue $ J.String "Accept")
]
@ -135,8 +135,8 @@ tests = do
[ ("insertedRows_AlbumId", API.mkColumnFieldValue $ J.Number 9002),
("insertedRows_Title", API.mkColumnFieldValue $ J.String "Accept This"),
( "insertedRows_Artist",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("ArtistId", API.mkColumnFieldValue $ J.Number 2),
("Name", API.mkColumnFieldValue $ J.String "Accept")
]
@ -200,26 +200,26 @@ tests = do
}
]
& API.mrOperations
.~ [ API.InsertOperation $
API.InsertMutationOperation
.~ [ API.InsertOperation
$ API.InsertMutationOperation
{ API._imoTable = mkTableName "Album",
API._imoRows =
[ API.RowObject $
mkFieldsMap
[ API.RowObject
$ mkFieldsMap
[ ("AlbumId", API.mkColumnInsertFieldValue $ J.Number 9001),
("ArtistId", API.mkColumnInsertFieldValue $ J.Number 2),
("Title", API.mkColumnInsertFieldValue $ J.String "Super Mega Rock")
],
API.RowObject $
mkFieldsMap
API.RowObject
$ mkFieldsMap
[ ("AlbumId", API.mkColumnInsertFieldValue $ J.Number 9002),
("ArtistId", API.mkColumnInsertFieldValue $ J.Number 2),
("Title", API.mkColumnInsertFieldValue $ J.String "Accept This")
]
],
API._imoPostInsertCheck =
Just $
API.ApplyBinaryComparisonOperator
Just
$ API.ApplyBinaryComparisonOperator
API.Equal
(API.ComparisonColumn API.CurrentTable (API.ColumnName "ArtistId") $ API.ScalarType "number")
(API.ScalarValueComparison $ API.ScalarValue (J.Number 2) (API.ScalarType "number")),

24
server/lib/api-tests/src/Test/DataConnector/MockAgent/OrderBySpec.hs
View File

@ -113,8 +113,8 @@ tests = describe "Order By Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Album")
( emptyQuery
& API.qFields
@ -122,8 +122,10 @@ tests = describe "Order By Tests" $ do
[ ("AlbumId", API.ColumnField (API.ColumnName "AlbumId") $ API.ScalarType "number"),
("Title", API.ColumnField (API.ColumnName "Title") $ API.ScalarType "string")
]
& API.qLimit ?~ 3
& API.qOrderBy ?~ API.OrderBy mempty (API.OrderByElement [] (API.OrderByColumn (API.ColumnName "AlbumId")) API.Ascending :| [])
& API.qLimit
?~ 3
& API.qOrderBy
?~ API.OrderBy mempty (API.OrderByElement [] (API.OrderByColumn (API.ColumnName "AlbumId")) API.Ascending :| [])
)
)
@ -156,12 +158,14 @@ tests = describe "Order By Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Artist")
( emptyQuery
& API.qFields ?~ mkFieldsMap [("Name", API.ColumnField (API.ColumnName "Name") (API.ScalarType "string"))]
& API.qLimit ?~ 2
& API.qFields
?~ mkFieldsMap [("Name", API.ColumnField (API.ColumnName "Name") (API.ScalarType "string"))]
& API.qLimit
?~ 2
& API.qOrderBy
?~ API.OrderBy
( HashMap.fromList
@ -174,8 +178,8 @@ tests = describe "Order By Tests" $ do
[ API.OrderByElement [API.RelationshipName "Albums"] API.OrderByStarCountAggregate API.Ascending,
API.OrderByElement
[API.RelationshipName "Albums"]
( API.OrderBySingleColumnAggregate $
API.SingleColumnAggregate
( API.OrderBySingleColumnAggregate
$ API.SingleColumnAggregate
(API.SingleColumnAggregateFunction [G.name|max|])
(API.ColumnName "AlbumId")
(API.ScalarType "number")

50
server/lib/api-tests/src/Test/DataConnector/MockAgent/QueryRelationshipsSpec.hs
View File

@ -162,14 +162,14 @@ tests = describe "Object Relationships Tests" $ do
mkRowsQueryResponse
[ [ ("Name", API.mkColumnFieldValue $ J.String "For Those About To Rock (We Salute You)"),
( "Genre",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [("Name", API.mkColumnFieldValue $ J.String "Rock")]
]
),
( "MediaType",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [("Name", API.mkColumnFieldValue $ J.String "MPEG audio file")]
]
)
@ -192,8 +192,8 @@ tests = describe "Object Relationships Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Track")
( emptyQuery
& API.qFields
@ -214,7 +214,8 @@ tests = describe "Object Relationships Tests" $ do
)
)
]
& API.qLimit ?~ 1
& API.qLimit
?~ 1
)
& API.qrRelationships
.~ Set.fromList
@ -262,11 +263,11 @@ tests = describe "Object Relationships Tests" $ do
let queryResponse =
mkRowsQueryResponse
[ [ ( "Album",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ( "Artist",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[[("Name", API.mkColumnFieldValue $ J.String "Zeca Pagodinho")]]
)
]
@ -291,8 +292,8 @@ tests = describe "Object Relationships Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Track")
( emptyQuery
& API.qFields
@ -317,7 +318,8 @@ tests = describe "Object Relationships Tests" $ do
)
)
]
& API.qLimit ?~ 1
& API.qLimit
?~ 1
& API.qOrderBy
?~ API.OrderBy
( HashMap.fromList
@ -402,12 +404,14 @@ tests = describe "Object Relationships Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Employee")
( emptyQuery
& API.qFields ?~ mkFieldsMap [("EmployeeId", API.ColumnField (API.ColumnName "EmployeeId") $ API.ScalarType "number")]
& API.qLimit ?~ 1
& API.qFields
?~ mkFieldsMap [("EmployeeId", API.ColumnField (API.ColumnName "EmployeeId") $ API.ScalarType "number")]
& API.qLimit
?~ 1
& API.qWhere
?~ API.Exists
(API.RelatedTable $ API.RelationshipName "SupportRepForCustomers")
@ -421,9 +425,9 @@ tests = describe "Object Relationships Tests" $ do
( HashMap.fromList
[ ( API.RelationshipName "SupportRepForCustomers",
API.OrderByRelation
( Just $
API.Exists (API.RelatedTable $ API.RelationshipName "SupportRep") $
API.ApplyBinaryComparisonOperator
( Just
$ API.Exists (API.RelatedTable $ API.RelationshipName "SupportRep")
$ API.ApplyBinaryComparisonOperator
API.Equal
(API.ComparisonColumn API.CurrentTable (API.ColumnName "Country") $ API.ScalarType "string")
(API.AnotherColumnComparison (API.ComparisonColumn API.QueryTable (API.ColumnName "Country") $ API.ScalarType "string"))
@ -474,7 +478,9 @@ noRelationshipsCapabilityMockConfig =
Mock.chinookMock
{ Mock._capabilitiesResponse =
Mock._capabilitiesResponse Mock.chinookMock
& API.crCapabilities . API.cRelationships .~ Nothing -- Remove relationships capability
& API.crCapabilities
. API.cRelationships
.~ Nothing -- Remove relationships capability
}
noRelationshipsCapabilitySourceMetadata :: J.Value

47
server/lib/api-tests/src/Test/DataConnector/MockAgent/RemoteRelationshipsSpec.hs
View File

@ -111,7 +111,7 @@ postgresTables =
pgSourceName :: String
pgSourceName = "pg_source"
setupPostgres :: HasCallStack => TestEnvironment -> IO ()
setupPostgres :: (HasCallStack) => TestEnvironment -> IO ()
setupPostgres testEnv = do
let sourceConfig = Postgres.defaultSourceConfiguration testEnv
schemaName = Schema.getSchemaName testEnv
@ -142,7 +142,7 @@ setupPostgres testEnv = do
name: #{tableName table}
|]
registerRemoteRelationships :: HasCallStack => TestEnvironment -> IO ()
registerRemoteRelationships :: (HasCallStack) => TestEnvironment -> IO ()
registerRemoteRelationships testEnv = do
let mockAgentSourceName = BackendType.backendSourceName Mock.backendTypeMetadata
schemaName = Schema.getSchemaName testEnv
@ -214,8 +214,8 @@ tests = do
let queryResponse =
mkRowsQueryResponse
[ [ ( "query",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("AlbumId", API.mkColumnFieldValue $ J.Number 1),
("Title", API.mkColumnFieldValue $ J.String "For Those About To Rock We Salute You")
],
@ -226,8 +226,8 @@ tests = do
)
],
[ ( "query",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("AlbumId", API.mkColumnFieldValue $ J.Number 2),
("Title", API.mkColumnFieldValue $ J.String "Balls to the Wall")
],
@ -264,8 +264,8 @@ tests = do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Album")
( emptyQuery
& API.qFields
@ -301,8 +301,8 @@ tests = do
let queryResponse =
mkRowsQueryResponse
[ [ ( "query",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("AlbumId", API.mkColumnFieldValue $ J.Number 3),
("Title", API.mkColumnFieldValue $ J.String "Restless and Wild")
]
@ -310,8 +310,8 @@ tests = do
)
],
[ ( "query",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("AlbumId", API.mkColumnFieldValue $ J.Number 1),
("Title", API.mkColumnFieldValue $ J.String "For Those About To Rock We Salute You")
]
@ -319,8 +319,8 @@ tests = do
)
],
[ ( "query",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("AlbumId", API.mkColumnFieldValue $ J.Number 4),
("Title", API.mkColumnFieldValue $ J.String "Let There Be Rock")
]
@ -355,8 +355,8 @@ tests = do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Album")
( emptyQuery
& API.qFields
@ -398,8 +398,8 @@ tests = do
let queryResponse =
mkRowsQueryResponse
[ [ ( "query",
API.mkRelationshipFieldValue $
mkQueryResponse
API.mkRelationshipFieldValue
$ mkQueryResponse
[ [ ("nodes_AlbumId", API.mkColumnFieldValue $ J.Number 1),
("nodes_Title", API.mkColumnFieldValue $ J.String "For Those About To Rock We Salute You")
],
@ -412,8 +412,8 @@ tests = do
)
],
[ ( "query",
API.mkRelationshipFieldValue $
mkQueryResponse
API.mkRelationshipFieldValue
$ mkQueryResponse
[ [ ("nodes_AlbumId", API.mkColumnFieldValue $ J.Number 2),
("nodes_Title", API.mkColumnFieldValue $ J.String "Balls to the Wall")
],
@ -458,8 +458,8 @@ tests = do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Album")
( emptyQuery
& API.qFields
@ -467,7 +467,8 @@ tests = do
[ ("nodes_AlbumId", API.ColumnField (API.ColumnName "AlbumId") $ API.ScalarType "number"),
("nodes_Title", API.ColumnField (API.ColumnName "Title") $ API.ScalarType "string")
]
& API.qAggregates ?~ mkFieldsMap [("aggregate_count", API.StarCount)]
& API.qAggregates
?~ mkFieldsMap [("aggregate_count", API.StarCount)]
)
& API._QRTable
. API.trForeach

7
server/lib/api-tests/src/Test/DataConnector/MockAgent/TransformedConfigurationSpec.hs
View File

@ -133,8 +133,8 @@ tests = describe "Transformed Configuration Tests" $ do
_mrrRecordedRequest
`shouldBe` Just
( Query $
mkTableRequest
( Query
$ mkTableRequest
(mkTableName "Album")
( emptyQuery
& API.qFields
@ -142,7 +142,8 @@ tests = describe "Transformed Configuration Tests" $ do
[ ("id", API.ColumnField (API.ColumnName "AlbumId") $ API.ScalarType "number"),
("title", API.ColumnField (API.ColumnName "Title") $ API.ScalarType "string")
]
& API.qLimit ?~ 1
& API.qLimit
?~ 1
)
)

95
server/lib/api-tests/src/Test/DataConnector/MockAgent/UpdateMutationsSpec.hs
View File

@ -134,8 +134,8 @@ tests = do
[ ("updatedRows_TrackId", API.mkColumnFieldValue $ J.Number 3),
("updatedRows_Name", API.mkColumnFieldValue $ J.String "Another Name"),
( "updatedRows_Genre",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("Name", API.mkColumnFieldValue $ J.String "Rock")
]
]
@ -145,8 +145,8 @@ tests = do
[ ("updatedRows_TrackId", API.mkColumnFieldValue $ J.Number 4),
("updatedRows_Name", API.mkColumnFieldValue $ J.String "Another Name"),
( "updatedRows_Genre",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("Name", API.mkColumnFieldValue $ J.String "Rock")
]
]
@ -156,8 +156,8 @@ tests = do
[ ("updatedRows_TrackId", API.mkColumnFieldValue $ J.Number 5),
("updatedRows_Name", API.mkColumnFieldValue $ J.String "Another Name"),
( "updatedRows_Genre",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("Name", API.mkColumnFieldValue $ J.String "Rock")
]
]
@ -209,33 +209,34 @@ tests = do
}
]
& API.mrOperations
.~ [ API.UpdateOperation $
API.UpdateMutationOperation
.~ [ API.UpdateOperation
$ API.UpdateMutationOperation
{ API._umoTable = mkTableName "Track",
API._umoUpdates =
Set.fromList
[ API.SetColumn $
API.RowColumnOperatorValue
[ API.SetColumn
$ API.RowColumnOperatorValue
{ API._rcovColumn = API.ColumnName "Name",
API._rcovValue = J.String "Another Name",
API._rcovValueType = API.ScalarType "string"
},
API.CustomUpdateColumnOperator (API.UpdateColumnOperatorName [G.name|inc|]) $
API.RowColumnOperatorValue
API.CustomUpdateColumnOperator (API.UpdateColumnOperatorName [G.name|inc|])
$ API.RowColumnOperatorValue
{ API._rcovColumn = API.ColumnName "Milliseconds",
API._rcovValue = J.Number 1000,
API._rcovValueType = API.ScalarType "number"
},
API.SetColumn $
API.RowColumnOperatorValue
API.SetColumn
$ API.RowColumnOperatorValue
{ API._rcovColumn = API.ColumnName "AlbumId",
API._rcovValue = J.Number 3,
API._rcovValueType = API.ScalarType "number"
}
],
API._umoWhere =
Just . API.And $
Set.fromList
Just
. API.And
$ Set.fromList
[ API.ApplyBinaryComparisonOperator
API.Equal
(API.ComparisonColumn API.CurrentTable (API.ColumnName "AlbumId") $ API.ScalarType "number")
@ -246,8 +247,8 @@ tests = do
(API.ScalarValueComparison $ API.ScalarValue (J.Number 1) (API.ScalarType "number"))
],
API._umoPostUpdateCheck =
Just $
API.ApplyBinaryComparisonOperator
Just
$ API.ApplyBinaryComparisonOperator
API.GreaterThan
(API.ComparisonColumn API.CurrentTable (API.ColumnName "UnitPrice") $ API.ScalarType "number")
(API.ScalarValueComparison $ API.ScalarValue (J.Number 0) (API.ScalarType "number")),
@ -297,8 +298,8 @@ tests = do
[ ("updatedRows_TrackId", API.mkColumnFieldValue $ J.Number 3),
("updatedRows_Name", API.mkColumnFieldValue $ J.String "Another Name"),
( "updatedRows_Genre",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("Name", API.mkColumnFieldValue $ J.String "Rock")
]
]
@ -314,8 +315,8 @@ tests = do
[ ("updatedRows_TrackId", API.mkColumnFieldValue $ J.Number 4),
("updatedRows_Name", API.mkColumnFieldValue $ J.String "Better Name"),
( "updatedRows_Genre",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("Name", API.mkColumnFieldValue $ J.String "Rock")
]
]
@ -325,8 +326,8 @@ tests = do
[ ("updatedRows_TrackId", API.mkColumnFieldValue $ J.Number 5),
("updatedRows_Name", API.mkColumnFieldValue $ J.String "Better Name"),
( "updatedRows_Genre",
API.mkRelationshipFieldValue $
mkRowsQueryResponse
API.mkRelationshipFieldValue
$ mkRowsQueryResponse
[ [ ("Name", API.mkColumnFieldValue $ J.String "Rock")
]
]
@ -362,8 +363,8 @@ tests = do
|]
let sharedPostUpdateCheck =
Just $
API.ApplyBinaryComparisonOperator
Just
$ API.ApplyBinaryComparisonOperator
API.GreaterThan
(API.ComparisonColumn API.CurrentTable (API.ColumnName "UnitPrice") $ API.ScalarType "number")
(API.ScalarValueComparison $ API.ScalarValue (J.Number 0) (API.ScalarType "number"))
@ -398,33 +399,34 @@ tests = do
}
]
& API.mrOperations
.~ [ API.UpdateOperation $
API.UpdateMutationOperation
.~ [ API.UpdateOperation
$ API.UpdateMutationOperation
{ API._umoTable = mkTableName "Track",
API._umoUpdates =
Set.fromList
[ API.SetColumn $
API.RowColumnOperatorValue
[ API.SetColumn
$ API.RowColumnOperatorValue
{ API._rcovColumn = API.ColumnName "Name",
API._rcovValue = J.String "Another Name",
API._rcovValueType = API.ScalarType "string"
},
API.CustomUpdateColumnOperator (API.UpdateColumnOperatorName [G.name|inc|]) $
API.RowColumnOperatorValue
API.CustomUpdateColumnOperator (API.UpdateColumnOperatorName [G.name|inc|])
$ API.RowColumnOperatorValue
{ API._rcovColumn = API.ColumnName "Milliseconds",
API._rcovValue = J.Number 1000,
API._rcovValueType = API.ScalarType "number"
},
API.SetColumn $
API.RowColumnOperatorValue
API.SetColumn
$ API.RowColumnOperatorValue
{ API._rcovColumn = API.ColumnName "AlbumId",
API._rcovValue = J.Number 3,
API._rcovValueType = API.ScalarType "number"
}
],
API._umoWhere =
Just . API.And $
Set.fromList
Just
. API.And
$ Set.fromList
[ API.ApplyBinaryComparisonOperator
API.Equal
(API.ComparisonColumn API.CurrentTable (API.ColumnName "AlbumId") $ API.ScalarType "number")
@ -437,33 +439,34 @@ tests = do
API._umoPostUpdateCheck = sharedPostUpdateCheck,
API._umoReturningFields = sharedReturning
},
API.UpdateOperation $
API.UpdateMutationOperation
API.UpdateOperation
$ API.UpdateMutationOperation
{ API._umoTable = mkTableName "Track",
API._umoUpdates =
Set.fromList
[ API.SetColumn $
API.RowColumnOperatorValue
[ API.SetColumn
$ API.RowColumnOperatorValue
{ API._rcovColumn = API.ColumnName "Name",
API._rcovValue = J.String "Better Name",
API._rcovValueType = API.ScalarType "string"
},
API.CustomUpdateColumnOperator (API.UpdateColumnOperatorName [G.name|inc|]) $
API.RowColumnOperatorValue
API.CustomUpdateColumnOperator (API.UpdateColumnOperatorName [G.name|inc|])
$ API.RowColumnOperatorValue
{ API._rcovColumn = API.ColumnName "UnitPrice",
API._rcovValue = J.Number 1,
API._rcovValueType = API.ScalarType "number"
},
API.SetColumn $
API.RowColumnOperatorValue
API.SetColumn
$ API.RowColumnOperatorValue
{ API._rcovColumn = API.ColumnName "AlbumId",
API._rcovValue = J.Number 3,
API._rcovValueType = API.ScalarType "number"
}
],
API._umoWhere =
Just . API.And $
Set.fromList
Just
. API.And
$ Set.fromList
[ API.ApplyBinaryComparisonOperator
API.Equal
(API.ComparisonColumn API.CurrentTable (API.ColumnName "AlbumId") $ API.ScalarType "number")

8
server/lib/api-tests/src/Test/Databases/BigQuery/Schema/ComputedFields/TableSpec.hs
View File

@ -98,8 +98,8 @@ setupFunction testEnv =
let schemaName = Schema.getSchemaName testEnv
in [ Fixture.SetupAction
{ Fixture.setupAction =
BigQuery.run_ $
[i|
BigQuery.run_
$ [i|
CREATE TABLE FUNCTION #{ unSchemaName schemaName }.fetch_articles_implicit_return(a_id INT64, search STRING)
AS
SELECT article_alias.*
@ -111,8 +111,8 @@ setupFunction testEnv =
},
Fixture.SetupAction
{ Fixture.setupAction =
BigQuery.run_ $
[i|
BigQuery.run_
$ [i|
CREATE TABLE FUNCTION #{ unSchemaName schemaName }.fetch_articles_explicit_return(a_id INT64, search STRING)
RETURNS TABLE<id INT64, title STRING, content STRING, author_id INT64> AS
SELECT article_alias.id, article_alias.title, article_alias.content, article_alias.author_id

12
server/lib/api-tests/src/Test/Databases/Postgres/JsonbSpec.hs
View File

@ -49,8 +49,8 @@ spec =
jsonType :: Schema.ScalarType
jsonType =
Schema.TCustomType $
Schema.defaultBackendScalarType
Schema.TCustomType
$ Schema.defaultBackendScalarType
{ Schema.bstPostgres = Just "JSON",
Schema.bstCitus = Just "JSON",
Schema.bstCockroach = Just "JSON"
@ -58,8 +58,8 @@ jsonType =
jsonbType :: Schema.ScalarType
jsonbType =
Schema.TCustomType $
Schema.defaultBackendScalarType
Schema.TCustomType
$ Schema.defaultBackendScalarType
{ Schema.bstPostgres = Just "JSONB",
Schema.bstCitus = Just "JSONB",
Schema.bstCockroach = Just "JSONB"
@ -67,8 +67,8 @@ jsonbType =
mkJsonValue :: Text -> Schema.ScalarValue
mkJsonValue json =
Schema.VCustomValue $
Schema.defaultBackendScalarValue
Schema.VCustomValue
$ Schema.defaultBackendScalarValue
{ Schema.bsvPostgres = Just (Schema.Quoted json),
Schema.bsvCitus = Just (Schema.Quoted json),
Schema.bsvCockroach = Just (Schema.Quoted json)

4
server/lib/api-tests/src/Test/Databases/SQLServer/DefaultValues/OnConflictSpec.hs
View File

@ -70,8 +70,8 @@ schema =
defaultDateTimeType :: Schema.ScalarType
defaultDateTimeType =
Schema.TCustomType $
Schema.defaultBackendScalarType
Schema.TCustomType
$ Schema.defaultBackendScalarType
{ Schema.bstMssql = Just "DATETIME DEFAULT GETDATE()",
Schema.bstCitus = Just "TIMESTAMP DEFAULT NOW()",
Schema.bstPostgres = Just "TIMESTAMP DEFAULT NOW()",

8
server/lib/api-tests/src/Test/EventTriggers/EventTriggersSpecialCharactersSpec.hs
View File

@ -82,8 +82,8 @@ schema = [dummyTable]
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "special characters of different languages in event trigger payload are encoded in UTF-8" do
it "check: inserting a new row invokes a event trigger" $
\(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
it "check: inserting a new row invokes a event trigger"
$ \(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
let backendTypeMetadata = fromMaybe (error "Expected a backend type but got nothing") $ getBackendTypeConfig testEnvironment
sourceName = BackendType.backendSourceName backendTypeMetadata
schemaName = Schema.getSchemaName testEnvironment
@ -166,8 +166,8 @@ dbSetup testEnvironment webhookServer = do
-- Track table using custom_name for the special character column since GraphQL
-- spec does not support special characters
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: #{backendPrefix}_track_table

12
server/lib/api-tests/src/Test/EventTriggers/MSSQL/EventTriggerDropSourceCleanupSpec.hs
View File

@ -75,8 +75,8 @@ authorsTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "dropping a source with event triggers should remove 'hdb_catalog' schema and the SQL triggers created on the table" do
it "check: inserting a new row invokes a event trigger" $
\(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
it "check: inserting a new row invokes a event trigger"
$ \(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
insertQuery =
@ -115,8 +115,8 @@ tests =
eventPayload `shouldBeYaml` expectedEventPayload
it "drop source, check the table works as it was before event trigger was created on it" $
\(testEnvironment, _) -> do
it "drop source, check the table works as it was before event trigger was created on it"
$ \(testEnvironment, _) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
let dropSourceQuery =
@ -184,8 +184,8 @@ mssqlSetupWithEventTriggers testEnvironment webhookServer = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: mssql_create_event_trigger

12
server/lib/api-tests/src/Test/EventTriggers/MSSQL/EventTriggerNextRetryAtTimezoneSpec.hs
View File

@ -77,8 +77,8 @@ tests =
-- The test checks that the event trigger retries as expected. In the test, we fire up the event trigger by adding a
-- row to the table. We wait for a few seconds so the event has retried completely and then see if the number of
-- retries are 2 (the event retries once)
it "check: the total number of tries is (number of retries + 1)" $
\(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
it "check: the total number of tries is (number of retries + 1)"
$ \(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
insertQuery =
@ -154,8 +154,8 @@ mssqlSetupWithEventTriggers testEnvironment webhookServer = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
webhookServerNextRetryEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/nextRetry"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: mssql_create_event_trigger
@ -175,8 +175,8 @@ mssqlSetupWithEventTriggers testEnvironment webhookServer = do
mssqlTeardown :: TestEnvironment -> IO ()
mssqlTeardown testEnvironment = do
GraphqlEngine.postMetadata_ testEnvironment $
[yaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [yaml|
type: bulk
args:
- type: mssql_delete_event_trigger

16
server/lib/api-tests/src/Test/EventTriggers/MSSQL/EventTriggersForReplicationSpec.hs
View File

@ -83,8 +83,8 @@ articlesTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "verify trigger status when logical replication is used" do
it "verify trigger is enabled on logical replication" $
\(testEnvironment, (webhookServer, (Webhook.EventsQueue _eventsQueue))) -> do
it "verify trigger is enabled on logical replication"
$ \(testEnvironment, (webhookServer, (Webhook.EventsQueue _eventsQueue))) -> do
mssqlSetupWithEventTriggers testEnvironment webhookServer "True"
let getTriggerInfoQuery =
[interpolateYaml|
@ -116,8 +116,8 @@ tests =
(GraphqlEngine.postV2Query 200 testEnvironment getTriggerInfoQuery)
expectedResponseForEnablingTriggers
it "verify trigger is disabled on logical replication" $
\(testEnvironment, (webhookServer, (Webhook.EventsQueue _eventsQueue))) -> do
it "verify trigger is disabled on logical replication"
$ \(testEnvironment, (webhookServer, (Webhook.EventsQueue _eventsQueue))) -> do
mssqlSetupWithEventTriggers testEnvironment webhookServer "False"
let getTriggerInfoQuery =
[interpolateYaml|
@ -158,8 +158,8 @@ mssqlSetupWithEventTriggers testEnvironment webhookServer triggerOnReplication =
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: mssql_create_event_trigger
@ -181,8 +181,8 @@ mssqlSetupWithEventTriggers testEnvironment webhookServer triggerOnReplication =
mssqlTeardown :: TestEnvironment -> IO ()
mssqlTeardown testEnvironment = do
GraphqlEngine.postMetadata_ testEnvironment $
[yaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [yaml|
type: mssql_delete_event_trigger
args:
name: author_trigger

4
server/lib/api-tests/src/Test/EventTriggers/MSSQL/EventTriggersNameQuotingSpec.hs
View File

@ -69,8 +69,8 @@ authorsTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests = describe "weird trigger names are allowed" do
it "metadata_api: allow creating an event trigger with weird name via replace_metadata" $
\(testEnvironment, (webhookServer, _)) -> do
it "metadata_api: allow creating an event trigger with weird name via replace_metadata"
$ \(testEnvironment, (webhookServer, _)) -> do
let createEventTriggerWithWeirdName =
addEventTriggerViaReplaceMetadata testEnvironment "weird]name]" webhookServer
createEventTriggerWithWeirdNameExpectedResponse =

20
server/lib/api-tests/src/Test/EventTriggers/MSSQL/EventTriggersUniqueNameSpec.hs
View File

@ -87,8 +87,8 @@ articlesTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "only unique trigger names are allowed" do
it "check: inserting a new row invokes a event trigger" $
\(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
it "check: inserting a new row invokes a event trigger"
$ \(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
insertQuery =
@ -127,8 +127,8 @@ tests =
eventPayload `shouldBeYaml` expectedEventPayload
it "metadata_api: does not allow creating an event trigger with a name that already exists" $
\(testEnvironment, (webhookServer, _)) -> do
it "metadata_api: does not allow creating an event trigger with a name that already exists"
$ \(testEnvironment, (webhookServer, _)) -> do
-- metadata <- GraphqlEngine.exportMetadata testEnvironment
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
@ -160,8 +160,8 @@ tests =
(GraphqlEngine.postWithHeadersStatus 400 testEnvironment "/v1/metadata/" mempty createEventTriggerWithDuplicateName)
createEventTriggerWithDuplicateNameExpectedResponse
it "replace_metadata: does not allow creating an event trigger with a name that already exists" $
\(testEnvironment, (webhookServer, _)) -> do
it "replace_metadata: does not allow creating an event trigger with a name that already exists"
$ \(testEnvironment, (webhookServer, _)) -> do
let replaceMetadata = getReplaceMetadata testEnvironment webhookServer
replaceMetadataWithDuplicateNameExpectedResponse =
@ -186,8 +186,8 @@ mssqlSetupWithEventTriggers testEnvironment webhookServer = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: mssql_create_event_trigger
@ -251,8 +251,8 @@ getReplaceMetadata testEnvironment webhookServer =
mssqlTeardown :: TestEnvironment -> IO ()
mssqlTeardown testEnvironment = do
GraphqlEngine.postMetadata_ testEnvironment $
[yaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [yaml|
type: bulk
args:
- type: mssql_delete_event_trigger

12
server/lib/api-tests/src/Test/EventTriggers/MSSQL/EventTriggersUntrackTableCleanupSpec.hs
View File

@ -74,8 +74,8 @@ authorsTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "untrack a table with event triggers should remove the SQL triggers created on the table" do
it "check: inserting a new row invokes a event trigger" $
\(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
it "check: inserting a new row invokes a event trigger"
$ \(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
insertQuery =
@ -114,8 +114,8 @@ tests =
eventPayload `shouldBeYaml` expectedEventPayload
it "untrack table, check the SQL triggers are deleted from the table" $
\(testEnvironment, _) -> do
it "untrack table, check the SQL triggers are deleted from the table"
$ \(testEnvironment, _) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
untrackTableQuery =
@ -178,8 +178,8 @@ mssqlSetup testEnvironment webhookServer = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: mssql_create_event_trigger

8
server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersClearMetadataSpec.hs
View File

@ -76,8 +76,8 @@ authorsTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "doing clear_metadata with an event trigger containing auto cleanup config should succeed" do
it "remove source via replace_metadata, check that the event_log table is removed as well" $
\(testEnvironment, (_, _)) -> do
it "remove source via replace_metadata, check that the event_log table is removed as well"
$ \(testEnvironment, (_, _)) -> do
-- remove the source using replace_meatadata API
let clearMetadata =
[yaml|
@ -105,8 +105,8 @@ postgresSetup testEnvironment webhookServer = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
let webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: pg_create_event_trigger

24
server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersExtensionSchemaSpec.hs
View File

@ -76,8 +76,8 @@ authorsTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "event triggers should work when extensions are created in different schema using 'extensions_schema'" do
it "check: inserting a new row invokes a event trigger" $
\(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
it "check: inserting a new row invokes a event trigger"
$ \(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
let insertQuery =
@ -169,7 +169,7 @@ tests =
-- ** Setup and teardown override
postgresSetup :: HasCallStack => TestEnvironment -> GraphqlEngine.Server -> IO ()
postgresSetup :: (HasCallStack) => TestEnvironment -> GraphqlEngine.Server -> IO ()
postgresSetup testEnvironment webhookServer = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
@ -186,8 +186,8 @@ postgresSetup testEnvironment webhookServer = do
webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
-- create a new source
GraphqlEngine.postMetadata_ testEnvironment $
[yaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [yaml|
type: pg_add_source
args:
name: *sourceName
@ -200,8 +200,8 @@ postgresSetup testEnvironment webhookServer = do
Schema.trackTable sourceName theTable testEnvironment
-- create the event trigger
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: pg_create_event_trigger
@ -216,10 +216,10 @@ postgresSetup testEnvironment webhookServer = do
columns: "*"
|]
postgresTeardown :: HasCallStack => TestEnvironment -> IO ()
postgresTeardown :: (HasCallStack) => TestEnvironment -> IO ()
postgresTeardown testEnvironment = do
GraphqlEngine.postMetadata_ testEnvironment $
[yaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [yaml|
type: bulk
args:
- type: pg_delete_event_trigger
@ -228,8 +228,8 @@ postgresTeardown testEnvironment = do
source: hge_test
|]
GraphqlEngine.postMetadata_ testEnvironment $
[yaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [yaml|
type: bulk
args:
- type: pg_drop_source

16
server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersForReplicationSpec.hs
View File

@ -83,8 +83,8 @@ articlesTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "verify trigger status when logical replication is used" do
it "verify trigger is enabled on logical replication" $
\(testEnvironment, (webhookServer, (Webhook.EventsQueue _eventsQueue))) -> do
it "verify trigger is enabled on logical replication"
$ \(testEnvironment, (webhookServer, (Webhook.EventsQueue _eventsQueue))) -> do
postgresSetupWithEventTriggers testEnvironment webhookServer "True"
let getTriggerInfoQuery =
[interpolateYaml|
@ -118,8 +118,8 @@ tests =
(GraphqlEngine.postV2Query 200 testEnvironment getTriggerInfoQuery)
expectedResponseForEnablingTriggers
it "verify trigger is disabled on logical replication" $
\(testEnvironment, (webhookServer, (Webhook.EventsQueue _eventsQueue))) -> do
it "verify trigger is disabled on logical replication"
$ \(testEnvironment, (webhookServer, (Webhook.EventsQueue _eventsQueue))) -> do
postgresSetupWithEventTriggers testEnvironment webhookServer "False"
let getTriggerInfoQuery =
[interpolateYaml|
@ -162,8 +162,8 @@ postgresSetupWithEventTriggers testEnvironment webhookServer triggerOnReplicatio
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: pg_create_event_trigger
args:
name: author_trigger
@ -183,8 +183,8 @@ postgresSetupWithEventTriggers testEnvironment webhookServer triggerOnReplicatio
postgresTeardown :: TestEnvironment -> IO ()
postgresTeardown testEnvironment = do
GraphqlEngine.postMetadata_ testEnvironment $
[yaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [yaml|
type: pg_delete_event_trigger
args:
name: author_trigger

4
server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersRecreationSpec.hs
View File

@ -165,8 +165,8 @@ postgresTeardown :: TestEnvironment -> IO ()
postgresTeardown testEnvironment = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
GraphqlEngine.postV2Query_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postV2Query_ testEnvironment
$ [interpolateYaml|
type: run_sql
args:
source: postgres

8
server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersReplaceMetadataCleanupSpec.hs
View File

@ -75,8 +75,8 @@ authorsTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "removing a source with event trigger via replace_metadata should also remove the event trigger related stuffs (hdb_catalog.event_log)" do
it "remove source via replace_metadata, check that the event_log table is removed as well" $
\(testEnvironment, (_, _)) -> do
it "remove source via replace_metadata, check that the event_log table is removed as well"
$ \(testEnvironment, (_, _)) -> do
-- `hdb_catalog.event_log` should be existing before (as we have added an event trigger in setup)
checkIfPGTableExists testEnvironment "hdb_catalog.event_log" >>= (`shouldBe` True)
@ -112,8 +112,8 @@ postgresSetup testEnvironment webhookServer = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
let webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: pg_create_event_trigger

16
server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersRunSQLSpec.hs
View File

@ -120,8 +120,8 @@ args:
result_type: CommandOk
result: null
|]
it "inserting a new row should work fine" $
\(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
it "inserting a new row should work fine"
$ \(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
shouldReturnYaml
@ -251,8 +251,8 @@ renameTableContainingTriggerTests = do
result_type: CommandOk
result: null
|]
it "inserting a new row should work fine" $
\(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
it "inserting a new row should work fine"
$ \(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
shouldReturnYaml
@ -294,8 +294,8 @@ postgresSetup testEnvironment webhookServer = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
let webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: pg_create_event_trigger
@ -324,8 +324,8 @@ postgresSetup testEnvironment webhookServer = do
postgresTeardown :: TestEnvironment -> IO ()
postgresTeardown testEnvironment = do
GraphqlEngine.postMetadata_ testEnvironment $
[yaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [yaml|
type: bulk
args:
- type: pg_delete_event_trigger

20
server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersUniqueNameSpec.hs
View File

@ -87,8 +87,8 @@ articlesTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "only unique trigger names are allowed" do
it "check: inserting a new row invokes a event trigger" $
\(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
it "check: inserting a new row invokes a event trigger"
$ \(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
let insertQuery =
@ -127,8 +127,8 @@ tests =
eventPayload `shouldBeYaml` expectedEventPayload
it "metadata_api: does not allow creating an event trigger with a name that already exists" $
\(testEnvironment, (webhookServer, _)) -> do
it "metadata_api: does not allow creating an event trigger with a name that already exists"
$ \(testEnvironment, (webhookServer, _)) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
-- metadata <- GraphqlEngine.exportMetadata testEnvironment
@ -160,8 +160,8 @@ tests =
(GraphqlEngine.postWithHeadersStatus 400 testEnvironment "/v1/metadata/" mempty createEventTriggerWithDuplicateName)
createEventTriggerWithDuplicateNameExpectedResponse
it "replace_metadata: does not allow creating an event trigger with a name that already exists" $
\(testEnvironment, (webhookServer, _)) -> do
it "replace_metadata: does not allow creating an event trigger with a name that already exists"
$ \(testEnvironment, (webhookServer, _)) -> do
let replaceMetadata = getReplaceMetadata testEnvironment webhookServer
replaceMetadataWithDuplicateNameExpectedResponse =
@ -186,8 +186,8 @@ postgresSetup testEnvironment webhookServer = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
let webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: pg_create_event_trigger
@ -251,8 +251,8 @@ getReplaceMetadata testEnvironment webhookServer =
postgresTeardown :: TestEnvironment -> IO ()
postgresTeardown testEnvironment = do
GraphqlEngine.postMetadata_ testEnvironment $
[yaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [yaml|
type: bulk
args:
- type: pg_delete_event_trigger

12
server/lib/api-tests/src/Test/EventTriggers/PG/EventTriggersUntrackTableCleanupSpec.hs
View File

@ -74,8 +74,8 @@ authorsTable tableName =
tests :: SpecWith (TestEnvironment, (GraphqlEngine.Server, Webhook.EventsQueue))
tests =
describe "untrack a table with event triggers should remove the SQL triggers created on the table" do
it "check: inserting a new row invokes a event trigger" $
\(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
it "check: inserting a new row invokes a event trigger"
$ \(testEnvironment, (_, (Webhook.EventsQueue eventsQueue))) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
let insertQuery =
@ -114,8 +114,8 @@ tests =
eventPayload `shouldBeYaml` expectedEventPayload
it "untrack table, check the SQL triggers are deleted from the table" $
\(testEnvironment, _) -> do
it "untrack table, check the SQL triggers are deleted from the table"
$ \(testEnvironment, _) -> do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
let untrackTableQuery =
@ -168,8 +168,8 @@ postgresSetup testEnvironment webhookServer = do
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment
let webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: bulk
args:
- type: pg_create_event_trigger

4
server/lib/api-tests/src/Test/Mutations/Upsert/OnConflictSpec.hs
View File

@ -106,8 +106,8 @@ schema =
serialInt :: Schema.ScalarType
serialInt =
Schema.TCustomType $
Schema.defaultBackendScalarType
Schema.TCustomType
$ Schema.defaultBackendScalarType
{ Schema.bstCitus = Just "INT",
Schema.bstPostgres = Just "INT",
Schema.bstCockroach = Just "INT4"

4
server/lib/api-tests/src/Test/PortedFromPytest/TestGraphQLQueryBasicCitus.hs
View File

@ -308,8 +308,8 @@ tests = do
describe "test_nested_select_with_foreign_key_alter" do
-- from: queries/graphql_query/citus/nested_select_with_foreign_key_alter_citus.yaml [0]
it "Alter foreign key constraint on article table" \testEnvironment -> do
void $
GraphqlEngine.postV2Query
void
$ GraphqlEngine.postV2Query
200
testEnvironment
[interpolateYaml|

4
server/lib/api-tests/src/Test/Queries/AggregationSpec.hs
View File

@ -36,8 +36,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True,
Fixture.skipTests = Just "BigQuery returns numbers as strings, which means the second test fails"
}

4
server/lib/api-tests/src/Test/Queries/DistinctSpec.hs
View File

@ -47,8 +47,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
}

4
server/lib/api-tests/src/Test/Queries/Errors/InvalidQuerySpec.hs
View File

@ -56,8 +56,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnvironment
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/Errors/MissingTableSpec.hs
View File

@ -56,8 +56,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnvironment
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/Errors/NoQueriesAvailableSpec.hs
View File

@ -54,8 +54,8 @@ spec = do
[ BigQuery.setupTablesAction tables testEnvironment
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/FilterSearch/FilterSearchSpec.hs
View File

@ -54,8 +54,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

8
server/lib/api-tests/src/Test/Queries/NativeQueriesSpec.hs
View File

@ -21,8 +21,8 @@ featureFlagForNativeQueries = "HASURA_FF_NATIVE_QUERY_INTERFACE"
spec :: SpecWith GlobalTestEnvironment
spec =
Fixture.hgeWithEnv [(featureFlagForNativeQueries, "True")] $
Fixture.runClean -- re-run fixture setup on every test
Fixture.hgeWithEnv [(featureFlagForNativeQueries, "True")]
$ Fixture.runClean -- re-run fixture setup on every test
( NE.fromList
[ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata)
{ Fixture.setupTeardown = \(testEnvironment, _) ->
@ -66,8 +66,8 @@ tests = do
(Schema.trackLogicalModelCommand source backendTypeMetadata helloWorldLogicalModel)
-- we expect this to fail
void $
GraphqlEngine.postMetadataWithStatus
void
$ GraphqlEngine.postMetadataWithStatus
400
testEnvironment
(Schema.trackNativeQueryCommand source backendTypeMetadata helloWorldNativeQuery)

4
server/lib/api-tests/src/Test/Queries/NestedObjectSpec.hs
View File

@ -53,8 +53,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/Paginate/LimitSpec.hs
View File

@ -54,8 +54,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/Paginate/OffsetSpec.hs
View File

@ -53,8 +53,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

16
server/lib/api-tests/src/Test/Queries/Simple/JSONSpec.hs
View File

@ -28,8 +28,8 @@ import Test.Hspec (SpecWith, it)
spec :: SpecWith GlobalTestEnvironment
spec = do
withEachProtocol $
Fixture.run
withEachProtocol
$ Fixture.run
( NE.fromList
[ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata)
{ Fixture.setupTeardown = \(testEnvironment, _) ->
@ -51,8 +51,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnvironment
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
}
@ -69,8 +69,8 @@ schema =
{ tableColumns =
[ Schema.column "id" Schema.TInt,
Schema.column "name" Schema.TStr,
Schema.column "address" $
Schema.TCustomType
Schema.column "address"
$ Schema.TCustomType
Schema.defaultBackendScalarType
{ Schema.bstCitus = Just "JSON",
Schema.bstCockroach = Just "JSON",
@ -82,8 +82,8 @@ schema =
tableData =
[ [ Schema.VInt 1,
Schema.VStr "Justin",
Schema.VCustomValue $
Schema.defaultBackendScalarValue
Schema.VCustomValue
$ Schema.defaultBackendScalarValue
{ Schema.bsvCitus = Just (Schema.Quoted "{ \"city\": \"Bristol\" }"),
Schema.bsvCockroach = Just (Schema.Quoted "{ \"city\": \"Bristol\" }"),
Schema.bsvPostgres = Just (Schema.Quoted "{ \"city\": \"Bristol\" }"),

24
server/lib/api-tests/src/Test/Queries/Simple/ObjectQueriesSpec.hs
View File

@ -36,18 +36,18 @@ import Test.Hspec (SpecWith, describe, it)
spec :: SpecWith GlobalTestEnvironment
spec = do
withHge emptyHgeConfig $ do
withPostgresSource "postgres-source" $
withSchemaName "test_schema" $
withPostgresSchema schema $
tests
withPostgresSource "postgres-source"
$ withSchemaName "test_schema"
$ withPostgresSchema schema
$ tests
DC.withDcPostgresSource "dc-postgres-source" $
withSchemaName "test_schema" $
DC.withDcPostgresSchema schema $
tests
DC.withDcPostgresSource "dc-postgres-source"
$ withSchemaName "test_schema"
$ DC.withDcPostgresSchema schema
$ tests
withEachProtocol $
Fixture.run
withEachProtocol
$ Fixture.run
( NE.fromList
[ (Fixture.fixture $ Fixture.Backend Citus.backendTypeMetadata)
{ Fixture.setupTeardown = \(testEnvironment, _) ->
@ -69,8 +69,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnvironment
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

8
server/lib/api-tests/src/Test/Queries/Simple/OperationNameSpec.hs
View File

@ -27,8 +27,8 @@ import Test.Hspec (SpecWith, describe, it)
spec :: SpecWith GlobalTestEnvironment
spec = do
withEachProtocol $
Fixture.run
withEachProtocol
$ Fixture.run
( NE.fromList
[ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata)
{ Fixture.setupTeardown = \(testEnv, _) ->
@ -55,8 +55,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/Simple/PrimaryKeySpec.hs
View File

@ -28,8 +28,8 @@ import Test.Hspec (SpecWith, describe, it)
spec :: SpecWith GlobalTestEnvironment
spec =
withEachProtocol $
Fixture.run
withEachProtocol
$ Fixture.run
( NE.fromList
[ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata)
{ Fixture.setupTeardown = \(testEnvironment, _) ->

4
server/lib/api-tests/src/Test/Queries/SortSpec.hs
View File

@ -54,8 +54,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/VariablesAliasesFragments/AliasesSpec.hs
View File

@ -50,8 +50,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/VariablesAliasesFragments/Directives/DirectivesSpec.hs
View File

@ -52,8 +52,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/VariablesAliasesFragments/Directives/IncludeAndSkipSpec.hs
View File

@ -52,8 +52,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/VariablesAliasesFragments/Directives/IncludeSpec.hs
View File

@ -55,8 +55,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/VariablesAliasesFragments/Directives/SkipSpec.hs
View File

@ -55,8 +55,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/VariablesAliasesFragments/FragmentsSpec.hs
View File

@ -50,8 +50,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Queries/VariablesAliasesFragments/VariablesSpec.hs
View File

@ -50,8 +50,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

4
server/lib/api-tests/src/Test/Regression/AggregateBoolExpConflictSpec.hs
View File

@ -76,8 +76,8 @@ schema =
serialInt :: Schema.ScalarType
serialInt =
Schema.TCustomType $
Schema.defaultBackendScalarType
Schema.TCustomType
$ Schema.defaultBackendScalarType
{ Schema.bstCitus = Just "INT",
Schema.bstPostgres = Just "INT",
Schema.bstCockroach = Just "INT4"

4
server/lib/api-tests/src/Test/Regression/LongIdentifiers3796Spec.hs
View File

@ -57,8 +57,8 @@ spec = do
[ BigQuery.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
}

4
server/lib/api-tests/src/Test/Regression/MultiColumnObjectRelationshipsSpec.hs
View File

@ -51,8 +51,8 @@ spec = do
setupRelationships BigQuery.backendTypeMetadata testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
},

6
server/lib/api-tests/src/Test/Regression/MultiplexQuerySpec.hs
View File

@ -66,7 +66,8 @@ setupFunctions testEnv =
fetch_users = Schema.unSchemaName schemaName <> ".fetch_users"
in Fixture.SetupAction
{ Fixture.setupAction = do
Postgres.run_ testEnv $
Postgres.run_ testEnv
$
-- get_age postgres function returns the age of a user calculated from the
-- birth_year column and in_year input parameter. The in_year should be a future year
-- from 2022 (the year when this test is being written)
@ -87,7 +88,8 @@ setupFunctions testEnv =
end;
$function$
|]
Postgres.run_ testEnv $
Postgres.run_ testEnv
$
-- fetch_users postgres function returns the list of users whose age is equal to given "age" input parameter
-- in given future "in_year" parameter. The in_year should be a future year
-- from 2022 (the year when this test is being written) and "age" should not be a negative value.

24
server/lib/api-tests/src/Test/Regression/NullRemoteRelationship8345Spec.hs
View File

@ -35,16 +35,16 @@ spec = Fixture.runWithLocalTestEnvironment contexts tests
contexts = NE.fromList $ do
(rhsName, rhsMkLocalEnv, rhsSetup, rhsTeardown, albumJoin, artistJoin) <- [rhsPostgres, rhsRemoteServer]
(lhsName, lhsMkLocalEnv, lhsSetup, lhsTeardown) <- [lhsPostgres, lhsRemoteServer]
pure $
Fixture.Fixture
pure
$ Fixture.Fixture
{ Fixture.name = Fixture.Combine lhsName rhsName,
Fixture.mkLocalTestEnvironment = \testEnvironment -> do
lhsServer <- lhsMkLocalEnv testEnvironment
rhsServer <- rhsMkLocalEnv testEnvironment
pure $ LocalTestTestEnvironment lhsServer rhsServer,
Fixture.setupTeardown = \(testEnvironment, LocalTestTestEnvironment lhsServer rhsServer) -> do
pure $
Fixture.SetupAction
pure
$ Fixture.SetupAction
{ Fixture.setupAction = do
let schemaName = Schema.getSchemaName testEnvironment
-- RHS must always be setup before the LHS
@ -98,8 +98,8 @@ spec = Fixture.runWithLocalTestEnvironment contexts tests
rhsRemoteServerMkLocalTestEnvironment,
rhsRemoteServerSetup,
rhsRemoteServerTeardown,
const $
[yaml|
const
$ [yaml|
to_remote_schema:
remote_schema: target
lhs_fields: [album_id]
@ -108,8 +108,8 @@ spec = Fixture.runWithLocalTestEnvironment contexts tests
arguments:
album_id: $album_id
|],
const $
[yaml|
const
$ [yaml|
to_remote_schema:
remote_schema: target
lhs_fields: [artist_id]
@ -288,7 +288,7 @@ data LHSQuery m = LHSQuery
}
deriving (Generic)
instance Typeable m => Morpheus.GQLType (LHSQuery m) where
instance (Typeable m) => Morpheus.GQLType (LHSQuery m) where
typeOptions _ _ = hasuraTypeOptions
data LHSHasuraTrackArgs = LHSHasuraTrackArgs
@ -309,7 +309,7 @@ data LHSHasuraTrack m = LHSHasuraTrack
}
deriving (Generic)
instance Typeable m => Morpheus.GQLType (LHSHasuraTrack m) where
instance (Typeable m) => Morpheus.GQLType (LHSHasuraTrack m) where
typeOptions _ _ = hasuraTypeOptions
data LHSHasuraTrackOrderBy = LHSHasuraTrackOrderBy
@ -368,8 +368,8 @@ lhsRemoteServerMkLocalTestEnvironment _ =
Nothing -> \_ _ -> EQ
Just orderByArg -> orderTrack orderByArg
limitFunction = maybe Hasura.Prelude.id take ta_limit
pure $
tracks
pure
$ tracks
& filter filterFunction
& sortBy orderByFunction
& limitFunction

2
server/lib/api-tests/src/Test/Regression/ObjectRelationshipsLimit7936Spec.hs
View File

@ -309,7 +309,7 @@ setupMetadata testEnvironment = do
--
-- We use 'Visual' internally to easily display the 'Value' as YAML
-- when the test suite uses its 'Show' instance.
shouldReturnOneOfYaml :: HasCallStack => TestEnvironment -> IO Value -> [Value] -> IO ()
shouldReturnOneOfYaml :: (HasCallStack) => TestEnvironment -> IO Value -> [Value] -> IO ()
shouldReturnOneOfYaml testEnv actualIO candidates = do
let Fixture.Options {stringifyNumbers} = _options testEnv
actual <- actualIO

28
server/lib/api-tests/src/Test/Regression/RemoteRelationshipStringifyNum8387Spec.hs
View File

@ -30,11 +30,11 @@ import Test.Schema.RemoteRelationships.MetadataAPI.Common qualified as Common
spec :: SpecWith GlobalTestEnvironment
spec = do
Fixture.hgeWithEnv [("HASURA_GRAPHQL_STRINGIFY_NUMERIC_TYPES", "true")] $
Fixture.runWithLocalTestEnvironment contexts testsWithFeatureOn
Fixture.hgeWithEnv [("HASURA_GRAPHQL_STRINGIFY_NUMERIC_TYPES", "true")]
$ Fixture.runWithLocalTestEnvironment contexts testsWithFeatureOn
Fixture.hgeWithEnv [("HASURA_GRAPHQL_STRINGIFY_NUMERIC_TYPES", "false")] $
Fixture.runWithLocalTestEnvironment contexts testsWithFeatureOff
Fixture.hgeWithEnv [("HASURA_GRAPHQL_STRINGIFY_NUMERIC_TYPES", "false")]
$ Fixture.runWithLocalTestEnvironment contexts testsWithFeatureOff
where
lhsFixtures = [lhsPostgres, lhsRemoteServer]
rhsFixtures = [rhsPostgres]
@ -80,8 +80,8 @@ rhsPostgres =
[ SetupAction.noTeardown (rhsPostgresSetup testEnv)
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
}
@ -124,29 +124,29 @@ album =
floatType :: Schema.ScalarType
floatType =
Schema.TCustomType $
Schema.defaultBackendScalarType
Schema.TCustomType
$ Schema.defaultBackendScalarType
{ Schema.bstPostgres = Just "NUMERIC"
}
mkFloatValue :: Text -> Schema.ScalarValue
mkFloatValue int =
Schema.VCustomValue $
Schema.defaultBackendScalarValue
Schema.VCustomValue
$ Schema.defaultBackendScalarValue
{ Schema.bsvPostgres = Just (Schema.Unquoted int)
}
bigIntType :: Schema.ScalarType
bigIntType =
Schema.TCustomType $
Schema.defaultBackendScalarType
Schema.TCustomType
$ Schema.defaultBackendScalarType
{ Schema.bstPostgres = Just "BIGINT"
}
mkBigIntValue :: Text -> Schema.ScalarValue
mkBigIntValue int =
Schema.VCustomValue $
Schema.defaultBackendScalarValue
Schema.VCustomValue
$ Schema.defaultBackendScalarValue
{ Schema.bsvPostgres = Just (Schema.Unquoted int)
}

4
server/lib/api-tests/src/Test/Regression/StreamConflictSpec.hs
View File

@ -19,8 +19,8 @@ spec =
[ Postgres.setupTablesAction schema testEnv
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.skipTests =
Just "Disabled until we can dynamically change server settings per test. To test, add EFHideStreamFields to soSubscriptions in Harness.Constants -> serveOptions"
}

6
server/lib/api-tests/src/Test/Regression/UsingTheSameFunctionForRootFieldAndComputedField8643Spec.hs
View File

@ -54,9 +54,9 @@ schema =
functionSetup :: TestEnvironment -> Fixture.SetupAction
functionSetup testEnvironment =
let schemaName = unSchemaName (getSchemaName testEnvironment)
in SetupAction.noTeardown $
Postgres.run_ testEnvironment $
"CREATE FUNCTION "
in SetupAction.noTeardown
$ Postgres.run_ testEnvironment
$ "CREATE FUNCTION "
<> schemaName
<> ".authors(author_row "
<> schemaName

8
server/lib/api-tests/src/Test/ScheduledEvents/ScheduledEventsInvalidEnvVarSpec.hs
View File

@ -82,8 +82,8 @@ tests = do
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
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|
@ -113,8 +113,8 @@ scheduledEventsWithInvalidEnvVar =
postgresSetup :: TestEnvironment -> GraphqlEngine.Server -> IO ()
postgresSetup testEnvironment webhookServer = do
let webhookServerEchoEndpoint = GraphqlEngine.serverUrl webhookServer ++ "/echo"
GraphqlEngine.postMetadata_ testEnvironment $
[interpolateYaml|
GraphqlEngine.postMetadata_ testEnvironment
$ [interpolateYaml|
type: create_scheduled_event
args:
webhook: #{webhookServerEchoEndpoint}

20
server/lib/api-tests/src/Test/Schema/ComputedFields/TableSpec.hs
View File

@ -45,8 +45,8 @@ spec =
<> bigquerySetupFunctions testEnv
<> setupMetadata testEnv,
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
}
@ -114,8 +114,8 @@ postgresSetupFunctions testEnv =
articleTableSQL = unSchemaName schemaName <> ".article"
in [ Fixture.SetupAction
{ Fixture.setupAction =
Postgres.run_ testEnv $
[i|
Postgres.run_ testEnv
$ [i|
CREATE FUNCTION #{ fetch_articles schemaName }(author_row author, search TEXT)
RETURNS SETOF article AS $$
SELECT *
@ -130,8 +130,8 @@ postgresSetupFunctions testEnv =
},
Fixture.SetupAction
{ Fixture.setupAction =
Postgres.run_ testEnv $
[i|
Postgres.run_ testEnv
$ [i|
CREATE FUNCTION #{ fetch_articles_no_user_args schemaName }(author_row author)
RETURNS SETOF article AS $$
SELECT *
@ -149,8 +149,8 @@ bigquerySetupFunctions testEnv =
articleTableSQL = unSchemaName schemaName <> ".article"
in [ Fixture.SetupAction
{ Fixture.setupAction =
BigQuery.run_ $
[i|
BigQuery.run_
$ [i|
CREATE TABLE FUNCTION
#{ fetch_articles schemaName }(a_id INT64, search STRING)
AS
@ -163,8 +163,8 @@ bigquerySetupFunctions testEnv =
},
Fixture.SetupAction
{ Fixture.setupAction =
BigQuery.run_ $
[i|
BigQuery.run_
$ [i|
CREATE TABLE FUNCTION
#{ fetch_articles_no_user_args schemaName }(a_id INT64)
AS

8
server/lib/api-tests/src/Test/Schema/DataValidations/Permissions/SelectSpec.hs
View File

@ -63,8 +63,8 @@ spec = do
setupMetadata DoesNotSupportArrayTypes BigQuery.backendTypeMetadata testEnvironment
],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
}
@ -226,8 +226,8 @@ tests arrayTypeSupport = describe "Permissions on queries" do
shouldReturnYaml testEnvironment actual expected
it "Editor role can select in review and published articles only" \testEnvironment -> do
when (arrayTypeSupport == DoesNotSupportArrayTypes) $
pendingWith "Backend does not support array types"
when (arrayTypeSupport == DoesNotSupportArrayTypes)
$ pendingWith "Backend does not support array types"
let schemaName :: Schema.SchemaName
schemaName = Schema.getSchemaName testEnvironment

4
server/lib/api-tests/src/Test/Schema/DefaultValues/OnConflictSpec.hs
View File

@ -79,8 +79,8 @@ schema =
defaultDateTimeType :: Schema.ScalarType
defaultDateTimeType =
Schema.TCustomType $
Schema.defaultBackendScalarType
Schema.TCustomType
$ Schema.defaultBackendScalarType
{ Schema.bstMssql = Just "DATETIME DEFAULT GETDATE()",
Schema.bstCitus = Just "TIMESTAMP DEFAULT NOW()",
Schema.bstPostgres = Just "TIMESTAMP DEFAULT NOW()",

23
server/lib/api-tests/src/Test/Schema/RemoteRelationships/FromRemoteSchemaSpec.hs
View File

@ -37,9 +37,9 @@ spec = Fixture.runWithLocalTestEnvironmentSingleSetup (NE.fromList [context]) te
(Fixture.fixture $ Fixture.RemoteGraphQLServer)
{ -- start only one remote server
Fixture.mkLocalTestEnvironment = \_testEnvironment ->
RemoteServer.run $
RemoteServer.generateQueryInterpreter $
Query
RemoteServer.run
$ RemoteServer.generateQueryInterpreter
$ Query
{ object = objectResolver,
writer = writerResolver,
artist = artistResolver,
@ -181,7 +181,7 @@ type Article {
|]
knownObjects :: Monad m => [(Int, Object m)]
knownObjects :: (Monad m) => [(Int, Object m)]
knownObjects =
[ (101, ObjectWriter writer1),
(102, ObjectWriter writer2),
@ -202,28 +202,29 @@ knownObjects =
article3 = Article (pure 303) (pure "Article3") (pure 201) (pure 102)
article4 = Article (pure 304) (pure "Article4") (pure 202) (pure 102)
objectResolver :: Monad m => Arg "id" Int -> m (Maybe (Object m))
objectResolver :: (Monad m) => Arg "id" Int -> m (Maybe (Object m))
objectResolver (Arg objectId) = pure $ lookup objectId knownObjects
writerResolver :: Monad m => Arg "id" Int -> m (Maybe (Writer m))
writerResolver :: (Monad m) => Arg "id" Int -> m (Maybe (Writer m))
writerResolver (Arg objectId) =
pure $ case lookup objectId knownObjects of
Just (ObjectWriter w) -> Just w
_ -> Nothing
artistResolver :: Monad m => Arg "id" Int -> m (Maybe (Artist m))
artistResolver :: (Monad m) => Arg "id" Int -> m (Maybe (Artist m))
artistResolver (Arg objectId) =
pure $ case lookup objectId knownObjects of
Just (ObjectArtist a) -> Just a
_ -> Nothing
objectsResolver :: Monad m => Arg "ids" [Int] -> m [Maybe (Object m)]
objectsResolver :: (Monad m) => Arg "ids" [Int] -> m [Maybe (Object m)]
objectsResolver (Arg objectIds) = pure [lookup objectId knownObjects | objectId <- objectIds]
articlesResolver :: Monad m => Arg "ids" [Int] -> m [Maybe (Article m)]
articlesResolver :: (Monad m) => Arg "ids" [Int] -> m [Maybe (Article m)]
articlesResolver (Arg objectIds) =
pure $
objectIds <&> \objectId ->
pure
$ objectIds
<&> \objectId ->
case lookup objectId knownObjects of
Just (ObjectArticle a) -> Just a
_ -> Nothing

12
server/lib/api-tests/src/Test/Schema/RemoteRelationships/MetadataAPI/Common.hs
View File

@ -65,8 +65,8 @@ data LocalTestTestEnvironment = LocalTestTestEnvironment
dbTodbRemoteRelationshipFixture :: Fixture.Fixture LocalTestTestEnvironment
dbTodbRemoteRelationshipFixture =
( Fixture.fixture $
Fixture.Combine
( Fixture.fixture
$ Fixture.Combine
(Fixture.Backend Postgres.backendTypeMetadata)
(Fixture.Backend Postgres.backendTypeMetadata)
)
@ -440,7 +440,7 @@ data LHSQuery m = LHSQuery
}
deriving (Generic)
instance Typeable m => Morpheus.GQLType (LHSQuery m) where
instance (Typeable m) => Morpheus.GQLType (LHSQuery m) where
typeOptions _ _ = hasuraTypeOptions
data LHSHasuraTrackArgs = LHSHasuraTrackArgs
@ -460,7 +460,7 @@ data LHSHasuraTrack m = LHSHasuraTrack
}
deriving (Generic)
instance Typeable m => Morpheus.GQLType (LHSHasuraTrack m) where
instance (Typeable m) => Morpheus.GQLType (LHSHasuraTrack m) where
typeOptions _ _ = hasuraTypeOptions
data LHSHasuraTrackOrderBy = LHSHasuraTrackOrderBy
@ -517,8 +517,8 @@ lhsRemoteServerMkLocalTestEnvironment _ =
Nothing -> \_ _ -> EQ
Just orderByArg -> orderTrack orderByArg
limitFunction = maybe Hasura.Prelude.id take ta_limit
pure $
tracks
pure
$ tracks
& filter filterFunction
& sortBy orderByFunction
& limitFunction

4
server/lib/api-tests/src/Test/Schema/RemoteRelationships/MetadataAPI/DropSource/DBtoDBRelationshipSpec.hs
View File

@ -90,8 +90,8 @@ tests = describe "drop-source-metadata-tests" do
let sources = key "sources" . values
-- Extract the 'source' DB info from the sources field in metadata
sourceDB =
Unsafe.fromJust $
findOf
Unsafe.fromJust
$ findOf
sources
(has $ key "name" . _String . only "source")
metadata

4
server/lib/api-tests/src/Test/Schema/RemoteRelationships/MetadataAPI/DropSource/RSToDBRelationshipSpec.hs
View File

@ -89,8 +89,8 @@ tests = describe "drop-source-metadata-tests" do
let remoteSchemas = key "remote_schemas" . values
-- Extract the 'source' remote schema and check if any remote relationships exists
sourceRemoteSchema =
Unsafe.fromJust $
findOf
Unsafe.fromJust
$ findOf
remoteSchemas
(has $ key "name" . _String . only "source")
metadata

30
server/lib/api-tests/src/Test/Schema/RemoteRelationships/XToDBArrayRelationshipSpec.hs
View File

@ -239,7 +239,7 @@ lhsRole2 =
selectPermissionSource = Just lhsSourceName_
}
createRemoteRelationship :: HasCallStack => Value -> Value -> TestEnvironment -> IO ()
createRemoteRelationship :: (HasCallStack) => Value -> Value -> TestEnvironment -> IO ()
createRemoteRelationship lhsTableName rhsTableName testEnvironment = do
let backendTypeMetadata = fromMaybe (error "Unknown backend") $ getBackendTypeConfig testEnvironment
backendType = BackendType.backendTypeString backendTypeMetadata
@ -333,7 +333,7 @@ rhsTable =
--------------------------------------------------------------------------------
-- LHS Postgres
lhsPostgresSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsPostgresSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsPostgresSetup rhsTableName (wholeTestEnvironment, _) = do
let testEnvironment = focusFixtureLeft wholeTestEnvironment
sourceConfig = Postgres.defaultSourceConfiguration testEnvironment
@ -359,7 +359,7 @@ lhsPostgresSetup rhsTableName (wholeTestEnvironment, _) = do
--------------------------------------------------------------------------------
-- LHS Cockroach
lhsCockroachSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsCockroachSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsCockroachSetup rhsTableName (wholeTestEnvironment, _) = do
let testEnvironment = focusFixtureLeft wholeTestEnvironment
sourceConfig = Cockroach.defaultSourceConfiguration testEnvironment
@ -386,7 +386,7 @@ lhsCockroachSetup rhsTableName (wholeTestEnvironment, _) = do
--------------------------------------------------------------------------------
-- LHS Citus
lhsCitusSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsCitusSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsCitusSetup rhsTableName (wholeTestEnvironment, _) = do
let testEnvironment = focusFixtureLeft wholeTestEnvironment
sourceConfig = Citus.defaultSourceConfiguration testEnvironment
@ -412,7 +412,7 @@ lhsCitusSetup rhsTableName (wholeTestEnvironment, _) = do
--------------------------------------------------------------------------------
-- LHS SQLServer
lhsSQLServerSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsSQLServerSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsSQLServerSetup rhsTableName (wholeTestEnvironment, _) = do
let testEnvironment = focusFixtureLeft wholeTestEnvironment
sourceConfig = SQLServer.defaultSourceConfiguration testEnvironment
@ -438,7 +438,7 @@ lhsSQLServerSetup rhsTableName (wholeTestEnvironment, _) = do
--------------------------------------------------------------------------------
-- LHS SQLite
lhsSqliteSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO API.DatasetCloneName
lhsSqliteSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO API.DatasetCloneName
lhsSqliteSetup rhsTableName (wholeTestEnvironment, _) = do
let testEnvironment = focusFixtureLeft wholeTestEnvironment
let cloneName = API.DatasetCloneName $ tshow (uniqueTestId testEnvironment) <> "-lhs"
@ -502,7 +502,7 @@ data Query m = Query
}
deriving (Generic)
instance Typeable m => Morpheus.GQLType (Query m)
instance (Typeable m) => Morpheus.GQLType (Query m)
data HasuraArtistArgs = HasuraArtistArgs
{ aa_where :: Maybe HasuraArtistBoolExp,
@ -520,7 +520,7 @@ data HasuraArtist m = HasuraArtist
}
deriving (Generic)
instance Typeable m => Morpheus.GQLType (HasuraArtist m) where
instance (Typeable m) => Morpheus.GQLType (HasuraArtist m) where
typeOptions _ _ = hasuraTypeOptions
data HasuraArtistOrderBy = HasuraArtistOrderBy
@ -575,8 +575,8 @@ lhsRemoteServerMkLocalTestEnvironment _ =
Nothing -> \_ _ -> EQ
Just orderByArg -> orderArtist orderByArg
limitFunction = maybe id take aa_limit
pure $
artists
pure
$ artists
& filter filterFunction
& sortBy orderByFunction
& limitFunction
@ -623,7 +623,7 @@ lhsRemoteServerMkLocalTestEnvironment _ =
a_name = pure $ Just artistName
}
lhsRemoteServerSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsRemoteServerSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsRemoteServerSetup tableName (testEnvironment, maybeRemoteServer) = case maybeRemoteServer of
Nothing -> error "XToDBArrayRelationshipSpec: remote server local testEnvironment did not succesfully create a server"
Just remoteServer -> do
@ -832,14 +832,14 @@ schemaTests =
. key "fields"
. values
albumsField =
Unsafe.fromJust $
findOf
Unsafe.fromJust
$ findOf
focusArtistFields
(has $ key "name" . _String . only "albums")
introspectionResult
albumsAggregateField =
Unsafe.fromJust $
findOf
Unsafe.fromJust
$ findOf
focusArtistFields
(has $ key "name" . _String . only "albums_aggregate")
introspectionResult

20
server/lib/api-tests/src/Test/Schema/RemoteRelationships/XToDBObjectRelationshipSpec.hs
View File

@ -257,7 +257,7 @@ album =
lhsPostgresMkLocalTestEnvironment :: TestEnvironment -> Managed (Maybe Server)
lhsPostgresMkLocalTestEnvironment _ = pure Nothing
lhsPostgresSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsPostgresSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsPostgresSetup rhsTableName (wholeTestEnvironment, _) = do
let testEnvironment = focusFixtureLeft wholeTestEnvironment
sourceName = "source"
@ -323,7 +323,7 @@ args:
lhsCitusMkLocalTestEnvironment :: TestEnvironment -> Managed (Maybe Server)
lhsCitusMkLocalTestEnvironment _ = pure Nothing
lhsCitusSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsCitusSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsCitusSetup rhsTableName (wholeTestEnvironment, _) = do
let testEnvironment = focusFixtureLeft wholeTestEnvironment
sourceName = "source"
@ -389,7 +389,7 @@ args:
lhsCockroachMkLocalTestEnvironment :: TestEnvironment -> Managed (Maybe Server)
lhsCockroachMkLocalTestEnvironment _ = pure Nothing
lhsCockroachSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsCockroachSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsCockroachSetup rhsTableName (wholeTestEnvironment, _) = do
let testEnvironment = focusFixtureLeft wholeTestEnvironment
sourceName = "source"
@ -455,7 +455,7 @@ lhsCockroachSetup rhsTableName (wholeTestEnvironment, _) = do
lhsSQLServerMkLocalTestEnvironment :: TestEnvironment -> Managed (Maybe Server)
lhsSQLServerMkLocalTestEnvironment _ = pure Nothing
lhsSQLServerSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsSQLServerSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsSQLServerSetup rhsTableName (wholeTestEnvironment, _) = do
let testEnvironment = focusFixtureLeft wholeTestEnvironment
sourceName = "source"
@ -519,7 +519,7 @@ args:
--------------------------------------------------------------------------------
-- LHS SQLite
lhsSqliteSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO API.DatasetCloneName
lhsSqliteSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO API.DatasetCloneName
lhsSqliteSetup rhsTableName (wholeTestEnvironment, _) = do
let testEnvironment = focusFixtureLeft wholeTestEnvironment
let cloneName = API.DatasetCloneName $ tshow (uniqueTestId testEnvironment) <> "-lhs"
@ -611,7 +611,7 @@ data Query m = Query
}
deriving (Generic)
instance Typeable m => Morpheus.GQLType (Query m)
instance (Typeable m) => Morpheus.GQLType (Query m)
data HasuraTrackArgs = HasuraTrackArgs
{ ta_where :: Maybe HasuraTrackBoolExp,
@ -630,7 +630,7 @@ data HasuraTrack m = HasuraTrack
}
deriving (Generic)
instance Typeable m => Morpheus.GQLType (HasuraTrack m) where
instance (Typeable m) => Morpheus.GQLType (HasuraTrack m) where
typeOptions _ _ = hasuraTypeOptions
data HasuraTrackOrderBy = HasuraTrackOrderBy
@ -687,8 +687,8 @@ lhsRemoteServerMkLocalTestEnvironment _ =
Nothing -> \_ _ -> EQ
Just orderByArg -> orderTrack orderByArg
limitFunction = maybe Hasura.Prelude.id take ta_limit
pure $
tracks
pure
$ tracks
& filter filterFunction
& sortBy orderByFunction
& limitFunction
@ -745,7 +745,7 @@ lhsRemoteServerMkLocalTestEnvironment _ =
t_album_id = pure albumId
}
lhsRemoteServerSetup :: HasCallStack => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsRemoteServerSetup :: (HasCallStack) => Value -> (TestEnvironment, Maybe Server) -> IO ()
lhsRemoteServerSetup tableName (testEnvironment, maybeRemoteServer) = case maybeRemoteServer of
Nothing -> error "XToDBObjectRelationshipSpec: remote server local testEnvironment did not succesfully create a server"
Just remoteServer -> do

12
server/lib/api-tests/src/Test/Schema/RemoteRelationships/XToRemoteSchemaRelationshipSpec.hs
View File

@ -47,8 +47,8 @@ spec :: SpecWith GlobalTestEnvironment
spec = Fixture.runWithLocalTestEnvironment contexts tests
where
contexts =
NE.fromList $
map
NE.fromList
$ map
mkFixture
[ (Fixture.fixture $ Fixture.Backend Postgres.backendTypeMetadata)
{ Fixture.mkLocalTestEnvironment = lhsPostgresMkLocalTestEnvironment,
@ -431,7 +431,7 @@ data LHSQuery m = LHSQuery
}
deriving (Generic)
instance Typeable m => Morpheus.GQLType (LHSQuery m) where
instance (Typeable m) => Morpheus.GQLType (LHSQuery m) where
typeOptions _ _ = hasuraTypeOptions
data LHSHasuraTrackArgs = LHSHasuraTrackArgs
@ -451,7 +451,7 @@ data LHSHasuraTrack m = LHSHasuraTrack
}
deriving (Generic)
instance Typeable m => Morpheus.GQLType (LHSHasuraTrack m) where
instance (Typeable m) => Morpheus.GQLType (LHSHasuraTrack m) where
typeOptions _ _ = hasuraTypeOptions
data LHSHasuraTrackOrderBy = LHSHasuraTrackOrderBy
@ -508,8 +508,8 @@ lhsRemoteServerMkLocalTestEnvironment _ =
Nothing -> \_ _ -> EQ
Just orderByArg -> orderTrack orderByArg
limitFunction = maybe Hasura.Prelude.id take ta_limit
pure $
tracks
pure
$ tracks
& filter filterFunction
& sortBy orderByFunction
& limitFunction

8
server/lib/api-tests/src/Test/Schema/RemoteSchemaCustomizationSpec.hs
View File

@ -27,9 +27,9 @@ spec = Fixture.runWithLocalTestEnvironment (NE.fromList [context]) tests
(Fixture.fixture $ Fixture.RemoteGraphQLServer)
{ -- start only one remote server
Fixture.mkLocalTestEnvironment = \_testEnvironment ->
RemoteServer.run $
RemoteServer.generateQueryInterpreter $
Query
RemoteServer.run
$ RemoteServer.generateQueryInterpreter
$ Query
{ echoEnum = echoEnumResolver
},
setupTeardown = \(testEnvironment, server) ->
@ -175,5 +175,5 @@ enum Profession {
|]
echoEnumResolver :: Monad m => Arg "x" Profession -> m Profession
echoEnumResolver :: (Monad m) => Arg "x" Profession -> m Profession
echoEnumResolver (Arg x) = pure x

4
server/lib/api-tests/src/Test/Schema/TableRelationships/ArrayRelationshipsSpec.hs
View File

@ -44,8 +44,8 @@ spec = do
{ Fixture.setupTeardown = \(testEnv, _) ->
[BigQuery.setupTablesAction schema testEnv],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
}

4
server/lib/api-tests/src/Test/Schema/TableRelationships/ObjectRelationshipsSpec.hs
View File

@ -72,8 +72,8 @@ spec = do
{ Fixture.setupTeardown = \(testEnv, _) ->
[BigQuery.setupTablesAction schema testEnv],
Fixture.customOptions =
Just $
Fixture.defaultOptions
Just
$ Fixture.defaultOptions
{ Fixture.stringifyNumbers = True
}
}

2
server/lib/arrows-extra/src/Control/Arrow/Interpret.hs
View File

@ -78,7 +78,7 @@ import Control.Monad.Trans.Writer
-- NB: This is conceptually different from `ArrowApply`, which expresses that a
-- given `Arrow` /is/ a Kleisli arrow. `ArrowInterpret` has no such condition
-- on @arr@.
interpretWriter :: ArrowWriter w arr => Writer w a `arr` a
interpretWriter :: (ArrowWriter w arr) => Writer w a `arr` a
interpretWriter = proc m -> do
let (a, w) = runWriter m
tellA -< w

2
server/lib/dc-api/test/Command.hs
View File

@ -252,5 +252,5 @@ baseUrl = eitherReader $ left show . parseBaseUrl
configValue :: ReadM API.Config
configValue = fmap API.Config jsonValue
jsonValue :: FromJSON v => ReadM v
jsonValue :: (FromJSON v) => ReadM v
jsonValue = eitherReader (eitherDecodeStrict' . Text.encodeUtf8 . Text.pack)

14
server/lib/dc-api/test/Test/AgentAPI.hs
View File

@ -46,13 +46,13 @@ import Test.Expectations (yamlShow)
import Test.Sandwich (HasBaseContext, expectationFailure)
import Prelude
client :: RunClient m => API.Routes (AsClientT m)
client :: (RunClient m) => API.Routes (AsClientT m)
client = genericClient @API.Routes
getCapabilitiesGuarded :: (HasBaseContext context, MonadReader context m, MonadThrow m, MonadIO m) => AgentClientT m API.CapabilitiesResponse
getCapabilitiesGuarded = guardCapabilitiesResponse =<< (client // API._capabilities)
guardCapabilitiesResponse :: MonadThrow m => Union API.CapabilitiesResponses -> m API.CapabilitiesResponse
guardCapabilitiesResponse :: (MonadThrow m) => Union API.CapabilitiesResponses -> m API.CapabilitiesResponse
guardCapabilitiesResponse = API.capabilitiesCase defaultAction successAction errorAction
where
defaultAction = expectationFailure "Expected CapabilitiesResponse"
@ -72,7 +72,7 @@ getSchemaGuarded = do
(sourceName, config) <- getSourceNameAndConfig
guardSchemaResponse =<< (client // API._schema) sourceName config
guardSchemaResponse :: MonadThrow m => Union API.SchemaResponses -> m API.SchemaResponse
guardSchemaResponse :: (MonadThrow m) => Union API.SchemaResponses -> m API.SchemaResponse
guardSchemaResponse = API.schemaCase defaultAction successAction errorAction
where
defaultAction = expectationFailure "Expected SchemaResponse"
@ -84,7 +84,7 @@ queryGuarded queryRequest = do
(sourceName, config) <- getSourceNameAndConfig
guardQueryResponse =<< (client // API._query) sourceName config queryRequest
guardQueryResponse :: MonadThrow m => Union API.QueryResponses -> m API.QueryResponse
guardQueryResponse :: (MonadThrow m) => Union API.QueryResponses -> m API.QueryResponse
guardQueryResponse = API.queryCase defaultAction successAction errorAction
where
defaultAction = expectationFailure "Expected QueryResponse"
@ -96,7 +96,7 @@ queryExpectError queryRequest = do
(sourceName, config) <- getSourceNameAndConfig
guardQueryErrorResponse =<< (client // API._query) sourceName config queryRequest
guardQueryErrorResponse :: MonadThrow m => Union API.QueryResponses -> m API.ErrorResponse
guardQueryErrorResponse :: (MonadThrow m) => Union API.QueryResponses -> m API.ErrorResponse
guardQueryErrorResponse = API.queryCase defaultAction successAction errorAction
where
defaultAction = expectationFailure "Expected ErrorResponse"
@ -116,7 +116,7 @@ mutationGuarded mutationRequest = do
(sourceName, config) <- getSourceNameAndConfig
guardMutationResponse =<< (client // API._mutation) sourceName config mutationRequest
guardMutationResponse :: MonadThrow m => Union API.MutationResponses -> m API.MutationResponse
guardMutationResponse :: (MonadThrow m) => Union API.MutationResponses -> m API.MutationResponse
guardMutationResponse = API.mutationCase defaultAction successAction errorAction
where
defaultAction = expectationFailure "Expected MutationResponse"
@ -128,7 +128,7 @@ mutationExpectError mutationRequest = do
(sourceName, config) <- getSourceNameAndConfig
guardMutationErrorResponse =<< (client // API._mutation) sourceName config mutationRequest
guardMutationErrorResponse :: MonadThrow m => Union API.MutationResponses -> m API.ErrorResponse
guardMutationErrorResponse :: (MonadThrow m) => Union API.MutationResponses -> m API.ErrorResponse
guardMutationErrorResponse = API.mutationCase defaultAction successAction errorAction
where
defaultAction = expectationFailure "Expected ErrorResponse"

12
server/lib/dc-api/test/Test/AgentClient.hs
View File

@ -51,7 +51,7 @@ import Prelude
-------------------------------------------------------------------------------
newtype AgentIOClient = AgentIOClient (forall m. MonadIO m => Client m (NamedRoutes API.Routes))
newtype AgentIOClient = AgentIOClient (forall m. (MonadIO m) => Client m (NamedRoutes API.Routes))
configHeader :: HeaderName
configHeader = CI.mk "X-Hasura-DataConnector-Config"
@ -61,7 +61,7 @@ newtype AgentAuthKey = AgentAuthKey {getAgentAuthKey :: ByteString}
eeLicenseKeyHeader :: HeaderName
eeLicenseKeyHeader = CI.mk "X-Hasura-License"
mkHttpClientManager :: MonadIO m => SensitiveOutputHandling -> Maybe AgentAuthKey -> m HttpClient.Manager
mkHttpClientManager :: (MonadIO m) => SensitiveOutputHandling -> Maybe AgentAuthKey -> m HttpClient.Manager
mkHttpClientManager sensitiveOutputHandling agentAuthKey =
let modifyRequest = addHeaderRedaction sensitiveOutputHandling . maybe id addLicenseKeyHeader agentAuthKey
settings = HttpClient.defaultManagerSettings {HttpClient.managerModifyRequest = pure . modifyRequest}
@ -76,7 +76,7 @@ addHeaderRedaction sensitiveOutputHandling request =
AllowSensitiveOutput -> request
DisallowSensitiveOutput -> request {HttpClient.redactHeaders = HttpClient.redactHeaders request <> Set.fromList [configHeader, eeLicenseKeyHeader]}
mkAgentIOClient :: MonadIO m => SensitiveOutputHandling -> Maybe AgentAuthKey -> BaseUrl -> m AgentIOClient
mkAgentIOClient :: (MonadIO m) => SensitiveOutputHandling -> Maybe AgentAuthKey -> BaseUrl -> m AgentIOClient
mkAgentIOClient sensitiveOutputHandling agentAuthKey agentBaseUrl = do
manager <- mkHttpClientManager sensitiveOutputHandling agentAuthKey
let clientEnv = mkClientEnv manager agentBaseUrl
@ -90,7 +90,7 @@ data AgentClientConfig = AgentClientConfig
_accSensitiveOutputHandling :: SensitiveOutputHandling
}
mkAgentClientConfig :: MonadIO m => SensitiveOutputHandling -> Maybe AgentAuthKey -> BaseUrl -> m AgentClientConfig
mkAgentClientConfig :: (MonadIO m) => SensitiveOutputHandling -> Maybe AgentAuthKey -> BaseUrl -> m AgentClientConfig
mkAgentClientConfig sensitiveOutputHandling agentAuthKey agentBaseUrl = do
manager <- mkHttpClientManager sensitiveOutputHandling agentAuthKey
pure $ AgentClientConfig agentBaseUrl manager sensitiveOutputHandling
@ -174,10 +174,10 @@ runRequestAcceptStatus' acceptStatus request = do
then pure $ response
else throwClientError $ mkFailureResponse _accBaseUrl request response
getClientState :: Monad m => AgentClientT m AgentClientState
getClientState :: (Monad m) => AgentClientT m AgentClientState
getClientState = AgentClientT get
incrementRequestCounter :: Monad m => AgentClientT m ()
incrementRequestCounter :: (Monad m) => AgentClientT m ()
incrementRequestCounter = AgentClientT $ modify' \state -> state {_acsRequestCounter = _acsRequestCounter state + 1}
redactJsonResponse :: Method -> ByteString -> J.Value -> J.Value

4
server/lib/dc-api/test/Test/Data.hs
View File

@ -801,8 +801,8 @@ mkSubqueryAggregatesFieldValue :: HashMap API.FieldName J.Value -> API.FieldValu
mkSubqueryAggregatesFieldValue aggregates =
API.mkRelationshipFieldValue $ API.QueryResponse Nothing (Just aggregates)
mkAndExpr :: Foldable f => f API.Expression -> API.Expression
mkAndExpr :: (Foldable f) => f API.Expression -> API.Expression
mkAndExpr = API.And . Set.fromList . Foldable.toList
mkOrExpr :: Foldable f => f API.Expression -> API.Expression
mkOrExpr :: (Foldable f) => f API.Expression -> API.Expression
mkOrExpr = API.Or . Set.fromList . Foldable.toList

2
server/lib/dc-api/test/Test/Expectations.hs
View File

@ -30,7 +30,7 @@ newtype YamlShow = YamlShow {unYamlShow :: Value}
instance Show YamlShow where
show = T.unpack . TE.decodeUtf8With TE.lenientDecode . Yaml.encode . unYamlShow
yamlShow :: ToJSON value => value -> String
yamlShow :: (ToJSON value) => value -> String
yamlShow = show . YamlShow . toJSON
-- | Compares two JSON values for equality, but prints their diff upon failure

2
server/lib/dc-api/test/Test/Specs/SchemaSpec.hs
View File

@ -141,7 +141,7 @@ spec TestData {..} API.Capabilities {..} = describe "schema API" $ preloadAgentS
Maybe API.TableInfo -> -- Actual table
ExampleT innerContext m ()
) ->
forall context. HasPreloadedAgentSchema context => SpecFree context IO ()
forall context. (HasPreloadedAgentSchema context) => SpecFree context IO ()
testPerTable description test =
describe description $ do
forM_ _tdSchemaTables $ \expectedTable@API.TableInfo {..} -> do

6
server/lib/error-message/src/Hasura/Base/ToErrorValue.hs
View File

@ -37,17 +37,17 @@ instance ToErrorValue () where
-- > [J.Number 1, J.Bool True, J.String "three"]
-- Will be printed as:
-- > "[1, true, \"three\"]"
instance ToErrorValue a => ToErrorValue [a] where
instance (ToErrorValue a) => ToErrorValue [a] where
toErrorValue values = "[" <> commaSeparatedValues <> "]"
where
commaSeparatedValues = foldr1 (<>) $ List.intersperse (toErrorMessage ", ") (map toErrorValue values)
-- | Will be printed as a list
instance ToErrorValue a => ToErrorValue (NonEmpty a) where
instance (ToErrorValue a) => ToErrorValue (NonEmpty a) where
toErrorValue = toErrorValue . NonEmpty.toList
-- | Will be printed as a list
instance ToErrorValue a => ToErrorValue (HashSet a) where
instance (ToErrorValue a) => ToErrorValue (HashSet a) where
toErrorValue = toErrorValue . HashSet.toList
-- | Will be printed with single quotes surrounding it

2
server/lib/error-message/test/Hasura/Base/ErrorMessageSpec.hs
View File

@ -105,7 +105,7 @@ spec =
newtype Thing a = Thing a
deriving newtype (Eq, Hashable)
instance Show a => ToErrorValue (Thing a) where
instance (Show a) => ToErrorValue (Thing a) where
toErrorValue (Thing x) = toErrorMessage $ "Thing " <> Text.pack (show x)
newtype SingleQuoted = SingleQuoted Char

26
server/lib/graphql-parser/src/Language/GraphQL/Draft/Generator.hs
View File

@ -96,7 +96,7 @@ instance Generator Void where
instance Generator Name where
genValue = genValueWith [genName]
generate :: MonadIO m => Gen a -> m a
generate :: (MonadIO m) => Gen a -> m a
generate = Gen.sample
-------------------------------------------------------------------------------
@ -107,7 +107,7 @@ genDocument :: Gen Document
genDocument =
Document <$> Gen.list (Range.linear 0 3) genDefinition
genExecutableDocument :: Generator a => Gen (ExecutableDocument a)
genExecutableDocument :: (Generator a) => Gen (ExecutableDocument a)
genExecutableDocument =
ExecutableDocument <$> Gen.list (Range.linear 1 3) genExecutableDefinition
@ -219,21 +219,21 @@ genDefinition =
DefinitionTypeSystem <$> genTypeSystemDefinition
]
genExecutableDefinition :: Generator a => Gen (ExecutableDefinition a)
genExecutableDefinition :: (Generator a) => Gen (ExecutableDefinition a)
genExecutableDefinition =
Gen.choice
[ ExecutableDefinitionOperation <$> genOperationDefinition,
ExecutableDefinitionFragment <$> genFragmentDefinition
]
genOperationDefinition :: Generator a => Gen (OperationDefinition FragmentSpread a)
genOperationDefinition :: (Generator a) => Gen (OperationDefinition FragmentSpread a)
genOperationDefinition =
Gen.choice
[ OperationDefinitionTyped <$> genTypedOperationDefinition,
OperationDefinitionUnTyped <$> genSelectionSet
]
genTypedOperationDefinition :: Generator a => Gen (TypedOperationDefinition FragmentSpread a)
genTypedOperationDefinition :: (Generator a) => Gen (TypedOperationDefinition FragmentSpread a)
genTypedOperationDefinition =
TypedOperationDefinition
<$> genOperationType
@ -422,10 +422,10 @@ genTypeSystemDirectiveLocation =
-- Structure
genSelectionSet :: Generator a => Gen (SelectionSet FragmentSpread a)
genSelectionSet :: (Generator a) => Gen (SelectionSet FragmentSpread a)
genSelectionSet = mkListNonEmpty genSelection
genSelection :: Generator a => Gen (Selection FragmentSpread a)
genSelection :: (Generator a) => Gen (Selection FragmentSpread a)
genSelection =
Gen.recursive
Gen.choice
@ -435,20 +435,20 @@ genSelection =
SelectionInlineFragment <$> genInlineFragment
]
genFragmentSpread :: Generator a => Gen (FragmentSpread a)
genFragmentSpread :: (Generator a) => Gen (FragmentSpread a)
genFragmentSpread =
FragmentSpread
<$> genName
<*> genDirectives
genInlineFragment :: Generator a => Gen (InlineFragment FragmentSpread a)
genInlineFragment :: (Generator a) => Gen (InlineFragment FragmentSpread a)
genInlineFragment =
InlineFragment
<$> Gen.maybe genName
<*> genDirectives
<*> genSelectionSet
genField :: Generator a => Gen (Field FragmentSpread a)
genField :: (Generator a) => Gen (Field FragmentSpread a)
genField =
Field
<$> Gen.maybe genName
@ -457,16 +457,16 @@ genField =
<*> genDirectives
<*> genSelectionSet
genDirective :: Generator a => Gen (Directive a)
genDirective :: (Generator a) => Gen (Directive a)
genDirective =
Directive
<$> genName
<*> (HashMap.fromList <$> mkList genArgument)
genDirectives :: Generator a => Gen [Directive a]
genDirectives :: (Generator a) => Gen [Directive a]
genDirectives = mkList genDirective
genArgument :: Generator a => Gen (Name, Value a)
genArgument :: (Generator a) => Gen (Name, Value a)
genArgument = (,) <$> genName <*> genValue
-------------------------------------------------------------------------------

28
server/lib/graphql-parser/src/Language/GraphQL/Draft/Parser.hs
View File

@ -136,10 +136,10 @@ class PossibleTypes pos where
instance PossibleTypes () where
possibleTypes = pure ()
selectionSet :: Variable var => Parser (AST.SelectionSet AST.FragmentSpread var)
selectionSet :: (Variable var) => Parser (AST.SelectionSet AST.FragmentSpread var)
selectionSet = braces $ many1 selection
selection :: Variable var => Parser (AST.Selection AST.FragmentSpread var)
selection :: (Variable var) => Parser (AST.Selection AST.FragmentSpread var)
selection =
AST.SelectionField <$> field
-- Inline first to catch `on` case
@ -155,7 +155,7 @@ aliasAndFld = do
Nothing -> return (Nothing, n)
{-# INLINE aliasAndFld #-}
field :: Variable var => Parser (AST.Field AST.FragmentSpread var)
field :: (Variable var) => Parser (AST.Field AST.FragmentSpread var)
field = do
(alM, n) <- aliasAndFld
AST.Field alM n
@ -165,7 +165,7 @@ field = do
-- * Fragments
fragmentSpread :: Variable var => Parser (AST.FragmentSpread var)
fragmentSpread :: (Variable var) => Parser (AST.FragmentSpread var)
-- TODO: Make sure it fails when `... on`.
-- See https://facebook.github.io/graphql/#FragmentSpread
fragmentSpread =
@ -175,7 +175,7 @@ fragmentSpread =
<*> optempty directives
-- InlineFragment tried first in order to guard against 'on' keyword
inlineFragment :: Variable var => Parser (AST.InlineFragment AST.FragmentSpread var)
inlineFragment :: (Variable var) => Parser (AST.InlineFragment AST.FragmentSpread var)
inlineFragment =
AST.InlineFragment
<$ tok "..."
@ -207,7 +207,7 @@ number = do
-- This will try to pick the first type it can runParser. If you are working with
-- explicit types use the `typedValue` parser.
value :: Variable var => Parser (AST.Value var)
value :: (Variable var) => Parser (AST.Value var)
value =
tok
( AST.VVariable <$> variable
@ -254,17 +254,17 @@ stringLiteral = unescapeText =<< (char '"' *> jstring_ <?> "string")
unescapeText :: Text -> Parser Text
unescapeText str = either fail pure $ A.parseOnly jstring ("\"" <> encodeUtf8 str <> "\"")
listLiteral :: Variable var => Parser [AST.Value var]
listLiteral :: (Variable var) => Parser [AST.Value var]
listLiteral = brackets (many value) <?> "list"
objectLiteral :: Variable var => Parser (HashMap AST.Name (AST.Value var))
objectLiteral :: (Variable var) => Parser (HashMap AST.Name (AST.Value var))
objectLiteral = braces (objectFields many) <?> "object"
arguments :: Variable var => Parser (HashMap AST.Name (AST.Value var))
arguments :: (Variable var) => Parser (HashMap AST.Name (AST.Value var))
arguments = parens (objectFields many1) <?> "arguments"
objectFields ::
Variable var =>
(Variable var) =>
(forall b. Parser b -> Parser [b]) ->
Parser (HashMap AST.Name (AST.Value var))
objectFields several = foldM insertField HashMap.empty =<< several objectField
@ -276,10 +276,10 @@ objectFields several = foldM insertField HashMap.empty =<< several objectField
-- * Directives
directives :: Variable var => Parser [AST.Directive var]
directives :: (Variable var) => Parser [AST.Directive var]
directives = many1 directive
directive :: Variable var => Parser (AST.Directive var)
directive :: (Variable var) => Parser (AST.Directive var)
directive =
AST.Directive
<$ tok "@"
@ -370,7 +370,7 @@ fieldDefinition =
argumentsDefinition :: Parser (AST.ArgumentsDefinition AST.InputValueDefinition)
argumentsDefinition = parens $ many1 inputValueDefinition
interfaceTypeDefinition :: PossibleTypes pos => Parser (AST.InterfaceTypeDefinition pos AST.InputValueDefinition)
interfaceTypeDefinition :: (PossibleTypes pos) => Parser (AST.InterfaceTypeDefinition pos AST.InputValueDefinition)
interfaceTypeDefinition =
AST.InterfaceTypeDefinition
<$> optDesc
@ -526,7 +526,7 @@ between :: Parser Text -> Parser Text -> Parser a -> Parser a
between open close p = tok open *> p <* tok close
-- `empty` /= `pure mempty` for `Parser`.
optempty :: Monoid a => Parser a -> Parser a
optempty :: (Monoid a) => Parser a -> Parser a
optempty = option mempty
data Expecting

60
server/lib/graphql-parser/src/Language/GraphQL/Draft/Printer.hs
View File

@ -124,7 +124,7 @@ instance Printer T.Text where
doubleP = T.pack . show
class Print a where
printP :: Printer b => a -> b
printP :: (Printer b) => a -> b
instance Print Void where
printP = absurd
@ -168,7 +168,7 @@ typedOperationDefinition :: (Print (frag var), Print var, Printer a) => TypedOpe
typedOperationDefinition op =
operationType (_todType op) <> charP ' ' <> nodeP op
operationType :: Printer a => OperationType -> a
operationType :: (Printer a) => OperationType -> a
operationType = \case
OperationTypeQuery -> "query"
OperationTypeMutation -> "mutation"
@ -204,7 +204,7 @@ field (Field alias name args dirs selSets) =
<> charP ' '
<> selectionSetP selSets
optAlias :: Printer a => Maybe Name -> a
optAlias :: (Printer a) => Maybe Name -> a
optAlias = maybe mempty (\a -> nameP a <> textP ": ")
inlineFragment :: (Print (frag var), Print var, Printer a) => InlineFragment frag var -> a
@ -214,14 +214,14 @@ inlineFragment (InlineFragment tc ds sels) =
<> optempty directives ds
<> selectionSetP sels
instance Print var => Print (FragmentSpread var) where
instance (Print var) => Print (FragmentSpread var) where
printP (FragmentSpread name ds) =
"..." <> nameP name <> optempty directives ds
instance Print (NoFragments var) where
printP = \case {}
fragmentDefinition :: Printer a => FragmentDefinition -> a
fragmentDefinition :: (Printer a) => FragmentDefinition -> a
fragmentDefinition (FragmentDefinition name tc dirs sels) =
"fragment "
<> nameP name
@ -240,7 +240,7 @@ directive (Directive name args) =
arguments :: (Print var, Printer a) => HashMap Name (Value var) -> a
arguments xs = charP '(' <> objectFields xs <> charP ')'
variableDefinitions :: Printer a => [VariableDefinition] -> a
variableDefinitions :: (Printer a) => [VariableDefinition] -> a
variableDefinitions vars =
mconcat
[ charP '(',
@ -250,26 +250,26 @@ variableDefinitions vars =
where
vars' = intersperse (charP ',') $ map variableDefinition vars
variableDefinition :: Printer a => VariableDefinition -> a
variableDefinition :: (Printer a) => VariableDefinition -> a
variableDefinition (VariableDefinition var ty defVal) =
variableP var <> ": " <> graphQLType ty <> maybe mempty defaultValue defVal
defaultValue :: Printer a => Value Void -> a
defaultValue :: (Printer a) => Value Void -> a
defaultValue v = " = " <> value v
description :: Printer a => Maybe Description -> a
description :: (Printer a) => Maybe Description -> a
description Nothing = mempty
description (Just desc) = dispatchStringPrinter (unDescription desc) <> " \n"
-- | Type Reference
graphQLType :: Printer a => GType -> a
graphQLType :: (Printer a) => GType -> a
graphQLType (TypeNamed n x) = nameP x <> nonNull n
graphQLType (TypeList n x) = listType x <> nonNull n
listType :: Printer a => GType -> a
listType :: (Printer a) => GType -> a
listType ty = charP '[' <> graphQLType ty <> charP ']'
nonNull :: Printer a => Nullability -> a
nonNull :: (Printer a) => Nullability -> a
nonNull n = bool (charP '!') mempty $ unNullability n
-- | Primitives
@ -290,7 +290,7 @@ value = \case
-- | Print a given text as a normal string or as a block string, depending on
-- its content.
dispatchStringPrinter :: Printer a => Text -> a
dispatchStringPrinter :: (Printer a) => Text -> a
dispatchStringPrinter t =
if printAsBlockString then blockStringValue t else stringValue t
where
@ -322,10 +322,10 @@ dispatchStringPrinter t =
isSourceCharacter = not . isControl
-- | We use Aeson to decode string values, and therefore use Aeson to encode them back.
stringValue :: Printer a => Text -> a
stringValue :: (Printer a) => Text -> a
stringValue s = textP $ LT.toStrict $ LTE.decodeUtf8 $ J.encode s
blockStringValue :: Printer a => Text -> a
blockStringValue :: (Printer a) => Text -> a
blockStringValue t = textP "\"\"\"\n" <> textP t <> textP "\n\"\"\""
listValue :: (Print var, Printer a) => [Value var] -> a
@ -341,7 +341,7 @@ objectFields o = mconcat $ intersperse (charP ',') $ map objectField $ HashMap.t
where
objectField (name, val) = nameP name <> ": " <> value val
fromBool :: Printer a => Bool -> a
fromBool :: (Printer a) => Bool -> a
fromBool True = "true"
fromBool False = "false"
@ -352,7 +352,7 @@ optempty f xs
schemaDefinition ::
forall a.
Printer a =>
(Printer a) =>
SchemaDefinition ->
a
schemaDefinition (SchemaDefinition dirs rootOpDefs) =
@ -362,15 +362,15 @@ schemaDefinition (SchemaDefinition dirs rootOpDefs) =
<> mconcat (intersperse (charP ' ') (map rootOperationTypeDefinition rootOpDefs))
<> " }"
rootOperationTypeDefinition :: Printer a => RootOperationTypeDefinition -> a
rootOperationTypeDefinition :: (Printer a) => RootOperationTypeDefinition -> a
rootOperationTypeDefinition (RootOperationTypeDefinition opType rootName) =
operationType opType <> ": " <> nameP rootName
typeSystemDefinition :: Printer a => TypeSystemDefinition -> a
typeSystemDefinition :: (Printer a) => TypeSystemDefinition -> a
typeSystemDefinition (TypeSystemDefinitionSchema schemaDefn) = schemaDefinition schemaDefn
typeSystemDefinition (TypeSystemDefinitionType typeDefn) = typeDefinitionP typeDefn
schemaDocument :: Printer a => SchemaDocument -> a
schemaDocument :: (Printer a) => SchemaDocument -> a
schemaDocument (SchemaDocument typeDefns) =
mconcat $ intersperse (textP "\n\n") $ map typeSystemDefinition $ sort $ filter isNotBuiltInScalar typeDefns
where
@ -383,7 +383,7 @@ schemaDocument (SchemaDocument typeDefns) =
) = name `notElem` builtInScalars
isNotBuiltInScalar _ = True
typeDefinitionP :: Printer a => TypeDefinition () InputValueDefinition -> a
typeDefinitionP :: (Printer a) => TypeDefinition () InputValueDefinition -> a
typeDefinitionP (TypeDefinitionScalar scalarDefn) = scalarTypeDefinition scalarDefn
typeDefinitionP (TypeDefinitionObject objDefn) = objectTypeDefinition objDefn
typeDefinitionP (TypeDefinitionInterface interfaceDefn) = interfaceTypeDefinition interfaceDefn
@ -391,7 +391,7 @@ typeDefinitionP (TypeDefinitionUnion unionDefn) = unionTypeDefinition unionDefn
typeDefinitionP (TypeDefinitionEnum enumDefn) = enumTypeDefinition enumDefn
typeDefinitionP (TypeDefinitionInputObject inpObjDefn) = inputObjectTypeDefinition inpObjDefn
scalarTypeDefinition :: Printer a => ScalarTypeDefinition -> a
scalarTypeDefinition :: (Printer a) => ScalarTypeDefinition -> a
scalarTypeDefinition (ScalarTypeDefinition desc name dirs) =
description desc
<> "scalar "
@ -400,7 +400,7 @@ scalarTypeDefinition (ScalarTypeDefinition desc name dirs) =
then mempty
else charP ' ' <> optempty directives dirs
inputValueDefinition :: Printer a => InputValueDefinition -> a
inputValueDefinition :: (Printer a) => InputValueDefinition -> a
inputValueDefinition (InputValueDefinition desc name gType defVal dirs) =
description desc
<> nameP name
@ -411,7 +411,7 @@ inputValueDefinition (InputValueDefinition desc name gType defVal dirs) =
then mempty
else charP ' ' <> optempty directives dirs
fieldDefinition :: Printer a => FieldDefinition InputValueDefinition -> a
fieldDefinition :: (Printer a) => FieldDefinition InputValueDefinition -> a
fieldDefinition (FieldDefinition desc name args gType dirs) =
description desc
<> nameP name
@ -425,7 +425,7 @@ fieldDefinition (FieldDefinition desc name args gType dirs) =
<> graphQLType gType
<> optempty directives dirs
objectTypeDefinition :: Printer a => ObjectTypeDefinition InputValueDefinition -> a
objectTypeDefinition :: (Printer a) => ObjectTypeDefinition InputValueDefinition -> a
objectTypeDefinition (ObjectTypeDefinition desc name ifaces dirs fieldDefinitions) =
description desc
<> "type "
@ -444,7 +444,7 @@ objectTypeDefinition (ObjectTypeDefinition desc name ifaces dirs fieldDefinition
<> "\n"
<> "}"
interfaceTypeDefinition :: Printer a => InterfaceTypeDefinition () InputValueDefinition -> a
interfaceTypeDefinition :: (Printer a) => InterfaceTypeDefinition () InputValueDefinition -> a
interfaceTypeDefinition (InterfaceTypeDefinition desc name dirs fieldDefinitions _possibleTypes) =
-- `possibleTypes` are not included with an interface definition in a GraphQL IDL
description desc
@ -462,7 +462,7 @@ interfaceTypeDefinition (InterfaceTypeDefinition desc name dirs fieldDefinitions
<> "\n"
<> "}"
unionTypeDefinition :: Printer a => UnionTypeDefinition -> a
unionTypeDefinition :: (Printer a) => UnionTypeDefinition -> a
unionTypeDefinition (UnionTypeDefinition desc name dirs members) =
description desc
<> "union "
@ -472,14 +472,14 @@ unionTypeDefinition (UnionTypeDefinition desc name dirs members) =
<> textP " = "
<> mconcat (intersperse (textP " | ") $ map nameP $ sort members)
enumValueDefinition :: Printer a => EnumValueDefinition -> a
enumValueDefinition :: (Printer a) => EnumValueDefinition -> a
enumValueDefinition (EnumValueDefinition desc name dirs) =
description desc
<> nameP (unEnumValue name)
<> charP ' '
<> optempty directives dirs
enumTypeDefinition :: Printer a => EnumTypeDefinition -> a
enumTypeDefinition :: (Printer a) => EnumTypeDefinition -> a
enumTypeDefinition (EnumTypeDefinition desc name dirs enumValDefns) =
description desc
<> "enum "
@ -495,7 +495,7 @@ enumTypeDefinition (EnumTypeDefinition desc name dirs enumValDefns) =
<> "\n"
<> "}"
inputObjectTypeDefinition :: Printer a => InputObjectTypeDefinition InputValueDefinition -> a
inputObjectTypeDefinition :: (Printer a) => InputObjectTypeDefinition InputValueDefinition -> a
inputObjectTypeDefinition (InputObjectTypeDefinition desc name dirs valDefns) =
description desc
<> "input "

8
server/lib/graphql-parser/src/Language/GraphQL/Draft/Syntax.hs
View File

@ -149,9 +149,9 @@ data ExecutableDefinition var
| ExecutableDefinitionFragment FragmentDefinition
deriving stock (Eq, Generic, Lift, Ord, Show, Functor, Foldable, Traversable)
instance Hashable var => Hashable (ExecutableDefinition var)
instance (Hashable var) => Hashable (ExecutableDefinition var)
instance NFData var => NFData (ExecutableDefinition var)
instance (NFData var) => NFData (ExecutableDefinition var)
partitionExDefs ::
[ExecutableDefinition var] ->
@ -320,7 +320,7 @@ data Value var
deriving stock (Eq, Generic, Ord, Show, Functor, Foldable, Traversable)
deriving anyclass (Hashable, NFData)
instance Lift var => Lift (Value var) where
instance (Lift var) => Lift (Value var) where
liftTyped (VVariable a) = [||VVariable a||]
liftTyped VNull = [||VNull||]
liftTyped (VInt a) = [||VInt a||]
@ -343,7 +343,7 @@ data Directive var = Directive
deriving stock (Eq, Generic, Ord, Show, Functor, Foldable, Traversable)
deriving anyclass (Hashable, NFData)
instance Lift var => Lift (Directive var) where
instance (Lift var) => Lift (Directive var) where
liftTyped Directive {..} =
[||
Directive

4
server/lib/graphql-parser/src/Language/GraphQL/Draft/Syntax/Name.hs
View File

@ -57,7 +57,7 @@ newtype NameSuffix = Suffix {unNameSuffix :: Text}
deriving stock (Eq, Lift, Ord, Show)
deriving newtype (Semigroup, Hashable, NFData, Pretty, J.ToJSONKey, J.ToJSON)
parseName :: MonadFail m => Text -> m Name
parseName :: (MonadFail m) => Text -> m Name
parseName text = maybe (fail errorMessage) pure $ mkName text
where
errorMessage = T.unpack text <> " is not valid GraphQL name"
@ -106,7 +106,7 @@ convertNameToSuffix = coerce
unsafeMkName :: Text -> Name
unsafeMkName = Name
parseSuffix :: MonadFail m => Text -> m NameSuffix
parseSuffix :: (MonadFail m) => Text -> m NameSuffix
parseSuffix text = maybe (fail errorMessage) pure $ mkNameSuffix text
where
errorMessage = T.unpack text <> " is not valid GraphQL suffix"

12
server/lib/hasura-base/src/Hasura/Base/Error.hs
View File

@ -202,8 +202,8 @@ instance ToJSON QErr where
"error" .= msg,
"code" .= code
]
toJSON (QErr jPath _ msg code (Just extra)) = object $
case extra of
toJSON (QErr jPath _ msg code (Just extra)) = object
$ case extra of
ExtraInternal e -> err ++ ["internal" .= e]
ExtraExtensions {} -> err
HideInconsistencies -> []
@ -346,8 +346,8 @@ throw500WithDetail t detail =
throwConnectionError :: (QErrM m) => Text -> m a
throwConnectionError t =
throwError $
(err500 Unexpected t)
throwError
$ (err500 Unexpected t)
{ qeInternal = Just HideInconsistencies,
qeCode = ConnectionNotEstablished
}
@ -407,7 +407,9 @@ indexedFoldlA' f = proc (e, (acc0, (xs, s))) ->
(|
foldlA'
(\acc (i, v) -> (| withPathIA ((e, (acc, (v, s))) >- f) |) i)
|) acc0 (zip [0 ..] (toList xs))
|)
acc0
(zip [0 ..] (toList xs))
indexedTraverseA_ ::
(ArrowChoice arr, ArrowError QErr arr, Foldable t) =>

Some files were not shown because too many files have changed in this diff Show More