graphql-engine/server/src-lib/Hasura/Backends/Postgres/DDL/Table.hs
Auke Booij 4c8ea8e865 Import pg-client-hs as PG
Result of executing the following commands:
```shell
# replace "as Q" imports with "as PG" (in retrospect this didn't need a regex)
git grep -lE 'as Q($|[^a-zA-Z])' -- '*.hs' | xargs sed -i -E 's/as Q($|[^a-zA-Z])/as PG\1/'
# replace " Q." with " PG."
git grep -lE ' Q\.' -- '*.hs' | xargs sed -i 's/ Q\./ PG./g'
# replace "(Q." with "(PG."
git grep -lE '\(Q\.' -- '*.hs' | xargs sed -i 's/(Q\./(PG./g'
# ditto, but for [, |, { and !
git grep -lE '\[Q\.' -- '*.hs' | xargs sed -i 's/\[Q\./\[PG./g'
git grep -l '|Q\.' -- '*.hs' | xargs sed -i 's/|Q\./|PG./g'
git grep -l '{Q\.' -- '*.hs' | xargs sed -i 's/{Q\./{PG./g'
git grep -l '!Q\.' -- '*.hs' | xargs sed -i 's/!Q\./!PG./g'
```
(Doing the `grep -l` before the `sed`, instead of `sed` on the entire codebase, reduces the number of `mtime` updates, and so reduces how many times a file gets recompiled while checking intermediate results.)

Finally, I manually removed a broken and unused `Arbitrary` instance in `Hasura.RQL.Network`. (It used an `import Test.QuickCheck.Arbitrary as Q` statement, which was erroneously caught by the first find-replace command.)

After this PR, `Q` is no longer used as an import qualifier. That was not the goal of this PR, but perhaps it's a useful fact for future efforts.

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5933
GitOrigin-RevId: 8c84c59d57789111d40f5d3322c5a885dcfbf40e
2022-09-20 19:55:51 +00:00

162 lines
6.9 KiB
Haskell
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

-- | Postgres DDL Table
--
-- Used to fill up the enum values field of 'Hasura.RQL.Types.Table.TableCoreInfoG'.
--
-- See 'Hasura.RQL.Types.Eventing.Backend'.
module Hasura.Backends.Postgres.DDL.Table
( fetchAndValidateEnumValues,
)
where
import Control.Monad.Trans.Control (MonadBaseControl)
import Control.Monad.Validate
import Data.HashMap.Strict qualified as Map
import Data.List (delete)
import Data.List.NonEmpty qualified as NE
import Data.Sequence qualified as Seq
import Data.Sequence.NonEmpty qualified as NESeq
import Data.Text.Extended
import Database.PG.Query qualified as PG
import Hasura.Backends.Postgres.Connection
import Hasura.Backends.Postgres.SQL.DML
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Base.Error
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Table
import Hasura.SQL.Backend
import Hasura.SQL.Types
import Hasura.Server.Utils
import Language.GraphQL.Draft.Syntax qualified as G
data EnumTableIntegrityError (b :: BackendType)
= EnumTablePostgresError Text
| EnumTableMissingPrimaryKey
| EnumTableMultiColumnPrimaryKey [PGCol]
| EnumTableNonTextualPrimaryKey (RawColumnInfo b)
| EnumTableNoEnumValues
| EnumTableInvalidEnumValueNames (NE.NonEmpty Text)
| EnumTableNonTextualCommentColumn (RawColumnInfo b)
| EnumTableTooManyColumns [PGCol]
fetchAndValidateEnumValues ::
forall pgKind m.
(Backend ('Postgres pgKind), MonadIO m, MonadBaseControl IO m) =>
PGSourceConfig ->
QualifiedTable ->
Maybe (PrimaryKey ('Postgres pgKind) (RawColumnInfo ('Postgres pgKind))) ->
[RawColumnInfo ('Postgres pgKind)] ->
m (Either QErr EnumValues)
fetchAndValidateEnumValues pgSourceConfig tableName maybePrimaryKey columnInfos =
runExceptT $
either (throw400 ConstraintViolation . showErrors) pure =<< runValidateT fetchAndValidate
where
fetchAndValidate ::
(MonadIO n, MonadBaseControl IO n, MonadValidate [EnumTableIntegrityError ('Postgres pgKind)] n) =>
n EnumValues
fetchAndValidate = do
maybePrimaryKeyColumn <- tolerate validatePrimaryKey
maybeCommentColumn <- validateColumns maybePrimaryKeyColumn
case maybePrimaryKeyColumn of
Nothing -> refute mempty
Just primaryKeyColumn -> do
result <-
runPgSourceReadTx pgSourceConfig $
runValidateT $
fetchEnumValuesFromDb tableName primaryKeyColumn maybeCommentColumn
case result of
Left e -> (refute . pure . EnumTablePostgresError . qeError) e
Right (Left vErrs) -> refute vErrs
Right (Right r) -> pure r
where
validatePrimaryKey = case maybePrimaryKey of
Nothing -> refute [EnumTableMissingPrimaryKey]
Just primaryKey -> case _pkColumns primaryKey of
column NESeq.:<|| Seq.Empty -> case rciType column of
PGText -> pure column
_ -> refute [EnumTableNonTextualPrimaryKey column]
columns -> refute [EnumTableMultiColumnPrimaryKey $ map rciName (toList columns)]
validateColumns primaryKeyColumn = do
let nonPrimaryKeyColumns = maybe columnInfos (`delete` columnInfos) primaryKeyColumn
case nonPrimaryKeyColumns of
[] -> pure Nothing
[column] -> case rciType column of
PGText -> pure $ Just column
_ -> dispute [EnumTableNonTextualCommentColumn column] $> Nothing
columns -> dispute [EnumTableTooManyColumns $ map rciName columns] $> Nothing
showErrors :: [EnumTableIntegrityError ('Postgres pgKind)] -> Text
showErrors allErrors =
"the table " <> tableName <<> " cannot be used as an enum " <> reasonsMessage
where
reasonsMessage = makeReasonMessage allErrors showOne
showOne :: EnumTableIntegrityError ('Postgres pgKind) -> Text
showOne = \case
EnumTablePostgresError err -> "postgres error: " <> err
EnumTableMissingPrimaryKey -> "the table must have a primary key"
EnumTableMultiColumnPrimaryKey cols ->
"the tables primary key must not span multiple columns ("
<> commaSeparated (sort cols)
<> ")"
EnumTableNonTextualPrimaryKey colInfo -> typeMismatch "primary key" colInfo PGText
EnumTableNoEnumValues -> "the table must have at least one row"
EnumTableInvalidEnumValueNames values ->
let pluralString = " are not valid GraphQL enum value names"
valuesString = case NE.reverse (NE.sort values) of
value NE.:| [] -> "value " <> value <<> " is not a valid GraphQL enum value name"
value2 NE.:| [value1] -> "values " <> value1 <<> " and " <> value2 <<> pluralString
lastValue NE.:| otherValues ->
"values " <> commaSeparated (reverse otherValues) <> ", and "
<> lastValue <<> pluralString
in "the " <> valuesString
EnumTableNonTextualCommentColumn colInfo -> typeMismatch "comment column" colInfo PGText
EnumTableTooManyColumns cols ->
"the table must have exactly one primary key and optionally one comment column, not "
<> tshow (length cols)
<> " columns ("
<> commaSeparated (sort cols)
<> ")"
where
typeMismatch description colInfo expected =
"the tables " <> description <> " (" <> rciName colInfo <<> ") must have type "
<> expected <<> ", not type " <>> rciType colInfo
fetchEnumValuesFromDb ::
forall pgKind m.
(MonadTx m, MonadValidate [EnumTableIntegrityError ('Postgres pgKind)] m) =>
QualifiedTable ->
RawColumnInfo ('Postgres pgKind) ->
Maybe (RawColumnInfo ('Postgres pgKind)) ->
m EnumValues
fetchEnumValuesFromDb tableName primaryKeyColumn maybeCommentColumn = do
let nullExtr = Extractor SENull Nothing
commentExtr = maybe nullExtr (mkExtr . rciName) maybeCommentColumn
query =
PG.fromBuilder $
toSQL
mkSelect
{ selFrom = Just $ mkSimpleFromExp tableName,
selExtr = [mkExtr (rciName primaryKeyColumn), commentExtr]
}
rawEnumValues <- liftTx $ PG.withQE defaultTxErrorHandler query () True
when (null rawEnumValues) $ dispute [EnumTableNoEnumValues]
let enumValues = flip map rawEnumValues $
\(enumValueText, comment) ->
case mkValidEnumValueName enumValueText of
Nothing -> Left enumValueText
Just enumValue -> Right (EnumValue enumValue, EnumValueInfo comment)
badNames = lefts enumValues
validEnums = rights enumValues
case NE.nonEmpty badNames of
Just someBadNames -> refute [EnumTableInvalidEnumValueNames someBadNames]
Nothing -> pure $ Map.fromList validEnums
where
-- https://graphql.github.io/graphql-spec/June2018/#EnumValue
mkValidEnumValueName name =
if name `elem` ["true", "false", "null"]
then Nothing
else G.mkName name