{-# LANGUAGE TemplateHaskell #-}

module Hasura.RQL.Types.Metadata.Object
  ( InconsistentMetadata (..),
    InconsistentRoleEntity (..),
    MetadataObjId (..),
    MetadataObject (..),
    SourceMetadataObjId (..),
    TableMetadataObjId (..),
    droppableInconsistentMetadata,
    getInconsistentRemoteSchemas,
    groupInconsistentMetadataById,
    imObjectIds,
    imReason,
    moDefinition,
    moId,
    moiName,
    moiTypeName,
    _AmbiguousRestEndpoints,
    _ConflictingInheritedPermission,
    _ConflictingObjects,
    _DuplicateObjects,
    _DuplicateRestVariables,
    _InconsistentObject,
    _InvalidRestSegments,
    _MOAction,
    _MOActionPermission,
    _MOCronTrigger,
    _MOCustomTypes,
    _MOEndpoint,
    _MOHostTlsAllowlist,
    _MOInheritedRole,
    _MORemoteSchema,
    _MORemoteSchemaPermissions,
    _MOSource,
    _MOSourceObjId,
  )
where

import Control.Lens hiding (set, (.=))
import Data.Aeson.Types
import Data.HashMap.Strict.Extended qualified as M
import Data.Text qualified as T
import Data.Text.Extended
import Hasura.Base.ErrorMessage
import Hasura.Base.ToErrorValue
import Hasura.Prelude
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.ComputedField
import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Instances ()
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.QueryCollection (CollectionName, ListedQuery (_lqName))
import Hasura.RQL.Types.RemoteSchema
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.Session
import Language.GraphQL.Draft.Syntax qualified as G

data TableMetadataObjId
  = MTORel RelName RelType
  | MTOComputedField ComputedFieldName
  | MTOPerm RoleName PermType
  | MTOTrigger TriggerName
  | MTORemoteRelationship RelName
  deriving (Int -> TableMetadataObjId -> ShowS
[TableMetadataObjId] -> ShowS
TableMetadataObjId -> String
(Int -> TableMetadataObjId -> ShowS)
-> (TableMetadataObjId -> String)
-> ([TableMetadataObjId] -> ShowS)
-> Show TableMetadataObjId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableMetadataObjId] -> ShowS
$cshowList :: [TableMetadataObjId] -> ShowS
show :: TableMetadataObjId -> String
$cshow :: TableMetadataObjId -> String
showsPrec :: Int -> TableMetadataObjId -> ShowS
$cshowsPrec :: Int -> TableMetadataObjId -> ShowS
Show, TableMetadataObjId -> TableMetadataObjId -> Bool
(TableMetadataObjId -> TableMetadataObjId -> Bool)
-> (TableMetadataObjId -> TableMetadataObjId -> Bool)
-> Eq TableMetadataObjId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TableMetadataObjId -> TableMetadataObjId -> Bool
$c/= :: TableMetadataObjId -> TableMetadataObjId -> Bool
== :: TableMetadataObjId -> TableMetadataObjId -> Bool
$c== :: TableMetadataObjId -> TableMetadataObjId -> Bool
Eq, (forall x. TableMetadataObjId -> Rep TableMetadataObjId x)
-> (forall x. Rep TableMetadataObjId x -> TableMetadataObjId)
-> Generic TableMetadataObjId
forall x. Rep TableMetadataObjId x -> TableMetadataObjId
forall x. TableMetadataObjId -> Rep TableMetadataObjId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TableMetadataObjId x -> TableMetadataObjId
$cfrom :: forall x. TableMetadataObjId -> Rep TableMetadataObjId x
Generic)

instance Hashable TableMetadataObjId

data SourceMetadataObjId b
  = SMOTable (TableName b)
  | SMOFunction (FunctionName b)
  | SMOFunctionPermission (FunctionName b) RoleName
  | SMOTableObj (TableName b) TableMetadataObjId
  deriving ((forall x. SourceMetadataObjId b -> Rep (SourceMetadataObjId b) x)
-> (forall x.
    Rep (SourceMetadataObjId b) x -> SourceMetadataObjId b)
-> Generic (SourceMetadataObjId b)
forall x. Rep (SourceMetadataObjId b) x -> SourceMetadataObjId b
forall x. SourceMetadataObjId b -> Rep (SourceMetadataObjId b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (SourceMetadataObjId b) x -> SourceMetadataObjId b
forall (b :: BackendType) x.
SourceMetadataObjId b -> Rep (SourceMetadataObjId b) x
$cto :: forall (b :: BackendType) x.
Rep (SourceMetadataObjId b) x -> SourceMetadataObjId b
$cfrom :: forall (b :: BackendType) x.
SourceMetadataObjId b -> Rep (SourceMetadataObjId b) x
Generic)

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

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

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

data MetadataObjId
  = MOSource SourceName
  | MOSourceObjId SourceName (AB.AnyBackend SourceMetadataObjId)
  | -- | Originates from user-defined '_arsqName'
    MORemoteSchema RemoteSchemaName
  | MORemoteSchemaPermissions RemoteSchemaName RoleName
  | -- | A remote relationship on a remote schema type, identified by
    -- 1. remote schema name
    -- 2. remote schema type on which the relationship is defined
    -- 3. name of the relationship
    MORemoteSchemaRemoteRelationship RemoteSchemaName G.Name RelName
  | MOCustomTypes
  | MOAction ActionName
  | MOActionPermission ActionName RoleName
  | MOCronTrigger TriggerName
  | MOInheritedRole RoleName
  | MOEndpoint EndpointName
  | MOHostTlsAllowlist String
  | MOQueryCollectionsQuery CollectionName ListedQuery
  deriving (Int -> MetadataObjId -> ShowS
[MetadataObjId] -> ShowS
MetadataObjId -> String
(Int -> MetadataObjId -> ShowS)
-> (MetadataObjId -> String)
-> ([MetadataObjId] -> ShowS)
-> Show MetadataObjId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetadataObjId] -> ShowS
$cshowList :: [MetadataObjId] -> ShowS
show :: MetadataObjId -> String
$cshow :: MetadataObjId -> String
showsPrec :: Int -> MetadataObjId -> ShowS
$cshowsPrec :: Int -> MetadataObjId -> ShowS
Show, MetadataObjId -> MetadataObjId -> Bool
(MetadataObjId -> MetadataObjId -> Bool)
-> (MetadataObjId -> MetadataObjId -> Bool) -> Eq MetadataObjId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetadataObjId -> MetadataObjId -> Bool
$c/= :: MetadataObjId -> MetadataObjId -> Bool
== :: MetadataObjId -> MetadataObjId -> Bool
$c== :: MetadataObjId -> MetadataObjId -> Bool
Eq, (forall x. MetadataObjId -> Rep MetadataObjId x)
-> (forall x. Rep MetadataObjId x -> MetadataObjId)
-> Generic MetadataObjId
forall x. Rep MetadataObjId x -> MetadataObjId
forall x. MetadataObjId -> Rep MetadataObjId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetadataObjId x -> MetadataObjId
$cfrom :: forall x. MetadataObjId -> Rep MetadataObjId x
Generic)

$(makePrisms ''MetadataObjId)

instance Hashable MetadataObjId

instance ToErrorValue MetadataObjId where
  toErrorValue :: MetadataObjId -> ErrorMessage
toErrorValue = Text -> ErrorMessage
toErrorMessage (Text -> ErrorMessage)
-> (MetadataObjId -> Text) -> MetadataObjId -> ErrorMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataObjId -> Text
moiName

moiTypeName :: MetadataObjId -> Text
moiTypeName :: MetadataObjId -> Text
moiTypeName = \case
  MOSource SourceName
_ -> Text
"source"
  MOSourceObjId SourceName
_ AnyBackend SourceMetadataObjId
exists -> AnyBackend SourceMetadataObjId
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadataObjId b -> Text)
-> Text
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend SourceMetadataObjId
exists forall (b :: BackendType).
Backend b =>
SourceMetadataObjId b -> Text
forall (b :: BackendType). SourceMetadataObjId b -> Text
handleSourceObj
  MORemoteSchema RemoteSchemaName
_ -> Text
"remote_schema"
  MORemoteSchemaPermissions RemoteSchemaName
_ RoleName
_ -> Text
"remote_schema_permission"
  MORemoteSchemaRemoteRelationship {} -> Text
"remote_schema_remote_relationship"
  MOCronTrigger TriggerName
_ -> Text
"cron_trigger"
  MetadataObjId
MOCustomTypes -> Text
"custom_types"
  MOAction ActionName
_ -> Text
"action"
  MOActionPermission ActionName
_ RoleName
_ -> Text
"action_permission"
  MOInheritedRole RoleName
_ -> Text
"inherited_role"
  MOEndpoint EndpointName
_ -> Text
"rest_endpoint"
  MOHostTlsAllowlist String
_ -> Text
"host_network_tls_allowlist"
  MOQueryCollectionsQuery CollectionName
_ ListedQuery
_ -> Text
"query_collections"
  where
    handleSourceObj :: forall b. SourceMetadataObjId b -> Text
    handleSourceObj :: SourceMetadataObjId b -> Text
handleSourceObj = \case
      SMOTable TableName b
_ -> Text
"table"
      SMOFunction FunctionName b
_ -> Text
"function"
      SMOFunctionPermission FunctionName b
_ RoleName
_ -> Text
"function_permission"
      SMOTableObj TableName b
_ TableMetadataObjId
tableObjectId -> case TableMetadataObjId
tableObjectId of
        MTORel RelName
_ RelType
relType -> RelType -> Text
relTypeToTxt RelType
relType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_relation"
        MTOPerm RoleName
_ PermType
permType -> PermType -> Text
permTypeToCode PermType
permType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_permission"
        MTOTrigger TriggerName
_ -> Text
"event_trigger"
        MTOComputedField ComputedFieldName
_ -> Text
"computed_field"
        MTORemoteRelationship RelName
_ -> Text
"remote_relationship"

moiName :: MetadataObjId -> Text
moiName :: MetadataObjId -> Text
moiName MetadataObjId
objectId =
  MetadataObjId -> Text
moiTypeName MetadataObjId
objectId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case MetadataObjId
objectId of
    MOSource SourceName
name -> SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
name
    MOSourceObjId SourceName
source AnyBackend SourceMetadataObjId
exists -> AnyBackend SourceMetadataObjId
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadataObjId b -> Text)
-> Text
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend SourceMetadataObjId
exists (SourceName -> SourceMetadataObjId b -> Text
forall (b :: BackendType).
Backend b =>
SourceName -> SourceMetadataObjId b -> Text
handleSourceObj SourceName
source)
    MORemoteSchema RemoteSchemaName
name -> RemoteSchemaName -> Text
forall a. ToTxt a => a -> Text
toTxt RemoteSchemaName
name
    MORemoteSchemaPermissions RemoteSchemaName
name RoleName
roleName ->
      RoleName -> Text
forall a. ToTxt a => a -> Text
toTxt RoleName
roleName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permission in remote schema " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName -> Text
forall a. ToTxt a => a -> Text
toTxt RemoteSchemaName
name
    MORemoteSchemaRemoteRelationship RemoteSchemaName
remoteSchemaName Name
typeName RelName
relationshipName ->
      Text
"remote_relationship " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RelName -> Text
forall a. ToTxt a => a -> Text
toTxt RelName
relationshipName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" on type " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
G.unName Name
typeName
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in remote schema "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName -> Text
forall a. ToTxt a => a -> Text
toTxt RemoteSchemaName
remoteSchemaName
    MOCronTrigger TriggerName
name -> TriggerName -> Text
forall a. ToTxt a => a -> Text
toTxt TriggerName
name
    MetadataObjId
MOCustomTypes -> Text
"custom_types"
    MOAction ActionName
name -> ActionName -> Text
forall a. ToTxt a => a -> Text
toTxt ActionName
name
    MOActionPermission ActionName
name RoleName
roleName -> RoleName -> Text
forall a. ToTxt a => a -> Text
toTxt RoleName
roleName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permission in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ActionName -> Text
forall a. ToTxt a => a -> Text
toTxt ActionName
name
    MOInheritedRole RoleName
inheritedRoleName -> Text
"inherited role " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName -> Text
forall a. ToTxt a => a -> Text
toTxt RoleName
inheritedRoleName
    MOEndpoint EndpointName
name -> EndpointName -> Text
forall a. ToTxt a => a -> Text
toTxt EndpointName
name
    MOHostTlsAllowlist String
hostTlsAllowlist -> String -> Text
T.pack String
hostTlsAllowlist
    MOQueryCollectionsQuery CollectionName
cName ListedQuery
lq -> (QueryName -> Text
forall a. ToTxt a => a -> Text
toTxt (QueryName -> Text)
-> (ListedQuery -> QueryName) -> ListedQuery -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListedQuery -> QueryName
_lqName) ListedQuery
lq Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CollectionName -> Text
forall a. ToTxt a => a -> Text
toTxt CollectionName
cName
  where
    handleSourceObj ::
      forall b.
      Backend b =>
      SourceName ->
      SourceMetadataObjId b ->
      Text
    handleSourceObj :: SourceName -> SourceMetadataObjId b -> Text
handleSourceObj SourceName
source = \case
      SMOTable TableName b
name -> TableName b -> Text
forall a. ToTxt a => a -> Text
toTxt TableName b
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
source
      SMOFunction FunctionName b
name -> FunctionName b -> Text
forall a. ToTxt a => a -> Text
toTxt FunctionName b
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
source
      SMOFunctionPermission FunctionName b
functionName RoleName
roleName ->
        RoleName -> Text
forall a. ToTxt a => a -> Text
toTxt RoleName
roleName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permission for function "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FunctionName b -> Text
forall a. ToTxt a => a -> Text
toTxt FunctionName b
functionName
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in source "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
forall a. ToTxt a => a -> Text
toTxt SourceName
source
      SMOTableObj TableName b
tableName TableMetadataObjId
tableObjectId ->
        let tableObjectName :: Text
tableObjectName = case TableMetadataObjId
tableObjectId of
              MTORel RelName
name RelType
_ -> RelName -> Text
forall a. ToTxt a => a -> Text
toTxt RelName
name
              MTOComputedField ComputedFieldName
name -> ComputedFieldName -> Text
forall a. ToTxt a => a -> Text
toTxt ComputedFieldName
name
              MTORemoteRelationship RelName
name -> RelName -> Text
forall a. ToTxt a => a -> Text
toTxt RelName
name
              MTOPerm RoleName
name PermType
_ -> RoleName -> Text
forall a. ToTxt a => a -> Text
toTxt RoleName
name
              MTOTrigger TriggerName
name -> TriggerName -> Text
forall a. ToTxt a => a -> Text
toTxt TriggerName
name
         in Text
tableObjectName
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MetadataObjId -> Text
moiName
                ( SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$
                    SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$
                      TableName b -> SourceMetadataObjId b
forall (b :: BackendType). TableName b -> SourceMetadataObjId b
SMOTable @b TableName b
tableName
                )

data MetadataObject = MetadataObject
  { MetadataObject -> MetadataObjId
_moId :: MetadataObjId,
    MetadataObject -> Value
_moDefinition :: Value
  }
  deriving (Int -> MetadataObject -> ShowS
[MetadataObject] -> ShowS
MetadataObject -> String
(Int -> MetadataObject -> ShowS)
-> (MetadataObject -> String)
-> ([MetadataObject] -> ShowS)
-> Show MetadataObject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetadataObject] -> ShowS
$cshowList :: [MetadataObject] -> ShowS
show :: MetadataObject -> String
$cshow :: MetadataObject -> String
showsPrec :: Int -> MetadataObject -> ShowS
$cshowsPrec :: Int -> MetadataObject -> ShowS
Show, MetadataObject -> MetadataObject -> Bool
(MetadataObject -> MetadataObject -> Bool)
-> (MetadataObject -> MetadataObject -> Bool) -> Eq MetadataObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetadataObject -> MetadataObject -> Bool
$c/= :: MetadataObject -> MetadataObject -> Bool
== :: MetadataObject -> MetadataObject -> Bool
$c== :: MetadataObject -> MetadataObject -> Bool
Eq, (forall x. MetadataObject -> Rep MetadataObject x)
-> (forall x. Rep MetadataObject x -> MetadataObject)
-> Generic MetadataObject
forall x. Rep MetadataObject x -> MetadataObject
forall x. MetadataObject -> Rep MetadataObject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetadataObject x -> MetadataObject
$cfrom :: forall x. MetadataObject -> Rep MetadataObject x
Generic)

instance Hashable MetadataObject

$(makeLenses ''MetadataObject)

data InconsistentRoleEntity
  = InconsistentTablePermission
      SourceName
      Text
      -- ^ Table name -- using `Text` here instead of `TableName b` for simplification,
      -- Otherwise, we'll have to create a newtype wrapper around `TableName b` and then
      -- use it with `AB.AnyBackend`
      PermType
  | InconsistentRemoteSchemaPermission RemoteSchemaName
  deriving stock (Int -> InconsistentRoleEntity -> ShowS
[InconsistentRoleEntity] -> ShowS
InconsistentRoleEntity -> String
(Int -> InconsistentRoleEntity -> ShowS)
-> (InconsistentRoleEntity -> String)
-> ([InconsistentRoleEntity] -> ShowS)
-> Show InconsistentRoleEntity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InconsistentRoleEntity] -> ShowS
$cshowList :: [InconsistentRoleEntity] -> ShowS
show :: InconsistentRoleEntity -> String
$cshow :: InconsistentRoleEntity -> String
showsPrec :: Int -> InconsistentRoleEntity -> ShowS
$cshowsPrec :: Int -> InconsistentRoleEntity -> ShowS
Show, InconsistentRoleEntity -> InconsistentRoleEntity -> Bool
(InconsistentRoleEntity -> InconsistentRoleEntity -> Bool)
-> (InconsistentRoleEntity -> InconsistentRoleEntity -> Bool)
-> Eq InconsistentRoleEntity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InconsistentRoleEntity -> InconsistentRoleEntity -> Bool
$c/= :: InconsistentRoleEntity -> InconsistentRoleEntity -> Bool
== :: InconsistentRoleEntity -> InconsistentRoleEntity -> Bool
$c== :: InconsistentRoleEntity -> InconsistentRoleEntity -> Bool
Eq, (forall x. InconsistentRoleEntity -> Rep InconsistentRoleEntity x)
-> (forall x.
    Rep InconsistentRoleEntity x -> InconsistentRoleEntity)
-> Generic InconsistentRoleEntity
forall x. Rep InconsistentRoleEntity x -> InconsistentRoleEntity
forall x. InconsistentRoleEntity -> Rep InconsistentRoleEntity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InconsistentRoleEntity x -> InconsistentRoleEntity
$cfrom :: forall x. InconsistentRoleEntity -> Rep InconsistentRoleEntity x
Generic)

instance Hashable InconsistentRoleEntity

instance ToTxt InconsistentRoleEntity where
  toTxt :: InconsistentRoleEntity -> Text
toTxt (InconsistentTablePermission SourceName
source Text
table PermType
permType) =
    PermType -> Text
permTypeToCode PermType
permType
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" permission"
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
", table: " :: Text)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
table
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", source: "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
forall a. ToTxt a => a -> Text
squote SourceName
source
  toTxt (InconsistentRemoteSchemaPermission RemoteSchemaName
remoteSchemaName) =
    Text
"remote schema: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName -> Text
forall a. ToTxt a => a -> Text
squote RemoteSchemaName
remoteSchemaName

instance ToJSON InconsistentRoleEntity where
  toJSON :: InconsistentRoleEntity -> Value
toJSON = \case
    InconsistentTablePermission SourceName
sourceName Text
tableName PermType
permType ->
      [Pair] -> Value
object
        [ Key
"table" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
tableName,
          Key
"source" Key -> SourceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= SourceName
sourceName,
          Key
"permission_type" Key -> PermType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PermType
permType
        ]
    InconsistentRemoteSchemaPermission RemoteSchemaName
remoteSchemaName ->
      [Pair] -> Value
object [Key
"remote_schema" Key -> RemoteSchemaName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RemoteSchemaName
remoteSchemaName]

data InconsistentMetadata
  = InconsistentObject Text (Maybe Value) MetadataObject
  | ConflictingObjects Text [MetadataObject]
  | DuplicateObjects MetadataObjId [Value]
  | DuplicateRestVariables Text MetadataObject
  | InvalidRestSegments Text MetadataObject
  | AmbiguousRestEndpoints Text [MetadataObject]
  | ConflictingInheritedPermission RoleName InconsistentRoleEntity
  deriving stock (Int -> InconsistentMetadata -> ShowS
[InconsistentMetadata] -> ShowS
InconsistentMetadata -> String
(Int -> InconsistentMetadata -> ShowS)
-> (InconsistentMetadata -> String)
-> ([InconsistentMetadata] -> ShowS)
-> Show InconsistentMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InconsistentMetadata] -> ShowS
$cshowList :: [InconsistentMetadata] -> ShowS
show :: InconsistentMetadata -> String
$cshow :: InconsistentMetadata -> String
showsPrec :: Int -> InconsistentMetadata -> ShowS
$cshowsPrec :: Int -> InconsistentMetadata -> ShowS
Show, InconsistentMetadata -> InconsistentMetadata -> Bool
(InconsistentMetadata -> InconsistentMetadata -> Bool)
-> (InconsistentMetadata -> InconsistentMetadata -> Bool)
-> Eq InconsistentMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InconsistentMetadata -> InconsistentMetadata -> Bool
$c/= :: InconsistentMetadata -> InconsistentMetadata -> Bool
== :: InconsistentMetadata -> InconsistentMetadata -> Bool
$c== :: InconsistentMetadata -> InconsistentMetadata -> Bool
Eq, (forall x. InconsistentMetadata -> Rep InconsistentMetadata x)
-> (forall x. Rep InconsistentMetadata x -> InconsistentMetadata)
-> Generic InconsistentMetadata
forall x. Rep InconsistentMetadata x -> InconsistentMetadata
forall x. InconsistentMetadata -> Rep InconsistentMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InconsistentMetadata x -> InconsistentMetadata
$cfrom :: forall x. InconsistentMetadata -> Rep InconsistentMetadata x
Generic)

instance Hashable InconsistentMetadata

$(makePrisms ''InconsistentMetadata)

-- | Helper function to differentiate which type of inconsistent
--   metadata can be dropped, if an inconsistency cannot be resolved
--   by dropping any part of the metadata then this function should
--   return `False`, otherwise it should return `True`
droppableInconsistentMetadata :: InconsistentMetadata -> Bool
droppableInconsistentMetadata :: InconsistentMetadata -> Bool
droppableInconsistentMetadata = \case
  InconsistentObject {} -> Bool
True
  ConflictingObjects {} -> Bool
True
  DuplicateObjects {} -> Bool
True
  DuplicateRestVariables {} -> Bool
True
  InvalidRestSegments {} -> Bool
True
  AmbiguousRestEndpoints {} -> Bool
True
  ConflictingInheritedPermission {} -> Bool
False

getInconsistentRemoteSchemas :: [InconsistentMetadata] -> [RemoteSchemaName]
getInconsistentRemoteSchemas :: [InconsistentMetadata] -> [RemoteSchemaName]
getInconsistentRemoteSchemas =
  Getting
  (Endo [RemoteSchemaName]) [InconsistentMetadata] RemoteSchemaName
-> [InconsistentMetadata] -> [RemoteSchemaName]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((InconsistentMetadata
 -> Const (Endo [RemoteSchemaName]) InconsistentMetadata)
-> [InconsistentMetadata]
-> Const (Endo [RemoteSchemaName]) [InconsistentMetadata]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((InconsistentMetadata
  -> Const (Endo [RemoteSchemaName]) InconsistentMetadata)
 -> [InconsistentMetadata]
 -> Const (Endo [RemoteSchemaName]) [InconsistentMetadata])
-> ((RemoteSchemaName
     -> Const (Endo [RemoteSchemaName]) RemoteSchemaName)
    -> InconsistentMetadata
    -> Const (Endo [RemoteSchemaName]) InconsistentMetadata)
-> Getting
     (Endo [RemoteSchemaName]) [InconsistentMetadata] RemoteSchemaName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Maybe Value, MetadataObject)
 -> Const
      (Endo [RemoteSchemaName]) (Text, Maybe Value, MetadataObject))
-> InconsistentMetadata
-> Const (Endo [RemoteSchemaName]) InconsistentMetadata
Prism' InconsistentMetadata (Text, Maybe Value, MetadataObject)
_InconsistentObject (((Text, Maybe Value, MetadataObject)
  -> Const
       (Endo [RemoteSchemaName]) (Text, Maybe Value, MetadataObject))
 -> InconsistentMetadata
 -> Const (Endo [RemoteSchemaName]) InconsistentMetadata)
-> ((RemoteSchemaName
     -> Const (Endo [RemoteSchemaName]) RemoteSchemaName)
    -> (Text, Maybe Value, MetadataObject)
    -> Const
         (Endo [RemoteSchemaName]) (Text, Maybe Value, MetadataObject))
-> (RemoteSchemaName
    -> Const (Endo [RemoteSchemaName]) RemoteSchemaName)
-> InconsistentMetadata
-> Const (Endo [RemoteSchemaName]) InconsistentMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetadataObject -> Const (Endo [RemoteSchemaName]) MetadataObject)
-> (Text, Maybe Value, MetadataObject)
-> Const
     (Endo [RemoteSchemaName]) (Text, Maybe Value, MetadataObject)
forall s t a b. Field3 s t a b => Lens s t a b
_3 ((MetadataObject -> Const (Endo [RemoteSchemaName]) MetadataObject)
 -> (Text, Maybe Value, MetadataObject)
 -> Const
      (Endo [RemoteSchemaName]) (Text, Maybe Value, MetadataObject))
-> ((RemoteSchemaName
     -> Const (Endo [RemoteSchemaName]) RemoteSchemaName)
    -> MetadataObject
    -> Const (Endo [RemoteSchemaName]) MetadataObject)
-> (RemoteSchemaName
    -> Const (Endo [RemoteSchemaName]) RemoteSchemaName)
-> (Text, Maybe Value, MetadataObject)
-> Const
     (Endo [RemoteSchemaName]) (Text, Maybe Value, MetadataObject)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MetadataObjId -> Const (Endo [RemoteSchemaName]) MetadataObjId)
-> MetadataObject -> Const (Endo [RemoteSchemaName]) MetadataObject
Lens' MetadataObject MetadataObjId
moId ((MetadataObjId -> Const (Endo [RemoteSchemaName]) MetadataObjId)
 -> MetadataObject
 -> Const (Endo [RemoteSchemaName]) MetadataObject)
-> ((RemoteSchemaName
     -> Const (Endo [RemoteSchemaName]) RemoteSchemaName)
    -> MetadataObjId -> Const (Endo [RemoteSchemaName]) MetadataObjId)
-> (RemoteSchemaName
    -> Const (Endo [RemoteSchemaName]) RemoteSchemaName)
-> MetadataObject
-> Const (Endo [RemoteSchemaName]) MetadataObject
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RemoteSchemaName
 -> Const (Endo [RemoteSchemaName]) RemoteSchemaName)
-> MetadataObjId -> Const (Endo [RemoteSchemaName]) MetadataObjId
Prism' MetadataObjId RemoteSchemaName
_MORemoteSchema)

imObjectIds :: InconsistentMetadata -> [MetadataObjId]
imObjectIds :: InconsistentMetadata -> [MetadataObjId]
imObjectIds = \case
  InconsistentObject Text
_ Maybe Value
_ MetadataObject
metadata -> [MetadataObject -> MetadataObjId
_moId MetadataObject
metadata]
  ConflictingObjects Text
_ [MetadataObject]
metadatas -> (MetadataObject -> MetadataObjId)
-> [MetadataObject] -> [MetadataObjId]
forall a b. (a -> b) -> [a] -> [b]
map MetadataObject -> MetadataObjId
_moId [MetadataObject]
metadatas
  DuplicateObjects MetadataObjId
objectId [Value]
_ -> [MetadataObjId
objectId]
  DuplicateRestVariables Text
_ MetadataObject
md -> [MetadataObject -> MetadataObjId
_moId MetadataObject
md]
  InvalidRestSegments Text
_ MetadataObject
md -> [MetadataObject -> MetadataObjId
_moId MetadataObject
md]
  AmbiguousRestEndpoints Text
_ [MetadataObject]
mds -> Int -> [MetadataObjId] -> [MetadataObjId]
forall a. Int -> [a] -> [a]
take Int
1 ([MetadataObjId] -> [MetadataObjId])
-> [MetadataObjId] -> [MetadataObjId]
forall a b. (a -> b) -> a -> b
$ (MetadataObject -> MetadataObjId)
-> [MetadataObject] -> [MetadataObjId]
forall a b. (a -> b) -> [a] -> [b]
map MetadataObject -> MetadataObjId
_moId [MetadataObject]
mds -- TODO: Take 1 is a workaround to ensure that conflicts are not reported multiple times per endpoint.
  ConflictingInheritedPermission RoleName
_ InconsistentRoleEntity
_ -> [MetadataObjId]
forall a. Monoid a => a
mempty -- @mempty@ because in such a case we just want the user to know that the permission was not able to derive and this inconsistency is purely informational

imReason :: InconsistentMetadata -> Text
imReason :: InconsistentMetadata -> Text
imReason = \case
  InconsistentObject Text
reason Maybe Value
_ MetadataObject
_ -> Text
"Inconsistent object: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reason
  ConflictingObjects Text
reason [MetadataObject]
_ -> Text
"Conflicting objects: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reason
  DuplicateObjects MetadataObjId
objectId [Value]
_ -> Text
"Multiple definitions for: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> MetadataObjId -> Text
moiName MetadataObjId
objectId
  DuplicateRestVariables Text
reason MetadataObject
_ -> Text
"Duplicate variables found in endpoint path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reason
  InvalidRestSegments Text
reason MetadataObject
_ -> Text
"Empty segments or unnamed variables are not allowed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reason
  AmbiguousRestEndpoints Text
reason [MetadataObject]
_ -> Text
"Ambiguous URL paths: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reason
  ConflictingInheritedPermission RoleName
roleName InconsistentRoleEntity
entity ->
    Text
"Could not inherit permission for the role "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RoleName -> Text
forall a. ToTxt a => a -> Text
squote RoleName
roleName
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text
" for the entity: " :: Text)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> InconsistentRoleEntity -> Text
forall a. ToTxt a => a -> Text
squote InconsistentRoleEntity
entity

-- | Builds a map from each unique metadata object id to the inconsistencies associated with it.
-- Note that a single inconsistency can involve multiple metadata objects, so the same inconsistency
-- may appear in the resulting map multiple times!
groupInconsistentMetadataById ::
  [InconsistentMetadata] -> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
groupInconsistentMetadataById :: [InconsistentMetadata]
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
groupInconsistentMetadataById =
  (NonEmpty InconsistentMetadata
 -> NonEmpty InconsistentMetadata -> NonEmpty InconsistentMetadata)
-> [(MetadataObjId, NonEmpty InconsistentMetadata)]
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> [(k, v)] -> HashMap k v
M.fromListWith NonEmpty InconsistentMetadata
-> NonEmpty InconsistentMetadata -> NonEmpty InconsistentMetadata
forall a. Semigroup a => a -> a -> a
(<>) ([(MetadataObjId, NonEmpty InconsistentMetadata)]
 -> HashMap MetadataObjId (NonEmpty InconsistentMetadata))
-> ([InconsistentMetadata]
    -> [(MetadataObjId, NonEmpty InconsistentMetadata)])
-> [InconsistentMetadata]
-> HashMap MetadataObjId (NonEmpty InconsistentMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InconsistentMetadata
 -> [(MetadataObjId, NonEmpty InconsistentMetadata)])
-> [InconsistentMetadata]
-> [(MetadataObjId, NonEmpty InconsistentMetadata)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap \InconsistentMetadata
metadata ->
    (MetadataObjId -> (MetadataObjId, NonEmpty InconsistentMetadata))
-> [MetadataObjId]
-> [(MetadataObjId, NonEmpty InconsistentMetadata)]
forall a b. (a -> b) -> [a] -> [b]
map (,InconsistentMetadata
metadata InconsistentMetadata
-> [InconsistentMetadata] -> NonEmpty InconsistentMetadata
forall a. a -> [a] -> NonEmpty a
:| []) (InconsistentMetadata -> [MetadataObjId]
imObjectIds InconsistentMetadata
metadata)

instance ToJSON InconsistentMetadata where
  toJSON :: InconsistentMetadata -> Value
toJSON InconsistentMetadata
inconsistentMetadata = [Pair] -> Value
object ((Key
"reason" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InconsistentMetadata -> Text
imReason InconsistentMetadata
inconsistentMetadata) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: [Pair]
extraFields)
    where
      extraFields :: [Pair]
extraFields = case InconsistentMetadata
inconsistentMetadata of
        InconsistentObject Text
_ Maybe Value
message MetadataObject
metadata -> Maybe Value -> MetadataObject -> [Pair]
forall a. KeyValue a => Maybe Value -> MetadataObject -> [a]
metadataObjectFields Maybe Value
message MetadataObject
metadata
        ConflictingObjects Text
_ [MetadataObject]
metadatas ->
          [Key
"objects" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (MetadataObject -> Value) -> [MetadataObject] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ([Pair] -> Value
object ([Pair] -> Value)
-> (MetadataObject -> [Pair]) -> MetadataObject -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Value -> MetadataObject -> [Pair]
forall a. KeyValue a => Maybe Value -> MetadataObject -> [a]
metadataObjectFields Maybe Value
forall a. Maybe a
Nothing) [MetadataObject]
metadatas]
        DuplicateObjects MetadataObjId
objectId [Value]
definitions ->
          [ Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (MetadataObjId -> Text
moiTypeName MetadataObjId
objectId),
            Key
"definitions" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Value]
definitions
          ]
        DuplicateRestVariables Text
_ MetadataObject
md -> Maybe Value -> MetadataObject -> [Pair]
forall a. KeyValue a => Maybe Value -> MetadataObject -> [a]
metadataObjectFields Maybe Value
forall a. Maybe a
Nothing MetadataObject
md
        InvalidRestSegments Text
_ MetadataObject
md -> Maybe Value -> MetadataObject -> [Pair]
forall a. KeyValue a => Maybe Value -> MetadataObject -> [a]
metadataObjectFields Maybe Value
forall a. Maybe a
Nothing MetadataObject
md
        AmbiguousRestEndpoints Text
_ [MetadataObject]
mds -> [Key
"conflicts" Key -> [Value] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (MetadataObject -> Value) -> [MetadataObject] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map MetadataObject -> Value
_moDefinition [MetadataObject]
mds]
        ConflictingInheritedPermission RoleName
role InconsistentRoleEntity
inconsistentEntity ->
          [ Key
"name" Key -> RoleName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RoleName
role,
            Key
"type" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (Text
"inherited role permission inconsistency" :: Text),
            Key
"entity" Key -> InconsistentRoleEntity -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= InconsistentRoleEntity
inconsistentEntity
          ]

      metadataObjectFields :: Maybe Value -> MetadataObject -> [a]
metadataObjectFields (Maybe Value
maybeMessage :: Maybe Value) (MetadataObject MetadataObjId
objectId Value
definition) =
        [ Key
"type" Key -> Value -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (MetadataObjId -> Text
moiTypeName MetadataObjId
objectId),
          Key
"name" Key -> Value -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (MetadataObjId -> Text
moiName MetadataObjId
objectId),
          Key
"definition" Key -> Value -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
definition
        ]
          [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a] -> (Value -> [a]) -> Maybe Value -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Value
message -> [Key
"message" Key -> Value -> a
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
message]) Maybe Value
maybeMessage