{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}

module Hasura.Table.Cache
  ( CombinedSelPermInfo (..),
    Constraint (..),
    ColumnConfig (..),
    CustomRootField (..),
    DBTableMetadata (..),
    DBTablesMetadata,
    DelPermInfo (..),
    FieldInfo (..),
    FieldInfoMap,
    ForeignKey (..),
    ForeignKeyMetadata (..),
    GraphQLType (..),
    InsPermInfo (..),
    PrimaryKey (..),
    RolePermInfo (..),
    RolePermInfoMap,
    SelPermInfo (..),
    TableCache,
    TableConfig (..),
    TableCoreCache,
    TableCoreInfo,
    TableEventTriggers,
    TableCoreInfoG (..),
    TableCustomRootFields (..),
    TableInfo (..),
    UniqueConstraint (..),
    UpdPermInfo (..),
    ViewInfo (..),
    askColInfo,
    askColumnType,
    askFieldInfo,
    assertColumnExists,
    askRelType,
    askComputedFieldInfo,
    askRemoteRel,
    combinedSelPermInfoToSelPermInfo,
    emptyCustomRootFields,
    emptyTableConfig,
    fieldInfoGraphQLName,
    fieldInfoGraphQLNames,
    fieldInfoName,
    getAllCustomRootFields,
    getCols,
    getColumnInfoM,
    getComputedFieldInfos,
    getFieldInfoM,
    getRels,
    getRemoteFieldInfoName,
    isListType,
    isMutable,
    isNullableType,
    mkAdminRolePermInfo,
    permDel,
    permIns,
    permSel,
    permUpd,
    pkColumns,
    pkConstraint,
    sortCols,
    tableInfoName,
    getRolePermInfo,
    tableArrayRelationships,
    tcCustomName,
    tcCustomRootFields,
    tcComment,
    tcColumnConfig,
    tciCustomConfig,
    tciDescription,
    tciApolloFederationConfig,
    tciEnumValues,
    tciExtraTableMetadata,
    tciFieldInfoMap,
    tciForeignKeys,
    tciName,
    tciPrimaryKey,
    tciUniqueConstraints,
    tciUniqueOrPrimaryKeyConstraints,
    tciViewInfo,
    tciRawColumns,
    tiAdminRolePermInfo,
    tiCoreInfo,
    tiEventTriggerInfoMap,
    tiName,
    tiRolePermInfoMap,
    _FIColumn,
    _FIComputedField,
    _FIRelationship,
    _FIRemoteRelationship,
  )
where

import Autodocodec
  ( HasCodec (codec),
    dimapCodec,
    disjointEitherCodec,
    hashMapCodec,
    nullCodec,
    optionalFieldOrNullWith',
    optionalFieldOrNullWithOmittedDefault',
    optionalFieldWithDefault',
    optionalFieldWithDefaultWith',
    optionalFieldWithOmittedDefault',
  )
import Autodocodec qualified as AC
import Autodocodec.Extended (graphQLFieldNameCodec)
import Control.Lens hiding ((.=))
import Data.Aeson qualified as J
import Data.Aeson.Casing
import Data.Aeson.Extended
import Data.Aeson.TH
import Data.Aeson.Types (Parser, prependFailure, typeMismatch)
import Data.HashMap.Strict.Extended qualified as HashMap
import Data.HashMap.Strict.NonEmpty (NEHashMap)
import Data.HashMap.Strict.NonEmpty qualified as NEHashMap
import Data.HashSet qualified as HS
import Data.List.Extended (duplicates)
import Data.List.NonEmpty qualified as NE
import Data.Semigroup (Any (..), Max (..))
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Backends.Postgres.SQL.Types qualified as Postgres (PGDescription)
import Hasura.Base.Error
import Hasura.Name qualified as Name
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp
import Hasura.RQL.IR.BoolExp.Lenses (_RedactIfFalse)
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendTag (backendPrefix)
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Permission (AllowedRootFields (..), QueryRootFieldType (..), SubscriptionRootFieldType (..), ValidateInput (..))
import Hasura.RQL.Types.Relationships.Local
import Hasura.RQL.Types.Relationships.Remote
import Hasura.RQL.Types.Roles (RoleName, adminRoleName)
import Hasura.SQL.AnyBackend (runBackend)
import Language.GraphQL.Draft.Parser qualified as GParse
import Language.GraphQL.Draft.Printer qualified as GPrint
import Language.GraphQL.Draft.Syntax qualified as G
import Text.Builder qualified as T

-- | A wrapper around 'G.GType' which allows us to define custom JSON
-- instances.
--
-- TODO: this name is ambiguous, and conflicts with
-- Hasura.RQL.DDL.RemoteSchema.Permission.GraphQLType; it should perhaps be
-- renamed, made internal to this module, or removed altogether?
newtype GraphQLType = GraphQLType {GraphQLType -> GType
unGraphQLType :: G.GType}
  deriving (Int -> GraphQLType -> ShowS
[GraphQLType] -> ShowS
GraphQLType -> String
(Int -> GraphQLType -> ShowS)
-> (GraphQLType -> String)
-> ([GraphQLType] -> ShowS)
-> Show GraphQLType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GraphQLType -> ShowS
showsPrec :: Int -> GraphQLType -> ShowS
$cshow :: GraphQLType -> String
show :: GraphQLType -> String
$cshowList :: [GraphQLType] -> ShowS
showList :: [GraphQLType] -> ShowS
Show, GraphQLType -> GraphQLType -> Bool
(GraphQLType -> GraphQLType -> Bool)
-> (GraphQLType -> GraphQLType -> Bool) -> Eq GraphQLType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GraphQLType -> GraphQLType -> Bool
== :: GraphQLType -> GraphQLType -> Bool
$c/= :: GraphQLType -> GraphQLType -> Bool
/= :: GraphQLType -> GraphQLType -> Bool
Eq, Eq GraphQLType
Eq GraphQLType
-> (GraphQLType -> GraphQLType -> Ordering)
-> (GraphQLType -> GraphQLType -> Bool)
-> (GraphQLType -> GraphQLType -> Bool)
-> (GraphQLType -> GraphQLType -> Bool)
-> (GraphQLType -> GraphQLType -> Bool)
-> (GraphQLType -> GraphQLType -> GraphQLType)
-> (GraphQLType -> GraphQLType -> GraphQLType)
-> Ord GraphQLType
GraphQLType -> GraphQLType -> Bool
GraphQLType -> GraphQLType -> Ordering
GraphQLType -> GraphQLType -> GraphQLType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GraphQLType -> GraphQLType -> Ordering
compare :: GraphQLType -> GraphQLType -> Ordering
$c< :: GraphQLType -> GraphQLType -> Bool
< :: GraphQLType -> GraphQLType -> Bool
$c<= :: GraphQLType -> GraphQLType -> Bool
<= :: GraphQLType -> GraphQLType -> Bool
$c> :: GraphQLType -> GraphQLType -> Bool
> :: GraphQLType -> GraphQLType -> Bool
$c>= :: GraphQLType -> GraphQLType -> Bool
>= :: GraphQLType -> GraphQLType -> Bool
$cmax :: GraphQLType -> GraphQLType -> GraphQLType
max :: GraphQLType -> GraphQLType -> GraphQLType
$cmin :: GraphQLType -> GraphQLType -> GraphQLType
min :: GraphQLType -> GraphQLType -> GraphQLType
Ord, (forall x. GraphQLType -> Rep GraphQLType x)
-> (forall x. Rep GraphQLType x -> GraphQLType)
-> Generic GraphQLType
forall x. Rep GraphQLType x -> GraphQLType
forall x. GraphQLType -> Rep GraphQLType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GraphQLType -> Rep GraphQLType x
from :: forall x. GraphQLType -> Rep GraphQLType x
$cto :: forall x. Rep GraphQLType x -> GraphQLType
to :: forall x. Rep GraphQLType x -> GraphQLType
Generic, GraphQLType -> ()
(GraphQLType -> ()) -> NFData GraphQLType
forall a. (a -> ()) -> NFData a
$crnf :: GraphQLType -> ()
rnf :: GraphQLType -> ()
NFData)

instance HasCodec GraphQLType where
  codec :: JSONCodec GraphQLType
codec = (Text -> Either String GraphQLType)
-> (GraphQLType -> Text)
-> Codec Value Text Text
-> JSONCodec GraphQLType
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> Either String newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
AC.bimapCodec Text -> Either String GraphQLType
dec GraphQLType -> Text
enc Codec Value Text Text
forall value. HasCodec value => JSONCodec value
codec
    where
      dec :: Text -> Either String GraphQLType
dec Text
t = case Text -> Either Text GType
GParse.parseGraphQLType Text
t of
        Left Text
_ -> String -> Either String GraphQLType
forall a b. a -> Either a b
Left (String -> Either String GraphQLType)
-> String -> Either String GraphQLType
forall a b. (a -> b) -> a -> b
$ String
"not a valid GraphQL type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t
        Right GType
a -> GraphQLType -> Either String GraphQLType
forall a b. b -> Either a b
Right (GraphQLType -> Either String GraphQLType)
-> GraphQLType -> Either String GraphQLType
forall a b. (a -> b) -> a -> b
$ GType -> GraphQLType
GraphQLType GType
a
      enc :: GraphQLType -> Text
enc = Builder -> Text
T.run (Builder -> Text)
-> (GraphQLType -> Builder) -> GraphQLType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GType -> Builder
forall a. Printer a => GType -> a
GPrint.graphQLType (GType -> Builder)
-> (GraphQLType -> GType) -> GraphQLType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphQLType -> GType
unGraphQLType

instance J.ToJSON GraphQLType where
  toJSON :: GraphQLType -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Text -> Value) -> (GraphQLType -> Text) -> GraphQLType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
T.run (Builder -> Text)
-> (GraphQLType -> Builder) -> GraphQLType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GType -> Builder
forall a. Printer a => GType -> a
GPrint.graphQLType (GType -> Builder)
-> (GraphQLType -> GType) -> GraphQLType -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GraphQLType -> GType
unGraphQLType

instance J.FromJSON GraphQLType where
  parseJSON :: Value -> Parser GraphQLType
parseJSON =
    String
-> (Text -> Parser GraphQLType) -> Value -> Parser GraphQLType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
J.withText String
"GraphQLType" ((Text -> Parser GraphQLType) -> Value -> Parser GraphQLType)
-> (Text -> Parser GraphQLType) -> Value -> Parser GraphQLType
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text -> Either Text GType
GParse.parseGraphQLType Text
t of
        Left Text
_ -> String -> Parser GraphQLType
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser GraphQLType) -> String -> Parser GraphQLType
forall a b. (a -> b) -> a -> b
$ String
"not a valid GraphQL type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t
        Right GType
a -> GraphQLType -> Parser GraphQLType
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (GraphQLType -> Parser GraphQLType)
-> GraphQLType -> Parser GraphQLType
forall a b. (a -> b) -> a -> b
$ GType -> GraphQLType
GraphQLType GType
a

isListType :: GraphQLType -> Bool
isListType :: GraphQLType -> Bool
isListType = (GType -> Bool) -> GraphQLType -> Bool
forall a b. Coercible a b => a -> b
coerce GType -> Bool
G.isListType

isNullableType :: GraphQLType -> Bool
isNullableType :: GraphQLType -> Bool
isNullableType = (GType -> Bool) -> GraphQLType -> Bool
forall a b. Coercible a b => a -> b
coerce GType -> Bool
G.isNullable

data CustomRootField = CustomRootField
  { CustomRootField -> Maybe Name
_crfName :: Maybe G.Name,
    CustomRootField -> Comment
_crfComment :: Comment
  }
  deriving (Int -> CustomRootField -> ShowS
[CustomRootField] -> ShowS
CustomRootField -> String
(Int -> CustomRootField -> ShowS)
-> (CustomRootField -> String)
-> ([CustomRootField] -> ShowS)
-> Show CustomRootField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomRootField -> ShowS
showsPrec :: Int -> CustomRootField -> ShowS
$cshow :: CustomRootField -> String
show :: CustomRootField -> String
$cshowList :: [CustomRootField] -> ShowS
showList :: [CustomRootField] -> ShowS
Show, CustomRootField -> CustomRootField -> Bool
(CustomRootField -> CustomRootField -> Bool)
-> (CustomRootField -> CustomRootField -> Bool)
-> Eq CustomRootField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomRootField -> CustomRootField -> Bool
== :: CustomRootField -> CustomRootField -> Bool
$c/= :: CustomRootField -> CustomRootField -> Bool
/= :: CustomRootField -> CustomRootField -> Bool
Eq, (forall x. CustomRootField -> Rep CustomRootField x)
-> (forall x. Rep CustomRootField x -> CustomRootField)
-> Generic CustomRootField
forall x. Rep CustomRootField x -> CustomRootField
forall x. CustomRootField -> Rep CustomRootField x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CustomRootField -> Rep CustomRootField x
from :: forall x. CustomRootField -> Rep CustomRootField x
$cto :: forall x. Rep CustomRootField x -> CustomRootField
to :: forall x. Rep CustomRootField x -> CustomRootField
Generic)

instance NFData CustomRootField

instance HasCodec CustomRootField where
  codec :: JSONCodec CustomRootField
codec =
    (Either () (Either Text CustomRootField) -> CustomRootField)
-> (CustomRootField -> Either () (Either Text CustomRootField))
-> Codec
     Value
     (Either () (Either Text CustomRootField))
     (Either () (Either Text CustomRootField))
-> JSONCodec CustomRootField
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Either () (Either Text CustomRootField) -> CustomRootField
forall {a}.
Either a (Either Text CustomRootField) -> CustomRootField
dec CustomRootField -> Either () (Either Text CustomRootField)
enc
      (Codec
   Value
   (Either () (Either Text CustomRootField))
   (Either () (Either Text CustomRootField))
 -> JSONCodec CustomRootField)
-> Codec
     Value
     (Either () (Either Text CustomRootField))
     (Either () (Either Text CustomRootField))
-> JSONCodec CustomRootField
forall a b. (a -> b) -> a -> b
$ Codec Value () ()
-> Codec
     Value (Either Text CustomRootField) (Either Text CustomRootField)
-> Codec
     Value
     (Either () (Either Text CustomRootField))
     (Either () (Either Text CustomRootField))
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec Codec Value () ()
nullCodec
      (Codec
   Value (Either Text CustomRootField) (Either Text CustomRootField)
 -> Codec
      Value
      (Either () (Either Text CustomRootField))
      (Either () (Either Text CustomRootField)))
-> Codec
     Value (Either Text CustomRootField) (Either Text CustomRootField)
-> Codec
     Value
     (Either () (Either Text CustomRootField))
     (Either () (Either Text CustomRootField))
forall a b. (a -> b) -> a -> b
$ Codec Value Text Text
-> JSONCodec CustomRootField
-> Codec
     Value (Either Text CustomRootField) (Either Text CustomRootField)
forall context input1 output1 input2 output2.
Codec context input1 output1
-> Codec context input2 output2
-> Codec context (Either input1 input2) (Either output1 output2)
disjointEitherCodec (forall value. HasCodec value => JSONCodec value
codec @Text) JSONCodec CustomRootField
nameAndComment
    where
      nameAndComment :: JSONCodec CustomRootField
nameAndComment =
        Text
-> ObjectCodec CustomRootField CustomRootField
-> JSONCodec CustomRootField
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"CustomRootField"
          (ObjectCodec CustomRootField CustomRootField
 -> JSONCodec CustomRootField)
-> ObjectCodec CustomRootField CustomRootField
-> JSONCodec CustomRootField
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Comment -> CustomRootField
CustomRootField
          (Maybe Name -> Comment -> CustomRootField)
-> Codec Object CustomRootField (Maybe Name)
-> Codec Object CustomRootField (Comment -> CustomRootField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ValueCodec Name Name -> ObjectCodec (Maybe Name) (Maybe Name)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldOrNullWith' Text
"name" ValueCodec Name Name
graphQLFieldNameCodec
          ObjectCodec (Maybe Name) (Maybe Name)
-> (CustomRootField -> Maybe Name)
-> Codec Object CustomRootField (Maybe Name)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CustomRootField -> Maybe Name
_crfName
            Codec Object CustomRootField (Comment -> CustomRootField)
-> Codec Object CustomRootField Comment
-> ObjectCodec CustomRootField CustomRootField
forall a b.
Codec Object CustomRootField (a -> b)
-> Codec Object CustomRootField a -> Codec Object CustomRootField b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Comment -> ObjectCodec Comment Comment
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldOrNullWithOmittedDefault' Text
"comment" Comment
Automatic
          ObjectCodec Comment Comment
-> (CustomRootField -> Comment)
-> Codec Object CustomRootField Comment
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CustomRootField -> Comment
_crfComment

      dec :: Either a (Either Text CustomRootField) -> CustomRootField
dec = \case
        Left a
_ -> Maybe Name -> Comment -> CustomRootField
CustomRootField Maybe Name
forall a. Maybe a
Nothing Comment
Automatic
        Right (Left Text
text) -> Maybe Name -> Comment -> CustomRootField
CustomRootField (Text -> Maybe Name
G.mkName Text
text) Comment
Automatic
        Right (Right CustomRootField
obj) -> CustomRootField
obj

      enc :: CustomRootField -> Either () (Either Text CustomRootField)
enc = \case
        (CustomRootField Maybe Name
Nothing Comment
Automatic) -> () -> Either () (Either Text CustomRootField)
forall a b. a -> Either a b
Left ()
        (CustomRootField (Just Name
name) Comment
Automatic) -> Either Text CustomRootField
-> Either () (Either Text CustomRootField)
forall a b. b -> Either a b
Right (Either Text CustomRootField
 -> Either () (Either Text CustomRootField))
-> Either Text CustomRootField
-> Either () (Either Text CustomRootField)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text CustomRootField
forall a b. a -> Either a b
Left (Text -> Either Text CustomRootField)
-> Text -> Either Text CustomRootField
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName Name
name
        CustomRootField
obj -> Either Text CustomRootField
-> Either () (Either Text CustomRootField)
forall a b. b -> Either a b
Right (Either Text CustomRootField
 -> Either () (Either Text CustomRootField))
-> Either Text CustomRootField
-> Either () (Either Text CustomRootField)
forall a b. (a -> b) -> a -> b
$ CustomRootField -> Either Text CustomRootField
forall a b. b -> Either a b
Right CustomRootField
obj

instance FromJSON CustomRootField where
  parseJSON :: Value -> Parser CustomRootField
parseJSON = \case
    Value
Null -> CustomRootField -> Parser CustomRootField
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CustomRootField -> Parser CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Comment -> CustomRootField
CustomRootField Maybe Name
forall a. Maybe a
Nothing Comment
Automatic
    String Text
text -> CustomRootField -> Parser CustomRootField
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CustomRootField -> Parser CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Comment -> CustomRootField
CustomRootField (Text -> Maybe Name
G.mkName Text
text) Comment
Automatic
    Object Object
obj ->
      Maybe Name -> Comment -> CustomRootField
CustomRootField
        (Maybe Name -> Comment -> CustomRootField)
-> Parser (Maybe Name) -> Parser (Comment -> CustomRootField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
        Parser (Comment -> CustomRootField)
-> Parser Comment -> Parser CustomRootField
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe Comment)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment" Parser (Maybe Comment) -> Comment -> Parser Comment
forall a. Parser (Maybe a) -> a -> Parser a
.!= Comment
Automatic)
    Value
val -> String -> Parser CustomRootField -> Parser CustomRootField
forall a. String -> Parser a -> Parser a
prependFailure String
"parsing CustomRootField failed, " (String -> Value -> Parser CustomRootField
forall a. String -> Value -> Parser a
typeMismatch String
"Object, String or Null" Value
val)

instance ToJSON CustomRootField where
  toJSON :: CustomRootField -> Value
toJSON (CustomRootField Maybe Name
Nothing Comment
Automatic) = Value
Null
  toJSON (CustomRootField (Just Name
name) Comment
Automatic) = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Name -> Text
G.unName Name
name
  toJSON (CustomRootField Maybe Name
name Comment
comment) =
    [Pair] -> Value
object
      [ Key
"name" Key -> Maybe Name -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Name
name,
        Key
"comment" Key -> Comment -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Comment
comment
      ]

defaultCustomRootField :: CustomRootField
defaultCustomRootField :: CustomRootField
defaultCustomRootField = Maybe Name -> Comment -> CustomRootField
CustomRootField Maybe Name
forall a. Maybe a
Nothing Comment
Automatic

data TableCustomRootFields = TableCustomRootFields
  { TableCustomRootFields -> CustomRootField
_tcrfSelect :: CustomRootField,
    TableCustomRootFields -> CustomRootField
_tcrfSelectByPk :: CustomRootField,
    TableCustomRootFields -> CustomRootField
_tcrfSelectAggregate :: CustomRootField,
    TableCustomRootFields -> CustomRootField
_tcrfSelectStream :: CustomRootField,
    TableCustomRootFields -> CustomRootField
_tcrfInsert :: CustomRootField,
    TableCustomRootFields -> CustomRootField
_tcrfInsertOne :: CustomRootField,
    TableCustomRootFields -> CustomRootField
_tcrfUpdate :: CustomRootField,
    TableCustomRootFields -> CustomRootField
_tcrfUpdateByPk :: CustomRootField,
    TableCustomRootFields -> CustomRootField
_tcrfUpdateMany :: CustomRootField,
    TableCustomRootFields -> CustomRootField
_tcrfDelete :: CustomRootField,
    TableCustomRootFields -> CustomRootField
_tcrfDeleteByPk :: CustomRootField
  }
  deriving (Int -> TableCustomRootFields -> ShowS
[TableCustomRootFields] -> ShowS
TableCustomRootFields -> String
(Int -> TableCustomRootFields -> ShowS)
-> (TableCustomRootFields -> String)
-> ([TableCustomRootFields] -> ShowS)
-> Show TableCustomRootFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableCustomRootFields -> ShowS
showsPrec :: Int -> TableCustomRootFields -> ShowS
$cshow :: TableCustomRootFields -> String
show :: TableCustomRootFields -> String
$cshowList :: [TableCustomRootFields] -> ShowS
showList :: [TableCustomRootFields] -> ShowS
Show, TableCustomRootFields -> TableCustomRootFields -> Bool
(TableCustomRootFields -> TableCustomRootFields -> Bool)
-> (TableCustomRootFields -> TableCustomRootFields -> Bool)
-> Eq TableCustomRootFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableCustomRootFields -> TableCustomRootFields -> Bool
== :: TableCustomRootFields -> TableCustomRootFields -> Bool
$c/= :: TableCustomRootFields -> TableCustomRootFields -> Bool
/= :: TableCustomRootFields -> TableCustomRootFields -> Bool
Eq, (forall x. TableCustomRootFields -> Rep TableCustomRootFields x)
-> (forall x. Rep TableCustomRootFields x -> TableCustomRootFields)
-> Generic TableCustomRootFields
forall x. Rep TableCustomRootFields x -> TableCustomRootFields
forall x. TableCustomRootFields -> Rep TableCustomRootFields x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableCustomRootFields -> Rep TableCustomRootFields x
from :: forall x. TableCustomRootFields -> Rep TableCustomRootFields x
$cto :: forall x. Rep TableCustomRootFields x -> TableCustomRootFields
to :: forall x. Rep TableCustomRootFields x -> TableCustomRootFields
Generic)

instance NFData TableCustomRootFields

instance HasCodec TableCustomRootFields where
  codec :: JSONCodec TableCustomRootFields
codec =
    Text
-> ObjectCodec TableCustomRootFields TableCustomRootFields
-> JSONCodec TableCustomRootFields
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"TableCustomRootFields"
      (ObjectCodec TableCustomRootFields TableCustomRootFields
 -> JSONCodec TableCustomRootFields)
-> ObjectCodec TableCustomRootFields TableCustomRootFields
-> JSONCodec TableCustomRootFields
forall a b. (a -> b) -> a -> b
$ CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> TableCustomRootFields
TableCustomRootFields
      (CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> Codec
     Object
     TableCustomRootFields
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"select"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfSelect
        Codec
  Object
  TableCustomRootFields
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> Codec
     Object
     TableCustomRootFields
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b.
Codec Object TableCustomRootFields (a -> b)
-> Codec Object TableCustomRootFields a
-> Codec Object TableCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"select_by_pk"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfSelectByPk
        Codec
  Object
  TableCustomRootFields
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> Codec
     Object
     TableCustomRootFields
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b.
Codec Object TableCustomRootFields (a -> b)
-> Codec Object TableCustomRootFields a
-> Codec Object TableCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"select_aggregate"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfSelectAggregate
        Codec
  Object
  TableCustomRootFields
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> Codec
     Object
     TableCustomRootFields
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b.
Codec Object TableCustomRootFields (a -> b)
-> Codec Object TableCustomRootFields a
-> Codec Object TableCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"select_stream"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfSelectStream
        Codec
  Object
  TableCustomRootFields
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> Codec
     Object
     TableCustomRootFields
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b.
Codec Object TableCustomRootFields (a -> b)
-> Codec Object TableCustomRootFields a
-> Codec Object TableCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"insert"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfInsert
        Codec
  Object
  TableCustomRootFields
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> Codec
     Object
     TableCustomRootFields
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b.
Codec Object TableCustomRootFields (a -> b)
-> Codec Object TableCustomRootFields a
-> Codec Object TableCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"insert_one"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfInsertOne
        Codec
  Object
  TableCustomRootFields
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> Codec
     Object
     TableCustomRootFields
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b.
Codec Object TableCustomRootFields (a -> b)
-> Codec Object TableCustomRootFields a
-> Codec Object TableCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"update"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfUpdate
        Codec
  Object
  TableCustomRootFields
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> Codec
     Object
     TableCustomRootFields
     (CustomRootField
      -> CustomRootField -> CustomRootField -> TableCustomRootFields)
forall a b.
Codec Object TableCustomRootFields (a -> b)
-> Codec Object TableCustomRootFields a
-> Codec Object TableCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"update_by_pk"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfUpdateByPk
        Codec
  Object
  TableCustomRootFields
  (CustomRootField
   -> CustomRootField -> CustomRootField -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> Codec
     Object
     TableCustomRootFields
     (CustomRootField -> CustomRootField -> TableCustomRootFields)
forall a b.
Codec Object TableCustomRootFields (a -> b)
-> Codec Object TableCustomRootFields a
-> Codec Object TableCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"update_many"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfUpdateMany
        Codec
  Object
  TableCustomRootFields
  (CustomRootField -> CustomRootField -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> Codec
     Object
     TableCustomRootFields
     (CustomRootField -> TableCustomRootFields)
forall a b.
Codec Object TableCustomRootFields (a -> b)
-> Codec Object TableCustomRootFields a
-> Codec Object TableCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"delete"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfDelete
        Codec
  Object
  TableCustomRootFields
  (CustomRootField -> TableCustomRootFields)
-> Codec Object TableCustomRootFields CustomRootField
-> ObjectCodec TableCustomRootFields TableCustomRootFields
forall a b.
Codec Object TableCustomRootFields (a -> b)
-> Codec Object TableCustomRootFields a
-> Codec Object TableCustomRootFields b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec CustomRootField CustomRootField
field Text
"delete_by_pk"
      ObjectCodec CustomRootField CustomRootField
-> (TableCustomRootFields -> CustomRootField)
-> Codec Object TableCustomRootFields CustomRootField
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableCustomRootFields -> CustomRootField
_tcrfDeleteByPk
    where
      field :: Text -> ObjectCodec CustomRootField CustomRootField
field Text
name = Text
-> CustomRootField -> ObjectCodec CustomRootField CustomRootField
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
name CustomRootField
defaultCustomRootField

instance ToJSON TableCustomRootFields where
  toJSON :: TableCustomRootFields -> Value
toJSON TableCustomRootFields {CustomRootField
_tcrfSelect :: TableCustomRootFields -> CustomRootField
_tcrfSelectByPk :: TableCustomRootFields -> CustomRootField
_tcrfSelectAggregate :: TableCustomRootFields -> CustomRootField
_tcrfSelectStream :: TableCustomRootFields -> CustomRootField
_tcrfInsert :: TableCustomRootFields -> CustomRootField
_tcrfInsertOne :: TableCustomRootFields -> CustomRootField
_tcrfUpdate :: TableCustomRootFields -> CustomRootField
_tcrfUpdateByPk :: TableCustomRootFields -> CustomRootField
_tcrfUpdateMany :: TableCustomRootFields -> CustomRootField
_tcrfDelete :: TableCustomRootFields -> CustomRootField
_tcrfDeleteByPk :: TableCustomRootFields -> CustomRootField
_tcrfSelect :: CustomRootField
_tcrfSelectByPk :: CustomRootField
_tcrfSelectAggregate :: CustomRootField
_tcrfSelectStream :: CustomRootField
_tcrfInsert :: CustomRootField
_tcrfInsertOne :: CustomRootField
_tcrfUpdate :: CustomRootField
_tcrfUpdateByPk :: CustomRootField
_tcrfUpdateMany :: CustomRootField
_tcrfDelete :: CustomRootField
_tcrfDeleteByPk :: CustomRootField
..} =
    [Pair] -> Value
object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter
        ((Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> Value
forall a b. (a, b) -> b
snd)
        [ Key
"select" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfSelect,
          Key
"select_by_pk" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfSelectByPk,
          Key
"select_aggregate" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfSelectAggregate,
          Key
"select_stream" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfSelectStream,
          Key
"insert" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfInsert,
          Key
"insert_one" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfInsertOne,
          Key
"update" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfUpdate,
          Key
"update_by_pk" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfUpdateByPk,
          Key
"update_many" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfUpdateMany,
          Key
"delete" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfDelete,
          Key
"delete_by_pk" Key -> CustomRootField -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= CustomRootField
_tcrfDeleteByPk
        ]

instance FromJSON TableCustomRootFields where
  parseJSON :: Value -> Parser TableCustomRootFields
parseJSON = String
-> (Object -> Parser TableCustomRootFields)
-> Value
-> Parser TableCustomRootFields
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Object" ((Object -> Parser TableCustomRootFields)
 -> Value -> Parser TableCustomRootFields)
-> (Object -> Parser TableCustomRootFields)
-> Value
-> Parser TableCustomRootFields
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    TableCustomRootFields
tableCustomRootFields <-
      CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> CustomRootField
-> TableCustomRootFields
TableCustomRootFields
        (CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> CustomRootField
 -> TableCustomRootFields)
-> Parser CustomRootField
-> Parser
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"select" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)
        Parser
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Parser CustomRootField
-> Parser
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"select_by_pk" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)
        Parser
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Parser CustomRootField
-> Parser
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"select_aggregate" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)
        Parser
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Parser CustomRootField
-> Parser
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"select_stream" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)
        Parser
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Parser CustomRootField
-> Parser
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"insert" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)
        Parser
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Parser CustomRootField
-> Parser
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"insert_one" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)
        Parser
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Parser CustomRootField
-> Parser
     (CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> CustomRootField
      -> TableCustomRootFields)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"update" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)
        Parser
  (CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> CustomRootField
   -> TableCustomRootFields)
-> Parser CustomRootField
-> Parser
     (CustomRootField
      -> CustomRootField -> CustomRootField -> TableCustomRootFields)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"update_by_pk" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)
        Parser
  (CustomRootField
   -> CustomRootField -> CustomRootField -> TableCustomRootFields)
-> Parser CustomRootField
-> Parser
     (CustomRootField -> CustomRootField -> TableCustomRootFields)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"update_many" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)
        Parser
  (CustomRootField -> CustomRootField -> TableCustomRootFields)
-> Parser CustomRootField
-> Parser (CustomRootField -> TableCustomRootFields)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"delete" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)
        Parser (CustomRootField -> TableCustomRootFields)
-> Parser CustomRootField -> Parser TableCustomRootFields
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Maybe CustomRootField)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"delete_by_pk" Parser (Maybe CustomRootField)
-> CustomRootField -> Parser CustomRootField
forall a. Parser (Maybe a) -> a -> Parser a
.!= CustomRootField
defaultCustomRootField)

    let duplicateRootFields :: [Name]
duplicateRootFields = HashSet Name -> [Name]
forall a. HashSet a -> [a]
HS.toList (HashSet Name -> [Name])
-> ([CustomRootField] -> HashSet Name)
-> [CustomRootField]
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> HashSet Name
forall a. Hashable a => [a] -> HashSet a
duplicates ([Name] -> HashSet Name)
-> ([CustomRootField] -> [Name])
-> [CustomRootField]
-> HashSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CustomRootField -> Maybe Name) -> [CustomRootField] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe CustomRootField -> Maybe Name
_crfName ([CustomRootField] -> [Name]) -> [CustomRootField] -> [Name]
forall a b. (a -> b) -> a -> b
$ TableCustomRootFields -> [CustomRootField]
getAllCustomRootFields TableCustomRootFields
tableCustomRootFields
    Maybe (NonEmpty Name) -> (NonEmpty Name -> Parser Any) -> Parser ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Name] -> Maybe (NonEmpty Name)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [Name]
duplicateRootFields) \NonEmpty Name
duplicatedFields ->
      String -> Parser Any
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
        (String -> Parser Any) -> (Text -> String) -> Text -> Parser Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
        (Text -> Parser Any) -> Text -> Parser Any
forall a b. (a -> b) -> a -> b
$ Text
"the following custom root field names are duplicated: "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> NonEmpty Text -> Text
englishList Text
"and" (Name -> Text
forall a. ToTxt a => a -> Text
toTxt (Name -> Text) -> NonEmpty Name -> NonEmpty Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Name
duplicatedFields)

    TableCustomRootFields -> Parser TableCustomRootFields
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TableCustomRootFields
tableCustomRootFields
    where
      englishList :: Text -> NonEmpty Text -> Text
      englishList :: Text -> NonEmpty Text -> Text
englishList Text
joiner = \case
        Text
one :| [] -> Text
one
        Text
one :| [Text
two] -> Text
one Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
joiner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
two
        NonEmpty Text
several ->
          let Text
final :| [Text]
initials = NonEmpty Text -> NonEmpty Text
forall a. NonEmpty a -> NonEmpty a
NE.reverse NonEmpty Text
several
           in [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
commaSeparated ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
initials) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
joiner Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
final

emptyCustomRootFields :: TableCustomRootFields
emptyCustomRootFields :: TableCustomRootFields
emptyCustomRootFields =
  TableCustomRootFields
    { _tcrfSelect :: CustomRootField
_tcrfSelect = CustomRootField
defaultCustomRootField,
      _tcrfSelectByPk :: CustomRootField
_tcrfSelectByPk = CustomRootField
defaultCustomRootField,
      _tcrfSelectStream :: CustomRootField
_tcrfSelectStream = CustomRootField
defaultCustomRootField,
      _tcrfSelectAggregate :: CustomRootField
_tcrfSelectAggregate = CustomRootField
defaultCustomRootField,
      _tcrfInsert :: CustomRootField
_tcrfInsert = CustomRootField
defaultCustomRootField,
      _tcrfInsertOne :: CustomRootField
_tcrfInsertOne = CustomRootField
defaultCustomRootField,
      _tcrfUpdate :: CustomRootField
_tcrfUpdate = CustomRootField
defaultCustomRootField,
      _tcrfUpdateByPk :: CustomRootField
_tcrfUpdateByPk = CustomRootField
defaultCustomRootField,
      _tcrfUpdateMany :: CustomRootField
_tcrfUpdateMany = CustomRootField
defaultCustomRootField,
      _tcrfDelete :: CustomRootField
_tcrfDelete = CustomRootField
defaultCustomRootField,
      _tcrfDeleteByPk :: CustomRootField
_tcrfDeleteByPk = CustomRootField
defaultCustomRootField
    }

getAllCustomRootFields :: TableCustomRootFields -> [CustomRootField]
getAllCustomRootFields :: TableCustomRootFields -> [CustomRootField]
getAllCustomRootFields TableCustomRootFields {CustomRootField
_tcrfSelect :: TableCustomRootFields -> CustomRootField
_tcrfSelectByPk :: TableCustomRootFields -> CustomRootField
_tcrfSelectAggregate :: TableCustomRootFields -> CustomRootField
_tcrfSelectStream :: TableCustomRootFields -> CustomRootField
_tcrfInsert :: TableCustomRootFields -> CustomRootField
_tcrfInsertOne :: TableCustomRootFields -> CustomRootField
_tcrfUpdate :: TableCustomRootFields -> CustomRootField
_tcrfUpdateByPk :: TableCustomRootFields -> CustomRootField
_tcrfUpdateMany :: TableCustomRootFields -> CustomRootField
_tcrfDelete :: TableCustomRootFields -> CustomRootField
_tcrfDeleteByPk :: TableCustomRootFields -> CustomRootField
_tcrfSelect :: CustomRootField
_tcrfSelectByPk :: CustomRootField
_tcrfSelectAggregate :: CustomRootField
_tcrfSelectStream :: CustomRootField
_tcrfInsert :: CustomRootField
_tcrfInsertOne :: CustomRootField
_tcrfUpdate :: CustomRootField
_tcrfUpdateByPk :: CustomRootField
_tcrfUpdateMany :: CustomRootField
_tcrfDelete :: CustomRootField
_tcrfDeleteByPk :: CustomRootField
..} =
  [ CustomRootField
_tcrfSelect,
    CustomRootField
_tcrfSelectByPk,
    CustomRootField
_tcrfSelectAggregate,
    CustomRootField
_tcrfSelectStream,
    CustomRootField
_tcrfInsert,
    CustomRootField
_tcrfInsertOne,
    CustomRootField
_tcrfUpdate,
    CustomRootField
_tcrfUpdateByPk,
    CustomRootField
_tcrfUpdateMany,
    CustomRootField
_tcrfDelete,
    CustomRootField
_tcrfDeleteByPk
  ]

data FieldInfo (b :: BackendType)
  = FIColumn (StructuredColumnInfo b)
  | FIRelationship (RelInfo b)
  | FIComputedField (ComputedFieldInfo b)
  | FIRemoteRelationship (RemoteFieldInfo (DBJoinField b))
  deriving ((forall x. FieldInfo b -> Rep (FieldInfo b) x)
-> (forall x. Rep (FieldInfo b) x -> FieldInfo b)
-> Generic (FieldInfo b)
forall x. Rep (FieldInfo b) x -> FieldInfo b
forall x. FieldInfo b -> Rep (FieldInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (FieldInfo b) x -> FieldInfo b
forall (b :: BackendType) x. FieldInfo b -> Rep (FieldInfo b) x
$cfrom :: forall (b :: BackendType) x. FieldInfo b -> Rep (FieldInfo b) x
from :: forall x. FieldInfo b -> Rep (FieldInfo b) x
$cto :: forall (b :: BackendType) x. Rep (FieldInfo b) x -> FieldInfo b
to :: forall x. Rep (FieldInfo b) x -> FieldInfo b
Generic)

deriving instance (Backend b) => Eq (FieldInfo b)

instance (Backend b) => ToJSON (FieldInfo b) where
  toJSON :: FieldInfo b -> Value
toJSON =
    Options -> FieldInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON
      (Options -> FieldInfo b -> Value)
-> Options -> FieldInfo b -> Value
forall a b. (a -> b) -> a -> b
$ Options
defaultOptions
        { constructorTagModifier :: ShowS
constructorTagModifier = ShowS
snakeCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
2,
          sumEncoding :: SumEncoding
sumEncoding = String -> String -> SumEncoding
TaggedObject String
"type" String
"detail"
        }

$(makePrisms ''FieldInfo)

type FieldInfoMap = HashMap.HashMap FieldName

fieldInfoName :: forall b. (Backend b) => FieldInfo b -> FieldName
fieldInfoName :: forall (b :: BackendType). Backend b => FieldInfo b -> FieldName
fieldInfoName = \case
  FIColumn StructuredColumnInfo b
info -> forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol @b (Column b -> FieldName) -> Column b -> FieldName
forall a b. (a -> b) -> a -> b
$ StructuredColumnInfo b -> Column b
forall (b :: BackendType). StructuredColumnInfo b -> Column b
structuredColumnInfoColumn StructuredColumnInfo b
info
  FIRelationship RelInfo b
info -> RelName -> FieldName
fromRel (RelName -> FieldName) -> RelName -> FieldName
forall a b. (a -> b) -> a -> b
$ RelInfo b -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo b
info
  FIComputedField ComputedFieldInfo b
info -> ComputedFieldName -> FieldName
fromComputedField (ComputedFieldName -> FieldName) -> ComputedFieldName -> FieldName
forall a b. (a -> b) -> a -> b
$ ComputedFieldInfo b -> ComputedFieldName
forall (b :: BackendType). ComputedFieldInfo b -> ComputedFieldName
_cfiName ComputedFieldInfo b
info
  FIRemoteRelationship RemoteFieldInfo (DBJoinField b)
info -> RelName -> FieldName
fromRemoteRelationship (RelName -> FieldName) -> RelName -> FieldName
forall a b. (a -> b) -> a -> b
$ RemoteFieldInfo (DBJoinField b) -> RelName
forall lhsJoinField. RemoteFieldInfo lhsJoinField -> RelName
getRemoteFieldInfoName RemoteFieldInfo (DBJoinField b)
info

fieldInfoGraphQLName :: FieldInfo b -> Maybe G.Name
fieldInfoGraphQLName :: forall (b :: BackendType). FieldInfo b -> Maybe Name
fieldInfoGraphQLName = \case
  FIColumn StructuredColumnInfo b
info -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ StructuredColumnInfo b -> Name
forall (b :: BackendType). StructuredColumnInfo b -> Name
structuredColumnInfoName StructuredColumnInfo b
info
  FIRelationship RelInfo b
info -> Text -> Maybe Name
G.mkName (Text -> Maybe Name) -> Text -> Maybe Name
forall a b. (a -> b) -> a -> b
$ RelName -> Text
relNameToTxt (RelName -> Text) -> RelName -> Text
forall a b. (a -> b) -> a -> b
$ RelInfo b -> RelName
forall (b :: BackendType). RelInfo b -> RelName
riName RelInfo b
info
  FIComputedField ComputedFieldInfo b
info -> Text -> Maybe Name
G.mkName (Text -> Maybe Name) -> Text -> Maybe Name
forall a b. (a -> b) -> a -> b
$ ComputedFieldName -> Text
computedFieldNameToText (ComputedFieldName -> Text) -> ComputedFieldName -> Text
forall a b. (a -> b) -> a -> b
$ ComputedFieldInfo b -> ComputedFieldName
forall (b :: BackendType). ComputedFieldInfo b -> ComputedFieldName
_cfiName ComputedFieldInfo b
info
  FIRemoteRelationship RemoteFieldInfo (DBJoinField b)
info -> Text -> Maybe Name
G.mkName (Text -> Maybe Name) -> Text -> Maybe Name
forall a b. (a -> b) -> a -> b
$ RelName -> Text
relNameToTxt (RelName -> Text) -> RelName -> Text
forall a b. (a -> b) -> a -> b
$ RemoteFieldInfo (DBJoinField b) -> RelName
forall lhsJoinField. RemoteFieldInfo lhsJoinField -> RelName
getRemoteFieldInfoName RemoteFieldInfo (DBJoinField b)
info

getRemoteFieldInfoName :: RemoteFieldInfo lhsJoinField -> RelName
getRemoteFieldInfoName :: forall lhsJoinField. RemoteFieldInfo lhsJoinField -> RelName
getRemoteFieldInfoName RemoteFieldInfo {RemoteFieldInfoRHS
_rfiRHS :: RemoteFieldInfoRHS
_rfiRHS :: forall lhsJoinField.
RemoteFieldInfo lhsJoinField -> RemoteFieldInfoRHS
_rfiRHS} = case RemoteFieldInfoRHS
_rfiRHS of
  RFISchema RemoteSchemaFieldInfo
schema -> RemoteSchemaFieldInfo -> RelName
_rrfiName RemoteSchemaFieldInfo
schema
  RFISource AnyBackend RemoteSourceFieldInfo
source -> AnyBackend RemoteSourceFieldInfo
-> (forall (b :: BackendType). RemoteSourceFieldInfo b -> RelName)
-> RelName
forall (i :: BackendType -> *) r.
AnyBackend i -> (forall (b :: BackendType). i b -> r) -> r
runBackend AnyBackend RemoteSourceFieldInfo
source RemoteSourceFieldInfo b -> RelName
forall (b :: BackendType). RemoteSourceFieldInfo b -> RelName
_rsfiName

-- | Returns all the field names created for the given field. Columns, object relationships, and
-- computed fields only ever produce a single field, but array relationships also contain an
-- @_aggregate@ field.
fieldInfoGraphQLNames :: FieldInfo b -> [G.Name]
fieldInfoGraphQLNames :: forall (b :: BackendType). FieldInfo b -> [Name]
fieldInfoGraphQLNames FieldInfo b
info = case FieldInfo b
info of
  FIColumn StructuredColumnInfo b
_ -> Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ FieldInfo b -> Maybe Name
forall (b :: BackendType). FieldInfo b -> Maybe Name
fieldInfoGraphQLName FieldInfo b
info
  FIRelationship RelInfo b
relationshipInfo -> Maybe [Name] -> [Name]
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold do
    Name
name <- FieldInfo b -> Maybe Name
forall (b :: BackendType). FieldInfo b -> Maybe Name
fieldInfoGraphQLName FieldInfo b
info
    [Name] -> Maybe [Name]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Name] -> Maybe [Name]) -> [Name] -> Maybe [Name]
forall a b. (a -> b) -> a -> b
$ case RelInfo b -> RelType
forall (b :: BackendType). RelInfo b -> RelType
riType RelInfo b
relationshipInfo of
      RelType
ObjRel -> [Name
name]
      RelType
ArrRel -> [Name] -> [Name]
addAggregateFields [Name
name]
  FIComputedField ComputedFieldInfo b
_ -> Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ FieldInfo b -> Maybe Name
forall (b :: BackendType). FieldInfo b -> Maybe Name
fieldInfoGraphQLName FieldInfo b
info
  FIRemoteRelationship RemoteFieldInfo (DBJoinField b)
_ -> Maybe Name -> [Name]
forall a. Maybe a -> [a]
maybeToList (Maybe Name -> [Name]) -> Maybe Name -> [Name]
forall a b. (a -> b) -> a -> b
$ FieldInfo b -> Maybe Name
forall (b :: BackendType). FieldInfo b -> Maybe Name
fieldInfoGraphQLName FieldInfo b
info
  where
    addAggregateFields :: [G.Name] -> [G.Name]
    addAggregateFields :: [Name] -> [Name]
addAggregateFields [Name]
names = do
      Name
name <- [Name]
names
      [Name
name, Name
name Name -> Name -> Name
forall a. Semigroup a => a -> a -> a
<> Name
Name.__aggregate]

getCols :: FieldInfoMap (FieldInfo backend) -> [StructuredColumnInfo backend]
getCols :: forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [StructuredColumnInfo backend]
getCols = (FieldInfo backend -> Maybe (StructuredColumnInfo backend))
-> [FieldInfo backend] -> [StructuredColumnInfo backend]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (FieldInfo backend
-> Getting
     (First (StructuredColumnInfo backend))
     (FieldInfo backend)
     (StructuredColumnInfo backend)
-> Maybe (StructuredColumnInfo backend)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (StructuredColumnInfo backend))
  (FieldInfo backend)
  (StructuredColumnInfo backend)
forall (b :: BackendType) (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (StructuredColumnInfo b) (f (StructuredColumnInfo b))
-> p (FieldInfo b) (f (FieldInfo b))
_FIColumn) ([FieldInfo backend] -> [StructuredColumnInfo backend])
-> (FieldInfoMap (FieldInfo backend) -> [FieldInfo backend])
-> FieldInfoMap (FieldInfo backend)
-> [StructuredColumnInfo backend]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfoMap (FieldInfo backend) -> [FieldInfo backend]
forall k v. HashMap k v -> [v]
HashMap.elems

-- | Sort columns based on their ordinal position
sortCols :: [ColumnInfo backend] -> [ColumnInfo backend]
sortCols :: forall (backend :: BackendType).
[ColumnInfo backend] -> [ColumnInfo backend]
sortCols = (ColumnInfo backend -> ColumnInfo backend -> Ordering)
-> [ColumnInfo backend] -> [ColumnInfo backend]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\ColumnInfo backend
l ColumnInfo backend
r -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ColumnInfo backend -> Int
forall (b :: BackendType). ColumnInfo b -> Int
ciPosition ColumnInfo backend
l) (ColumnInfo backend -> Int
forall (b :: BackendType). ColumnInfo b -> Int
ciPosition ColumnInfo backend
r))

getRels :: FieldInfoMap (FieldInfo backend) -> [RelInfo backend]
getRels :: forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [RelInfo backend]
getRels = (FieldInfo backend -> Maybe (RelInfo backend))
-> [FieldInfo backend] -> [RelInfo backend]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (FieldInfo backend
-> Getting
     (First (RelInfo backend)) (FieldInfo backend) (RelInfo backend)
-> Maybe (RelInfo backend)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (RelInfo backend)) (FieldInfo backend) (RelInfo backend)
forall (b :: BackendType) (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (RelInfo b) (f (RelInfo b)) -> p (FieldInfo b) (f (FieldInfo b))
_FIRelationship) ([FieldInfo backend] -> [RelInfo backend])
-> (FieldInfoMap (FieldInfo backend) -> [FieldInfo backend])
-> FieldInfoMap (FieldInfo backend)
-> [RelInfo backend]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfoMap (FieldInfo backend) -> [FieldInfo backend]
forall k v. HashMap k v -> [v]
HashMap.elems

getComputedFieldInfos :: FieldInfoMap (FieldInfo backend) -> [ComputedFieldInfo backend]
getComputedFieldInfos :: forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [ComputedFieldInfo backend]
getComputedFieldInfos = (FieldInfo backend -> Maybe (ComputedFieldInfo backend))
-> [FieldInfo backend] -> [ComputedFieldInfo backend]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (FieldInfo backend
-> Getting
     (First (ComputedFieldInfo backend))
     (FieldInfo backend)
     (ComputedFieldInfo backend)
-> Maybe (ComputedFieldInfo backend)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (ComputedFieldInfo backend))
  (FieldInfo backend)
  (ComputedFieldInfo backend)
forall (b :: BackendType) (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (ComputedFieldInfo b) (f (ComputedFieldInfo b))
-> p (FieldInfo b) (f (FieldInfo b))
_FIComputedField) ([FieldInfo backend] -> [ComputedFieldInfo backend])
-> (FieldInfoMap (FieldInfo backend) -> [FieldInfo backend])
-> FieldInfoMap (FieldInfo backend)
-> [ComputedFieldInfo backend]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldInfoMap (FieldInfo backend) -> [FieldInfo backend]
forall k v. HashMap k v -> [v]
HashMap.elems

data InsPermInfo (b :: BackendType) = InsPermInfo
  { forall (b :: BackendType). InsPermInfo b -> HashSet (Column b)
ipiCols :: HS.HashSet (Column b),
    forall (b :: BackendType). InsPermInfo b -> AnnBoolExpPartialSQL b
ipiCheck :: AnnBoolExpPartialSQL b,
    forall (b :: BackendType). InsPermInfo b -> PreSetColsPartial b
ipiSet :: PreSetColsPartial b,
    forall (b :: BackendType). InsPermInfo b -> Bool
ipiBackendOnly :: Bool,
    forall (b :: BackendType). InsPermInfo b -> HashSet Text
ipiRequiredHeaders :: HS.HashSet Text,
    forall (b :: BackendType).
InsPermInfo b -> Maybe (ValidateInput ResolvedWebhook)
ipiValidateInput :: Maybe (ValidateInput ResolvedWebhook)
  }
  deriving ((forall x. InsPermInfo b -> Rep (InsPermInfo b) x)
-> (forall x. Rep (InsPermInfo b) x -> InsPermInfo b)
-> Generic (InsPermInfo b)
forall x. Rep (InsPermInfo b) x -> InsPermInfo b
forall x. InsPermInfo b -> Rep (InsPermInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (InsPermInfo b) x -> InsPermInfo b
forall (b :: BackendType) x. InsPermInfo b -> Rep (InsPermInfo b) x
$cfrom :: forall (b :: BackendType) x. InsPermInfo b -> Rep (InsPermInfo b) x
from :: forall x. InsPermInfo b -> Rep (InsPermInfo b) x
$cto :: forall (b :: BackendType) x. Rep (InsPermInfo b) x -> InsPermInfo b
to :: forall x. Rep (InsPermInfo b) x -> InsPermInfo b
Generic)

deriving instance
  ( Backend b,
    Eq (AnnBoolExpPartialSQL b)
  ) =>
  Eq (InsPermInfo b)

deriving instance
  ( Backend b,
    Show (AnnBoolExpPartialSQL b)
  ) =>
  Show (InsPermInfo b)

instance
  ( Backend b,
    NFData (AnnBoolExpPartialSQL b),
    NFData (PreSetColsPartial b)
  ) =>
  NFData (InsPermInfo b)

instance
  ( Backend b,
    ToJSON (AnnBoolExpPartialSQL b)
  ) =>
  ToJSON (InsPermInfo b)
  where
  toJSON :: InsPermInfo b -> Value
toJSON = Options -> InsPermInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

-- | This type is only used as an intermediate type
--   to combine more than one select permissions for inherited roles.
data CombinedSelPermInfo (b :: BackendType) = CombinedSelPermInfo
  { forall (b :: BackendType).
CombinedSelPermInfo b
-> [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
cspiCols :: [(HashMap.HashMap (Column b) (AnnRedactionExpPartialSQL b))],
    forall (b :: BackendType).
CombinedSelPermInfo b
-> [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
cspiComputedFields :: [(HashMap.HashMap ComputedFieldName (AnnRedactionExpPartialSQL b))],
    forall (b :: BackendType).
CombinedSelPermInfo b -> [AnnBoolExpPartialSQL b]
cspiFilter :: [(AnnBoolExpPartialSQL b)],
    forall (b :: BackendType). CombinedSelPermInfo b -> Maybe (Max Int)
cspiLimit :: Maybe (Max Int),
    forall (b :: BackendType). CombinedSelPermInfo b -> Any
cspiAllowAgg :: Any,
    forall (b :: BackendType). CombinedSelPermInfo b -> HashSet Text
cspiRequiredHeaders :: HS.HashSet Text,
    forall (b :: BackendType).
CombinedSelPermInfo b -> AllowedRootFields QueryRootFieldType
cspiAllowedQueryRootFieldTypes :: AllowedRootFields QueryRootFieldType,
    forall (b :: BackendType).
CombinedSelPermInfo b
-> AllowedRootFields SubscriptionRootFieldType
cspiAllowedSubscriptionRootFieldTypes :: AllowedRootFields SubscriptionRootFieldType
  }

instance (Backend b) => Semigroup (CombinedSelPermInfo b) where
  CombinedSelPermInfo [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
colsL [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
scalarComputedFieldsL [AnnBoolExpPartialSQL b]
filterL Maybe (Max Int)
limitL Any
allowAggL HashSet Text
reqHeadersL AllowedRootFields QueryRootFieldType
allowedQueryRFTypesL AllowedRootFields SubscriptionRootFieldType
allowedSubsRFTypesL
    <> :: CombinedSelPermInfo b
-> CombinedSelPermInfo b -> CombinedSelPermInfo b
<> CombinedSelPermInfo [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
colsR [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
scalarComputedFieldsR [AnnBoolExpPartialSQL b]
filterR Maybe (Max Int)
limitR Any
allowAggR HashSet Text
reqHeadersR AllowedRootFields QueryRootFieldType
allowedQueryRFTypesR AllowedRootFields SubscriptionRootFieldType
allowedSubsRFTypesR =
      [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
-> [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
-> [AnnBoolExpPartialSQL b]
-> Maybe (Max Int)
-> Any
-> HashSet Text
-> AllowedRootFields QueryRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
-> CombinedSelPermInfo b
forall (b :: BackendType).
[HashMap (Column b) (AnnRedactionExpPartialSQL b)]
-> [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
-> [AnnBoolExpPartialSQL b]
-> Maybe (Max Int)
-> Any
-> HashSet Text
-> AllowedRootFields QueryRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
-> CombinedSelPermInfo b
CombinedSelPermInfo
        ([HashMap (Column b) (AnnRedactionExpPartialSQL b)]
colsL [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
-> [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
-> [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
forall a. Semigroup a => a -> a -> a
<> [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
colsR)
        ([HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
scalarComputedFieldsL [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
-> [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
-> [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
forall a. Semigroup a => a -> a -> a
<> [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
scalarComputedFieldsR)
        ([AnnBoolExpPartialSQL b]
filterL [AnnBoolExpPartialSQL b]
-> [AnnBoolExpPartialSQL b] -> [AnnBoolExpPartialSQL b]
forall a. Semigroup a => a -> a -> a
<> [AnnBoolExpPartialSQL b]
filterR)
        (Maybe (Max Int)
limitL Maybe (Max Int) -> Maybe (Max Int) -> Maybe (Max Int)
forall a. Semigroup a => a -> a -> a
<> Maybe (Max Int)
limitR)
        (Any
allowAggL Any -> Any -> Any
forall a. Semigroup a => a -> a -> a
<> Any
allowAggR)
        (HashSet Text
reqHeadersL HashSet Text -> HashSet Text -> HashSet Text
forall a. Semigroup a => a -> a -> a
<> HashSet Text
reqHeadersR)
        (AllowedRootFields QueryRootFieldType
allowedQueryRFTypesL AllowedRootFields QueryRootFieldType
-> AllowedRootFields QueryRootFieldType
-> AllowedRootFields QueryRootFieldType
forall a. Semigroup a => a -> a -> a
<> AllowedRootFields QueryRootFieldType
allowedQueryRFTypesR)
        (AllowedRootFields SubscriptionRootFieldType
allowedSubsRFTypesL AllowedRootFields SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
forall a. Semigroup a => a -> a -> a
<> AllowedRootFields SubscriptionRootFieldType
allowedSubsRFTypesR)

combinedSelPermInfoToSelPermInfo ::
  (Backend b) =>
  Int ->
  CombinedSelPermInfo b ->
  SelPermInfo b
combinedSelPermInfoToSelPermInfo :: forall (b :: BackendType).
Backend b =>
Int -> CombinedSelPermInfo b -> SelPermInfo b
combinedSelPermInfoToSelPermInfo Int
selPermsCount CombinedSelPermInfo {[HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
[HashMap (Column b) (AnnRedactionExpPartialSQL b)]
[AnnBoolExpPartialSQL b]
Maybe (Max Int)
Any
HashSet Text
AllowedRootFields SubscriptionRootFieldType
AllowedRootFields QueryRootFieldType
cspiCols :: forall (b :: BackendType).
CombinedSelPermInfo b
-> [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
cspiComputedFields :: forall (b :: BackendType).
CombinedSelPermInfo b
-> [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
cspiFilter :: forall (b :: BackendType).
CombinedSelPermInfo b -> [AnnBoolExpPartialSQL b]
cspiLimit :: forall (b :: BackendType). CombinedSelPermInfo b -> Maybe (Max Int)
cspiAllowAgg :: forall (b :: BackendType). CombinedSelPermInfo b -> Any
cspiRequiredHeaders :: forall (b :: BackendType). CombinedSelPermInfo b -> HashSet Text
cspiAllowedQueryRootFieldTypes :: forall (b :: BackendType).
CombinedSelPermInfo b -> AllowedRootFields QueryRootFieldType
cspiAllowedSubscriptionRootFieldTypes :: forall (b :: BackendType).
CombinedSelPermInfo b
-> AllowedRootFields SubscriptionRootFieldType
cspiCols :: [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
cspiComputedFields :: [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
cspiFilter :: [AnnBoolExpPartialSQL b]
cspiLimit :: Maybe (Max Int)
cspiAllowAgg :: Any
cspiRequiredHeaders :: HashSet Text
cspiAllowedQueryRootFieldTypes :: AllowedRootFields QueryRootFieldType
cspiAllowedSubscriptionRootFieldTypes :: AllowedRootFields SubscriptionRootFieldType
..} =
  HashMap (Column b) (AnnRedactionExpPartialSQL b)
-> HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
-> AnnBoolExpPartialSQL b
-> Maybe Int
-> Bool
-> HashSet Text
-> AllowedRootFields QueryRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
-> SelPermInfo b
forall (b :: BackendType).
HashMap (Column b) (AnnRedactionExpPartialSQL b)
-> HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
-> AnnBoolExpPartialSQL b
-> Maybe Int
-> Bool
-> HashSet Text
-> AllowedRootFields QueryRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
-> SelPermInfo b
SelPermInfo
    (NonEmpty (AnnRedactionExpPartialSQL b)
-> AnnRedactionExpPartialSQL b
forall (b :: BackendType).
NonEmpty (AnnRedactionExp b (PartialSQLExp b))
-> AnnRedactionExp b (PartialSQLExp b)
mergeColumnsWithBoolExp (NonEmpty (AnnRedactionExpPartialSQL b)
 -> AnnRedactionExpPartialSQL b)
-> HashMap (Column b) (NonEmpty (AnnRedactionExpPartialSQL b))
-> HashMap (Column b) (AnnRedactionExpPartialSQL b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
-> HashMap (Column b) (NonEmpty (AnnRedactionExpPartialSQL b))
forall k (t :: * -> *) v.
(Hashable k, Foldable t) =>
t (HashMap k v) -> HashMap k (NonEmpty v)
HashMap.unionsAll [HashMap (Column b) (AnnRedactionExpPartialSQL b)]
cspiCols)
    (NonEmpty (AnnRedactionExpPartialSQL b)
-> AnnRedactionExpPartialSQL b
forall (b :: BackendType).
NonEmpty (AnnRedactionExp b (PartialSQLExp b))
-> AnnRedactionExp b (PartialSQLExp b)
mergeColumnsWithBoolExp (NonEmpty (AnnRedactionExpPartialSQL b)
 -> AnnRedactionExpPartialSQL b)
-> HashMap
     ComputedFieldName (NonEmpty (AnnRedactionExpPartialSQL b))
-> HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
-> HashMap
     ComputedFieldName (NonEmpty (AnnRedactionExpPartialSQL b))
forall k (t :: * -> *) v.
(Hashable k, Foldable t) =>
t (HashMap k v) -> HashMap k (NonEmpty v)
HashMap.unionsAll [HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)]
cspiComputedFields)
    ([AnnBoolExpPartialSQL b] -> AnnBoolExpPartialSQL b
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
BoolOr [AnnBoolExpPartialSQL b]
cspiFilter)
    (Max Int -> Int
forall a. Max a -> a
getMax (Max Int -> Int) -> Maybe (Max Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Max Int)
cspiLimit)
    (Any -> Bool
getAny Any
cspiAllowAgg)
    HashSet Text
cspiRequiredHeaders
    AllowedRootFields QueryRootFieldType
cspiAllowedQueryRootFieldTypes
    AllowedRootFields SubscriptionRootFieldType
cspiAllowedSubscriptionRootFieldTypes
  where
    mergeColumnsWithBoolExp ::
      NonEmpty (AnnRedactionExp b (PartialSQLExp b)) ->
      AnnRedactionExp b (PartialSQLExp b)
    mergeColumnsWithBoolExp :: forall (b :: BackendType).
NonEmpty (AnnRedactionExp b (PartialSQLExp b))
-> AnnRedactionExp b (PartialSQLExp b)
mergeColumnsWithBoolExp NonEmpty (AnnRedactionExp b (PartialSQLExp b))
redactionExpressions
      -- when all the parent roles have a select permission, then we set
      -- the redaction expression to `NoRedaction`. Suppose this were not done, then
      -- the resulting boolean expression will be an expression which will always evaluate to
      -- `True`. So, to avoid additional computations, we just set the case boolean expression
      -- to `NoRedaction`.
      --
      -- Suppose, an inherited role, `inherited_role` inherits from two roles `role1` and `role2`.
      -- `role1` has the filter: `{"published": {"eq": true}}` and `role2` has the filter:
      -- `{"early_preview": {"eq": true}}` then the filter boolean expression of the inherited select permission will be
      -- the boolean OR of the parent roles filters.

      -- Now, let's say both `role1` and `role2` allow access to
      -- the `title` column of the table, the `RedactIfFalse` boolean expression of the `title` column will be
      -- the boolean OR of the parent roles filters i.e. same as the filter of the select permission. Since,
      -- the `RedactIfFalse` boolean expression is equal to the row filter boolean expression, the `RedactIfFalse`
      -- boolean expression will always evaluate to `True`; and since the `RedactIfFalse` boolean expression
      -- will always evaluate to `True`, we simply change the `RedactIfFalse` to a `NoRedaction` redaction expression
      -- when for a column all the select permissions exists.
      | Int
selPermsCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty (AnnRedactionExp b (PartialSQLExp b)) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (AnnRedactionExp b (PartialSQLExp b))
redactionExpressions = AnnRedactionExp b (PartialSQLExp b)
forall (b :: BackendType) v. AnnRedactionExp b v
NoRedaction
      | Bool
otherwise =
          let redactionBoolExps :: [GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))]
redactionBoolExps = (AnnRedactionExp b (PartialSQLExp b)
 -> Maybe (GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))))
-> [AnnRedactionExp b (PartialSQLExp b)]
-> [GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (AnnRedactionExp b (PartialSQLExp b)
-> Getting
     (First (GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))))
     (AnnRedactionExp b (PartialSQLExp b))
     (GBoolExp b (AnnBoolExpFld b (PartialSQLExp b)))
-> Maybe (GBoolExp b (AnnBoolExpFld b (PartialSQLExp b)))
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting
  (First (GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))))
  (AnnRedactionExp b (PartialSQLExp b))
  (GBoolExp b (AnnBoolExpFld b (PartialSQLExp b)))
forall (b1 :: BackendType) v1 (b2 :: BackendType) v2
       (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (GBoolExp b1 (AnnBoolExpFld b1 v1))
  (f (GBoolExp b2 (AnnBoolExpFld b2 v2)))
-> p (AnnRedactionExp b1 v1) (f (AnnRedactionExp b2 v2))
_RedactIfFalse) ([AnnRedactionExp b (PartialSQLExp b)]
 -> [GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))])
-> [AnnRedactionExp b (PartialSQLExp b)]
-> [GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))]
forall a b. (a -> b) -> a -> b
$ NonEmpty (AnnRedactionExp b (PartialSQLExp b))
-> [AnnRedactionExp b (PartialSQLExp b)]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty (AnnRedactionExp b (PartialSQLExp b))
redactionExpressions
           in AnnRedactionExp b (PartialSQLExp b)
-> AnnRedactionExp b (PartialSQLExp b)
-> Bool
-> AnnRedactionExp b (PartialSQLExp b)
forall a. a -> a -> Bool -> a
bool (GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))
-> AnnRedactionExp b (PartialSQLExp b)
forall (b :: BackendType) v.
GBoolExp b (AnnBoolExpFld b v) -> AnnRedactionExp b v
RedactIfFalse (GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))
 -> AnnRedactionExp b (PartialSQLExp b))
-> GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))
-> AnnRedactionExp b (PartialSQLExp b)
forall a b. (a -> b) -> a -> b
$ [GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))]
-> GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))
forall (backend :: BackendType) field.
[GBoolExp backend field] -> GBoolExp backend field
BoolOr [GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))]
redactionBoolExps) AnnRedactionExp b (PartialSQLExp b)
forall (b :: BackendType) v. AnnRedactionExp b v
NoRedaction (Bool -> AnnRedactionExp b (PartialSQLExp b))
-> Bool -> AnnRedactionExp b (PartialSQLExp b)
forall a b. (a -> b) -> a -> b
$ [GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [GBoolExp b (AnnBoolExpFld b (PartialSQLExp b))]
redactionBoolExps

data SelPermInfo (b :: BackendType) = SelPermInfo
  { -- | HashMap of accessible columns to the role, the `Column` may be mapped to
    -- an `AnnRedactionExpPartialSQL`, which is `RedactIfFalse` only in the case of an
    -- inherited role, for a non-inherited role, it will always be `NoRedaction`. The `RedactIfFalse`
    -- bool exp will determine if the column should be nullified in a row, when
    -- there aren't requisite permissions.
    forall (b :: BackendType).
SelPermInfo b -> HashMap (Column b) (AnnRedactionExpPartialSQL b)
spiCols :: HashMap.HashMap (Column b) (AnnRedactionExpPartialSQL b),
    -- | HashMap of accessible computed fields to the role, mapped to
    -- `AnnRedactionExpPartialSQL`, simililar to `spiCols`.
    -- These computed fields do not return rows of existing table.
    forall (b :: BackendType).
SelPermInfo b
-> HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
spiComputedFields :: HashMap.HashMap ComputedFieldName (AnnRedactionExpPartialSQL b),
    forall (b :: BackendType). SelPermInfo b -> AnnBoolExpPartialSQL b
spiFilter :: AnnBoolExpPartialSQL b,
    forall (b :: BackendType). SelPermInfo b -> Maybe Int
spiLimit :: Maybe Int,
    forall (b :: BackendType). SelPermInfo b -> Bool
spiAllowAgg :: Bool,
    forall (b :: BackendType). SelPermInfo b -> HashSet Text
spiRequiredHeaders :: HashSet Text,
    -- | allowed root field types to be exposed in the query_root
    forall (b :: BackendType).
SelPermInfo b -> AllowedRootFields QueryRootFieldType
spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType,
    -- | allowed root field types to be exposed in the subscription_root
    forall (b :: BackendType).
SelPermInfo b -> AllowedRootFields SubscriptionRootFieldType
spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
  }
  deriving ((forall x. SelPermInfo b -> Rep (SelPermInfo b) x)
-> (forall x. Rep (SelPermInfo b) x -> SelPermInfo b)
-> Generic (SelPermInfo b)
forall x. Rep (SelPermInfo b) x -> SelPermInfo b
forall x. SelPermInfo b -> Rep (SelPermInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (SelPermInfo b) x -> SelPermInfo b
forall (b :: BackendType) x. SelPermInfo b -> Rep (SelPermInfo b) x
$cfrom :: forall (b :: BackendType) x. SelPermInfo b -> Rep (SelPermInfo b) x
from :: forall x. SelPermInfo b -> Rep (SelPermInfo b) x
$cto :: forall (b :: BackendType) x. Rep (SelPermInfo b) x -> SelPermInfo b
to :: forall x. Rep (SelPermInfo b) x -> SelPermInfo b
Generic)

deriving instance
  ( Backend b,
    Eq (AnnBoolExpPartialSQL b)
  ) =>
  Eq (SelPermInfo b)

deriving instance
  ( Backend b,
    Show (AnnBoolExpPartialSQL b)
  ) =>
  Show (SelPermInfo b)

instance
  ( Backend b,
    NFData (AnnBoolExpPartialSQL b)
  ) =>
  NFData (SelPermInfo b)

instance
  ( Backend b,
    ToJSON (AnnBoolExpPartialSQL b)
  ) =>
  ToJSON (SelPermInfo b)
  where
  toJSON :: SelPermInfo b -> Value
toJSON = Options -> SelPermInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

data UpdPermInfo (b :: BackendType) = UpdPermInfo
  { forall (b :: BackendType). UpdPermInfo b -> HashSet (Column b)
upiCols :: HS.HashSet (Column b),
    forall (b :: BackendType). UpdPermInfo b -> TableName b
upiTable :: TableName b,
    forall (b :: BackendType). UpdPermInfo b -> AnnBoolExpPartialSQL b
upiFilter :: AnnBoolExpPartialSQL b,
    forall (b :: BackendType).
UpdPermInfo b -> Maybe (AnnBoolExpPartialSQL b)
upiCheck :: Maybe (AnnBoolExpPartialSQL b),
    forall (b :: BackendType). UpdPermInfo b -> PreSetColsPartial b
upiSet :: PreSetColsPartial b,
    forall (b :: BackendType). UpdPermInfo b -> Bool
upiBackendOnly :: Bool,
    forall (b :: BackendType). UpdPermInfo b -> HashSet Text
upiRequiredHeaders :: HashSet Text,
    forall (b :: BackendType).
UpdPermInfo b -> Maybe (ValidateInput ResolvedWebhook)
upiValidateInput :: Maybe (ValidateInput ResolvedWebhook)
  }
  deriving ((forall x. UpdPermInfo b -> Rep (UpdPermInfo b) x)
-> (forall x. Rep (UpdPermInfo b) x -> UpdPermInfo b)
-> Generic (UpdPermInfo b)
forall x. Rep (UpdPermInfo b) x -> UpdPermInfo b
forall x. UpdPermInfo b -> Rep (UpdPermInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (UpdPermInfo b) x -> UpdPermInfo b
forall (b :: BackendType) x. UpdPermInfo b -> Rep (UpdPermInfo b) x
$cfrom :: forall (b :: BackendType) x. UpdPermInfo b -> Rep (UpdPermInfo b) x
from :: forall x. UpdPermInfo b -> Rep (UpdPermInfo b) x
$cto :: forall (b :: BackendType) x. Rep (UpdPermInfo b) x -> UpdPermInfo b
to :: forall x. Rep (UpdPermInfo b) x -> UpdPermInfo b
Generic)

deriving instance
  ( Backend b,
    Eq (AnnBoolExpPartialSQL b)
  ) =>
  Eq (UpdPermInfo b)

deriving instance
  ( Backend b,
    Show (AnnBoolExpPartialSQL b)
  ) =>
  Show (UpdPermInfo b)

instance
  ( Backend b,
    NFData (AnnBoolExpPartialSQL b),
    NFData (PreSetColsPartial b)
  ) =>
  NFData (UpdPermInfo b)

instance
  ( Backend b,
    ToJSON (AnnBoolExpPartialSQL b)
  ) =>
  ToJSON (UpdPermInfo b)
  where
  toJSON :: UpdPermInfo b -> Value
toJSON = Options -> UpdPermInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

data DelPermInfo (b :: BackendType) = DelPermInfo
  { forall (b :: BackendType). DelPermInfo b -> TableName b
dpiTable :: TableName b,
    forall (b :: BackendType). DelPermInfo b -> AnnBoolExpPartialSQL b
dpiFilter :: AnnBoolExpPartialSQL b,
    forall (b :: BackendType). DelPermInfo b -> Bool
dpiBackendOnly :: !Bool,
    forall (b :: BackendType). DelPermInfo b -> HashSet Text
dpiRequiredHeaders :: HashSet Text,
    forall (b :: BackendType).
DelPermInfo b -> Maybe (ValidateInput ResolvedWebhook)
dpiValidateInput :: Maybe (ValidateInput ResolvedWebhook)
  }
  deriving ((forall x. DelPermInfo b -> Rep (DelPermInfo b) x)
-> (forall x. Rep (DelPermInfo b) x -> DelPermInfo b)
-> Generic (DelPermInfo b)
forall x. Rep (DelPermInfo b) x -> DelPermInfo b
forall x. DelPermInfo b -> Rep (DelPermInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (DelPermInfo b) x -> DelPermInfo b
forall (b :: BackendType) x. DelPermInfo b -> Rep (DelPermInfo b) x
$cfrom :: forall (b :: BackendType) x. DelPermInfo b -> Rep (DelPermInfo b) x
from :: forall x. DelPermInfo b -> Rep (DelPermInfo b) x
$cto :: forall (b :: BackendType) x. Rep (DelPermInfo b) x -> DelPermInfo b
to :: forall x. Rep (DelPermInfo b) x -> DelPermInfo b
Generic)

deriving instance
  ( Backend b,
    Eq (AnnBoolExpPartialSQL b)
  ) =>
  Eq (DelPermInfo b)

deriving instance
  ( Backend b,
    Show (AnnBoolExpPartialSQL b)
  ) =>
  Show (DelPermInfo b)

instance
  ( Backend b,
    NFData (AnnBoolExpPartialSQL b)
  ) =>
  NFData (DelPermInfo b)

instance
  ( Backend b,
    ToJSON (AnnBoolExpPartialSQL b)
  ) =>
  ToJSON (DelPermInfo b)
  where
  toJSON :: DelPermInfo b -> Value
toJSON = Options -> DelPermInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

data RolePermInfo (b :: BackendType) = RolePermInfo
  { forall (b :: BackendType). RolePermInfo b -> Maybe (InsPermInfo b)
_permIns :: Maybe (InsPermInfo b),
    forall (b :: BackendType). RolePermInfo b -> Maybe (SelPermInfo b)
_permSel :: Maybe (SelPermInfo b),
    forall (b :: BackendType). RolePermInfo b -> Maybe (UpdPermInfo b)
_permUpd :: Maybe (UpdPermInfo b),
    forall (b :: BackendType). RolePermInfo b -> Maybe (DelPermInfo b)
_permDel :: Maybe (DelPermInfo b)
  }
  deriving ((forall x. RolePermInfo b -> Rep (RolePermInfo b) x)
-> (forall x. Rep (RolePermInfo b) x -> RolePermInfo b)
-> Generic (RolePermInfo b)
forall x. Rep (RolePermInfo b) x -> RolePermInfo b
forall x. RolePermInfo b -> Rep (RolePermInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (RolePermInfo b) x -> RolePermInfo b
forall (b :: BackendType) x.
RolePermInfo b -> Rep (RolePermInfo b) x
$cfrom :: forall (b :: BackendType) x.
RolePermInfo b -> Rep (RolePermInfo b) x
from :: forall x. RolePermInfo b -> Rep (RolePermInfo b) x
$cto :: forall (b :: BackendType) x.
Rep (RolePermInfo b) x -> RolePermInfo b
to :: forall x. Rep (RolePermInfo b) x -> RolePermInfo b
Generic)

instance
  ( Backend b,
    NFData (InsPermInfo b),
    NFData (SelPermInfo b),
    NFData (UpdPermInfo b),
    NFData (DelPermInfo b)
  ) =>
  NFData (RolePermInfo b)

instance
  ( Backend b,
    ToJSON (InsPermInfo b),
    ToJSON (SelPermInfo b),
    ToJSON (UpdPermInfo b),
    ToJSON (DelPermInfo b)
  ) =>
  ToJSON (RolePermInfo b)
  where
  toJSON :: RolePermInfo b -> Value
toJSON = Options -> RolePermInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

makeLenses ''RolePermInfo

type RolePermInfoMap b = HashMap.HashMap RoleName (RolePermInfo b)

-- data ConstraintType
--   = CTCHECK
--   | CTFOREIGNKEY
--   | CTPRIMARYKEY
--   | CTUNIQUE
--   deriving Eq

-- constraintTyToTxt :: ConstraintType -> Text
-- constraintTyToTxt ty = case ty of
--   CTCHECK      -> "CHECK"
--   CTFOREIGNKEY -> "FOREIGN KEY"
--   CTPRIMARYKEY -> "PRIMARY KEY"
--   CTUNIQUE     -> "UNIQUE"

-- instance Show ConstraintType where
--   show = T.unpack . constraintTyToTxt

-- instance FromJSON ConstraintType where
--   parseJSON = withText "ConstraintType" $ \case
--     "CHECK"       -> return CTCHECK
--     "FOREIGN KEY" -> return CTFOREIGNKEY
--     "PRIMARY KEY" -> return CTPRIMARYKEY
--     "UNIQUE"      -> return CTUNIQUE
--     c             -> fail $ "unexpected ConstraintType: " <> T.unpack c

-- instance ToJSON ConstraintType where
--   toJSON = String . constraintTyToTxt

-- isUniqueOrPrimary :: ConstraintType -> Bool
-- isUniqueOrPrimary = \case
--   CTPRIMARYKEY -> True
--   CTUNIQUE     -> True
--   _            -> False

-- isForeignKey :: ConstraintType -> Bool
-- isForeignKey = \case
--   CTFOREIGNKEY -> True
--   _            -> False

-- data TableConstraint
--   = TableConstraint
--   { tcType :: ConstraintType
--   , tcName :: ConstraintName
--   } deriving (Show, Eq)

-- $(deriveJSON hasuraJSON ''TableConstraint)

data ViewInfo = ViewInfo
  { ViewInfo -> Bool
viIsUpdatable :: Bool,
    ViewInfo -> Bool
viIsDeletable :: Bool,
    ViewInfo -> Bool
viIsInsertable :: Bool
  }
  deriving (Int -> ViewInfo -> ShowS
[ViewInfo] -> ShowS
ViewInfo -> String
(Int -> ViewInfo -> ShowS)
-> (ViewInfo -> String) -> ([ViewInfo] -> ShowS) -> Show ViewInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ViewInfo -> ShowS
showsPrec :: Int -> ViewInfo -> ShowS
$cshow :: ViewInfo -> String
show :: ViewInfo -> String
$cshowList :: [ViewInfo] -> ShowS
showList :: [ViewInfo] -> ShowS
Show, ViewInfo -> ViewInfo -> Bool
(ViewInfo -> ViewInfo -> Bool)
-> (ViewInfo -> ViewInfo -> Bool) -> Eq ViewInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ViewInfo -> ViewInfo -> Bool
== :: ViewInfo -> ViewInfo -> Bool
$c/= :: ViewInfo -> ViewInfo -> Bool
/= :: ViewInfo -> ViewInfo -> Bool
Eq, (forall x. ViewInfo -> Rep ViewInfo x)
-> (forall x. Rep ViewInfo x -> ViewInfo) -> Generic ViewInfo
forall x. Rep ViewInfo x -> ViewInfo
forall x. ViewInfo -> Rep ViewInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ViewInfo -> Rep ViewInfo x
from :: forall x. ViewInfo -> Rep ViewInfo x
$cto :: forall x. Rep ViewInfo x -> ViewInfo
to :: forall x. Rep ViewInfo x -> ViewInfo
Generic)

instance NFData ViewInfo

$(deriveJSON hasuraJSON ''ViewInfo)

isMutable :: (ViewInfo -> Bool) -> Maybe ViewInfo -> Bool
isMutable :: (ViewInfo -> Bool) -> Maybe ViewInfo -> Bool
isMutable ViewInfo -> Bool
_ Maybe ViewInfo
Nothing = Bool
True
isMutable ViewInfo -> Bool
f (Just ViewInfo
vi) = ViewInfo -> Bool
f ViewInfo
vi

data ColumnConfig = ColumnConfig
  { ColumnConfig -> Maybe Name
_ccfgCustomName :: Maybe G.Name,
    ColumnConfig -> Comment
_ccfgComment :: Comment
  }
  deriving stock (ColumnConfig -> ColumnConfig -> Bool
(ColumnConfig -> ColumnConfig -> Bool)
-> (ColumnConfig -> ColumnConfig -> Bool) -> Eq ColumnConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnConfig -> ColumnConfig -> Bool
== :: ColumnConfig -> ColumnConfig -> Bool
$c/= :: ColumnConfig -> ColumnConfig -> Bool
/= :: ColumnConfig -> ColumnConfig -> Bool
Eq, Int -> ColumnConfig -> ShowS
[ColumnConfig] -> ShowS
ColumnConfig -> String
(Int -> ColumnConfig -> ShowS)
-> (ColumnConfig -> String)
-> ([ColumnConfig] -> ShowS)
-> Show ColumnConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnConfig -> ShowS
showsPrec :: Int -> ColumnConfig -> ShowS
$cshow :: ColumnConfig -> String
show :: ColumnConfig -> String
$cshowList :: [ColumnConfig] -> ShowS
showList :: [ColumnConfig] -> ShowS
Show, (forall x. ColumnConfig -> Rep ColumnConfig x)
-> (forall x. Rep ColumnConfig x -> ColumnConfig)
-> Generic ColumnConfig
forall x. Rep ColumnConfig x -> ColumnConfig
forall x. ColumnConfig -> Rep ColumnConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColumnConfig -> Rep ColumnConfig x
from :: forall x. ColumnConfig -> Rep ColumnConfig x
$cto :: forall x. Rep ColumnConfig x -> ColumnConfig
to :: forall x. Rep ColumnConfig x -> ColumnConfig
Generic)

instance NFData ColumnConfig

instance HasCodec ColumnConfig where
  codec :: JSONCodec ColumnConfig
codec =
    Text
-> ObjectCodec ColumnConfig ColumnConfig -> JSONCodec ColumnConfig
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"ColumnConfig"
      (ObjectCodec ColumnConfig ColumnConfig -> JSONCodec ColumnConfig)
-> ObjectCodec ColumnConfig ColumnConfig -> JSONCodec ColumnConfig
forall a b. (a -> b) -> a -> b
$ Maybe Name -> Comment -> ColumnConfig
ColumnConfig
      (Maybe Name -> Comment -> ColumnConfig)
-> Codec Object ColumnConfig (Maybe Name)
-> Codec Object ColumnConfig (Comment -> ColumnConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ValueCodec Name Name -> ObjectCodec (Maybe Name) (Maybe Name)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldOrNullWith' Text
"custom_name" ValueCodec Name Name
graphQLFieldNameCodec
      ObjectCodec (Maybe Name) (Maybe Name)
-> (ColumnConfig -> Maybe Name)
-> Codec Object ColumnConfig (Maybe Name)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ColumnConfig -> Maybe Name
_ccfgCustomName
        Codec Object ColumnConfig (Comment -> ColumnConfig)
-> Codec Object ColumnConfig Comment
-> ObjectCodec ColumnConfig ColumnConfig
forall a b.
Codec Object ColumnConfig (a -> b)
-> Codec Object ColumnConfig a -> Codec Object ColumnConfig b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Comment -> ObjectCodec Comment Comment
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"comment" Comment
Automatic
      ObjectCodec Comment Comment
-> (ColumnConfig -> Comment) -> Codec Object ColumnConfig Comment
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ColumnConfig -> Comment
_ccfgComment

instance ToJSON ColumnConfig where
  toJSON :: ColumnConfig -> Value
toJSON ColumnConfig {Maybe Name
Comment
_ccfgCustomName :: ColumnConfig -> Maybe Name
_ccfgComment :: ColumnConfig -> Comment
_ccfgCustomName :: Maybe Name
_ccfgComment :: Comment
..} =
    [Pair] -> Value
object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter
        ((Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> Value
forall a b. (a, b) -> b
snd)
        [ Key
"custom_name" Key -> Maybe Name -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Name
_ccfgCustomName,
          Key
"comment" Key -> Comment -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Comment
_ccfgComment
        ]

instance FromJSON ColumnConfig where
  parseJSON :: Value -> Parser ColumnConfig
parseJSON = String
-> (Object -> Parser ColumnConfig) -> Value -> Parser ColumnConfig
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ColumnConfig" ((Object -> Parser ColumnConfig) -> Value -> Parser ColumnConfig)
-> (Object -> Parser ColumnConfig) -> Value -> Parser ColumnConfig
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Maybe Name -> Comment -> ColumnConfig
ColumnConfig
      (Maybe Name -> Comment -> ColumnConfig)
-> Parser (Maybe Name) -> Parser (Comment -> ColumnConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj
      Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_name"
      Parser (Comment -> ColumnConfig)
-> Parser Comment -> Parser ColumnConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj
      Object -> Key -> Parser (Maybe Comment)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment"
      Parser (Maybe Comment) -> Comment -> Parser Comment
forall a. Parser (Maybe a) -> a -> Parser a
.!= Comment
Automatic

instance Semigroup ColumnConfig where
  ColumnConfig
a <> :: ColumnConfig -> ColumnConfig -> ColumnConfig
<> ColumnConfig
b = Maybe Name -> Comment -> ColumnConfig
ColumnConfig Maybe Name
customName Comment
comment
    where
      customName :: Maybe Name
customName = ColumnConfig -> Maybe Name
_ccfgCustomName ColumnConfig
a Maybe Name -> Maybe Name -> Maybe Name
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ColumnConfig -> Maybe Name
_ccfgCustomName ColumnConfig
b
      comment :: Comment
comment = case (ColumnConfig -> Comment
_ccfgComment ColumnConfig
a, ColumnConfig -> Comment
_ccfgComment ColumnConfig
b) of
        (Comment
Automatic, Comment
explicit) -> Comment
explicit
        (Comment
explicit, Comment
_) -> Comment
explicit

instance Monoid ColumnConfig where
  mempty :: ColumnConfig
mempty = Maybe Name -> Comment -> ColumnConfig
ColumnConfig Maybe Name
forall a. Maybe a
Nothing Comment
Automatic

data TableConfig b = TableConfig
  { forall (b :: BackendType). TableConfig b -> TableCustomRootFields
_tcCustomRootFields :: TableCustomRootFields,
    forall (b :: BackendType).
TableConfig b -> HashMap (Column b) ColumnConfig
_tcColumnConfig :: HashMap (Column b) ColumnConfig,
    forall (b :: BackendType). TableConfig b -> Maybe Name
_tcCustomName :: Maybe G.Name,
    forall (b :: BackendType). TableConfig b -> Comment
_tcComment :: Comment
  }
  deriving ((forall x. TableConfig b -> Rep (TableConfig b) x)
-> (forall x. Rep (TableConfig b) x -> TableConfig b)
-> Generic (TableConfig b)
forall x. Rep (TableConfig b) x -> TableConfig b
forall x. TableConfig b -> Rep (TableConfig b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (TableConfig b) x -> TableConfig b
forall (b :: BackendType) x. TableConfig b -> Rep (TableConfig b) x
$cfrom :: forall (b :: BackendType) x. TableConfig b -> Rep (TableConfig b) x
from :: forall x. TableConfig b -> Rep (TableConfig b) x
$cto :: forall (b :: BackendType) x. Rep (TableConfig b) x -> TableConfig b
to :: forall x. Rep (TableConfig b) x -> TableConfig b
Generic)

deriving instance (Backend b) => Eq (TableConfig b)

deriving instance (Backend b) => Show (TableConfig b)

instance (Backend b) => NFData (TableConfig b)

$(makeLenses ''TableConfig)

emptyTableConfig :: TableConfig b
emptyTableConfig :: forall (b :: BackendType). TableConfig b
emptyTableConfig =
  TableCustomRootFields
-> HashMap (Column b) ColumnConfig
-> Maybe Name
-> Comment
-> TableConfig b
forall (b :: BackendType).
TableCustomRootFields
-> HashMap (Column b) ColumnConfig
-> Maybe Name
-> Comment
-> TableConfig b
TableConfig TableCustomRootFields
emptyCustomRootFields HashMap (Column b) ColumnConfig
forall k v. HashMap k v
HashMap.empty Maybe Name
forall a. Maybe a
Nothing Comment
Automatic

instance (Backend b) => HasCodec (TableConfig b) where
  codec :: JSONCodec (TableConfig b)
codec =
    Text
-> ObjectCodec (TableConfig b) (TableConfig b)
-> JSONCodec (TableConfig b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (forall (b :: BackendType). HasTag b => Text
backendPrefix @b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"TableConfig")
      (ObjectCodec (TableConfig b) (TableConfig b)
 -> JSONCodec (TableConfig b))
-> ObjectCodec (TableConfig b) (TableConfig b)
-> JSONCodec (TableConfig b)
forall a b. (a -> b) -> a -> b
$ TableCustomRootFields
-> HashMap (Column b) ColumnConfig
-> Maybe Name
-> Comment
-> TableConfig b
forall (b :: BackendType).
TableCustomRootFields
-> HashMap (Column b) ColumnConfig
-> Maybe Name
-> Comment
-> TableConfig b
TableConfig
      (TableCustomRootFields
 -> HashMap (Column b) ColumnConfig
 -> Maybe Name
 -> Comment
 -> TableConfig b)
-> Codec Object (TableConfig b) TableCustomRootFields
-> Codec
     Object
     (TableConfig b)
     (HashMap (Column b) ColumnConfig
      -> Maybe Name -> Comment -> TableConfig b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> TableCustomRootFields
-> ObjectCodec TableCustomRootFields TableCustomRootFields
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"custom_root_fields" TableCustomRootFields
emptyCustomRootFields
      ObjectCodec TableCustomRootFields TableCustomRootFields
-> (TableConfig b -> TableCustomRootFields)
-> Codec Object (TableConfig b) TableCustomRootFields
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableConfig b -> TableCustomRootFields
forall (b :: BackendType). TableConfig b -> TableCustomRootFields
_tcCustomRootFields
        Codec
  Object
  (TableConfig b)
  (HashMap (Column b) ColumnConfig
   -> Maybe Name -> Comment -> TableConfig b)
-> Codec Object (TableConfig b) (HashMap (Column b) ColumnConfig)
-> Codec
     Object (TableConfig b) (Maybe Name -> Comment -> TableConfig b)
forall a b.
Codec Object (TableConfig b) (a -> b)
-> Codec Object (TableConfig b) a -> Codec Object (TableConfig b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Codec
  Object
  (HashMap (Column b) ColumnConfig)
  (HashMap (Column b) ColumnConfig)
columnConfigCodec
      Codec
  Object
  (HashMap (Column b) ColumnConfig)
  (HashMap (Column b) ColumnConfig)
-> (TableConfig b -> HashMap (Column b) ColumnConfig)
-> Codec Object (TableConfig b) (HashMap (Column b) ColumnConfig)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableConfig b -> HashMap (Column b) ColumnConfig
forall (b :: BackendType).
TableConfig b -> HashMap (Column b) ColumnConfig
_tcColumnConfig
        Codec
  Object (TableConfig b) (Maybe Name -> Comment -> TableConfig b)
-> Codec Object (TableConfig b) (Maybe Name)
-> Codec Object (TableConfig b) (Comment -> TableConfig b)
forall a b.
Codec Object (TableConfig b) (a -> b)
-> Codec Object (TableConfig b) a -> Codec Object (TableConfig b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Name Name -> ObjectCodec (Maybe Name) (Maybe Name)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldOrNullWith' Text
"custom_name" ValueCodec Name Name
graphQLFieldNameCodec
      ObjectCodec (Maybe Name) (Maybe Name)
-> (TableConfig b -> Maybe Name)
-> Codec Object (TableConfig b) (Maybe Name)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableConfig b -> Maybe Name
forall (b :: BackendType). TableConfig b -> Maybe Name
_tcCustomName
        Codec Object (TableConfig b) (Comment -> TableConfig b)
-> Codec Object (TableConfig b) Comment
-> ObjectCodec (TableConfig b) (TableConfig b)
forall a b.
Codec Object (TableConfig b) (a -> b)
-> Codec Object (TableConfig b) a -> Codec Object (TableConfig b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Comment -> ObjectCodec Comment Comment
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"comment" Comment
Automatic
      ObjectCodec Comment Comment
-> (TableConfig b -> Comment)
-> Codec Object (TableConfig b) Comment
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TableConfig b -> Comment
forall (b :: BackendType). TableConfig b -> Comment
_tcComment
    where
      -- custom_column_names is a deprecated property that has been replaced by column_config.
      -- We merge custom_column_names into column_config transparently to maintain backwards
      -- compatibility (with both the metadata API and the metadata JSON saved in the HGE DB)
      -- custom_column_names can be removed once the deprecation period has expired and we get rid of it
      --
      -- This codec translates between a single column config value on the
      -- Haskell side, and a pair of object properties on the JSON side that are
      -- merged into the object codec above. When encoding the value for
      -- @custom_column_names@ is derived from @_tcColumnConfig@. When decoding
      -- values from @column_config@ and @custom_column_names@ are merged
      -- produce one value for @_tcColumnConfig@.
      columnConfigCodec :: Codec
  Object
  (HashMap (Column b) ColumnConfig)
  (HashMap (Column b) ColumnConfig)
columnConfigCodec =
        ((HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
 -> HashMap (Column b) ColumnConfig)
-> (HashMap (Column b) ColumnConfig
    -> (HashMap (Column b) ColumnConfig, HashMap (Column b) Name))
-> Codec
     Object
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
-> Codec
     Object
     (HashMap (Column b) ColumnConfig)
     (HashMap (Column b) ColumnConfig)
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
-> HashMap (Column b) ColumnConfig
forall {k}.
Hashable k =>
(HashMap k ColumnConfig, HashMap k Name) -> HashMap k ColumnConfig
dec HashMap (Column b) ColumnConfig
-> (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
forall {k}.
Hashable k =>
HashMap k ColumnConfig -> (HashMap k ColumnConfig, HashMap k Name)
enc
          (Codec
   Object
   (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
   (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
 -> Codec
      Object
      (HashMap (Column b) ColumnConfig)
      (HashMap (Column b) ColumnConfig))
-> Codec
     Object
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
-> Codec
     Object
     (HashMap (Column b) ColumnConfig)
     (HashMap (Column b) ColumnConfig)
forall a b. (a -> b) -> a -> b
$ (,)
          (HashMap (Column b) ColumnConfig
 -> HashMap (Column b) Name
 -> (HashMap (Column b) ColumnConfig, HashMap (Column b) Name))
-> Codec
     Object
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
     (HashMap (Column b) ColumnConfig)
-> Codec
     Object
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
     (HashMap (Column b) Name
      -> (HashMap (Column b) ColumnConfig, HashMap (Column b) Name))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> HashMap (Column b) ColumnConfig
-> Codec
     Object
     (HashMap (Column b) ColumnConfig)
     (HashMap (Column b) ColumnConfig)
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"column_config" HashMap (Column b) ColumnConfig
forall k v. HashMap k v
HashMap.empty
          Codec
  Object
  (HashMap (Column b) ColumnConfig)
  (HashMap (Column b) ColumnConfig)
-> ((HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
    -> HashMap (Column b) ColumnConfig)
-> Codec
     Object
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
     (HashMap (Column b) ColumnConfig)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
-> HashMap (Column b) ColumnConfig
forall a b. (a, b) -> a
fst
            Codec
  Object
  (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
  (HashMap (Column b) Name
   -> (HashMap (Column b) ColumnConfig, HashMap (Column b) Name))
-> Codec
     Object
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
     (HashMap (Column b) Name)
-> Codec
     Object
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
forall a b.
Codec
  Object
  (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
  (a -> b)
-> Codec
     Object (HashMap (Column b) ColumnConfig, HashMap (Column b) Name) a
-> Codec
     Object (HashMap (Column b) ColumnConfig, HashMap (Column b) Name) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec (HashMap (Column b) Name)
-> HashMap (Column b) Name
-> ObjectCodec (HashMap (Column b) Name) (HashMap (Column b) Name)
forall output.
Text -> JSONCodec output -> output -> ObjectCodec output output
optionalFieldWithDefaultWith' Text
"custom_column_names" (ValueCodec Name Name -> JSONCodec (HashMap (Column b) Name)
forall k v.
(Eq k, Hashable k, FromJSONKey k, ToJSONKey k) =>
JSONCodec v -> JSONCodec (HashMap k v)
hashMapCodec ValueCodec Name Name
graphQLFieldNameCodec) HashMap (Column b) Name
forall k v. HashMap k v
HashMap.empty
          ObjectCodec (HashMap (Column b) Name) (HashMap (Column b) Name)
-> ((HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
    -> HashMap (Column b) Name)
-> Codec
     Object
     (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
     (HashMap (Column b) Name)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= (HashMap (Column b) ColumnConfig, HashMap (Column b) Name)
-> HashMap (Column b) Name
forall a b. (a, b) -> b
snd

      -- if @custom_column_names@ was given then merge its value during decoding
      -- to get a complete value for _tcColumnConfig
      dec :: (HashMap k ColumnConfig, HashMap k Name) -> HashMap k ColumnConfig
dec (HashMap k ColumnConfig
columnConfig, HashMap k Name
legacyCustomColumnNames) =
        let legacyColumnConfig :: HashMap k ColumnConfig
legacyColumnConfig = (\Name
name -> Maybe Name -> Comment -> ColumnConfig
ColumnConfig (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
name) Comment
Automatic) (Name -> ColumnConfig) -> HashMap k Name -> HashMap k ColumnConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap k Name
legacyCustomColumnNames
         in (ColumnConfig -> ColumnConfig -> ColumnConfig)
-> HashMap k ColumnConfig
-> HashMap k ColumnConfig
-> HashMap k ColumnConfig
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith ColumnConfig -> ColumnConfig -> ColumnConfig
forall a. Semigroup a => a -> a -> a
(<>) HashMap k ColumnConfig
columnConfig HashMap k ColumnConfig
legacyColumnConfig -- columnConfig takes precedence over legacy

      -- encode value from _tcColumnConfig for @column_config@, and for the
      -- legacy representation for @custom_column_names@.
      enc :: HashMap k ColumnConfig -> (HashMap k ColumnConfig, HashMap k Name)
enc HashMap k ColumnConfig
columnConfig =
        let outputColumnConfig :: HashMap k ColumnConfig
outputColumnConfig = (ColumnConfig -> Bool)
-> HashMap k ColumnConfig -> HashMap k ColumnConfig
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter (ColumnConfig -> ColumnConfig -> Bool
forall a. Eq a => a -> a -> Bool
/= ColumnConfig
forall a. Monoid a => a
mempty) HashMap k ColumnConfig
columnConfig
            legacyCustomColumnNames :: HashMap k Name
legacyCustomColumnNames = (ColumnConfig -> Maybe Name)
-> HashMap k ColumnConfig -> HashMap k Name
forall a b. (a -> Maybe b) -> HashMap k a -> HashMap k b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ColumnConfig -> Maybe Name
_ccfgCustomName HashMap k ColumnConfig
columnConfig
         in (HashMap k ColumnConfig
outputColumnConfig, HashMap k Name
legacyCustomColumnNames)

instance (Backend b) => FromJSON (TableConfig b) where
  parseJSON :: Value -> Parser (TableConfig b)
parseJSON = String
-> (Object -> Parser (TableConfig b))
-> Value
-> Parser (TableConfig b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TableConfig" ((Object -> Parser (TableConfig b))
 -> Value -> Parser (TableConfig b))
-> (Object -> Parser (TableConfig b))
-> Value
-> Parser (TableConfig b)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
    TableCustomRootFields
-> HashMap (Column b) ColumnConfig
-> Maybe Name
-> Comment
-> TableConfig b
forall (b :: BackendType).
TableCustomRootFields
-> HashMap (Column b) ColumnConfig
-> Maybe Name
-> Comment
-> TableConfig b
TableConfig
      (TableCustomRootFields
 -> HashMap (Column b) ColumnConfig
 -> Maybe Name
 -> Comment
 -> TableConfig b)
-> Parser TableCustomRootFields
-> Parser
     (HashMap (Column b) ColumnConfig
      -> Maybe Name -> Comment -> TableConfig b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj
      Object -> Key -> Parser (Maybe TableCustomRootFields)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_root_fields"
      Parser (Maybe TableCustomRootFields)
-> TableCustomRootFields -> Parser TableCustomRootFields
forall a. Parser (Maybe a) -> a -> Parser a
.!= TableCustomRootFields
emptyCustomRootFields
      Parser
  (HashMap (Column b) ColumnConfig
   -> Maybe Name -> Comment -> TableConfig b)
-> Parser (HashMap (Column b) ColumnConfig)
-> Parser (Maybe Name -> Comment -> TableConfig b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser (HashMap (Column b) ColumnConfig)
parseColumnConfig Object
obj
      Parser (Maybe Name -> Comment -> TableConfig b)
-> Parser (Maybe Name) -> Parser (Comment -> TableConfig b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj
      Object -> Key -> Parser (Maybe Name)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_name"
      Parser (Comment -> TableConfig b)
-> Parser Comment -> Parser (TableConfig b)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj
      Object -> Key -> Parser (Maybe Comment)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment"
      Parser (Maybe Comment) -> Comment -> Parser Comment
forall a. Parser (Maybe a) -> a -> Parser a
.!= Comment
Automatic
    where
      -- custom_column_names is a deprecated property that has been replaced by column_config.
      -- We merge custom_column_names into column_config transparently to maintain backwards
      -- compatibility (with both the metadata API and the metadata JSON saved in the HGE DB)
      -- custom_column_names can be removed once the deprecation period has expired and we get rid of it
      parseColumnConfig :: Object -> Parser (HashMap (Column b) ColumnConfig)
      parseColumnConfig :: Object -> Parser (HashMap (Column b) ColumnConfig)
parseColumnConfig Object
obj = do
        HashMap (Column b) ColumnConfig
columnConfig <- Object
obj Object -> Key -> Parser (Maybe (HashMap (Column b) ColumnConfig))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"column_config" Parser (Maybe (HashMap (Column b) ColumnConfig))
-> HashMap (Column b) ColumnConfig
-> Parser (HashMap (Column b) ColumnConfig)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap (Column b) ColumnConfig
forall k v. HashMap k v
HashMap.empty
        HashMap (Column b) Name
legacyCustomColumnNames <- Object
obj Object -> Key -> Parser (Maybe (HashMap (Column b) Name))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_column_names" Parser (Maybe (HashMap (Column b) Name))
-> HashMap (Column b) Name -> Parser (HashMap (Column b) Name)
forall a. Parser (Maybe a) -> a -> Parser a
.!= HashMap (Column b) Name
forall k v. HashMap k v
HashMap.empty
        let legacyColumnConfig :: HashMap (Column b) ColumnConfig
legacyColumnConfig = (\Name
name -> Maybe Name -> Comment -> ColumnConfig
ColumnConfig (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
name) Comment
Automatic) (Name -> ColumnConfig)
-> HashMap (Column b) Name -> HashMap (Column b) ColumnConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap (Column b) Name
legacyCustomColumnNames
        HashMap (Column b) ColumnConfig
-> Parser (HashMap (Column b) ColumnConfig)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap (Column b) ColumnConfig
 -> Parser (HashMap (Column b) ColumnConfig))
-> HashMap (Column b) ColumnConfig
-> Parser (HashMap (Column b) ColumnConfig)
forall a b. (a -> b) -> a -> b
$ (ColumnConfig -> ColumnConfig -> ColumnConfig)
-> HashMap (Column b) ColumnConfig
-> HashMap (Column b) ColumnConfig
-> HashMap (Column b) ColumnConfig
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HashMap.unionWith ColumnConfig -> ColumnConfig -> ColumnConfig
forall a. Semigroup a => a -> a -> a
(<>) HashMap (Column b) ColumnConfig
columnConfig HashMap (Column b) ColumnConfig
legacyColumnConfig -- columnConfig takes precedence over legacy

instance (Backend b) => ToJSON (TableConfig b) where
  toJSON :: TableConfig b -> Value
toJSON TableConfig {Maybe Name
HashMap (Column b) ColumnConfig
Comment
TableCustomRootFields
_tcCustomRootFields :: forall (b :: BackendType). TableConfig b -> TableCustomRootFields
_tcColumnConfig :: forall (b :: BackendType).
TableConfig b -> HashMap (Column b) ColumnConfig
_tcCustomName :: forall (b :: BackendType). TableConfig b -> Maybe Name
_tcComment :: forall (b :: BackendType). TableConfig b -> Comment
_tcCustomRootFields :: TableCustomRootFields
_tcColumnConfig :: HashMap (Column b) ColumnConfig
_tcCustomName :: Maybe Name
_tcComment :: Comment
..} =
    [Pair] -> Value
object
      ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter
        ((Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null) (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> Value
forall a b. (a, b) -> b
snd)
        [ Key
"custom_root_fields" Key -> TableCustomRootFields -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TableCustomRootFields
_tcCustomRootFields,
          -- custom_column_names is a deprecated property that has been replaced by column_config.
          -- We are retaining it here, sourcing its values from column_config, for backwards-compatibility
          -- custom_column_names can be removed once the deprecation period has expired and we get rid of it
          Key
"custom_column_names" Key -> HashMap (Column b) Name -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (ColumnConfig -> Maybe Name)
-> HashMap (Column b) ColumnConfig -> HashMap (Column b) Name
forall a b.
(a -> Maybe b) -> HashMap (Column b) a -> HashMap (Column b) b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe ColumnConfig -> Maybe Name
_ccfgCustomName HashMap (Column b) ColumnConfig
_tcColumnConfig,
          Key
"column_config" Key -> HashMap (Column b) ColumnConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (ColumnConfig -> Bool)
-> HashMap (Column b) ColumnConfig
-> HashMap (Column b) ColumnConfig
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter (ColumnConfig -> ColumnConfig -> Bool
forall a. Eq a => a -> a -> Bool
/= ColumnConfig
forall a. Monoid a => a
mempty) HashMap (Column b) ColumnConfig
_tcColumnConfig,
          Key
"custom_name" Key -> Maybe Name -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Name
_tcCustomName,
          Key
"comment" Key -> Comment -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Comment
_tcComment
        ]

data Constraint (b :: BackendType) = Constraint
  { forall (b :: BackendType). Constraint b -> ConstraintName b
_cName :: ConstraintName b,
    forall (b :: BackendType). Constraint b -> OID
_cOid :: OID
  }
  deriving ((forall x. Constraint b -> Rep (Constraint b) x)
-> (forall x. Rep (Constraint b) x -> Constraint b)
-> Generic (Constraint b)
forall x. Rep (Constraint b) x -> Constraint b
forall x. Constraint b -> Rep (Constraint b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (Constraint b) x -> Constraint b
forall (b :: BackendType) x. Constraint b -> Rep (Constraint b) x
$cfrom :: forall (b :: BackendType) x. Constraint b -> Rep (Constraint b) x
from :: forall x. Constraint b -> Rep (Constraint b) x
$cto :: forall (b :: BackendType) x. Rep (Constraint b) x -> Constraint b
to :: forall x. Rep (Constraint b) x -> Constraint b
Generic)

deriving instance (Backend b) => Eq (Constraint b)

deriving instance (Backend b) => Show (Constraint b)

instance (Backend b) => NFData (Constraint b)

instance (Backend b) => Hashable (Constraint b)

instance (Backend b) => ToJSON (Constraint b) where
  toJSON :: Constraint b -> Value
toJSON = Options -> Constraint b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

instance (Backend b) => FromJSON (Constraint b) where
  parseJSON :: Value -> Parser (Constraint b)
parseJSON = Options -> Value -> Parser (Constraint b)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

data PrimaryKey (b :: BackendType) a = PrimaryKey
  { forall (b :: BackendType) a. PrimaryKey b a -> Constraint b
_pkConstraint :: Constraint b,
    forall (b :: BackendType) a. PrimaryKey b a -> NESeq a
_pkColumns :: NESeq a
  }
  deriving ((forall x. PrimaryKey b a -> Rep (PrimaryKey b a) x)
-> (forall x. Rep (PrimaryKey b a) x -> PrimaryKey b a)
-> Generic (PrimaryKey b a)
forall x. Rep (PrimaryKey b a) x -> PrimaryKey b a
forall x. PrimaryKey b a -> Rep (PrimaryKey b a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) a x.
Rep (PrimaryKey b a) x -> PrimaryKey b a
forall (b :: BackendType) a x.
PrimaryKey b a -> Rep (PrimaryKey b a) x
$cfrom :: forall (b :: BackendType) a x.
PrimaryKey b a -> Rep (PrimaryKey b a) x
from :: forall x. PrimaryKey b a -> Rep (PrimaryKey b a) x
$cto :: forall (b :: BackendType) a x.
Rep (PrimaryKey b a) x -> PrimaryKey b a
to :: forall x. Rep (PrimaryKey b a) x -> PrimaryKey b a
Generic, (forall m. Monoid m => PrimaryKey b m -> m)
-> (forall m a. Monoid m => (a -> m) -> PrimaryKey b a -> m)
-> (forall m a. Monoid m => (a -> m) -> PrimaryKey b a -> m)
-> (forall a b. (a -> b -> b) -> b -> PrimaryKey b a -> b)
-> (forall a b. (a -> b -> b) -> b -> PrimaryKey b a -> b)
-> (forall b a. (b -> a -> b) -> b -> PrimaryKey b a -> b)
-> (forall b a. (b -> a -> b) -> b -> PrimaryKey b a -> b)
-> (forall a. (a -> a -> a) -> PrimaryKey b a -> a)
-> (forall a. (a -> a -> a) -> PrimaryKey b a -> a)
-> (forall a. PrimaryKey b a -> [a])
-> (forall a. PrimaryKey b a -> Bool)
-> (forall a. PrimaryKey b a -> Int)
-> (forall a. Eq a => a -> PrimaryKey b a -> Bool)
-> (forall a. Ord a => PrimaryKey b a -> a)
-> (forall a. Ord a => PrimaryKey b a -> a)
-> (forall a. Num a => PrimaryKey b a -> a)
-> (forall a. Num a => PrimaryKey b a -> a)
-> Foldable (PrimaryKey b)
forall a. Eq a => a -> PrimaryKey b a -> Bool
forall a. Num a => PrimaryKey b a -> a
forall a. Ord a => PrimaryKey b a -> a
forall m. Monoid m => PrimaryKey b m -> m
forall a. PrimaryKey b a -> Bool
forall a. PrimaryKey b a -> Int
forall a. PrimaryKey b a -> [a]
forall a. (a -> a -> a) -> PrimaryKey b a -> a
forall m a. Monoid m => (a -> m) -> PrimaryKey b a -> m
forall b a. (b -> a -> b) -> b -> PrimaryKey b a -> b
forall a b. (a -> b -> b) -> b -> PrimaryKey b a -> b
forall (b :: BackendType) a. Eq a => a -> PrimaryKey b a -> Bool
forall (b :: BackendType) a. Num a => PrimaryKey b a -> a
forall (b :: BackendType) a. Ord a => PrimaryKey b a -> a
forall (b :: BackendType) m. Monoid m => PrimaryKey b m -> m
forall (b :: BackendType) a. PrimaryKey b a -> Bool
forall (b :: BackendType) a. PrimaryKey b a -> Int
forall (b :: BackendType) a. PrimaryKey b a -> [a]
forall (b :: BackendType) a. (a -> a -> a) -> PrimaryKey b a -> a
forall (b :: BackendType) m a.
Monoid m =>
(a -> m) -> PrimaryKey b a -> m
forall (b :: BackendType) b a.
(b -> a -> b) -> b -> PrimaryKey b a -> b
forall (b :: BackendType) a b.
(a -> b -> b) -> b -> PrimaryKey b a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall (b :: BackendType) m. Monoid m => PrimaryKey b m -> m
fold :: forall m. Monoid m => PrimaryKey b m -> m
$cfoldMap :: forall (b :: BackendType) m a.
Monoid m =>
(a -> m) -> PrimaryKey b a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> PrimaryKey b a -> m
$cfoldMap' :: forall (b :: BackendType) m a.
Monoid m =>
(a -> m) -> PrimaryKey b a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> PrimaryKey b a -> m
$cfoldr :: forall (b :: BackendType) a b.
(a -> b -> b) -> b -> PrimaryKey b a -> b
foldr :: forall a b. (a -> b -> b) -> b -> PrimaryKey b a -> b
$cfoldr' :: forall (b :: BackendType) a b.
(a -> b -> b) -> b -> PrimaryKey b a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> PrimaryKey b a -> b
$cfoldl :: forall (b :: BackendType) b a.
(b -> a -> b) -> b -> PrimaryKey b a -> b
foldl :: forall b a. (b -> a -> b) -> b -> PrimaryKey b a -> b
$cfoldl' :: forall (b :: BackendType) b a.
(b -> a -> b) -> b -> PrimaryKey b a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> PrimaryKey b a -> b
$cfoldr1 :: forall (b :: BackendType) a. (a -> a -> a) -> PrimaryKey b a -> a
foldr1 :: forall a. (a -> a -> a) -> PrimaryKey b a -> a
$cfoldl1 :: forall (b :: BackendType) a. (a -> a -> a) -> PrimaryKey b a -> a
foldl1 :: forall a. (a -> a -> a) -> PrimaryKey b a -> a
$ctoList :: forall (b :: BackendType) a. PrimaryKey b a -> [a]
toList :: forall a. PrimaryKey b a -> [a]
$cnull :: forall (b :: BackendType) a. PrimaryKey b a -> Bool
null :: forall a. PrimaryKey b a -> Bool
$clength :: forall (b :: BackendType) a. PrimaryKey b a -> Int
length :: forall a. PrimaryKey b a -> Int
$celem :: forall (b :: BackendType) a. Eq a => a -> PrimaryKey b a -> Bool
elem :: forall a. Eq a => a -> PrimaryKey b a -> Bool
$cmaximum :: forall (b :: BackendType) a. Ord a => PrimaryKey b a -> a
maximum :: forall a. Ord a => PrimaryKey b a -> a
$cminimum :: forall (b :: BackendType) a. Ord a => PrimaryKey b a -> a
minimum :: forall a. Ord a => PrimaryKey b a -> a
$csum :: forall (b :: BackendType) a. Num a => PrimaryKey b a -> a
sum :: forall a. Num a => PrimaryKey b a -> a
$cproduct :: forall (b :: BackendType) a. Num a => PrimaryKey b a -> a
product :: forall a. Num a => PrimaryKey b a -> a
Foldable)

deriving instance (Backend b, Eq a) => Eq (PrimaryKey b a)

deriving instance (Backend b, Show a) => Show (PrimaryKey b a)

instance (Backend b, NFData a) => NFData (PrimaryKey b a)

instance (Eq a, Backend b, Hashable (NESeq a)) => Hashable (PrimaryKey b a)

instance (Backend b, ToJSON a) => ToJSON (PrimaryKey b a) where
  toJSON :: PrimaryKey b a -> Value
toJSON = Options -> PrimaryKey b a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

instance (Backend b, FromJSON a) => FromJSON (PrimaryKey b a) where
  parseJSON :: Value -> Parser (PrimaryKey b a)
parseJSON = Options -> Value -> Parser (PrimaryKey b a)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

$(makeLenses ''PrimaryKey)

-- | Data type modelling uniqueness constraints. Occasionally this will include
-- primary keys, although those are tracked separately in `TableCoreInfoG`.
--
-- For more information about unique constraints, visit the postgresql documentation:
-- <https://www.postgresql.org/docs/current/ddl-constraints.html#DDL-CONSTRAINTS-UNIQUE-CONSTRAINTS>.
data UniqueConstraint (b :: BackendType) = UniqueConstraint
  { -- | The postgresql name and object id of a unique constraint.
    forall (b :: BackendType). UniqueConstraint b -> Constraint b
_ucConstraint :: Constraint b,
    -- | The set of columns which should be unique for this particular constraint.
    --   Used for permissions calculation.
    forall (b :: BackendType). UniqueConstraint b -> HashSet (Column b)
_ucColumns :: HashSet (Column b)
  }
  deriving ((forall x. UniqueConstraint b -> Rep (UniqueConstraint b) x)
-> (forall x. Rep (UniqueConstraint b) x -> UniqueConstraint b)
-> Generic (UniqueConstraint b)
forall x. Rep (UniqueConstraint b) x -> UniqueConstraint b
forall x. UniqueConstraint b -> Rep (UniqueConstraint b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (UniqueConstraint b) x -> UniqueConstraint b
forall (b :: BackendType) x.
UniqueConstraint b -> Rep (UniqueConstraint b) x
$cfrom :: forall (b :: BackendType) x.
UniqueConstraint b -> Rep (UniqueConstraint b) x
from :: forall x. UniqueConstraint b -> Rep (UniqueConstraint b) x
$cto :: forall (b :: BackendType) x.
Rep (UniqueConstraint b) x -> UniqueConstraint b
to :: forall x. Rep (UniqueConstraint b) x -> UniqueConstraint b
Generic)

deriving instance (Backend b) => Eq (UniqueConstraint b)

deriving instance (Backend b) => Show (UniqueConstraint b)

instance (Backend b) => NFData (UniqueConstraint b)

instance (Backend b) => Hashable (UniqueConstraint b)

instance (Backend b) => ToJSON (UniqueConstraint b) where
  toJSON :: UniqueConstraint b -> Value
toJSON = Options -> UniqueConstraint b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

instance (Backend b) => FromJSON (UniqueConstraint b) where
  parseJSON :: Value -> Parser (UniqueConstraint b)
parseJSON = Options -> Value -> Parser (UniqueConstraint b)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

data ForeignKey (b :: BackendType) = ForeignKey
  { forall (b :: BackendType). ForeignKey b -> Constraint b
_fkConstraint :: Constraint b,
    forall (b :: BackendType). ForeignKey b -> TableName b
_fkForeignTable :: TableName b,
    forall (b :: BackendType).
ForeignKey b -> NEHashMap (Column b) (Column b)
_fkColumnMapping :: NEHashMap (Column b) (Column b)
  }
  deriving ((forall x. ForeignKey b -> Rep (ForeignKey b) x)
-> (forall x. Rep (ForeignKey b) x -> ForeignKey b)
-> Generic (ForeignKey b)
forall x. Rep (ForeignKey b) x -> ForeignKey b
forall x. ForeignKey b -> Rep (ForeignKey b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (ForeignKey b) x -> ForeignKey b
forall (b :: BackendType) x. ForeignKey b -> Rep (ForeignKey b) x
$cfrom :: forall (b :: BackendType) x. ForeignKey b -> Rep (ForeignKey b) x
from :: forall x. ForeignKey b -> Rep (ForeignKey b) x
$cto :: forall (b :: BackendType) x. Rep (ForeignKey b) x -> ForeignKey b
to :: forall x. Rep (ForeignKey b) x -> ForeignKey b
Generic)

deriving instance (Backend b) => Eq (ForeignKey b)

deriving instance (Backend b) => Show (ForeignKey b)

instance (Backend b) => NFData (ForeignKey b)

instance (Backend b) => Hashable (ForeignKey b)

instance (Backend b) => ToJSON (ForeignKey b) where
  toJSON :: ForeignKey b -> Value
toJSON = Options -> ForeignKey b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

instance (Backend b) => FromJSON (ForeignKey b) where
  parseJSON :: Value -> Parser (ForeignKey b)
parseJSON = Options -> Value -> Parser (ForeignKey b)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

-- | The @field@ and @primaryKeyColumn@ type parameters vary as the schema cache is built and more
-- information is accumulated. See also 'TableCoreInfo'.
data TableCoreInfoG (b :: BackendType) field primaryKeyColumn = TableCoreInfo
  { forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciName :: TableName b,
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe PGDescription
_tciDescription :: Maybe Postgres.PGDescription, -- TODO make into type family?
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap :: FieldInfoMap field,
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe (PrimaryKey b primaryKeyColumn)
_tciPrimaryKey :: Maybe (PrimaryKey b primaryKeyColumn),
    -- | Does /not/ include the primary key; use 'tciUniqueOrPrimaryKeyConstraints' if you need both.
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> HashSet (UniqueConstraint b)
_tciUniqueConstraints :: HashSet (UniqueConstraint b),
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> HashSet (ForeignKey b)
_tciForeignKeys :: HashSet (ForeignKey b),
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe ViewInfo
_tciViewInfo :: Maybe ViewInfo,
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> Maybe EnumValues
_tciEnumValues :: Maybe EnumValues,
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableConfig b
_tciCustomConfig :: TableConfig b,
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> ExtraTableMetadata b
_tciExtraTableMetadata :: ExtraTableMetadata b,
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe ApolloFederationConfig
_tciApolloFederationConfig :: Maybe ApolloFederationConfig,
    forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> [RawColumnInfo b]
_tciRawColumns :: [RawColumnInfo b]
  }
  deriving ((forall x.
 TableCoreInfoG b field primaryKeyColumn
 -> Rep (TableCoreInfoG b field primaryKeyColumn) x)
-> (forall x.
    Rep (TableCoreInfoG b field primaryKeyColumn) x
    -> TableCoreInfoG b field primaryKeyColumn)
-> Generic (TableCoreInfoG b field primaryKeyColumn)
forall x.
Rep (TableCoreInfoG b field primaryKeyColumn) x
-> TableCoreInfoG b field primaryKeyColumn
forall x.
TableCoreInfoG b field primaryKeyColumn
-> Rep (TableCoreInfoG b field primaryKeyColumn) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) field primaryKeyColumn x.
Rep (TableCoreInfoG b field primaryKeyColumn) x
-> TableCoreInfoG b field primaryKeyColumn
forall (b :: BackendType) field primaryKeyColumn x.
TableCoreInfoG b field primaryKeyColumn
-> Rep (TableCoreInfoG b field primaryKeyColumn) x
$cfrom :: forall (b :: BackendType) field primaryKeyColumn x.
TableCoreInfoG b field primaryKeyColumn
-> Rep (TableCoreInfoG b field primaryKeyColumn) x
from :: forall x.
TableCoreInfoG b field primaryKeyColumn
-> Rep (TableCoreInfoG b field primaryKeyColumn) x
$cto :: forall (b :: BackendType) field primaryKeyColumn x.
Rep (TableCoreInfoG b field primaryKeyColumn) x
-> TableCoreInfoG b field primaryKeyColumn
to :: forall x.
Rep (TableCoreInfoG b field primaryKeyColumn) x
-> TableCoreInfoG b field primaryKeyColumn
Generic)

deriving instance (Eq field, Eq pkCol, Backend b) => Eq (TableCoreInfoG b field pkCol)

instance (Backend b, Generic pkCol, ToJSON field, ToJSON pkCol) => ToJSON (TableCoreInfoG b field pkCol) where
  toJSON :: TableCoreInfoG b field pkCol -> Value
toJSON = Options -> TableCoreInfoG b field pkCol -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

$(makeLenses ''TableCoreInfoG)

-- | Fully-processed table info that includes non-column fields.
type TableCoreInfo b = TableCoreInfoG b (FieldInfo b) (ColumnInfo b)

tciUniqueOrPrimaryKeyConstraints ::
  forall b f.
  (Hashable (Column b)) =>
  TableCoreInfoG b f (ColumnInfo b) ->
  Maybe (NonEmpty (UniqueConstraint b))
tciUniqueOrPrimaryKeyConstraints :: forall (b :: BackendType) f.
Hashable (Column b) =>
TableCoreInfoG b f (ColumnInfo b)
-> Maybe (NonEmpty (UniqueConstraint b))
tciUniqueOrPrimaryKeyConstraints TableCoreInfoG b f (ColumnInfo b)
info =
  [UniqueConstraint b] -> Maybe (NonEmpty (UniqueConstraint b))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty
    ([UniqueConstraint b] -> Maybe (NonEmpty (UniqueConstraint b)))
-> [UniqueConstraint b] -> Maybe (NonEmpty (UniqueConstraint b))
forall a b. (a -> b) -> a -> b
$ Maybe (UniqueConstraint b) -> [UniqueConstraint b]
forall a. Maybe a -> [a]
maybeToList (PrimaryKey b (ColumnInfo b) -> UniqueConstraint b
primaryToUnique (PrimaryKey b (ColumnInfo b) -> UniqueConstraint b)
-> Maybe (PrimaryKey b (ColumnInfo b))
-> Maybe (UniqueConstraint b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableCoreInfoG b f (ColumnInfo b)
-> Maybe (PrimaryKey b (ColumnInfo b))
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> Maybe (PrimaryKey b primaryKeyColumn)
_tciPrimaryKey TableCoreInfoG b f (ColumnInfo b)
info)
    [UniqueConstraint b]
-> [UniqueConstraint b] -> [UniqueConstraint b]
forall a. Semigroup a => a -> a -> a
<> (HashSet (UniqueConstraint b) -> [UniqueConstraint b]
forall a. HashSet a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TableCoreInfoG b f (ColumnInfo b) -> HashSet (UniqueConstraint b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn
-> HashSet (UniqueConstraint b)
_tciUniqueConstraints TableCoreInfoG b f (ColumnInfo b)
info))
  where
    primaryToUnique :: PrimaryKey b (ColumnInfo b) -> UniqueConstraint b
    primaryToUnique :: PrimaryKey b (ColumnInfo b) -> UniqueConstraint b
primaryToUnique PrimaryKey b (ColumnInfo b)
pk = Constraint b -> HashSet (Column b) -> UniqueConstraint b
forall (b :: BackendType).
Constraint b -> HashSet (Column b) -> UniqueConstraint b
UniqueConstraint (PrimaryKey b (ColumnInfo b) -> Constraint b
forall (b :: BackendType) a. PrimaryKey b a -> Constraint b
_pkConstraint PrimaryKey b (ColumnInfo b)
pk) ([Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([Column b] -> HashSet (Column b))
-> (NESeq (ColumnInfo b) -> [Column b])
-> NESeq (ColumnInfo b)
-> HashSet (Column b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnInfo b -> Column b) -> [ColumnInfo b] -> [Column b]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ColumnInfo b -> Column b
forall (b :: BackendType). ColumnInfo b -> Column b
ciColumn ([ColumnInfo b] -> [Column b])
-> (NESeq (ColumnInfo b) -> [ColumnInfo b])
-> NESeq (ColumnInfo b)
-> [Column b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NESeq (ColumnInfo b) -> [ColumnInfo b]
forall a. NESeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NESeq (ColumnInfo b) -> HashSet (Column b))
-> NESeq (ColumnInfo b) -> HashSet (Column b)
forall a b. (a -> b) -> a -> b
$ PrimaryKey b (ColumnInfo b) -> NESeq (ColumnInfo b)
forall (b :: BackendType) a. PrimaryKey b a -> NESeq a
_pkColumns PrimaryKey b (ColumnInfo b)
pk)

data TableInfo (b :: BackendType) = TableInfo
  { forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo :: TableCoreInfo b,
    forall (b :: BackendType). TableInfo b -> RolePermInfoMap b
_tiRolePermInfoMap :: RolePermInfoMap b,
    forall (b :: BackendType). TableInfo b -> EventTriggerInfoMap b
_tiEventTriggerInfoMap :: EventTriggerInfoMap b,
    forall (b :: BackendType). TableInfo b -> RolePermInfo b
_tiAdminRolePermInfo :: RolePermInfo b
  }
  deriving ((forall x. TableInfo b -> Rep (TableInfo b) x)
-> (forall x. Rep (TableInfo b) x -> TableInfo b)
-> Generic (TableInfo b)
forall x. Rep (TableInfo b) x -> TableInfo b
forall x. TableInfo b -> Rep (TableInfo b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x. Rep (TableInfo b) x -> TableInfo b
forall (b :: BackendType) x. TableInfo b -> Rep (TableInfo b) x
$cfrom :: forall (b :: BackendType) x. TableInfo b -> Rep (TableInfo b) x
from :: forall x. TableInfo b -> Rep (TableInfo b) x
$cto :: forall (b :: BackendType) x. Rep (TableInfo b) x -> TableInfo b
to :: forall x. Rep (TableInfo b) x -> TableInfo b
Generic)

instance
  ( Backend b,
    ToJSON (EventTriggerInfoMap b),
    ToJSON (RolePermInfo b),
    ToJSON (RolePermInfoMap b),
    ToJSON (TableCoreInfo b)
  ) =>
  ToJSON (TableInfo b)
  where
  toJSON :: TableInfo b -> Value
toJSON = Options -> TableInfo b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

$(makeLenses ''TableInfo)

tiName :: Lens' (TableInfo b) (TableName b)
tiName :: forall (b :: BackendType) (f :: * -> *).
Functor f =>
(TableName b -> f (TableName b)) -> TableInfo b -> f (TableInfo b)
tiName = (TableCoreInfo b -> f (TableCoreInfo b))
-> TableInfo b -> f (TableInfo b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(TableCoreInfo b -> f (TableCoreInfo b))
-> TableInfo b -> f (TableInfo b)
tiCoreInfo ((TableCoreInfo b -> f (TableCoreInfo b))
 -> TableInfo b -> f (TableInfo b))
-> ((TableName b -> f (TableName b))
    -> TableCoreInfo b -> f (TableCoreInfo b))
-> (TableName b -> f (TableName b))
-> TableInfo b
-> f (TableInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableName b -> f (TableName b))
-> TableCoreInfo b -> f (TableCoreInfo b)
forall (b :: BackendType) field primaryKeyColumn (f :: * -> *).
Functor f =>
(TableName b -> f (TableName b))
-> TableCoreInfoG b field primaryKeyColumn
-> f (TableCoreInfoG b field primaryKeyColumn)
tciName

tableInfoName :: TableInfo b -> TableName b
tableInfoName :: forall (b :: BackendType). TableInfo b -> TableName b
tableInfoName = Getting (TableName b) (TableInfo b) (TableName b)
-> TableInfo b -> TableName b
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TableName b) (TableInfo b) (TableName b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(TableName b -> f (TableName b)) -> TableInfo b -> f (TableInfo b)
tiName

tableArrayRelationships :: TableInfo b -> [RelInfo b]
tableArrayRelationships :: forall (b :: BackendType). TableInfo b -> [RelInfo b]
tableArrayRelationships TableInfo b
ti = [RelInfo b
rel | RelInfo b
rel <- FieldInfoMap (FieldInfo b) -> [RelInfo b]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [RelInfo backend]
getRels (FieldInfoMap (FieldInfo b) -> [RelInfo b])
-> (TableInfo b -> FieldInfoMap (FieldInfo b))
-> TableInfo b
-> [RelInfo b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
-> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap (TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
 -> FieldInfoMap (FieldInfo b))
-> (TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b))
-> TableInfo b
-> FieldInfoMap (FieldInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableInfo b -> TableCoreInfoG b (FieldInfo b) (ColumnInfo b)
forall (b :: BackendType). TableInfo b -> TableCoreInfo b
_tiCoreInfo (TableInfo b -> [RelInfo b]) -> TableInfo b -> [RelInfo b]
forall a b. (a -> b) -> a -> b
$ TableInfo b
ti, RelInfo b -> RelType
forall (b :: BackendType). RelInfo b -> RelType
riType RelInfo b
rel RelType -> RelType -> Bool
forall a. Eq a => a -> a -> Bool
== RelType
ArrRel]

getRolePermInfo :: RoleName -> TableInfo b -> RolePermInfo b
getRolePermInfo :: forall (b :: BackendType).
RoleName -> TableInfo b -> RolePermInfo b
getRolePermInfo RoleName
role TableInfo b
tableInfo
  | RoleName
role RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName = TableInfo b -> RolePermInfo b
forall (b :: BackendType). TableInfo b -> RolePermInfo b
_tiAdminRolePermInfo TableInfo b
tableInfo
  | Bool
otherwise =
      RolePermInfo b -> Maybe (RolePermInfo b) -> RolePermInfo b
forall a. a -> Maybe a -> a
fromMaybe
        (Maybe (InsPermInfo b)
-> Maybe (SelPermInfo b)
-> Maybe (UpdPermInfo b)
-> Maybe (DelPermInfo b)
-> RolePermInfo b
forall (b :: BackendType).
Maybe (InsPermInfo b)
-> Maybe (SelPermInfo b)
-> Maybe (UpdPermInfo b)
-> Maybe (DelPermInfo b)
-> RolePermInfo b
RolePermInfo Maybe (InsPermInfo b)
forall a. Maybe a
Nothing Maybe (SelPermInfo b)
forall a. Maybe a
Nothing Maybe (UpdPermInfo b)
forall a. Maybe a
Nothing Maybe (DelPermInfo b)
forall a. Maybe a
Nothing)
        (RoleName
-> HashMap RoleName (RolePermInfo b) -> Maybe (RolePermInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RoleName
role (HashMap RoleName (RolePermInfo b) -> Maybe (RolePermInfo b))
-> HashMap RoleName (RolePermInfo b) -> Maybe (RolePermInfo b)
forall a b. (a -> b) -> a -> b
$ TableInfo b -> HashMap RoleName (RolePermInfo b)
forall (b :: BackendType). TableInfo b -> RolePermInfoMap b
_tiRolePermInfoMap TableInfo b
tableInfo)

type TableCoreCache b = HashMap.HashMap (TableName b) (TableCoreInfo b)

type TableCache b = HashMap.HashMap (TableName b) (TableInfo b) -- info of all tables

-- map of all event triggers on the table
type TableEventTriggers b = HashMap.HashMap (TableName b) [TriggerName]

-- | Metadata of a Postgres foreign key constraint which is being
-- extracted from database via 'src-rsr/pg_table_metadata.sql'
newtype ForeignKeyMetadata (b :: BackendType) = ForeignKeyMetadata
  { forall (b :: BackendType). ForeignKeyMetadata b -> ForeignKey b
unForeignKeyMetadata :: ForeignKey b
  }
  deriving (Int -> ForeignKeyMetadata b -> ShowS
[ForeignKeyMetadata b] -> ShowS
ForeignKeyMetadata b -> String
(Int -> ForeignKeyMetadata b -> ShowS)
-> (ForeignKeyMetadata b -> String)
-> ([ForeignKeyMetadata b] -> ShowS)
-> Show (ForeignKeyMetadata b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (b :: BackendType).
Backend b =>
Int -> ForeignKeyMetadata b -> ShowS
forall (b :: BackendType).
Backend b =>
[ForeignKeyMetadata b] -> ShowS
forall (b :: BackendType).
Backend b =>
ForeignKeyMetadata b -> String
$cshowsPrec :: forall (b :: BackendType).
Backend b =>
Int -> ForeignKeyMetadata b -> ShowS
showsPrec :: Int -> ForeignKeyMetadata b -> ShowS
$cshow :: forall (b :: BackendType).
Backend b =>
ForeignKeyMetadata b -> String
show :: ForeignKeyMetadata b -> String
$cshowList :: forall (b :: BackendType).
Backend b =>
[ForeignKeyMetadata b] -> ShowS
showList :: [ForeignKeyMetadata b] -> ShowS
Show, ForeignKeyMetadata b -> ForeignKeyMetadata b -> Bool
(ForeignKeyMetadata b -> ForeignKeyMetadata b -> Bool)
-> (ForeignKeyMetadata b -> ForeignKeyMetadata b -> Bool)
-> Eq (ForeignKeyMetadata b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (b :: BackendType).
Backend b =>
ForeignKeyMetadata b -> ForeignKeyMetadata b -> Bool
$c== :: forall (b :: BackendType).
Backend b =>
ForeignKeyMetadata b -> ForeignKeyMetadata b -> Bool
== :: ForeignKeyMetadata b -> ForeignKeyMetadata b -> Bool
$c/= :: forall (b :: BackendType).
Backend b =>
ForeignKeyMetadata b -> ForeignKeyMetadata b -> Bool
/= :: ForeignKeyMetadata b -> ForeignKeyMetadata b -> Bool
Eq, ForeignKeyMetadata b -> ()
(ForeignKeyMetadata b -> ()) -> NFData (ForeignKeyMetadata b)
forall a. (a -> ()) -> NFData a
forall (b :: BackendType). Backend b => ForeignKeyMetadata b -> ()
$crnf :: forall (b :: BackendType). Backend b => ForeignKeyMetadata b -> ()
rnf :: ForeignKeyMetadata b -> ()
NFData, Eq (ForeignKeyMetadata b)
Eq (ForeignKeyMetadata b)
-> (Int -> ForeignKeyMetadata b -> Int)
-> (ForeignKeyMetadata b -> Int)
-> Hashable (ForeignKeyMetadata b)
Int -> ForeignKeyMetadata b -> Int
ForeignKeyMetadata b -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (b :: BackendType). Backend b => Eq (ForeignKeyMetadata b)
forall (b :: BackendType).
Backend b =>
Int -> ForeignKeyMetadata b -> Int
forall (b :: BackendType). Backend b => ForeignKeyMetadata b -> Int
$chashWithSalt :: forall (b :: BackendType).
Backend b =>
Int -> ForeignKeyMetadata b -> Int
hashWithSalt :: Int -> ForeignKeyMetadata b -> Int
$chash :: forall (b :: BackendType). Backend b => ForeignKeyMetadata b -> Int
hash :: ForeignKeyMetadata b -> Int
Hashable)

instance (Backend b) => FromJSON (ForeignKeyMetadata b) where
  parseJSON :: Value -> Parser (ForeignKeyMetadata b)
parseJSON = String
-> (Object -> Parser (ForeignKeyMetadata b))
-> Value
-> Parser (ForeignKeyMetadata b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ForeignKeyMetadata" \Object
o -> do
    Constraint b
constraint <- Object
o Object -> Key -> Parser (Constraint b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"constraint"
    TableName b
foreignTable <- Object
o Object -> Key -> Parser (TableName b)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"foreign_table"

    NonEmpty (Column b)
columns <-
      Object
o Object -> Key -> Parser [Column b]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columns" Parser [Column b]
-> ([Column b] -> Parser (NonEmpty (Column b)))
-> Parser (NonEmpty (Column b))
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Column b
x : [Column b]
xs -> NonEmpty (Column b) -> Parser (NonEmpty (Column b))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column b
x Column b -> [Column b] -> NonEmpty (Column b)
forall a. a -> [a] -> NonEmpty a
:| [Column b]
xs)
        [] -> String -> Parser (NonEmpty (Column b))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"columns must be non-empty"

    NonEmpty (Column b)
foreignColumns <-
      Object
o Object -> Key -> Parser [Column b]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"foreign_columns" Parser [Column b]
-> ([Column b] -> Parser (NonEmpty (Column b)))
-> Parser (NonEmpty (Column b))
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Column b
x : [Column b]
xs -> NonEmpty (Column b) -> Parser (NonEmpty (Column b))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Column b
x Column b -> [Column b] -> NonEmpty (Column b)
forall a. a -> [a] -> NonEmpty a
:| [Column b]
xs)
        [] -> String -> Parser (NonEmpty (Column b))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"foreign_columns must be non-empty"

    Bool -> Parser () -> Parser ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (NonEmpty (Column b) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Column b)
columns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty (Column b) -> Int
forall a. NonEmpty a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NonEmpty (Column b)
foreignColumns) do
      String -> Parser ()
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"columns and foreign_columns differ in length"

    ForeignKeyMetadata b -> Parser (ForeignKeyMetadata b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (ForeignKeyMetadata b -> Parser (ForeignKeyMetadata b))
-> ForeignKeyMetadata b -> Parser (ForeignKeyMetadata b)
forall a b. (a -> b) -> a -> b
$ ForeignKey b -> ForeignKeyMetadata b
forall (b :: BackendType). ForeignKey b -> ForeignKeyMetadata b
ForeignKeyMetadata
        ForeignKey
          { _fkConstraint :: Constraint b
_fkConstraint = Constraint b
constraint,
            _fkForeignTable :: TableName b
_fkForeignTable = TableName b
foreignTable,
            _fkColumnMapping :: NEHashMap (Column b) (Column b)
_fkColumnMapping =
              NonEmpty (Column b, Column b) -> NEHashMap (Column b) (Column b)
forall k v. Hashable k => NonEmpty (k, v) -> NEHashMap k v
NEHashMap.fromNonEmpty
                (NonEmpty (Column b, Column b) -> NEHashMap (Column b) (Column b))
-> NonEmpty (Column b, Column b) -> NEHashMap (Column b) (Column b)
forall a b. (a -> b) -> a -> b
$ NonEmpty (Column b)
-> NonEmpty (Column b) -> NonEmpty (Column b, Column b)
forall a b. NonEmpty a -> NonEmpty b -> NonEmpty (a, b)
NE.zip NonEmpty (Column b)
columns NonEmpty (Column b)
foreignColumns
          }

instance (Backend b) => ToJSON (ForeignKeyMetadata b) where
  toJSON :: ForeignKeyMetadata b -> Value
toJSON (ForeignKeyMetadata (ForeignKey Constraint b
constraint TableName b
foreignTable NEHashMap (Column b) (Column b)
columnMapping)) =
    let ([Column b]
columns, [Column b]
foreignColumns) = [(Column b, Column b)] -> ([Column b], [Column b])
forall (f :: * -> *) a b. Functor f => f (a, b) -> (f a, f b)
NE.unzip ([(Column b, Column b)] -> ([Column b], [Column b]))
-> [(Column b, Column b)] -> ([Column b], [Column b])
forall a b. (a -> b) -> a -> b
$ NEHashMap (Column b) (Column b) -> [(Column b, Column b)]
forall k v. NEHashMap k v -> [(k, v)]
NEHashMap.toList NEHashMap (Column b) (Column b)
columnMapping
     in [Pair] -> Value
object
          [ Key
"constraint" Key -> Constraint b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Constraint b
constraint,
            Key
"foreign_table" Key -> TableName b -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TableName b
foreignTable,
            Key
"columns" Key -> [Column b] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Column b]
columns,
            Key
"foreign_columns" Key -> [Column b] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Column b]
foreignColumns
          ]

-- | Metadata of any Backend table which is being extracted from source database
data DBTableMetadata (b :: BackendType) = DBTableMetadata
  { forall (b :: BackendType). DBTableMetadata b -> OID
_ptmiOid :: OID,
    forall (b :: BackendType). DBTableMetadata b -> [RawColumnInfo b]
_ptmiColumns :: [RawColumnInfo b],
    forall (b :: BackendType).
DBTableMetadata b -> Maybe (PrimaryKey b (Column b))
_ptmiPrimaryKey :: Maybe (PrimaryKey b (Column b)),
    -- | Does /not/ include the primary key
    forall (b :: BackendType).
DBTableMetadata b -> HashSet (UniqueConstraint b)
_ptmiUniqueConstraints :: HashSet (UniqueConstraint b),
    forall (b :: BackendType).
DBTableMetadata b -> HashSet (ForeignKeyMetadata b)
_ptmiForeignKeys :: HashSet (ForeignKeyMetadata b),
    forall (b :: BackendType). DBTableMetadata b -> Maybe ViewInfo
_ptmiViewInfo :: Maybe ViewInfo,
    forall (b :: BackendType). DBTableMetadata b -> Maybe PGDescription
_ptmiDescription :: Maybe Postgres.PGDescription,
    forall (b :: BackendType).
DBTableMetadata b -> ExtraTableMetadata b
_ptmiExtraTableMetadata :: ExtraTableMetadata b
  }
  deriving ((forall x. DBTableMetadata b -> Rep (DBTableMetadata b) x)
-> (forall x. Rep (DBTableMetadata b) x -> DBTableMetadata b)
-> Generic (DBTableMetadata b)
forall x. Rep (DBTableMetadata b) x -> DBTableMetadata b
forall x. DBTableMetadata b -> Rep (DBTableMetadata b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (DBTableMetadata b) x -> DBTableMetadata b
forall (b :: BackendType) x.
DBTableMetadata b -> Rep (DBTableMetadata b) x
$cfrom :: forall (b :: BackendType) x.
DBTableMetadata b -> Rep (DBTableMetadata b) x
from :: forall x. DBTableMetadata b -> Rep (DBTableMetadata b) x
$cto :: forall (b :: BackendType) x.
Rep (DBTableMetadata b) x -> DBTableMetadata b
to :: forall x. Rep (DBTableMetadata b) x -> DBTableMetadata b
Generic)

deriving instance (Backend b) => Eq (DBTableMetadata b)

deriving instance (Backend b) => Show (DBTableMetadata b)

instance (Backend b) => NFData (DBTableMetadata b)

instance (Backend b) => FromJSON (DBTableMetadata b) where
  parseJSON :: Value -> Parser (DBTableMetadata b)
parseJSON = Options -> Value -> Parser (DBTableMetadata b)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
hasuraJSON

instance (Backend b) => ToJSON (DBTableMetadata b) where
  toJSON :: DBTableMetadata b -> Value
toJSON = Options -> DBTableMetadata b -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
hasuraJSON

type DBTablesMetadata b = HashMap (TableName b) (DBTableMetadata b)

getFieldInfoM ::
  TableInfo b -> FieldName -> Maybe (FieldInfo b)
getFieldInfoM :: forall (b :: BackendType).
TableInfo b -> FieldName -> Maybe (FieldInfo b)
getFieldInfoM TableInfo b
tableInfo FieldName
fieldName =
  TableInfo b
tableInfo TableInfo b
-> Getting
     (Maybe (FieldInfo b)) (TableInfo b) (Maybe (FieldInfo b))
-> Maybe (FieldInfo b)
forall s a. s -> Getting a s a -> a
^. (TableCoreInfo b -> Const (Maybe (FieldInfo b)) (TableCoreInfo b))
-> TableInfo b -> Const (Maybe (FieldInfo b)) (TableInfo b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(TableCoreInfo b -> f (TableCoreInfo b))
-> TableInfo b -> f (TableInfo b)
tiCoreInfo ((TableCoreInfo b -> Const (Maybe (FieldInfo b)) (TableCoreInfo b))
 -> TableInfo b -> Const (Maybe (FieldInfo b)) (TableInfo b))
-> ((Maybe (FieldInfo b)
     -> Const (Maybe (FieldInfo b)) (Maybe (FieldInfo b)))
    -> TableCoreInfo b
    -> Const (Maybe (FieldInfo b)) (TableCoreInfo b))
-> Getting
     (Maybe (FieldInfo b)) (TableInfo b) (Maybe (FieldInfo b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldInfoMap (FieldInfo b)
 -> Const (Maybe (FieldInfo b)) (FieldInfoMap (FieldInfo b)))
-> TableCoreInfo b -> Const (Maybe (FieldInfo b)) (TableCoreInfo b)
forall (b :: BackendType) field primaryKeyColumn field
       (f :: * -> *).
Functor f =>
(FieldInfoMap field -> f (FieldInfoMap field))
-> TableCoreInfoG b field primaryKeyColumn
-> f (TableCoreInfoG b field primaryKeyColumn)
tciFieldInfoMap ((FieldInfoMap (FieldInfo b)
  -> Const (Maybe (FieldInfo b)) (FieldInfoMap (FieldInfo b)))
 -> TableCoreInfo b
 -> Const (Maybe (FieldInfo b)) (TableCoreInfo b))
-> ((Maybe (FieldInfo b)
     -> Const (Maybe (FieldInfo b)) (Maybe (FieldInfo b)))
    -> FieldInfoMap (FieldInfo b)
    -> Const (Maybe (FieldInfo b)) (FieldInfoMap (FieldInfo b)))
-> (Maybe (FieldInfo b)
    -> Const (Maybe (FieldInfo b)) (Maybe (FieldInfo b)))
-> TableCoreInfo b
-> Const (Maybe (FieldInfo b)) (TableCoreInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (FieldInfoMap (FieldInfo b))
-> Lens'
     (FieldInfoMap (FieldInfo b))
     (Maybe (IxValue (FieldInfoMap (FieldInfo b))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (FieldInfoMap (FieldInfo b))
FieldName
fieldName

getColumnInfoM ::
  TableInfo b -> FieldName -> Maybe (ColumnInfo b)
getColumnInfoM :: forall (b :: BackendType).
TableInfo b -> FieldName -> Maybe (ColumnInfo b)
getColumnInfoM TableInfo b
tableInfo FieldName
fieldName =
  (FieldInfo b
-> Getting (First (ColumnInfo b)) (FieldInfo b) (ColumnInfo b)
-> Maybe (ColumnInfo b)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (StructuredColumnInfo b
 -> Const (First (ColumnInfo b)) (StructuredColumnInfo b))
-> FieldInfo b -> Const (First (ColumnInfo b)) (FieldInfo b)
forall (b :: BackendType) (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (StructuredColumnInfo b) (f (StructuredColumnInfo b))
-> p (FieldInfo b) (f (FieldInfo b))
_FIColumn ((StructuredColumnInfo b
  -> Const (First (ColumnInfo b)) (StructuredColumnInfo b))
 -> FieldInfo b -> Const (First (ColumnInfo b)) (FieldInfo b))
-> ((ColumnInfo b -> Const (First (ColumnInfo b)) (ColumnInfo b))
    -> StructuredColumnInfo b
    -> Const (First (ColumnInfo b)) (StructuredColumnInfo b))
-> Getting (First (ColumnInfo b)) (FieldInfo b) (ColumnInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ColumnInfo b -> Const (First (ColumnInfo b)) (ColumnInfo b))
-> StructuredColumnInfo b
-> Const (First (ColumnInfo b)) (StructuredColumnInfo b)
forall (b :: BackendType) (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (ColumnInfo b) (f (ColumnInfo b))
-> p (StructuredColumnInfo b) (f (StructuredColumnInfo b))
_SCIScalarColumn) (FieldInfo b -> Maybe (ColumnInfo b))
-> Maybe (FieldInfo b) -> Maybe (ColumnInfo b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< TableInfo b -> FieldName -> Maybe (FieldInfo b)
forall (b :: BackendType).
TableInfo b -> FieldName -> Maybe (FieldInfo b)
getFieldInfoM TableInfo b
tableInfo FieldName
fieldName

askFieldInfo ::
  (MonadError QErr m) =>
  FieldInfoMap fieldInfo ->
  FieldName ->
  m fieldInfo
askFieldInfo :: forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap fieldInfo
m FieldName
f =
  Maybe fieldInfo -> m fieldInfo -> m fieldInfo
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing (FieldName -> FieldInfoMap fieldInfo -> Maybe fieldInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup FieldName
f FieldInfoMap fieldInfo
m) (m fieldInfo -> m fieldInfo) -> m fieldInfo -> m fieldInfo
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m fieldInfo
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists (FieldName
f FieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" does not exist")

askColumnType ::
  (MonadError QErr m, Backend backend) =>
  FieldInfoMap (FieldInfo backend) ->
  Column backend ->
  Text ->
  m (ColumnType backend)
askColumnType :: forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnType backend)
askColumnType FieldInfoMap (FieldInfo backend)
m Column backend
c Text
msg =
  ColumnInfo backend -> ColumnType backend
forall (b :: BackendType). ColumnInfo b -> ColumnType b
ciType (ColumnInfo backend -> ColumnType backend)
-> m (ColumnInfo backend) -> m (ColumnType backend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnInfo backend)
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnInfo backend)
askColInfo FieldInfoMap (FieldInfo backend)
m Column backend
c Text
msg

askColInfo ::
  forall m backend.
  (MonadError QErr m, Backend backend) =>
  FieldInfoMap (FieldInfo backend) ->
  Column backend ->
  Text ->
  m (ColumnInfo backend)
askColInfo :: forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnInfo backend)
askColInfo FieldInfoMap (FieldInfo backend)
m Column backend
c Text
msg = do
  FieldInfo backend
fieldInfo <-
    (Text -> Text) -> m (FieldInfo backend) -> m (FieldInfo backend)
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (Text
"column " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
      (m (FieldInfo backend) -> m (FieldInfo backend))
-> m (FieldInfo backend) -> m (FieldInfo backend)
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo backend)
-> FieldName -> m (FieldInfo backend)
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (FieldInfo backend)
m (forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol @backend Column backend
c)
  case FieldInfo backend
fieldInfo of
    (FIColumn (SCIScalarColumn ColumnInfo backend
colInfo)) -> ColumnInfo backend -> m (ColumnInfo backend)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ColumnInfo backend
colInfo
    (FIColumn (SCIObjectColumn NestedObjectInfo backend
_)) -> Text -> m (ColumnInfo backend)
throwErr Text
"object"
    (FIColumn (SCIArrayColumn NestedArrayInfo backend
_)) -> Text -> m (ColumnInfo backend)
throwErr Text
"array"
    (FIRelationship RelInfo backend
_) -> Text -> m (ColumnInfo backend)
throwErr Text
"relationship"
    (FIComputedField ComputedFieldInfo backend
_) -> Text -> m (ColumnInfo backend)
throwErr Text
"computed field"
    (FIRemoteRelationship RemoteFieldInfo (DBJoinField backend)
_) -> Text -> m (ColumnInfo backend)
throwErr Text
"remote relationship"
  where
    throwErr :: Text -> m (ColumnInfo backend)
throwErr Text
fieldType =
      QErr -> m (ColumnInfo backend)
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        (QErr -> m (ColumnInfo backend)) -> QErr -> m (ColumnInfo backend)
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err400 Code
UnexpectedPayload
        (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ Text
"expecting a database column; but, "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Column backend
c
        Column backend -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldType
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"; "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg

askComputedFieldInfo ::
  (MonadError QErr m) =>
  FieldInfoMap (FieldInfo backend) ->
  ComputedFieldName ->
  m (ComputedFieldInfo backend)
askComputedFieldInfo :: forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> ComputedFieldName -> m (ComputedFieldInfo backend)
askComputedFieldInfo FieldInfoMap (FieldInfo backend)
fields ComputedFieldName
computedField = do
  FieldInfo backend
fieldInfo <-
    (Text -> Text) -> m (FieldInfo backend) -> m (FieldInfo backend)
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (Text
"computed field " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
      (m (FieldInfo backend) -> m (FieldInfo backend))
-> m (FieldInfo backend) -> m (FieldInfo backend)
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo backend)
-> FieldName -> m (FieldInfo backend)
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (FieldInfo backend)
fields
      (FieldName -> m (FieldInfo backend))
-> FieldName -> m (FieldInfo backend)
forall a b. (a -> b) -> a -> b
$ ComputedFieldName -> FieldName
fromComputedField ComputedFieldName
computedField
  case FieldInfo backend
fieldInfo of
    (FIColumn StructuredColumnInfo backend
_) -> Text -> m (ComputedFieldInfo backend)
throwErr Text
"column"
    (FIRelationship RelInfo backend
_) -> Text -> m (ComputedFieldInfo backend)
throwErr Text
"relationship"
    (FIRemoteRelationship RemoteFieldInfo (DBJoinField backend)
_) -> Text -> m (ComputedFieldInfo backend)
throwErr Text
"remote relationship"
    (FIComputedField ComputedFieldInfo backend
cci) -> ComputedFieldInfo backend -> m (ComputedFieldInfo backend)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComputedFieldInfo backend
cci
  where
    throwErr :: Text -> m (ComputedFieldInfo backend)
throwErr Text
fieldType =
      QErr -> m (ComputedFieldInfo backend)
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        (QErr -> m (ComputedFieldInfo backend))
-> QErr -> m (ComputedFieldInfo backend)
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err400 Code
UnexpectedPayload
        (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ Text
"expecting a computed field; but, "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ComputedFieldName
computedField
        ComputedFieldName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fieldType

assertColumnExists ::
  forall backend m.
  (MonadError QErr m, Backend backend) =>
  FieldInfoMap (FieldInfo backend) ->
  Text ->
  Column backend ->
  m ()
assertColumnExists :: forall (backend :: BackendType) (m :: * -> *).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend) -> Text -> Column backend -> m ()
assertColumnExists FieldInfoMap (FieldInfo backend)
m Text
msg Column backend
c = do
  m (ColumnInfo backend) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (ColumnInfo backend) -> m ()) -> m (ColumnInfo backend) -> m ()
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnInfo backend)
forall (m :: * -> *) (backend :: BackendType).
(MonadError QErr m, Backend backend) =>
FieldInfoMap (FieldInfo backend)
-> Column backend -> Text -> m (ColumnInfo backend)
askColInfo FieldInfoMap (FieldInfo backend)
m Column backend
c Text
msg

askRelType ::
  (MonadError QErr m) =>
  FieldInfoMap (FieldInfo backend) ->
  RelName ->
  Text ->
  m (RelInfo backend)
askRelType :: forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> Text -> m (RelInfo backend)
askRelType FieldInfoMap (FieldInfo backend)
m RelName
r Text
msg = do
  FieldInfo backend
colInfo <-
    (Text -> Text) -> m (FieldInfo backend) -> m (FieldInfo backend)
forall (m :: * -> *) a. QErrM m => (Text -> Text) -> m a -> m a
modifyErr (Text
"relationship " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
      (m (FieldInfo backend) -> m (FieldInfo backend))
-> m (FieldInfo backend) -> m (FieldInfo backend)
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo backend)
-> FieldName -> m (FieldInfo backend)
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (FieldInfo backend)
m (RelName -> FieldName
fromRel RelName
r)
  case FieldInfo backend
colInfo of
    (FIRelationship RelInfo backend
relInfo) -> RelInfo backend -> m (RelInfo backend)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RelInfo backend
relInfo
    FieldInfo backend
_ ->
      QErr -> m (RelInfo backend)
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
        (QErr -> m (RelInfo backend)) -> QErr -> m (RelInfo backend)
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err400 Code
UnexpectedPayload
        (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ Text
"expecting a relationship; but, "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName
r
        RelName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" is a postgres column; "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg

askRemoteRel ::
  (MonadError QErr m) =>
  FieldInfoMap (FieldInfo backend) ->
  RelName ->
  m (RemoteFieldInfo (DBJoinField backend))
askRemoteRel :: forall (m :: * -> *) (backend :: BackendType).
MonadError QErr m =>
FieldInfoMap (FieldInfo backend)
-> RelName -> m (RemoteFieldInfo (DBJoinField backend))
askRemoteRel FieldInfoMap (FieldInfo backend)
fieldInfoMap RelName
relName = do
  FieldInfo backend
fieldInfo <- FieldInfoMap (FieldInfo backend)
-> FieldName -> m (FieldInfo backend)
forall (m :: * -> *) fieldInfo.
MonadError QErr m =>
FieldInfoMap fieldInfo -> FieldName -> m fieldInfo
askFieldInfo FieldInfoMap (FieldInfo backend)
fieldInfoMap (RelName -> FieldName
fromRemoteRelationship RelName
relName)
  case FieldInfo backend
fieldInfo of
    (FIRemoteRelationship RemoteFieldInfo (DBJoinField backend)
remoteFieldInfo) -> RemoteFieldInfo (DBJoinField backend)
-> m (RemoteFieldInfo (DBJoinField backend))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return RemoteFieldInfo (DBJoinField backend)
remoteFieldInfo
    FieldInfo backend
_ ->
      Code -> Text -> m (RemoteFieldInfo (DBJoinField backend))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
UnexpectedPayload Text
"expecting a remote relationship"

mkAdminRolePermInfo :: (Backend b) => TableCoreInfo b -> RolePermInfo b
mkAdminRolePermInfo :: forall (b :: BackendType).
Backend b =>
TableCoreInfo b -> RolePermInfo b
mkAdminRolePermInfo TableCoreInfo b
tableInfo =
  Maybe (InsPermInfo b)
-> Maybe (SelPermInfo b)
-> Maybe (UpdPermInfo b)
-> Maybe (DelPermInfo b)
-> RolePermInfo b
forall (b :: BackendType).
Maybe (InsPermInfo b)
-> Maybe (SelPermInfo b)
-> Maybe (UpdPermInfo b)
-> Maybe (DelPermInfo b)
-> RolePermInfo b
RolePermInfo (InsPermInfo b -> Maybe (InsPermInfo b)
forall a. a -> Maybe a
Just InsPermInfo b
i) (SelPermInfo b -> Maybe (SelPermInfo b)
forall a. a -> Maybe a
Just SelPermInfo b
s) (UpdPermInfo b -> Maybe (UpdPermInfo b)
forall a. a -> Maybe a
Just UpdPermInfo b
u) (DelPermInfo b -> Maybe (DelPermInfo b)
forall a. a -> Maybe a
Just DelPermInfo b
d)
  where
    fields :: FieldInfoMap (FieldInfo b)
fields = TableCoreInfo b -> FieldInfoMap (FieldInfo b)
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> FieldInfoMap field
_tciFieldInfoMap TableCoreInfo b
tableInfo
    pgCols :: [Column b]
pgCols = (StructuredColumnInfo b -> Column b)
-> [StructuredColumnInfo b] -> [Column b]
forall a b. (a -> b) -> [a] -> [b]
map StructuredColumnInfo b -> Column b
forall (b :: BackendType). StructuredColumnInfo b -> Column b
structuredColumnInfoColumn ([StructuredColumnInfo b] -> [Column b])
-> [StructuredColumnInfo b] -> [Column b]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo b) -> [StructuredColumnInfo b]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [StructuredColumnInfo backend]
getCols FieldInfoMap (FieldInfo b)
fields
    pgColsWithFilter :: HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b))
pgColsWithFilter = [(Column b, AnnRedactionExp b (PartialSQLExp b))]
-> HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b))
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Column b, AnnRedactionExp b (PartialSQLExp b))]
 -> HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b)))
-> [(Column b, AnnRedactionExp b (PartialSQLExp b))]
-> HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b))
forall a b. (a -> b) -> a -> b
$ (Column b -> (Column b, AnnRedactionExp b (PartialSQLExp b)))
-> [Column b] -> [(Column b, AnnRedactionExp b (PartialSQLExp b))]
forall a b. (a -> b) -> [a] -> [b]
map (,AnnRedactionExp b (PartialSQLExp b)
forall (b :: BackendType) v. AnnRedactionExp b v
NoRedaction) [Column b]
pgCols
    computedFields :: HashSet ComputedFieldName
computedFields =
      -- Fetch the list of computed fields not returning rows of existing table.
      -- For other computed fields returning existing table rows, the admin role can query them
      -- as their permissions are derived from returning table permissions.
      [ComputedFieldName] -> HashSet ComputedFieldName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([ComputedFieldName] -> HashSet ComputedFieldName)
-> [ComputedFieldName] -> HashSet ComputedFieldName
forall a b. (a -> b) -> a -> b
$ (ComputedFieldInfo b -> ComputedFieldName)
-> [ComputedFieldInfo b] -> [ComputedFieldName]
forall a b. (a -> b) -> [a] -> [b]
map ComputedFieldInfo b -> ComputedFieldName
forall (b :: BackendType). ComputedFieldInfo b -> ComputedFieldName
_cfiName ([ComputedFieldInfo b] -> [ComputedFieldName])
-> [ComputedFieldInfo b] -> [ComputedFieldName]
forall a b. (a -> b) -> a -> b
$ [ComputedFieldInfo b] -> [ComputedFieldInfo b]
forall (backend :: BackendType).
Backend backend =>
[ComputedFieldInfo backend] -> [ComputedFieldInfo backend]
removeComputedFieldsReturningExistingTable ([ComputedFieldInfo b] -> [ComputedFieldInfo b])
-> [ComputedFieldInfo b] -> [ComputedFieldInfo b]
forall a b. (a -> b) -> a -> b
$ FieldInfoMap (FieldInfo b) -> [ComputedFieldInfo b]
forall (backend :: BackendType).
FieldInfoMap (FieldInfo backend) -> [ComputedFieldInfo backend]
getComputedFieldInfos FieldInfoMap (FieldInfo b)
fields
    computedFields' :: HashMap ComputedFieldName (AnnRedactionExp b (PartialSQLExp b))
computedFields' = HashSet ComputedFieldName -> HashMap ComputedFieldName ()
forall a. HashSet a -> HashMap a ()
HS.toMap HashSet ComputedFieldName
computedFields HashMap ComputedFieldName ()
-> AnnRedactionExp b (PartialSQLExp b)
-> HashMap ComputedFieldName (AnnRedactionExp b (PartialSQLExp b))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> AnnRedactionExp b (PartialSQLExp b)
forall (b :: BackendType) v. AnnRedactionExp b v
NoRedaction

    tableName :: TableName b
tableName = TableCoreInfo b -> TableName b
forall (b :: BackendType) field primaryKeyColumn.
TableCoreInfoG b field primaryKeyColumn -> TableName b
_tciName TableCoreInfo b
tableInfo
    i :: InsPermInfo b
i = HashSet (Column b)
-> AnnBoolExpPartialSQL b
-> PreSetColsPartial b
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> InsPermInfo b
forall (b :: BackendType).
HashSet (Column b)
-> AnnBoolExpPartialSQL b
-> PreSetColsPartial b
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> InsPermInfo b
InsPermInfo ([Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [Column b]
pgCols) AnnBoolExpPartialSQL b
forall (backend :: BackendType) scalar. AnnBoolExp backend scalar
annBoolExpTrue PreSetColsPartial b
forall k v. HashMap k v
HashMap.empty Bool
False HashSet Text
forall a. Monoid a => a
mempty Maybe (ValidateInput ResolvedWebhook)
forall a. Maybe a
Nothing
    s :: SelPermInfo b
s = HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b))
-> HashMap ComputedFieldName (AnnRedactionExp b (PartialSQLExp b))
-> AnnBoolExpPartialSQL b
-> Maybe Int
-> Bool
-> HashSet Text
-> AllowedRootFields QueryRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
-> SelPermInfo b
forall (b :: BackendType).
HashMap (Column b) (AnnRedactionExpPartialSQL b)
-> HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
-> AnnBoolExpPartialSQL b
-> Maybe Int
-> Bool
-> HashSet Text
-> AllowedRootFields QueryRootFieldType
-> AllowedRootFields SubscriptionRootFieldType
-> SelPermInfo b
SelPermInfo HashMap (Column b) (AnnRedactionExp b (PartialSQLExp b))
pgColsWithFilter HashMap ComputedFieldName (AnnRedactionExp b (PartialSQLExp b))
computedFields' AnnBoolExpPartialSQL b
forall (backend :: BackendType) scalar. AnnBoolExp backend scalar
annBoolExpTrue Maybe Int
forall a. Maybe a
Nothing Bool
True HashSet Text
forall a. Monoid a => a
mempty AllowedRootFields QueryRootFieldType
forall rootFieldType. AllowedRootFields rootFieldType
ARFAllowAllRootFields AllowedRootFields SubscriptionRootFieldType
forall rootFieldType. AllowedRootFields rootFieldType
ARFAllowAllRootFields
    u :: UpdPermInfo b
u = HashSet (Column b)
-> TableName b
-> AnnBoolExpPartialSQL b
-> Maybe (AnnBoolExpPartialSQL b)
-> PreSetColsPartial b
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> UpdPermInfo b
forall (b :: BackendType).
HashSet (Column b)
-> TableName b
-> AnnBoolExpPartialSQL b
-> Maybe (AnnBoolExpPartialSQL b)
-> PreSetColsPartial b
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> UpdPermInfo b
UpdPermInfo ([Column b] -> HashSet (Column b)
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [Column b]
pgCols) TableName b
tableName AnnBoolExpPartialSQL b
forall (backend :: BackendType) scalar. AnnBoolExp backend scalar
annBoolExpTrue Maybe (AnnBoolExpPartialSQL b)
forall a. Maybe a
Nothing PreSetColsPartial b
forall k v. HashMap k v
HashMap.empty Bool
False HashSet Text
forall a. Monoid a => a
mempty Maybe (ValidateInput ResolvedWebhook)
forall a. Maybe a
Nothing
    d :: DelPermInfo b
d = TableName b
-> AnnBoolExpPartialSQL b
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> DelPermInfo b
forall (b :: BackendType).
TableName b
-> AnnBoolExpPartialSQL b
-> Bool
-> HashSet Text
-> Maybe (ValidateInput ResolvedWebhook)
-> DelPermInfo b
DelPermInfo TableName b
tableName AnnBoolExpPartialSQL b
forall (backend :: BackendType) scalar. AnnBoolExp backend scalar
annBoolExpTrue Bool
False HashSet Text
forall a. Monoid a => a
mempty Maybe (ValidateInput ResolvedWebhook)
forall a. Maybe a
Nothing