mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
346804fc67
## Description This change adds support for nested object fields in HGE IR and Schema Cache, the Data Connectors backend and API, and the MongoDB agent. ### Data Connector API changes - The `/schema` endpoint response now includes an optional set of GraphQL type definitions. Table column types can refer to these definitions by name. - Queries can now include a new field type `object` which contains a column name and a nested query. This allows querying into a nested object within a field. ### MongoDB agent changes - Add support for querying into nested documents using the new `object` field type. ### HGE changes - The `Backend` type class has a new type family `XNestedObjects b` which controls whether or not a backend supports querying into nested objects. This is currently enabled only for the `DataConnector` backend. - For backends that support nested objects, the `FieldInfo` type gets a new constructor `FINestedObject`, and the `AnnFieldG` type gets a new constructor `AFNestedObject`. - If the DC `/schema` endpoint returns any custom GraphQL type definitions they are stored in the `TableInfo` for each table in the source. - During schema cache building, the function `addNonColumnFields` will check whether any column types match custom GraphQL object types stored in the `TableInfo`. If so, they are converted into `FINestedObject` instead of `FIColumn` in the `FieldInfoMap`. - When building the `FieldParser`s from `FieldInfo` (function `fieldSelection`) any `FINestedObject` fields are converted into nested object parsers returning `AFNestedObject`. - The `DataConnector` query planner converts `AFNestedObject` fields into `object` field types in the query sent to the agent. ## Limitations ### HGE not yet implemented: - Support for nested arrays - Support for nested objects/arrays in mutations - Support for nested objects/arrays in order-by - Support for filters (`where`) in nested objects/arrays - Support for adding custom GraphQL types via track table metadata API - Support for interface and union types - Tests for nested objects ### Mongo agent not yet implemented: - Generate nested object types from validation schema - Support for aggregates - Support for order-by - Configure agent port - Build agent in CI - Agent tests for nested objects and MongoDB agent PR-URL: https://github.com/hasura/graphql-engine-mono/pull/7844 GitOrigin-RevId: aec9ec1e4216293286a68f9b1af6f3f5317db423
753 lines
35 KiB
Haskell
753 lines
35 KiB
Haskell
{-# LANGUAGE DeriveAnyClass #-}
|
|
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Test.Data
|
|
( -- = Chinook Test Data
|
|
TestData (..),
|
|
mkTestData,
|
|
schemaTables,
|
|
allTableRows,
|
|
-- = TestingEdgeCases Test Data
|
|
EdgeCasesTestData (..),
|
|
mkEdgeCasesTestData,
|
|
-- = Utilities
|
|
emptyQuery,
|
|
emptyMutationRequest,
|
|
sortBy,
|
|
filterColumnsByQueryFields,
|
|
filterColumns,
|
|
renameColumns,
|
|
onlyKeepRelationships,
|
|
queryFields,
|
|
responseRows,
|
|
sortResponseRowsBy,
|
|
responseAggregates,
|
|
mkFieldsMap,
|
|
insertField,
|
|
deleteField,
|
|
field,
|
|
fieldAt,
|
|
_ColumnFieldNumber,
|
|
_ColumnFieldString,
|
|
_ColumnFieldBoolean,
|
|
_ColumnFieldNull,
|
|
_RelationshipFieldRows,
|
|
scalarValueComparison,
|
|
orderByColumn,
|
|
insertAutoIncPk,
|
|
autoIncPks,
|
|
mkSubqueryFieldValue,
|
|
mkSubqueryRowsFieldValue,
|
|
mkSubqueryAggregatesFieldValue,
|
|
)
|
|
where
|
|
|
|
import Codec.Compression.GZip qualified as GZip
|
|
import Command (NameCasing (..), TestConfig (..))
|
|
import Control.Arrow (first, (>>>))
|
|
import Control.Lens (At, Index, IxValue, Ixed, Traversal', at, ix, (%~), (&), (?~), (^.), (^..), (^?), _Just)
|
|
import Data.Aeson (eitherDecodeStrict)
|
|
import Data.Aeson qualified as J
|
|
import Data.Aeson.Lens (_Bool, _Null, _Number, _String)
|
|
import Data.Bifunctor (bimap)
|
|
import Data.ByteString (ByteString)
|
|
import Data.ByteString.Lazy qualified as BSL
|
|
import Data.CaseInsensitive (CI)
|
|
import Data.CaseInsensitive qualified as CI
|
|
import Data.FileEmbed (embedFile, makeRelativeToProject)
|
|
import Data.HashMap.Strict (HashMap)
|
|
import Data.HashMap.Strict qualified as HashMap
|
|
import Data.List (find, sortOn)
|
|
import Data.List.NonEmpty (NonEmpty (..))
|
|
import Data.List.NonEmpty qualified as NonEmpty
|
|
import Data.Maybe (fromMaybe, mapMaybe)
|
|
import Data.Scientific (Scientific)
|
|
import Data.Text (Text)
|
|
import Data.Text qualified as Text
|
|
import Data.Text.Encoding qualified as Text
|
|
import Hasura.Backends.DataConnector.API qualified as API
|
|
import Text.XML qualified as XML
|
|
import Text.XML.Lens qualified as XML
|
|
import Prelude
|
|
|
|
schemaBS :: ByteString
|
|
schemaBS = $(makeRelativeToProject "test/Test/Data/schema-tables.json" >>= embedFile)
|
|
|
|
schemaTables :: [API.TableInfo]
|
|
schemaTables = either error id . eitherDecodeStrict $ schemaBS
|
|
|
|
numericColumns :: [API.ColumnName]
|
|
numericColumns =
|
|
schemaTables
|
|
>>= ( API._tiColumns
|
|
>>> mapMaybe
|
|
( \API.ColumnInfo {..} ->
|
|
if _ciType == API.ScalarType "number"
|
|
then Just _ciName
|
|
else Nothing
|
|
)
|
|
)
|
|
|
|
edgeCasesSchemaBS :: ByteString
|
|
edgeCasesSchemaBS = $(makeRelativeToProject "test/Test/Data/edge-cases-schema-tables.json" >>= embedFile)
|
|
|
|
edgeCasesSchemaTables :: [API.TableInfo]
|
|
edgeCasesSchemaTables = either error id . eitherDecodeStrict $ edgeCasesSchemaBS
|
|
|
|
chinookXmlBS :: ByteString
|
|
chinookXmlBS = $(makeRelativeToProject "test/Test/Data/Chinook.xml.gz" >>= embedFile)
|
|
|
|
chinookXml :: XML.Document
|
|
chinookXml = XML.parseLBS_ XML.def . GZip.decompress $ BSL.fromStrict chinookXmlBS
|
|
|
|
readTableFromXmlIntoRows :: API.TableName -> [HashMap API.FieldName API.FieldValue]
|
|
readTableFromXmlIntoRows tableName =
|
|
rowToJsonObject <$> tableRows
|
|
where
|
|
tableNameToXmlTag :: API.TableName -> CI Text
|
|
tableNameToXmlTag (API.TableName names) = CI.mk . Text.intercalate "_" $ NonEmpty.toList names
|
|
|
|
tableRows :: [XML.Element]
|
|
tableRows = chinookXml ^.. XML.root . XML.nodes . traverse . XML._Element . XML.named (tableNameToXmlTag tableName)
|
|
|
|
rowToJsonObject :: XML.Element -> HashMap API.FieldName API.FieldValue
|
|
rowToJsonObject element =
|
|
let columnElements = element ^.. XML.nodes . traverse . XML._Element
|
|
keyValuePairs = columnElementToProperty <$> columnElements
|
|
in HashMap.fromList keyValuePairs
|
|
|
|
columnElementToProperty :: XML.Element -> (API.FieldName, API.FieldValue)
|
|
columnElementToProperty columnElement =
|
|
let name = columnElement ^. XML.localName
|
|
value = case columnElement ^. XML.nodes of
|
|
[] -> API.mkColumnFieldValue $ J.Null
|
|
_ ->
|
|
let textValue = Text.concat $ columnElement ^.. XML.text
|
|
in if API.ColumnName name `elem` numericColumns
|
|
then case eitherDecodeStrict $ Text.encodeUtf8 textValue of
|
|
Left _ -> API.mkColumnFieldValue $ J.String textValue
|
|
Right scientific -> API.mkColumnFieldValue $ J.Number scientific
|
|
else API.mkColumnFieldValue $ J.String textValue
|
|
in (API.FieldName name, value)
|
|
|
|
mkTableName :: Text -> API.TableName
|
|
mkTableName = API.TableName . (:| [])
|
|
|
|
artistsTableName :: API.TableName
|
|
artistsTableName = mkTableName "Artist"
|
|
|
|
artistsRows :: [HashMap API.FieldName API.FieldValue]
|
|
artistsRows = sortBy (API.FieldName "ArtistId") $ readTableFromXmlIntoRows artistsTableName
|
|
|
|
artistsRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue)
|
|
artistsRowsById =
|
|
HashMap.fromList $ mapMaybe (\artist -> (,artist) <$> artist ^? field "ArtistId" . _ColumnFieldNumber) artistsRows
|
|
|
|
albumsRelationshipName :: API.RelationshipName
|
|
albumsRelationshipName = API.RelationshipName "Albums"
|
|
|
|
artistsTableRelationships :: API.TableRelationships
|
|
artistsTableRelationships =
|
|
let joinFieldMapping = HashMap.fromList [(API.ColumnName "ArtistId", API.ColumnName "ArtistId")]
|
|
in API.TableRelationships
|
|
artistsTableName
|
|
( HashMap.fromList
|
|
[ (albumsRelationshipName, API.Relationship albumsTableName API.ArrayRelationship joinFieldMapping)
|
|
]
|
|
)
|
|
|
|
albumsTableName :: API.TableName
|
|
albumsTableName = mkTableName "Album"
|
|
|
|
albumsRows :: [HashMap API.FieldName API.FieldValue]
|
|
albumsRows = sortBy (API.FieldName "AlbumId") $ readTableFromXmlIntoRows albumsTableName
|
|
|
|
albumsRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue)
|
|
albumsRowsById =
|
|
HashMap.fromList $ mapMaybe (\album -> (,album) <$> album ^? field "AlbumId" . _ColumnFieldNumber) albumsRows
|
|
|
|
albumsTableRelationships :: API.TableRelationships
|
|
albumsTableRelationships =
|
|
let artistsJoinFieldMapping = HashMap.fromList [(API.ColumnName "ArtistId", API.ColumnName "ArtistId")]
|
|
tracksJoinFieldMapping = HashMap.fromList [(API.ColumnName "AlbumId", API.ColumnName "AlbumId")]
|
|
in API.TableRelationships
|
|
albumsTableName
|
|
( HashMap.fromList
|
|
[ (artistRelationshipName, API.Relationship artistsTableName API.ObjectRelationship artistsJoinFieldMapping),
|
|
(tracksRelationshipName, API.Relationship tracksTableName API.ArrayRelationship tracksJoinFieldMapping)
|
|
]
|
|
)
|
|
|
|
artistRelationshipName :: API.RelationshipName
|
|
artistRelationshipName = API.RelationshipName "Artist"
|
|
|
|
tracksRelationshipName :: API.RelationshipName
|
|
tracksRelationshipName = API.RelationshipName "Tracks"
|
|
|
|
customersTableName :: API.TableName
|
|
customersTableName = mkTableName "Customer"
|
|
|
|
customersRows :: [HashMap API.FieldName API.FieldValue]
|
|
customersRows = sortBy (API.FieldName "CustomerId") $ readTableFromXmlIntoRows customersTableName
|
|
|
|
customersTableRelationships :: API.TableRelationships
|
|
customersTableRelationships =
|
|
let joinFieldMapping = HashMap.fromList [(API.ColumnName "SupportRepId", API.ColumnName "EmployeeId")]
|
|
in API.TableRelationships
|
|
customersTableName
|
|
( HashMap.fromList
|
|
[ (supportRepRelationshipName, API.Relationship employeesTableName API.ObjectRelationship joinFieldMapping)
|
|
]
|
|
)
|
|
|
|
supportRepRelationshipName :: API.RelationshipName
|
|
supportRepRelationshipName = API.RelationshipName "SupportRep"
|
|
|
|
employeesTableName :: API.TableName
|
|
employeesTableName = mkTableName "Employee"
|
|
|
|
employeesRows :: [HashMap API.FieldName API.FieldValue]
|
|
employeesRows = sortBy (API.FieldName "EmployeeId") $ readTableFromXmlIntoRows employeesTableName
|
|
|
|
employeesRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue)
|
|
employeesRowsById =
|
|
HashMap.fromList $ mapMaybe (\employee -> (,employee) <$> employee ^? field "EmployeeId" . _ColumnFieldNumber) employeesRows
|
|
|
|
employeesTableRelationships :: API.TableRelationships
|
|
employeesTableRelationships =
|
|
let supportRepJoinFieldMapping = HashMap.fromList [(API.ColumnName "EmployeeId", API.ColumnName "SupportRepId")]
|
|
reportsToEmployeeJoinFieldMapping = HashMap.fromList [(API.ColumnName "ReportsTo", API.ColumnName "EmployeeId")]
|
|
in API.TableRelationships
|
|
employeesTableName
|
|
( HashMap.fromList
|
|
[ (supportRepForCustomersRelationshipName, API.Relationship customersTableName API.ArrayRelationship supportRepJoinFieldMapping),
|
|
(reportsToEmployeeRelationshipName, API.Relationship employeesTableName API.ObjectRelationship reportsToEmployeeJoinFieldMapping)
|
|
]
|
|
)
|
|
|
|
supportRepForCustomersRelationshipName :: API.RelationshipName
|
|
supportRepForCustomersRelationshipName = API.RelationshipName "SupportRepForCustomers"
|
|
|
|
reportsToEmployeeRelationshipName :: API.RelationshipName
|
|
reportsToEmployeeRelationshipName = API.RelationshipName "ReportsToEmployee"
|
|
|
|
invoicesTableName :: API.TableName
|
|
invoicesTableName = mkTableName "Invoice"
|
|
|
|
invoicesRows :: [HashMap API.FieldName API.FieldValue]
|
|
invoicesRows = sortBy (API.FieldName "InvoiceId") $ readTableFromXmlIntoRows invoicesTableName
|
|
|
|
invoicesRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue)
|
|
invoicesRowsById =
|
|
HashMap.fromList $ mapMaybe (\invoice -> (,invoice) <$> invoice ^? field "InvoiceId" . _ColumnFieldNumber) invoicesRows
|
|
|
|
invoicesTableRelationships :: API.TableRelationships
|
|
invoicesTableRelationships =
|
|
let invoiceLinesJoinFieldMapping = HashMap.fromList [(API.ColumnName "InvoiceId", API.ColumnName "InvoiceId")]
|
|
customersJoinFieldMapping = HashMap.fromList [(API.ColumnName "CustomerId", API.ColumnName "CustomerId")]
|
|
in API.TableRelationships
|
|
invoicesTableName
|
|
( HashMap.fromList
|
|
[ (invoiceLinesRelationshipName, API.Relationship invoiceLinesTableName API.ArrayRelationship invoiceLinesJoinFieldMapping),
|
|
(customerRelationshipName, API.Relationship customersTableName API.ObjectRelationship customersJoinFieldMapping)
|
|
]
|
|
)
|
|
|
|
customerRelationshipName :: API.RelationshipName
|
|
customerRelationshipName = API.RelationshipName "Customer"
|
|
|
|
invoiceLinesTableName :: API.TableName
|
|
invoiceLinesTableName = mkTableName "InvoiceLine"
|
|
|
|
invoiceLinesRows :: [HashMap API.FieldName API.FieldValue]
|
|
invoiceLinesRows = sortBy (API.FieldName "InvoiceLineId") $ readTableFromXmlIntoRows invoiceLinesTableName
|
|
|
|
invoiceLinesTableRelationships :: API.TableRelationships
|
|
invoiceLinesTableRelationships =
|
|
let invoiceJoinFieldMapping = HashMap.fromList [(API.ColumnName "InvoiceId", API.ColumnName "InvoiceId")]
|
|
tracksJoinFieldMapping = HashMap.fromList [(API.ColumnName "TrackId", API.ColumnName "TrackId")]
|
|
in API.TableRelationships
|
|
invoiceLinesTableName
|
|
( HashMap.fromList
|
|
[ (invoiceRelationshipName, API.Relationship invoicesTableName API.ObjectRelationship invoiceJoinFieldMapping),
|
|
(trackRelationshipName, API.Relationship tracksTableName API.ObjectRelationship tracksJoinFieldMapping)
|
|
]
|
|
)
|
|
|
|
invoiceRelationshipName :: API.RelationshipName
|
|
invoiceRelationshipName = API.RelationshipName "Invoice"
|
|
|
|
trackRelationshipName :: API.RelationshipName
|
|
trackRelationshipName = API.RelationshipName "Track"
|
|
|
|
mediaTypesTableName :: API.TableName
|
|
mediaTypesTableName = mkTableName "MediaType"
|
|
|
|
mediaTypesRows :: [HashMap API.FieldName API.FieldValue]
|
|
mediaTypesRows = sortBy (API.FieldName "MediaTypeId") $ readTableFromXmlIntoRows mediaTypesTableName
|
|
|
|
tracksTableName :: API.TableName
|
|
tracksTableName = mkTableName "Track"
|
|
|
|
tracksRows :: [HashMap API.FieldName API.FieldValue]
|
|
tracksRows = sortBy (API.FieldName "TrackId") $ readTableFromXmlIntoRows tracksTableName
|
|
|
|
tracksRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue)
|
|
tracksRowsById =
|
|
HashMap.fromList $ mapMaybe (\track -> (,track) <$> track ^? field "TrackId" . _ColumnFieldNumber) tracksRows
|
|
|
|
tracksTableRelationships :: API.TableRelationships
|
|
tracksTableRelationships =
|
|
let invoiceLinesJoinFieldMapping = HashMap.fromList [(API.ColumnName "TrackId", API.ColumnName "TrackId")]
|
|
mediaTypeJoinFieldMapping = HashMap.fromList [(API.ColumnName "MediaTypeId", API.ColumnName "MediaTypeId")]
|
|
albumJoinFieldMapping = HashMap.fromList [(API.ColumnName "AlbumId", API.ColumnName "AlbumId")]
|
|
genreJoinFieldMapping = HashMap.fromList [(API.ColumnName "GenreId", API.ColumnName "GenreId")]
|
|
playlistTracksJoinFieldMapping = HashMap.fromList [(API.ColumnName "TrackId", API.ColumnName "TrackId")]
|
|
in API.TableRelationships
|
|
tracksTableName
|
|
( HashMap.fromList
|
|
[ (invoiceLinesRelationshipName, API.Relationship invoiceLinesTableName API.ArrayRelationship invoiceLinesJoinFieldMapping),
|
|
(mediaTypeRelationshipName, API.Relationship mediaTypesTableName API.ObjectRelationship mediaTypeJoinFieldMapping),
|
|
(albumRelationshipName, API.Relationship albumsTableName API.ObjectRelationship albumJoinFieldMapping),
|
|
(genreRelationshipName, API.Relationship genresTableName API.ObjectRelationship genreJoinFieldMapping),
|
|
(playlistTracksRelationshipName, API.Relationship playlistTracksTableName API.ArrayRelationship playlistTracksJoinFieldMapping)
|
|
]
|
|
)
|
|
|
|
invoiceLinesRelationshipName :: API.RelationshipName
|
|
invoiceLinesRelationshipName = API.RelationshipName "InvoiceLines"
|
|
|
|
mediaTypeRelationshipName :: API.RelationshipName
|
|
mediaTypeRelationshipName = API.RelationshipName "MediaType"
|
|
|
|
albumRelationshipName :: API.RelationshipName
|
|
albumRelationshipName = API.RelationshipName "Album"
|
|
|
|
genreRelationshipName :: API.RelationshipName
|
|
genreRelationshipName = API.RelationshipName "Genre"
|
|
|
|
playlistTracksRelationshipName :: API.RelationshipName
|
|
playlistTracksRelationshipName = API.RelationshipName "PlaylistTracks"
|
|
|
|
genresTableName :: API.TableName
|
|
genresTableName = mkTableName "Genre"
|
|
|
|
genresRows :: [HashMap API.FieldName API.FieldValue]
|
|
genresRows = sortBy (API.FieldName "GenreId") $ readTableFromXmlIntoRows genresTableName
|
|
|
|
genresTableRelationships :: API.TableRelationships
|
|
genresTableRelationships =
|
|
let joinFieldMapping = HashMap.fromList [(API.ColumnName "GenreId", API.ColumnName "GenreId")]
|
|
in API.TableRelationships
|
|
genresTableName
|
|
( HashMap.fromList
|
|
[ (tracksRelationshipName, API.Relationship tracksTableName API.ArrayRelationship joinFieldMapping)
|
|
]
|
|
)
|
|
|
|
playlistsTableName :: API.TableName
|
|
playlistsTableName = mkTableName "Playlist"
|
|
|
|
playlistsRows :: [HashMap API.FieldName API.FieldValue]
|
|
playlistsRows = sortBy (API.FieldName "PlaylistId") $ readTableFromXmlIntoRows playlistsTableName
|
|
|
|
playlistTracksTableName :: API.TableName
|
|
playlistTracksTableName = mkTableName "PlaylistTrack"
|
|
|
|
playlistTracksRows :: [HashMap API.FieldName API.FieldValue]
|
|
playlistTracksRows = sortOn (\r -> (r ^? ix (API.FieldName "PlaylistId"), r ^? ix (API.FieldName "TrackId"))) $ readTableFromXmlIntoRows playlistTracksTableName
|
|
|
|
allTableRows :: HashMap API.TableName ([HashMap API.FieldName API.FieldValue])
|
|
allTableRows =
|
|
HashMap.fromList
|
|
[ (artistsTableName, artistsRows),
|
|
(albumsTableName, albumsRows),
|
|
(customersTableName, customersRows),
|
|
(employeesTableName, employeesRows),
|
|
(genresTableName, genresRows),
|
|
(invoicesTableName, invoicesRows),
|
|
(invoiceLinesTableName, invoiceLinesRows),
|
|
(mediaTypesTableName, mediaTypesRows),
|
|
(playlistsTableName, playlistsRows),
|
|
(playlistTracksTableName, playlistTracksRows),
|
|
(tracksTableName, tracksRows)
|
|
]
|
|
|
|
data TestData = TestData
|
|
{ -- = Schema
|
|
_tdSchemaTables :: [API.TableInfo],
|
|
-- = Artists table
|
|
_tdArtistsTableName :: API.TableName,
|
|
_tdArtistsRows :: [HashMap API.FieldName API.FieldValue],
|
|
_tdArtistsRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue),
|
|
_tdArtistsTableRelationships :: API.TableRelationships,
|
|
_tdAlbumsRelationshipName :: API.RelationshipName,
|
|
-- = Albums table
|
|
_tdAlbumsTableName :: API.TableName,
|
|
_tdAlbumsRows :: [HashMap API.FieldName API.FieldValue],
|
|
_tdAlbumsRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue),
|
|
_tdAlbumsTableRelationships :: API.TableRelationships,
|
|
_tdArtistRelationshipName :: API.RelationshipName,
|
|
_tdTracksRelationshipName :: API.RelationshipName,
|
|
-- = Customers table
|
|
_tdCustomersTableName :: API.TableName,
|
|
_tdCustomersRows :: [HashMap API.FieldName API.FieldValue],
|
|
_tdCustomersTableRelationships :: API.TableRelationships,
|
|
_tdSupportRepRelationshipName :: API.RelationshipName,
|
|
-- = Employees table
|
|
_tdEmployeesTableName :: API.TableName,
|
|
_tdEmployeesRows :: [HashMap API.FieldName API.FieldValue],
|
|
_tdEmployeesRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue),
|
|
_tdEmployeesTableRelationships :: API.TableRelationships,
|
|
_tdSupportRepForCustomersRelationshipName :: API.RelationshipName,
|
|
_tdReportsToEmployeeRelationshipName :: API.RelationshipName,
|
|
-- = Invoices table
|
|
_tdInvoicesTableName :: API.TableName,
|
|
_tdInvoicesRows :: [HashMap API.FieldName API.FieldValue],
|
|
_tdInvoicesRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue),
|
|
_tdInvoicesTableRelationships :: API.TableRelationships,
|
|
_tdCustomerRelationshipName :: API.RelationshipName,
|
|
-- = InvoiceLines table
|
|
_tdInvoiceLinesTableName :: API.TableName,
|
|
_tdInvoiceLinesRows :: [HashMap API.FieldName API.FieldValue],
|
|
_tdInvoiceLinesTableRelationships :: API.TableRelationships,
|
|
_tdInvoiceRelationshipName :: API.RelationshipName,
|
|
_tdTrackRelationshipName :: API.RelationshipName,
|
|
-- = MediaTypes table
|
|
_tdMediaTypesTableName :: API.TableName,
|
|
_tdMediaTypesRows :: [HashMap API.FieldName API.FieldValue],
|
|
-- = Tracks table
|
|
_tdTracksTableName :: API.TableName,
|
|
_tdTracksRows :: [HashMap API.FieldName API.FieldValue],
|
|
_tdTracksRowsById :: HashMap Scientific (HashMap API.FieldName API.FieldValue),
|
|
_tdTracksTableRelationships :: API.TableRelationships,
|
|
_tdInvoiceLinesRelationshipName :: API.RelationshipName,
|
|
_tdMediaTypeRelationshipName :: API.RelationshipName,
|
|
_tdAlbumRelationshipName :: API.RelationshipName,
|
|
_tdGenreRelationshipName :: API.RelationshipName,
|
|
_tdPlaylistTracksRelationshipName :: API.RelationshipName,
|
|
-- = PlaylistTracks table
|
|
_tdPlaylistTracksTableName :: API.TableName,
|
|
_tdPlaylistTracksRows :: [HashMap API.FieldName API.FieldValue],
|
|
-- = Genres table
|
|
_tdGenresTableName :: API.TableName,
|
|
_tdGenresRows :: [HashMap API.FieldName API.FieldValue],
|
|
_tdGenresTableRelationships :: API.TableRelationships,
|
|
-- = Scalar Types
|
|
_tdFindColumnScalarType :: API.TableName -> Text -> API.ScalarType,
|
|
-- = Utility functions
|
|
_tdColumnName :: Text -> API.ColumnName,
|
|
_tdColumnField :: API.TableName -> Text -> API.Field,
|
|
_tdMkDefaultTableInsertSchema :: API.TableName -> API.TableInsertSchema,
|
|
_tdColumnInsertSchema :: API.TableName -> Text -> API.ColumnInsertSchema,
|
|
_tdRowColumnOperatorValue :: API.TableName -> Text -> J.Value -> API.RowColumnOperatorValue,
|
|
_tdQueryComparisonColumn :: Text -> API.ScalarType -> API.ComparisonColumn,
|
|
_tdCurrentComparisonColumn :: Text -> API.ScalarType -> API.ComparisonColumn,
|
|
_tdOrderByColumn :: [API.RelationshipName] -> Text -> API.OrderDirection -> API.OrderByElement
|
|
}
|
|
|
|
-- | Test data from the Chinook dataset template
|
|
mkTestData :: API.SchemaResponse -> TestConfig -> TestData
|
|
mkTestData schemaResponse testConfig =
|
|
TestData
|
|
{ _tdSchemaTables = formatTableInfo testConfig <$> schemaTables,
|
|
_tdArtistsTableName = formatTableName testConfig artistsTableName,
|
|
_tdArtistsRows = artistsRows,
|
|
_tdArtistsRowsById = artistsRowsById,
|
|
_tdArtistsTableRelationships = formatTableRelationships artistsTableRelationships,
|
|
_tdAlbumsRelationshipName = albumsRelationshipName,
|
|
_tdAlbumsTableName = formatTableName testConfig albumsTableName,
|
|
_tdAlbumsRows = albumsRows,
|
|
_tdAlbumsRowsById = albumsRowsById,
|
|
_tdAlbumsTableRelationships = formatTableRelationships albumsTableRelationships,
|
|
_tdArtistRelationshipName = artistRelationshipName,
|
|
_tdTracksRelationshipName = tracksRelationshipName,
|
|
_tdCustomersTableName = formatTableName testConfig customersTableName,
|
|
_tdCustomersRows = customersRows,
|
|
_tdCustomersTableRelationships = formatTableRelationships customersTableRelationships,
|
|
_tdSupportRepRelationshipName = supportRepRelationshipName,
|
|
_tdEmployeesTableName = formatTableName testConfig employeesTableName,
|
|
_tdEmployeesRows = employeesRows,
|
|
_tdEmployeesRowsById = employeesRowsById,
|
|
_tdEmployeesTableRelationships = formatTableRelationships employeesTableRelationships,
|
|
_tdSupportRepForCustomersRelationshipName = supportRepForCustomersRelationshipName,
|
|
_tdReportsToEmployeeRelationshipName = reportsToEmployeeRelationshipName,
|
|
_tdInvoicesTableName = formatTableName testConfig invoicesTableName,
|
|
_tdInvoicesRows = invoicesRows,
|
|
_tdInvoicesRowsById = invoicesRowsById,
|
|
_tdInvoicesTableRelationships = formatTableRelationships invoicesTableRelationships,
|
|
_tdCustomerRelationshipName = customerRelationshipName,
|
|
_tdInvoiceLinesTableName = formatTableName testConfig invoiceLinesTableName,
|
|
_tdInvoiceLinesRows = invoiceLinesRows,
|
|
_tdInvoiceLinesTableRelationships = formatTableRelationships invoiceLinesTableRelationships,
|
|
_tdInvoiceRelationshipName = invoiceRelationshipName,
|
|
_tdTrackRelationshipName = trackRelationshipName,
|
|
_tdMediaTypesTableName = formatTableName testConfig mediaTypesTableName,
|
|
_tdMediaTypesRows = mediaTypesRows,
|
|
_tdTracksTableName = formatTableName testConfig tracksTableName,
|
|
_tdTracksRows = tracksRows,
|
|
_tdTracksRowsById = tracksRowsById,
|
|
_tdTracksTableRelationships = formatTableRelationships tracksTableRelationships,
|
|
_tdInvoiceLinesRelationshipName = invoiceLinesRelationshipName,
|
|
_tdMediaTypeRelationshipName = mediaTypeRelationshipName,
|
|
_tdAlbumRelationshipName = albumRelationshipName,
|
|
_tdGenreRelationshipName = genreRelationshipName,
|
|
_tdPlaylistTracksRelationshipName = playlistTracksRelationshipName,
|
|
_tdPlaylistTracksTableName = formatTableName testConfig playlistTracksTableName,
|
|
_tdPlaylistTracksRows = playlistTracksRows,
|
|
_tdGenresTableName = formatTableName testConfig genresTableName,
|
|
_tdGenresRows = genresRows,
|
|
_tdGenresTableRelationships = formatTableRelationships genresTableRelationships,
|
|
_tdColumnName = formatColumnName testConfig . API.ColumnName,
|
|
_tdColumnField = columnField schemaResponse testConfig,
|
|
_tdMkDefaultTableInsertSchema = mkDefaultTableInsertSchema schemaResponse testConfig schemaTables,
|
|
_tdColumnInsertSchema = columnInsertSchema schemaResponse testConfig,
|
|
_tdRowColumnOperatorValue = rowColumnOperatorValue schemaResponse testConfig,
|
|
_tdFindColumnScalarType = \tableName name -> findColumnScalarType schemaResponse tableName (formatColumnName testConfig $ API.ColumnName name),
|
|
_tdQueryComparisonColumn = API.ComparisonColumn API.QueryTable . formatColumnName testConfig . API.ColumnName,
|
|
_tdCurrentComparisonColumn = API.ComparisonColumn API.CurrentTable . formatColumnName testConfig . API.ColumnName,
|
|
_tdOrderByColumn = \targetPath name -> orderByColumn targetPath (formatColumnName testConfig $ API.ColumnName name)
|
|
}
|
|
where
|
|
formatTableRelationships :: API.TableRelationships -> API.TableRelationships
|
|
formatTableRelationships =
|
|
prefixTableRelationships
|
|
>>> API.trRelationships . traverse . API.rColumnMapping %~ (HashMap.toList >>> fmap (bimap (formatColumnName testConfig) (formatColumnName testConfig)) >>> HashMap.fromList)
|
|
|
|
prefixTableRelationships :: API.TableRelationships -> API.TableRelationships
|
|
prefixTableRelationships =
|
|
API.trSourceTable %~ formatTableName testConfig
|
|
>>> API.trRelationships . traverse . API.rTargetTable %~ formatTableName testConfig
|
|
|
|
-- | Test data from the TestingEdgeCases dataset template
|
|
data EdgeCasesTestData = EdgeCasesTestData
|
|
{ -- = NoPrimaryKey table
|
|
_ectdNoPrimaryKeyTableName :: API.TableName,
|
|
-- = DefaultedPrimaryKey table
|
|
_ectdDefaultedPrimaryKeyTableName :: API.TableName,
|
|
-- = AllColumnsDefaultable table
|
|
_ectdAllColumnsDefaultableTableName :: API.TableName,
|
|
-- = Scalar Types
|
|
_ectdFindColumnScalarType :: API.TableName -> Text -> API.ScalarType,
|
|
-- = Utility functions
|
|
_ectdTableExists :: API.TableName -> Bool,
|
|
_ectdColumnField :: API.TableName -> Text -> API.Field,
|
|
_ectdMkDefaultTableInsertSchema :: API.TableName -> API.TableInsertSchema,
|
|
_ectdRowColumnOperatorValue :: API.TableName -> Text -> J.Value -> API.RowColumnOperatorValue,
|
|
_ectdCurrentComparisonColumn :: Text -> API.ScalarType -> API.ComparisonColumn
|
|
}
|
|
|
|
mkEdgeCasesTestData :: TestConfig -> API.SchemaResponse -> EdgeCasesTestData
|
|
mkEdgeCasesTestData testConfig schemaResponse =
|
|
EdgeCasesTestData
|
|
{ _ectdNoPrimaryKeyTableName = noPrimaryKeyTableName,
|
|
_ectdDefaultedPrimaryKeyTableName = defaultedPrimaryKeyTableName,
|
|
_ectdAllColumnsDefaultableTableName = allColumnsDefaultableTableName,
|
|
_ectdFindColumnScalarType = \tableName name -> findColumnScalarType schemaResponse tableName (formatColumnName testConfig $ API.ColumnName name),
|
|
_ectdTableExists = tableExists,
|
|
_ectdColumnField = columnField schemaResponse testConfig,
|
|
_ectdMkDefaultTableInsertSchema = mkDefaultTableInsertSchema schemaResponse testConfig edgeCasesSchemaTables,
|
|
_ectdRowColumnOperatorValue = rowColumnOperatorValue schemaResponse testConfig,
|
|
_ectdCurrentComparisonColumn = API.ComparisonColumn API.CurrentTable . formatColumnName testConfig . API.ColumnName
|
|
}
|
|
where
|
|
tableExists :: API.TableName -> Bool
|
|
tableExists tableName = tableName `elem` (API._tiName <$> API._srTables schemaResponse)
|
|
|
|
noPrimaryKeyTableName = formatTableName testConfig (API.TableName $ "NoPrimaryKey" :| [])
|
|
defaultedPrimaryKeyTableName = formatTableName testConfig (API.TableName $ "DefaultedPrimaryKey" :| [])
|
|
allColumnsDefaultableTableName = formatTableName testConfig (API.TableName $ "AllColumnsDefaultable" :| [])
|
|
|
|
formatTableName :: TestConfig -> API.TableName -> API.TableName
|
|
formatTableName TestConfig {..} = applyTableNamePrefix _tcTableNamePrefix . API.TableName . fmap (applyNameCasing _tcTableNameCasing) . API.unTableName
|
|
|
|
formatTableInfo :: TestConfig -> API.TableInfo -> API.TableInfo
|
|
formatTableInfo testConfig =
|
|
API.tiName %~ formatTableName testConfig
|
|
>>> API.tiColumns . traverse . API.ciName %~ formatColumnName testConfig
|
|
>>> API.tiPrimaryKey . _Just . traverse %~ formatColumnName testConfig
|
|
>>> API.tiForeignKeys . API.unForeignKeys . traverse
|
|
%~ ( API.cForeignTable %~ formatTableName testConfig
|
|
>>> API.cColumnMapping %~ (HashMap.toList >>> fmap (bimap (formatColumnName testConfig) (formatColumnName testConfig)) >>> HashMap.fromList)
|
|
)
|
|
|
|
applyTableNamePrefix :: [Text] -> API.TableName -> API.TableName
|
|
applyTableNamePrefix prefix tableName@(API.TableName rawTableName) =
|
|
case NonEmpty.nonEmpty prefix of
|
|
Just prefix' -> API.TableName (prefix' <> rawTableName)
|
|
Nothing -> tableName
|
|
|
|
applyNameCasing :: NameCasing -> Text -> Text
|
|
applyNameCasing casing text = case casing of
|
|
PascalCase -> text
|
|
Lowercase -> Text.toLower text
|
|
Uppercase -> Text.toUpper text
|
|
|
|
formatColumnName :: TestConfig -> API.ColumnName -> API.ColumnName
|
|
formatColumnName TestConfig {..} = API.ColumnName . applyNameCasing _tcColumnNameCasing . API.unColumnName
|
|
|
|
columnField :: API.SchemaResponse -> TestConfig -> API.TableName -> Text -> API.Field
|
|
columnField schemaResponse testConfig tableName columnName =
|
|
API.ColumnField columnName' scalarType
|
|
where
|
|
columnName' = formatColumnName testConfig $ API.ColumnName columnName
|
|
scalarType = findColumnScalarType schemaResponse tableName columnName'
|
|
|
|
mkDefaultTableInsertSchema :: API.SchemaResponse -> TestConfig -> [API.TableInfo] -> API.TableName -> API.TableInsertSchema
|
|
mkDefaultTableInsertSchema schemaResponse testConfig expectedSchemaTables tableName =
|
|
API.TableInsertSchema
|
|
{ _tisTable = tableName,
|
|
_tisPrimaryKey = fmap (formatColumnName testConfig) <$> API._tiPrimaryKey tableInfo,
|
|
_tisFields = mkFieldsMap insertFields
|
|
}
|
|
where
|
|
tableInfo =
|
|
expectedSchemaTables
|
|
& find (\API.TableInfo {..} -> formatTableName testConfig _tiName == tableName)
|
|
& fromMaybe (error $ "Can't find table " <> show tableName <> " in schema")
|
|
columnNames =
|
|
tableInfo
|
|
& API._tiColumns
|
|
& fmap API._ciName
|
|
insertFields =
|
|
columnNames
|
|
& fmap
|
|
( \columnName ->
|
|
let formattedColumnName = formatColumnName testConfig columnName
|
|
API.ColumnInfo {..} = findColumnInfo schemaResponse tableName formattedColumnName
|
|
columnNameText = API.unColumnName columnName
|
|
in (columnNameText, API.ColumnInsert $ API.ColumnInsertSchema _ciName _ciType _ciNullable _ciValueGenerated)
|
|
)
|
|
|
|
columnInsertSchema :: API.SchemaResponse -> TestConfig -> API.TableName -> Text -> API.ColumnInsertSchema
|
|
columnInsertSchema schemaResponse testConfig tableName columnName =
|
|
API.ColumnInsertSchema columnName' (API._ciType columnInfo) (API._ciNullable columnInfo) (API._ciValueGenerated columnInfo)
|
|
where
|
|
columnName' = formatColumnName testConfig $ API.ColumnName columnName
|
|
columnInfo = findColumnInfo schemaResponse tableName columnName'
|
|
|
|
rowColumnOperatorValue :: API.SchemaResponse -> TestConfig -> API.TableName -> Text -> J.Value -> API.RowColumnOperatorValue
|
|
rowColumnOperatorValue schemaResponse testConfig tableName columnName value =
|
|
API.RowColumnOperatorValue columnName' value scalarType
|
|
where
|
|
columnName' = formatColumnName testConfig $ API.ColumnName columnName
|
|
scalarType = findColumnScalarType schemaResponse tableName columnName'
|
|
|
|
findColumnInfo :: API.SchemaResponse -> API.TableName -> API.ColumnName -> API.ColumnInfo
|
|
findColumnInfo API.SchemaResponse {..} tableName columnName =
|
|
fromMaybe (error $ "Can't find the scalar type of column " <> show columnName <> " in table " <> show tableName) columnInfo
|
|
where
|
|
tableInfo = find (\API.TableInfo {..} -> _tiName == tableName) _srTables
|
|
columnInfo = find (\API.ColumnInfo {..} -> _ciName == columnName) =<< API._tiColumns <$> tableInfo
|
|
|
|
findColumnScalarType :: API.SchemaResponse -> API.TableName -> API.ColumnName -> API.ScalarType
|
|
findColumnScalarType schemaResponse tableName columnName =
|
|
API._ciType $ findColumnInfo schemaResponse tableName columnName
|
|
|
|
emptyQuery :: API.Query
|
|
emptyQuery = API.Query Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
|
|
|
emptyMutationRequest :: API.MutationRequest
|
|
emptyMutationRequest = API.MutationRequest mempty mempty mempty
|
|
|
|
sortBy :: (Ixed m, Ord (IxValue m)) => Index m -> [m] -> [m]
|
|
sortBy propName = sortOn (^? ix propName)
|
|
|
|
filterColumnsByQueryFields :: API.Query -> HashMap API.FieldName API.FieldValue -> HashMap API.FieldName API.FieldValue
|
|
filterColumnsByQueryFields query =
|
|
HashMap.filterWithKey (\key _value -> key `elem` columns)
|
|
where
|
|
columns = HashMap.keys $ queryFields query
|
|
|
|
filterColumns :: [Text] -> [HashMap API.FieldName API.FieldValue] -> [HashMap API.FieldName API.FieldValue]
|
|
filterColumns columns =
|
|
fmap (HashMap.filterWithKey (\key _value -> key `elem` columns'))
|
|
where
|
|
columns' = API.FieldName <$> columns
|
|
|
|
renameColumns :: [(Text, Text)] -> [HashMap API.FieldName API.FieldValue] -> [HashMap API.FieldName API.FieldValue]
|
|
renameColumns columns =
|
|
fmap (HashMap.fromList . fmap rename . HashMap.toList)
|
|
where
|
|
columns' = bimap API.FieldName API.FieldName <$> columns
|
|
rename original@(key, value) =
|
|
case find (\(k, _) -> k == key) columns' of
|
|
Just (_, renamedKey) -> (renamedKey, value)
|
|
Nothing -> original
|
|
|
|
onlyKeepRelationships :: [API.RelationshipName] -> API.TableRelationships -> API.TableRelationships
|
|
onlyKeepRelationships names tableRels =
|
|
tableRels & API.trRelationships %~ HashMap.filterWithKey (\relName _ -> relName `elem` names)
|
|
|
|
queryFields :: API.Query -> HashMap API.FieldName API.Field
|
|
queryFields = fromMaybe mempty . API._qFields
|
|
|
|
responseRows :: API.QueryResponse -> [HashMap API.FieldName API.FieldValue]
|
|
responseRows = fromMaybe [] . API._qrRows
|
|
|
|
sortResponseRowsBy :: Text -> API.QueryResponse -> API.QueryResponse
|
|
sortResponseRowsBy columnName response = response & API.qrRows %~ (fmap (sortBy (API.FieldName columnName)))
|
|
|
|
responseAggregates :: API.QueryResponse -> HashMap API.FieldName J.Value
|
|
responseAggregates = fromMaybe mempty . API._qrAggregates
|
|
|
|
mkFieldsMap :: [(Text, v)] -> HashMap API.FieldName v
|
|
mkFieldsMap = HashMap.fromList . fmap (first API.FieldName)
|
|
|
|
insertField :: Text -> v -> HashMap API.FieldName v -> HashMap API.FieldName v
|
|
insertField fieldName = HashMap.insert (API.FieldName fieldName)
|
|
|
|
deleteField :: Text -> HashMap API.FieldName v -> HashMap API.FieldName v
|
|
deleteField fieldName = HashMap.delete (API.FieldName fieldName)
|
|
|
|
field :: (Ixed m, Index m ~ API.FieldName) => Text -> Traversal' m (IxValue m)
|
|
field fieldName = ix (API.FieldName fieldName)
|
|
|
|
fieldAt :: (At m, Index m ~ API.FieldName) => Text -> Traversal' m (Maybe (IxValue m))
|
|
fieldAt fieldName = at (API.FieldName fieldName)
|
|
|
|
_ColumnFieldNumber :: Traversal' API.FieldValue Scientific
|
|
_ColumnFieldNumber = API._ColumnFieldValue . _Number
|
|
|
|
_ColumnFieldString :: Traversal' API.FieldValue Text
|
|
_ColumnFieldString = API._ColumnFieldValue . _String
|
|
|
|
_ColumnFieldBoolean :: Traversal' API.FieldValue Bool
|
|
_ColumnFieldBoolean = API._ColumnFieldValue . _Bool
|
|
|
|
_ColumnFieldNull :: Traversal' API.FieldValue ()
|
|
_ColumnFieldNull = API._ColumnFieldValue . _Null
|
|
|
|
_RelationshipFieldRows :: Traversal' API.FieldValue [HashMap API.FieldName API.FieldValue]
|
|
_RelationshipFieldRows = API._RelationshipFieldValue . API.qrRows . _Just
|
|
|
|
scalarValueComparison :: J.Value -> API.ScalarType -> API.ComparisonValue
|
|
scalarValueComparison value valueType = API.ScalarValueComparison $ API.ScalarValue value valueType
|
|
|
|
orderByColumn :: [API.RelationshipName] -> API.ColumnName -> API.OrderDirection -> API.OrderByElement
|
|
orderByColumn targetPath columnName orderDirection =
|
|
API.OrderByElement targetPath (API.OrderByColumn columnName) orderDirection
|
|
|
|
insertAutoIncPk :: Text -> Integer -> [HashMap API.FieldName API.FieldValue] -> [HashMap API.FieldName API.FieldValue]
|
|
insertAutoIncPk pkFieldName startingPkId rows =
|
|
zip [startingPkId ..] rows
|
|
& fmap
|
|
( \(albumId, albumRow) ->
|
|
albumRow & at (API.FieldName pkFieldName) ?~ API.mkColumnFieldValue (J.Number $ fromInteger albumId)
|
|
)
|
|
|
|
autoIncPks :: Integer -> [a] -> [Integer]
|
|
autoIncPks startingPkId rows = fst <$> zip [startingPkId ..] rows
|
|
|
|
mkSubqueryFieldValue :: Maybe [HashMap API.FieldName API.FieldValue] -> Maybe (HashMap API.FieldName J.Value) -> API.FieldValue
|
|
mkSubqueryFieldValue rows aggregates =
|
|
API.mkRelationshipFieldValue $ API.QueryResponse rows aggregates
|
|
|
|
mkSubqueryRowsFieldValue :: [HashMap API.FieldName API.FieldValue] -> API.FieldValue
|
|
mkSubqueryRowsFieldValue rows =
|
|
API.mkRelationshipFieldValue $ API.QueryResponse (Just rows) Nothing
|
|
|
|
mkSubqueryAggregatesFieldValue :: HashMap API.FieldName J.Value -> API.FieldValue
|
|
mkSubqueryAggregatesFieldValue aggregates =
|
|
API.mkRelationshipFieldValue $ API.QueryResponse Nothing (Just aggregates)
|