module Hasura.RQL.DDL.Metadata
  ( runReplaceMetadata,
    runReplaceMetadataV2,
    runExportMetadata,
    runExportMetadataV2,
    runClearMetadata,
    runReloadMetadata,
    runDumpInternalState,
    runGetInconsistentMetadata,
    runDropInconsistentMetadata,
    runGetCatalogState,
    runSetCatalogState,
    runTestWebhookTransform,
    runSetMetricsConfig,
    runRemoveMetricsConfig,
    module Hasura.RQL.DDL.Metadata.Types,
  )
where

import Control.Lens (to, (.~), (^.), (^?))
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Aeson qualified as J
import Data.Aeson.Ordered qualified as AO
import Data.Attoparsec.Text qualified as AT
import Data.Bifunctor (first)
import Data.Bitraversable
import Data.ByteString.Lazy qualified as BL
import Data.CaseInsensitive qualified as CI
import Data.Environment qualified as Env
import Data.Has (Has, getter)
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd.Extended qualified as InsOrdHashMap
import Data.HashSet qualified as HS
import Data.List qualified as L
import Data.List.Extended qualified as L
import Data.Map.Strict qualified as Map
import Data.SerializableBlob qualified as SB
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Text.Extended (dquote, dquoteList, (<<>))
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Eventing.Backend (BackendEventTrigger (..))
import Hasura.Function.API
import Hasura.Logging qualified as HL
import Hasura.LogicalModel.API
import Hasura.Metadata.Class
import Hasura.NativeQuery.API
import Hasura.Prelude hiding (first)
import Hasura.RQL.DDL.Action
import Hasura.RQL.DDL.ApiLimit
import Hasura.RQL.DDL.ComputedField
import Hasura.RQL.DDL.CustomTypes
import Hasura.RQL.DDL.Endpoint
import Hasura.RQL.DDL.EventTrigger
import Hasura.RQL.DDL.InheritedRoles
import Hasura.RQL.DDL.Metadata.Types
import Hasura.RQL.DDL.Permission
import Hasura.RQL.DDL.Relationship
import Hasura.RQL.DDL.RemoteRelationship
import Hasura.RQL.DDL.ScheduledTrigger
import Hasura.RQL.DDL.Schema
import Hasura.RQL.DDL.Schema.Source
import Hasura.RQL.DDL.Warnings
import Hasura.RQL.DDL.Webhook.Transform
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.ApiLimit
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType (BackendType (..))
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Endpoint
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.EventTrigger qualified as ET
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.OpenTelemetry
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.ScheduledTrigger
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.RQL.Types.Source (unsafeSourceInfo)
import Hasura.RQL.Types.SourceCustomization
import Hasura.SQL.AnyBackend qualified as AB
import Hasura.SQL.BackendMap qualified as BackendMap
import Hasura.Server.Logging (MetadataLog (..))
import Hasura.Server.Types (MonadGetPolicies (..))
import Hasura.StoredProcedure.API (dropStoredProcedureInMetadata)
import Hasura.Table.Metadata (TableMetadata (..))
import Network.HTTP.Client.Transformable qualified as HTTP
import Network.Types.Extended

-- | Helper function to run the post drop source hook
postDropSourceHookHelper ::
  ( MonadError QErr m,
    MonadIO m,
    MonadBaseControl IO m,
    MonadReader r m,
    Has (HL.Logger HL.Hasura) r,
    MonadWarnings m
  ) =>
  SchemaCache ->
  SourceName ->
  AB.AnyBackend SourceMetadata ->
  m ()
postDropSourceHookHelper :: forall (m :: * -> *) r.
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadReader r m, Has (Logger Hasura) r, MonadWarnings m) =>
SchemaCache -> SourceName -> AnyBackend SourceMetadata -> m ()
postDropSourceHookHelper SchemaCache
oldSchemaCache SourceName
sourceName AnyBackend SourceMetadata
sourceMetadataBackend = do
  Logger Hasura
logger :: (HL.Logger HL.Hasura) <- (r -> Logger Hasura) -> m (Logger Hasura)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> Logger Hasura
forall a t. Has a t => t -> a
getter

  forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @BackendMetadata AnyBackend SourceMetadata
sourceMetadataBackend \(SourceMetadata b
oldSourceMetadata :: SourceMetadata b) -> do
    let sourceInfoMaybe :: Maybe (SourceInfo b)
sourceInfoMaybe = forall (b :: BackendType).
HasTag b =>
BackendSourceInfo -> Maybe (SourceInfo b)
unsafeSourceInfo @b (BackendSourceInfo -> Maybe (SourceInfo b))
-> Maybe BackendSourceInfo -> Maybe (SourceInfo b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< SourceName
-> HashMap SourceName BackendSourceInfo -> Maybe BackendSourceInfo
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup SourceName
sourceName (SchemaCache -> HashMap SourceName BackendSourceInfo
scSources SchemaCache
oldSchemaCache)
    case Maybe (SourceInfo b)
sourceInfoMaybe of
      Maybe (SourceInfo b)
Nothing -> do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (InsOrdHashMap TriggerName (EventTriggerConf b) -> Bool
forall a. InsOrdHashMap TriggerName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SourceMetadata b -> InsOrdHashMap TriggerName (EventTriggerConf b)
forall (b :: BackendType).
SourceMetadata b -> InsOrdHashMap TriggerName (EventTriggerConf b)
getTriggersMap SourceMetadata b
oldSourceMetadata)) do
          let message :: Text
message =
                Text
"Could not cleanup the source '"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName
                  SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"' while dropping it from the graphql-engine as it is inconsistent."
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Please consider cleaning the resources created by the graphql engine,"
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" refer https://hasura.io/docs/latest/graphql/core/event-triggers/remove-event-triggers/#clean-footprints-manually"
          Logger Hasura
-> forall a (m :: * -> *).
   (ToEngineLog a Hasura, MonadIO m) =>
   a -> m ()
forall impl.
Logger impl
-> forall a (m :: * -> *).
   (ToEngineLog a impl, MonadIO m) =>
   a -> m ()
HL.unLogger Logger Hasura
logger (MetadataLog -> m ()) -> MetadataLog -> m ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text -> Value -> MetadataLog
MetadataLog LogLevel
HL.LevelWarn Text
message Value
J.Null
          MetadataWarning -> m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> m ()) -> MetadataWarning -> m ()
forall a b. (a -> b) -> a -> b
$ WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCSourceCleanupFailed (SourceName -> MetadataObjId
MOSource SourceName
sourceName) Text
message
      Just SourceInfo b
sourceInfo -> SourceName -> SourceInfo b -> m ()
forall (m :: * -> *) r (b :: BackendType).
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadReader r m, Has (Logger Hasura) r, BackendMetadata b) =>
SourceName -> SourceInfo b -> m ()
runPostDropSourceHook SourceName
defaultSource SourceInfo b
sourceInfo

runClearMetadata ::
  forall m r.
  ( MonadIO m,
    CacheRWM m,
    MetadataM m,
    MonadMetadataStorage m,
    MonadBaseControl IO m,
    MonadReader r m,
    MonadError QErr m,
    Has (HL.Logger HL.Hasura) r,
    MonadEventLogCleanup m,
    MonadGetPolicies m
  ) =>
  ClearMetadata ->
  m EncJSON
runClearMetadata :: forall (m :: * -> *) r.
(MonadIO m, CacheRWM m, MetadataM m, MonadMetadataStorage m,
 MonadBaseControl IO m, MonadReader r m, MonadError QErr m,
 Has (Logger Hasura) r, MonadEventLogCleanup m,
 MonadGetPolicies m) =>
ClearMetadata -> m EncJSON
runClearMetadata ClearMetadata
_ = do
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata

  SchemaCache
oldSchemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

  -- We can infer whether the server is started with `--database-url` option
  -- (or corresponding env variable) by checking the existence of @'defaultSource'
  -- in current metadata.
  let maybeDefaultSourceMetadata :: Maybe (AnyBackend SourceMetadata)
maybeDefaultSourceMetadata = Metadata
metadata Metadata
-> Getting
     (First (AnyBackend SourceMetadata))
     Metadata
     (AnyBackend SourceMetadata)
-> Maybe (AnyBackend SourceMetadata)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Sources -> Const (First (AnyBackend SourceMetadata)) Sources)
-> Metadata -> Const (First (AnyBackend SourceMetadata)) Metadata
Lens' Metadata Sources
metaSources ((Sources -> Const (First (AnyBackend SourceMetadata)) Sources)
 -> Metadata -> Const (First (AnyBackend SourceMetadata)) Metadata)
-> ((AnyBackend SourceMetadata
     -> Const
          (First (AnyBackend SourceMetadata)) (AnyBackend SourceMetadata))
    -> Sources -> Const (First (AnyBackend SourceMetadata)) Sources)
-> Getting
     (First (AnyBackend SourceMetadata))
     Metadata
     (AnyBackend SourceMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
defaultSource ((BackendSourceMetadata
  -> Const (First (AnyBackend SourceMetadata)) BackendSourceMetadata)
 -> Sources -> Const (First (AnyBackend SourceMetadata)) Sources)
-> ((AnyBackend SourceMetadata
     -> Const
          (First (AnyBackend SourceMetadata)) (AnyBackend SourceMetadata))
    -> BackendSourceMetadata
    -> Const (First (AnyBackend SourceMetadata)) BackendSourceMetadata)
-> (AnyBackend SourceMetadata
    -> Const
         (First (AnyBackend SourceMetadata)) (AnyBackend SourceMetadata))
-> Sources
-> Const (First (AnyBackend SourceMetadata)) Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BackendSourceMetadata -> AnyBackend SourceMetadata)
-> (AnyBackend SourceMetadata
    -> Const
         (First (AnyBackend SourceMetadata)) (AnyBackend SourceMetadata))
-> BackendSourceMetadata
-> Const (First (AnyBackend SourceMetadata)) BackendSourceMetadata
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata
      emptyMetadata' :: Metadata
emptyMetadata' = case Maybe (AnyBackend SourceMetadata)
maybeDefaultSourceMetadata of
        Maybe (AnyBackend SourceMetadata)
Nothing -> Metadata
emptyMetadata
        Just AnyBackend SourceMetadata
exists ->
          -- If default postgres source is defined, we need to set metadata
          -- which contains only default source without any tables and functions.
          let emptyDefaultSource :: BackendSourceMetadata
emptyDefaultSource =
                forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @Backend AnyBackend SourceMetadata
exists \(SourceMetadata b
s :: SourceMetadata b) ->
                  AnyBackend SourceMetadata -> BackendSourceMetadata
BackendSourceMetadata
                    (AnyBackend SourceMetadata -> BackendSourceMetadata)
-> AnyBackend SourceMetadata -> BackendSourceMetadata
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend @b
                    (SourceMetadata b -> AnyBackend SourceMetadata)
-> SourceMetadata b -> AnyBackend SourceMetadata
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
SourceName
-> BackendSourceKind b
-> Tables b
-> Functions b
-> NativeQueries b
-> StoredProcedures b
-> LogicalModels b
-> SourceConnConfiguration b
-> Maybe QueryTagsConfig
-> SourceCustomization
-> Maybe (HealthCheckConfig b)
-> SourceMetadata b
SourceMetadata
                      @b
                      SourceName
defaultSource
                      (forall (b :: BackendType). SourceMetadata b -> BackendSourceKind b
_smKind @b SourceMetadata b
s)
                      InsOrdHashMap (TableName b) (TableMetadata b)
forall a. Monoid a => a
mempty
                      InsOrdHashMap (FunctionName b) (FunctionMetadata b)
forall a. Monoid a => a
mempty
                      NativeQueries b
forall a. Monoid a => a
mempty
                      InsOrdHashMap (FunctionName b) (StoredProcedureMetadata b)
forall a. Monoid a => a
mempty
                      LogicalModels b
forall a. Monoid a => a
mempty
                      (forall (b :: BackendType).
SourceMetadata b -> SourceConnConfiguration b
_smConfiguration @b SourceMetadata b
s)
                      Maybe QueryTagsConfig
forall a. Maybe a
Nothing
                      SourceCustomization
emptySourceCustomization
                      Maybe (HealthCheckConfig b)
forall a. Maybe a
Nothing
           in Metadata
emptyMetadata
                Metadata -> (Metadata -> Metadata) -> Metadata
forall a b. a -> (a -> b) -> b
& (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources
                ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> (Sources -> Sources) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SourceName -> BackendSourceMetadata -> Sources -> Sources
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert SourceName
defaultSource BackendSourceMetadata
emptyDefaultSource

  ([InconsistentMetadata]
_inconsistencies, MetadataWarnings
replaceMetadataWarnings) <- StateT MetadataWarnings m [InconsistentMetadata]
-> m ([InconsistentMetadata], MetadataWarnings)
forall (m :: * -> *) a.
StateT MetadataWarnings m a -> m (a, MetadataWarnings)
runMetadataWarnings (StateT MetadataWarnings m [InconsistentMetadata]
 -> m ([InconsistentMetadata], MetadataWarnings))
-> (ReplaceMetadataV1
    -> StateT MetadataWarnings m [InconsistentMetadata])
-> ReplaceMetadataV1
-> m ([InconsistentMetadata], MetadataWarnings)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplaceMetadataV2
-> StateT MetadataWarnings m [InconsistentMetadata]
forall (m :: * -> *) r.
(CacheRWM m, MetadataM m, MonadIO m, MonadBaseControl IO m,
 MonadMetadataStorage m, MonadReader r m, MonadError QErr m,
 Has (Logger Hasura) r, MonadEventLogCleanup m, MonadWarnings m,
 MonadGetPolicies m) =>
ReplaceMetadataV2 -> m [InconsistentMetadata]
runReplaceMetadataV2' (ReplaceMetadataV2
 -> StateT MetadataWarnings m [InconsistentMetadata])
-> (ReplaceMetadataV1 -> ReplaceMetadataV2)
-> ReplaceMetadataV1
-> StateT MetadataWarnings m [InconsistentMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowInconsistentMetadata
-> AllowWarnings -> ReplaceMetadataV1 -> ReplaceMetadataV2
ReplaceMetadataV2 AllowInconsistentMetadata
NoAllowInconsistentMetadata AllowWarnings
AllowWarnings (ReplaceMetadataV1 -> m ([InconsistentMetadata], MetadataWarnings))
-> ReplaceMetadataV1
-> m ([InconsistentMetadata], MetadataWarnings)
forall a b. (a -> b) -> a -> b
$ Metadata -> ReplaceMetadataV1
RMWithSources Metadata
emptyMetadata'

  -- Cleanup the default source explicitly because in the `runReplaceMetadataV1`
  -- call it won't be considered as a dropped source because we artificially add
  -- a empty source metadata for the default source metadata. So, for `runReplaceMetadataV1`
  -- the default source will not be a dropped source and hence there will not be
  -- any post drop source action on it. So, here we expicitly do the post drop source
  -- action for the default source, if it existed in the metadata.
  (Maybe ()
_, MetadataWarnings
dropSourceHookWarnings) <- StateT MetadataWarnings m (Maybe ())
-> m (Maybe (), MetadataWarnings)
forall (m :: * -> *) a.
StateT MetadataWarnings m a -> m (a, MetadataWarnings)
runMetadataWarnings (StateT MetadataWarnings m (Maybe ())
 -> m (Maybe (), MetadataWarnings))
-> StateT MetadataWarnings m (Maybe ())
-> m (Maybe (), MetadataWarnings)
forall a b. (a -> b) -> a -> b
$ Maybe (AnyBackend SourceMetadata)
-> (AnyBackend SourceMetadata -> StateT MetadataWarnings m ())
-> StateT MetadataWarnings m (Maybe ())
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe (AnyBackend SourceMetadata)
maybeDefaultSourceMetadata ((AnyBackend SourceMetadata -> StateT MetadataWarnings m ())
 -> StateT MetadataWarnings m (Maybe ()))
-> (AnyBackend SourceMetadata -> StateT MetadataWarnings m ())
-> StateT MetadataWarnings m (Maybe ())
forall a b. (a -> b) -> a -> b
$ SchemaCache
-> SourceName
-> AnyBackend SourceMetadata
-> StateT MetadataWarnings m ()
forall (m :: * -> *) r.
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadReader r m, Has (Logger Hasura) r, MonadWarnings m) =>
SchemaCache -> SourceName -> AnyBackend SourceMetadata -> m ()
postDropSourceHookHelper SchemaCache
oldSchemaCache SourceName
defaultSource
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ MetadataWarnings -> EncJSON
mkSuccessResponseWithWarnings (MetadataWarnings
replaceMetadataWarnings MetadataWarnings -> MetadataWarnings -> MetadataWarnings
forall a. Semigroup a => a -> a -> a
<> MetadataWarnings
dropSourceHookWarnings)

{- Note [Cleanup for dropped triggers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
There was an issue (https://github.com/hasura/graphql-engine/issues/5461)
fixed (via https://github.com/hasura/graphql-engine/pull/6137) related to
event triggers while replacing metadata in the catalog prior to metadata
separation. The metadata separation solves the issue naturally, since the
'hdb_catalog.event_triggers' table is no more in use and new/updated event
triggers are processed in building schema cache. But we need to drop the
database trigger and archive events for dropped event triggers. This is handled
explicitly in @'runReplaceMetadata' function.
-}

-- | Replace the 'current metadata' with the 'new metadata'
-- The 'new metadata' might come via the 'Import Metadata' in console
runReplaceMetadata ::
  ( CacheRWM m,
    MetadataM m,
    MonadIO m,
    MonadBaseControl IO m,
    MonadMetadataStorage m,
    MonadReader r m,
    MonadError QErr m,
    Has (HL.Logger HL.Hasura) r,
    MonadEventLogCleanup m,
    MonadGetPolicies m
  ) =>
  ReplaceMetadata ->
  m EncJSON
runReplaceMetadata :: forall (m :: * -> *) r.
(CacheRWM m, MetadataM m, MonadIO m, MonadBaseControl IO m,
 MonadMetadataStorage m, MonadReader r m, MonadError QErr m,
 Has (Logger Hasura) r, MonadEventLogCleanup m,
 MonadGetPolicies m) =>
ReplaceMetadata -> m EncJSON
runReplaceMetadata = \case
  RMReplaceMetadataV1 ReplaceMetadataV1
v1args -> ReplaceMetadataV1 -> m EncJSON
forall (m :: * -> *) r.
(CacheRWM m, MetadataM m, MonadIO m, MonadBaseControl IO m,
 MonadMetadataStorage m, MonadReader r m, MonadError QErr m,
 Has (Logger Hasura) r, MonadEventLogCleanup m,
 MonadGetPolicies m) =>
ReplaceMetadataV1 -> m EncJSON
runReplaceMetadataV1 ReplaceMetadataV1
v1args
  RMReplaceMetadataV2 ReplaceMetadataV2
v2args -> ReplaceMetadataV2 -> m EncJSON
forall (m :: * -> *) r.
(CacheRWM m, MetadataM m, MonadIO m, MonadBaseControl IO m,
 MonadMetadataStorage m, MonadReader r m, MonadError QErr m,
 Has (Logger Hasura) r, MonadEventLogCleanup m,
 MonadGetPolicies m) =>
ReplaceMetadataV2 -> m EncJSON
runReplaceMetadataV2 ReplaceMetadataV2
v2args

runReplaceMetadataV1 ::
  ( CacheRWM m,
    MetadataM m,
    MonadIO m,
    MonadBaseControl IO m,
    MonadMetadataStorage m,
    MonadReader r m,
    MonadError QErr m,
    Has (HL.Logger HL.Hasura) r,
    MonadEventLogCleanup m,
    MonadGetPolicies m
  ) =>
  ReplaceMetadataV1 ->
  m EncJSON
runReplaceMetadataV1 :: forall (m :: * -> *) r.
(CacheRWM m, MetadataM m, MonadIO m, MonadBaseControl IO m,
 MonadMetadataStorage m, MonadReader r m, MonadError QErr m,
 Has (Logger Hasura) r, MonadEventLogCleanup m,
 MonadGetPolicies m) =>
ReplaceMetadataV1 -> m EncJSON
runReplaceMetadataV1 =
  ((MetadataWarnings -> EncJSON
mkSuccessResponseWithWarnings (MetadataWarnings -> EncJSON)
-> (([InconsistentMetadata], MetadataWarnings) -> MetadataWarnings)
-> ([InconsistentMetadata], MetadataWarnings)
-> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([InconsistentMetadata], MetadataWarnings) -> MetadataWarnings
forall a b. (a, b) -> b
snd) (([InconsistentMetadata], MetadataWarnings) -> EncJSON)
-> m ([InconsistentMetadata], MetadataWarnings) -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (m ([InconsistentMetadata], MetadataWarnings) -> m EncJSON)
-> (ReplaceMetadataV1
    -> m ([InconsistentMetadata], MetadataWarnings))
-> ReplaceMetadataV1
-> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT MetadataWarnings m [InconsistentMetadata]
-> m ([InconsistentMetadata], MetadataWarnings)
forall (m :: * -> *) a.
StateT MetadataWarnings m a -> m (a, MetadataWarnings)
runMetadataWarnings (StateT MetadataWarnings m [InconsistentMetadata]
 -> m ([InconsistentMetadata], MetadataWarnings))
-> (ReplaceMetadataV1
    -> StateT MetadataWarnings m [InconsistentMetadata])
-> ReplaceMetadataV1
-> m ([InconsistentMetadata], MetadataWarnings)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplaceMetadataV2
-> StateT MetadataWarnings m [InconsistentMetadata]
forall (m :: * -> *) r.
(CacheRWM m, MetadataM m, MonadIO m, MonadBaseControl IO m,
 MonadMetadataStorage m, MonadReader r m, MonadError QErr m,
 Has (Logger Hasura) r, MonadEventLogCleanup m, MonadWarnings m,
 MonadGetPolicies m) =>
ReplaceMetadataV2 -> m [InconsistentMetadata]
runReplaceMetadataV2' (ReplaceMetadataV2
 -> StateT MetadataWarnings m [InconsistentMetadata])
-> (ReplaceMetadataV1 -> ReplaceMetadataV2)
-> ReplaceMetadataV1
-> StateT MetadataWarnings m [InconsistentMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowInconsistentMetadata
-> AllowWarnings -> ReplaceMetadataV1 -> ReplaceMetadataV2
ReplaceMetadataV2 AllowInconsistentMetadata
NoAllowInconsistentMetadata AllowWarnings
AllowWarnings

runReplaceMetadataV2 ::
  forall m r.
  ( CacheRWM m,
    MetadataM m,
    MonadIO m,
    MonadBaseControl IO m,
    MonadMetadataStorage m,
    MonadReader r m,
    MonadError QErr m,
    Has (HL.Logger HL.Hasura) r,
    MonadEventLogCleanup m,
    MonadGetPolicies m
  ) =>
  ReplaceMetadataV2 ->
  m EncJSON
runReplaceMetadataV2 :: forall (m :: * -> *) r.
(CacheRWM m, MetadataM m, MonadIO m, MonadBaseControl IO m,
 MonadMetadataStorage m, MonadReader r m, MonadError QErr m,
 Has (Logger Hasura) r, MonadEventLogCleanup m,
 MonadGetPolicies m) =>
ReplaceMetadataV2 -> m EncJSON
runReplaceMetadataV2 ReplaceMetadataV2
replaceMetadataArgs = do
  ([InconsistentMetadata]
inconsistentObjects, MetadataWarnings
metadataWarnings) <- StateT MetadataWarnings m [InconsistentMetadata]
-> m ([InconsistentMetadata], MetadataWarnings)
forall (m :: * -> *) a.
StateT MetadataWarnings m a -> m (a, MetadataWarnings)
runMetadataWarnings (StateT MetadataWarnings m [InconsistentMetadata]
 -> m ([InconsistentMetadata], MetadataWarnings))
-> StateT MetadataWarnings m [InconsistentMetadata]
-> m ([InconsistentMetadata], MetadataWarnings)
forall a b. (a -> b) -> a -> b
$ (ReplaceMetadataV2
-> StateT MetadataWarnings m [InconsistentMetadata]
forall (m :: * -> *) r.
(CacheRWM m, MetadataM m, MonadIO m, MonadBaseControl IO m,
 MonadMetadataStorage m, MonadReader r m, MonadError QErr m,
 Has (Logger Hasura) r, MonadEventLogCleanup m, MonadWarnings m,
 MonadGetPolicies m) =>
ReplaceMetadataV2 -> m [InconsistentMetadata]
runReplaceMetadataV2' ReplaceMetadataV2
replaceMetadataArgs)
  case ReplaceMetadataV2 -> AllowWarnings
_rmv2AllowWarningss ReplaceMetadataV2
replaceMetadataArgs of
    AllowWarnings
AllowWarnings -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    AllowWarnings
DisallowWarnings ->
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MetadataWarnings -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null MetadataWarnings
metadataWarnings)
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> Value -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail (Text -> Code
CustomCode Text
"metadata-warnings") Text
"failed due to metadata warnings" (MetadataWarnings -> Value
forall a. ToJSON a => a -> Value
J.toJSON MetadataWarnings
metadataWarnings)
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (Value -> EncJSON) -> Value -> EncJSON
forall a b. (a -> b) -> a -> b
$ [InconsistentMetadata] -> MetadataWarnings -> Value
formatInconsistentObjs [InconsistentMetadata]
inconsistentObjects MetadataWarnings
metadataWarnings

runReplaceMetadataV2' ::
  forall m r.
  ( CacheRWM m,
    MetadataM m,
    MonadIO m,
    MonadBaseControl IO m,
    MonadMetadataStorage m,
    MonadReader r m,
    MonadError QErr m,
    Has (HL.Logger HL.Hasura) r,
    MonadEventLogCleanup m,
    MonadWarnings m,
    MonadGetPolicies m
  ) =>
  ReplaceMetadataV2 ->
  m [InconsistentMetadata]
runReplaceMetadataV2' :: forall (m :: * -> *) r.
(CacheRWM m, MetadataM m, MonadIO m, MonadBaseControl IO m,
 MonadMetadataStorage m, MonadReader r m, MonadError QErr m,
 Has (Logger Hasura) r, MonadEventLogCleanup m, MonadWarnings m,
 MonadGetPolicies m) =>
ReplaceMetadataV2 -> m [InconsistentMetadata]
runReplaceMetadataV2' ReplaceMetadataV2 {AllowWarnings
ReplaceMetadataV1
AllowInconsistentMetadata
_rmv2AllowWarningss :: ReplaceMetadataV2 -> AllowWarnings
_rmv2AllowInconsistentMetadata :: AllowInconsistentMetadata
_rmv2AllowWarningss :: AllowWarnings
_rmv2Metadata :: ReplaceMetadataV1
_rmv2AllowInconsistentMetadata :: ReplaceMetadataV2 -> AllowInconsistentMetadata
_rmv2Metadata :: ReplaceMetadataV2 -> ReplaceMetadataV1
..} = do
  Logger Hasura
logger :: (HL.Logger HL.Hasura) <- (r -> Logger Hasura) -> m (Logger Hasura)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks r -> Logger Hasura
forall a t. Has a t => t -> a
getter
  -- we drop all the future cron trigger events before inserting the new metadata
  -- and re-populating future cron events below
  let introspectionDisabledRoles :: SetGraphqlIntrospectionOptions
introspectionDisabledRoles =
        case ReplaceMetadataV1
_rmv2Metadata of
          RMWithSources Metadata
m -> Metadata -> SetGraphqlIntrospectionOptions
_metaSetGraphqlIntrospectionOptions Metadata
m
          RMWithoutSources MetadataNoSources
_ -> SetGraphqlIntrospectionOptions
forall a. Monoid a => a
mempty
  Metadata
oldMetadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  SchemaCache
oldSchemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

  (CronTriggers
cronTriggersMetadata, HashMap TriggerName CronTriggerMetadata
cronTriggersToBeAdded) <- Metadata
-> m (CronTriggers, HashMap TriggerName CronTriggerMetadata)
processCronTriggers Metadata
oldMetadata

  Metadata
metadata <- case ReplaceMetadataV1
_rmv2Metadata of
    RMWithSources Metadata
m -> Metadata -> m Metadata
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata -> m Metadata) -> Metadata -> m Metadata
forall a b. (a -> b) -> a -> b
$ Metadata
m {_metaCronTriggers :: CronTriggers
_metaCronTriggers = CronTriggers
cronTriggersMetadata}
    RMWithoutSources MetadataNoSources {QueryCollections
MetadataAllowlist
RemoteSchemas
Tables ('Postgres 'Vanilla)
Functions ('Postgres 'Vanilla)
CronTriggers
Actions
CustomTypes
_mnsTables :: Tables ('Postgres 'Vanilla)
_mnsFunctions :: Functions ('Postgres 'Vanilla)
_mnsRemoteSchemas :: RemoteSchemas
_mnsQueryCollections :: QueryCollections
_mnsAllowlist :: MetadataAllowlist
_mnsCustomTypes :: CustomTypes
_mnsActions :: Actions
_mnsCronTriggers :: CronTriggers
_mnsTables :: MetadataNoSources -> Tables ('Postgres 'Vanilla)
_mnsFunctions :: MetadataNoSources -> Functions ('Postgres 'Vanilla)
_mnsRemoteSchemas :: MetadataNoSources -> RemoteSchemas
_mnsQueryCollections :: MetadataNoSources -> QueryCollections
_mnsAllowlist :: MetadataNoSources -> MetadataAllowlist
_mnsCustomTypes :: MetadataNoSources -> CustomTypes
_mnsActions :: MetadataNoSources -> Actions
_mnsCronTriggers :: MetadataNoSources -> CronTriggers
..} -> do
      let maybeDefaultSourceMetadata :: Maybe (SourceMetadata ('Postgres 'Vanilla))
maybeDefaultSourceMetadata = Metadata
oldMetadata Metadata
-> Getting
     (First (SourceMetadata ('Postgres 'Vanilla)))
     Metadata
     (SourceMetadata ('Postgres 'Vanilla))
-> Maybe (SourceMetadata ('Postgres 'Vanilla))
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Sources
 -> Const (First (SourceMetadata ('Postgres 'Vanilla))) Sources)
-> Metadata
-> Const (First (SourceMetadata ('Postgres 'Vanilla))) Metadata
Lens' Metadata Sources
metaSources ((Sources
  -> Const (First (SourceMetadata ('Postgres 'Vanilla))) Sources)
 -> Metadata
 -> Const (First (SourceMetadata ('Postgres 'Vanilla))) Metadata)
-> ((SourceMetadata ('Postgres 'Vanilla)
     -> Const
          (First (SourceMetadata ('Postgres 'Vanilla)))
          (SourceMetadata ('Postgres 'Vanilla)))
    -> Sources
    -> Const (First (SourceMetadata ('Postgres 'Vanilla))) Sources)
-> Getting
     (First (SourceMetadata ('Postgres 'Vanilla)))
     Metadata
     (SourceMetadata ('Postgres 'Vanilla))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
defaultSource ((BackendSourceMetadata
  -> Const
       (First (SourceMetadata ('Postgres 'Vanilla)))
       BackendSourceMetadata)
 -> Sources
 -> Const (First (SourceMetadata ('Postgres 'Vanilla))) Sources)
-> ((SourceMetadata ('Postgres 'Vanilla)
     -> Const
          (First (SourceMetadata ('Postgres 'Vanilla)))
          (SourceMetadata ('Postgres 'Vanilla)))
    -> BackendSourceMetadata
    -> Const
         (First (SourceMetadata ('Postgres 'Vanilla)))
         BackendSourceMetadata)
-> (SourceMetadata ('Postgres 'Vanilla)
    -> Const
         (First (SourceMetadata ('Postgres 'Vanilla)))
         (SourceMetadata ('Postgres 'Vanilla)))
-> Sources
-> Const (First (SourceMetadata ('Postgres 'Vanilla))) Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceMetadata ('Postgres 'Vanilla)
 -> Const
      (First (SourceMetadata ('Postgres 'Vanilla)))
      (SourceMetadata ('Postgres 'Vanilla)))
-> BackendSourceMetadata
-> Const
     (First (SourceMetadata ('Postgres 'Vanilla))) BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
Prism' BackendSourceMetadata (SourceMetadata ('Postgres 'Vanilla))
toSourceMetadata
      SourceMetadata ('Postgres 'Vanilla)
defaultSourceMetadata <-
        Maybe (SourceMetadata ('Postgres 'Vanilla))
-> m (SourceMetadata ('Postgres 'Vanilla))
-> m (SourceMetadata ('Postgres 'Vanilla))
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
onNothing Maybe (SourceMetadata ('Postgres 'Vanilla))
maybeDefaultSourceMetadata
          (m (SourceMetadata ('Postgres 'Vanilla))
 -> m (SourceMetadata ('Postgres 'Vanilla)))
-> m (SourceMetadata ('Postgres 'Vanilla))
-> m (SourceMetadata ('Postgres 'Vanilla))
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m (SourceMetadata ('Postgres 'Vanilla))
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported Text
"cannot import metadata without sources since no default source is defined"
      let newDefaultSourceMetadata :: BackendSourceMetadata
newDefaultSourceMetadata =
            AnyBackend SourceMetadata -> BackendSourceMetadata
BackendSourceMetadata
              (AnyBackend SourceMetadata -> BackendSourceMetadata)
-> AnyBackend SourceMetadata -> BackendSourceMetadata
forall a b. (a -> b) -> a -> b
$ SourceMetadata ('Postgres 'Vanilla) -> AnyBackend SourceMetadata
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
                SourceMetadata ('Postgres 'Vanilla)
defaultSourceMetadata
                  { _smTables :: Tables ('Postgres 'Vanilla)
_smTables = Tables ('Postgres 'Vanilla)
_mnsTables,
                    _smFunctions :: Functions ('Postgres 'Vanilla)
_smFunctions = Functions ('Postgres 'Vanilla)
_mnsFunctions
                  }
      Metadata -> m Metadata
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        (Metadata -> m Metadata) -> Metadata -> m Metadata
forall a b. (a -> b) -> a -> b
$ Sources
-> RemoteSchemas
-> QueryCollections
-> MetadataAllowlist
-> CustomTypes
-> Actions
-> CronTriggers
-> Endpoints
-> ApiLimit
-> MetricsConfig
-> InheritedRoles
-> SetGraphqlIntrospectionOptions
-> Network
-> BackendMap BackendConfigWrapper
-> OpenTelemetryConfig
-> Metadata
Metadata
          (SourceName -> BackendSourceMetadata -> Sources
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrdHashMap.singleton SourceName
defaultSource BackendSourceMetadata
newDefaultSourceMetadata)
          RemoteSchemas
_mnsRemoteSchemas
          QueryCollections
_mnsQueryCollections
          MetadataAllowlist
_mnsAllowlist
          CustomTypes
_mnsCustomTypes
          Actions
_mnsActions
          CronTriggers
cronTriggersMetadata
          (Metadata -> Endpoints
_metaRestEndpoints Metadata
oldMetadata)
          ApiLimit
emptyApiLimit
          MetricsConfig
emptyMetricsConfig
          InheritedRoles
forall a. Monoid a => a
mempty
          SetGraphqlIntrospectionOptions
introspectionDisabledRoles
          Network
emptyNetwork
          BackendMap BackendConfigWrapper
forall a. Monoid a => a
mempty
          OpenTelemetryConfig
emptyOpenTelemetryConfig

  let (Sources
oldSources, Sources
newSources) = (Metadata -> Sources
_metaSources Metadata
oldMetadata, Metadata -> Sources
_metaSources Metadata
metadata)

  -- Check for duplicate and illegal trigger names in the new source metadata
  [(SourceName, BackendSourceMetadata)]
-> ((SourceName, BackendSourceMetadata) -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Sources -> [(SourceName, BackendSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList Sources
newSources) (((SourceName, BackendSourceMetadata) -> m ()) -> m ())
-> ((SourceName, BackendSourceMetadata) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(SourceName
source, BackendSourceMetadata
newBackendSourceMetadata) -> do
    Maybe BackendSourceMetadata
-> (BackendSourceMetadata -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (SourceName -> Sources -> Maybe BackendSourceMetadata
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup SourceName
source Sources
oldSources) ((BackendSourceMetadata -> m ()) -> m ())
-> (BackendSourceMetadata -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \BackendSourceMetadata
oldBackendSourceMetadata ->
      forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @BackendEventTrigger (BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata BackendSourceMetadata
newBackendSourceMetadata) \(SourceMetadata b
newSourceMetadata :: SourceMetadata b) -> do
        let newTriggerNames :: [TriggerName]
newTriggerNames = (TableMetadata b -> [TriggerName])
-> [TableMetadata b] -> [TriggerName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (InsOrdHashMap TriggerName (EventTriggerConf b) -> [TriggerName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys (InsOrdHashMap TriggerName (EventTriggerConf b) -> [TriggerName])
-> (TableMetadata b
    -> InsOrdHashMap TriggerName (EventTriggerConf b))
-> TableMetadata b
-> [TriggerName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TableMetadata b -> InsOrdHashMap TriggerName (EventTriggerConf b)
forall (b :: BackendType). TableMetadata b -> EventTriggers b
_tmEventTriggers) (InsOrdHashMap (TableName b) (TableMetadata b) -> [TableMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems (InsOrdHashMap (TableName b) (TableMetadata b)
 -> [TableMetadata b])
-> InsOrdHashMap (TableName b) (TableMetadata b)
-> [TableMetadata b]
forall a b. (a -> b) -> a -> b
$ SourceMetadata b -> InsOrdHashMap (TableName b) (TableMetadata b)
forall (b :: BackendType). SourceMetadata b -> Tables b
_smTables SourceMetadata b
newSourceMetadata)
            duplicateTriggerNamesInNewMetadata :: [TriggerName]
duplicateTriggerNamesInNewMetadata = [TriggerName]
newTriggerNames [TriggerName] -> [TriggerName] -> [TriggerName]
forall a. Eq a => [a] -> [a] -> [a]
\\ ([TriggerName] -> [TriggerName]
forall a. Ord a => [a] -> [a]
L.uniques [TriggerName]
newTriggerNames)
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TriggerName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TriggerName]
duplicateTriggerNamesInNewMetadata) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text
"Event trigger with duplicate names not allowed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t (f :: * -> *). (ToTxt t, Foldable f) => f t -> Text
dquoteList ((TriggerName -> Text) -> [TriggerName] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TriggerName -> Text
triggerNameToTxt [TriggerName]
duplicateTriggerNamesInNewMetadata))
        BackendSourceMetadata
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    SourceMetadata b -> m ())
-> m ()
forall {r}.
BackendSourceMetadata
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    SourceMetadata b -> r)
-> r
dispatch BackendSourceMetadata
oldBackendSourceMetadata \SourceMetadata b
oldSourceMetadata -> do
          let oldTriggersMap :: InsOrdHashMap TriggerName (EventTriggerConf b)
oldTriggersMap = SourceMetadata b -> InsOrdHashMap TriggerName (EventTriggerConf b)
forall (b :: BackendType).
SourceMetadata b -> InsOrdHashMap TriggerName (EventTriggerConf b)
getTriggersMap SourceMetadata b
oldSourceMetadata
              addedTriggerNames :: [(TableName b, TriggerName)]
addedTriggerNames = ((TableName b, TriggerName) -> Bool)
-> [(TableName b, TriggerName)] -> [(TableName b, TriggerName)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(TableName b
_, TriggerName
n) -> Bool -> Bool
not (TriggerName
-> InsOrdHashMap TriggerName (EventTriggerConf b) -> Bool
forall k a. (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool
InsOrdHashMap.member TriggerName
n InsOrdHashMap TriggerName (EventTriggerConf b)
oldTriggersMap)) ([(TableName b, TriggerName)] -> [(TableName b, TriggerName)])
-> [(TableName b, TriggerName)] -> [(TableName b, TriggerName)]
forall a b. (a -> b) -> a -> b
$ SourceMetadata b -> [(TableName b, TriggerName)]
forall (b :: BackendType).
SourceMetadata b -> [(TableName b, TriggerName)]
getSourceTableAndTriggers SourceMetadata b
newSourceMetadata
              newIllegalTriggerNamesInNewMetadata :: [(TableName b, TriggerName)]
newIllegalTriggerNamesInNewMetadata = ((TableName b, TriggerName) -> Bool)
-> [(TableName b, TriggerName)] -> [(TableName b, TriggerName)]
forall a. (a -> Bool) -> [a] -> [a]
filter (TriggerName -> Bool
isIllegalTriggerName (TriggerName -> Bool)
-> ((TableName b, TriggerName) -> TriggerName)
-> (TableName b, TriggerName)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableName b, TriggerName) -> TriggerName
forall a b. (a, b) -> b
snd) [(TableName b, TriggerName)]
addedTriggerNames
              mkEventTriggerObjID :: TableName b -> TriggerName -> MetadataObjId
mkEventTriggerObjID TableName b
tableName TriggerName
triggerName = 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
$ forall (b :: BackendType).
TableName b -> TableMetadataObjId -> SourceMetadataObjId b
SMOTableObj @b TableName b
tableName (TableMetadataObjId -> SourceMetadataObjId b)
-> TableMetadataObjId -> SourceMetadataObjId b
forall a b. (a -> b) -> a -> b
$ TriggerName -> TableMetadataObjId
MTOTrigger TriggerName
triggerName
              mkIllegalEventTriggerNameWarning :: (TableName b, TriggerName) -> MetadataWarning
mkIllegalEventTriggerNameWarning (TableName b
tableName, TriggerName
triggerName) =
                -- TODO: capture the path as well
                WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCIllegalEventTriggerName (TableName b -> TriggerName -> MetadataObjId
mkEventTriggerObjID TableName b
tableName TriggerName
triggerName)
                  (Text -> MetadataWarning) -> Text -> MetadataWarning
forall a b. (a -> b) -> a -> b
$ Text
"The event trigger with name "
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall t. ToTxt t => t -> Text
dquote (TriggerName -> Text
triggerNameToTxt TriggerName
triggerName)
                  Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" may not work as expected, hasura suggests to use only alphanumeric, underscore and hyphens in an event trigger name"

          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(TableName b, TriggerName)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(TableName b, TriggerName)]
newIllegalTriggerNamesInNewMetadata) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            ((TableName b, TriggerName) -> m ())
-> [(TableName b, TriggerName)] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (MetadataWarning -> m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> m ())
-> ((TableName b, TriggerName) -> MetadataWarning)
-> (TableName b, TriggerName)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TableName b, TriggerName) -> MetadataWarning
mkIllegalEventTriggerNameWarning) [(TableName b, TriggerName)]
newIllegalTriggerNamesInNewMetadata

  -- Throw a warning if the API time limit exceeds the system limit
  let userTimeLimitAPILimit :: Maybe MaxTime
userTimeLimitAPILimit = Limit MaxTime -> MaxTime
forall a. Limit a -> a
_lGlobal (Limit MaxTime -> MaxTime)
-> Maybe (Limit MaxTime) -> Maybe MaxTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiLimit -> Maybe (Limit MaxTime)
_alTimeLimit (Metadata -> ApiLimit
_metaApiLimits Metadata
metadata)
  Either MetadataWarning ()
warningResultEither <- Maybe MaxTime -> m (Either MetadataWarning ())
forall (m :: * -> *).
MonadGetPolicies m =>
Maybe MaxTime -> m (Either MetadataWarning ())
compareTimeLimitWith Maybe MaxTime
userTimeLimitAPILimit
  case Either MetadataWarning ()
warningResultEither of
    Left MetadataWarning
warning -> MetadataWarning -> m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn MetadataWarning
warning
    Right ()
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  let cacheInvalidations :: CacheInvalidations
cacheInvalidations =
        CacheInvalidations
          { ciMetadata :: Bool
ciMetadata = Bool
False,
            ciRemoteSchemas :: HashSet RemoteSchemaName
ciRemoteSchemas = HashSet RemoteSchemaName
forall a. Monoid a => a
mempty,
            ciSources :: HashSet SourceName
ciSources = [SourceName] -> HashSet SourceName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([SourceName] -> HashSet SourceName)
-> [SourceName] -> HashSet SourceName
forall a b. (a -> b) -> a -> b
$ Sources -> [SourceName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys Sources
newSources,
            ciDataConnectors :: HashSet DataConnectorName
ciDataConnectors = HashSet DataConnectorName
forall a. Monoid a => a
mempty
          }

  -- put the new metadata in the state managed by the `MetadataT`
  Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata Metadata
metadata

  -- build the schema cache with the new metadata
  CacheInvalidations -> MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
CacheInvalidations -> MetadataModifier -> m ()
buildSchemaCacheWithInvalidations CacheInvalidations
cacheInvalidations MetadataModifier
forall a. Monoid a => a
mempty

  case AllowInconsistentMetadata
_rmv2AllowInconsistentMetadata of
    AllowInconsistentMetadata
AllowInconsistentMetadata -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    AllowInconsistentMetadata
NoAllowInconsistentMetadata -> m ()
forall (m :: * -> *). (QErrM m, CacheRWM m) => m ()
throwOnInconsistencies

  -- populate future cron events for all the new cron triggers that are imported
  HashMap TriggerName CronTriggerMetadata
-> (CronTriggerMetadata -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ HashMap TriggerName CronTriggerMetadata
cronTriggersToBeAdded ((CronTriggerMetadata -> m ()) -> m ())
-> (CronTriggerMetadata -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \CronTriggerMetadata {Bool
[HeaderConf]
Maybe Text
Maybe Value
Maybe RequestTransform
Maybe MetadataResponseTransform
CronSchedule
InputWebhook
TriggerName
STRetryConf
ctName :: TriggerName
ctWebhook :: InputWebhook
ctSchedule :: CronSchedule
ctPayload :: Maybe Value
ctRetryConf :: STRetryConf
ctHeaders :: [HeaderConf]
ctIncludeInMetadata :: Bool
ctComment :: Maybe Text
ctRequestTransform :: Maybe RequestTransform
ctResponseTransform :: Maybe MetadataResponseTransform
ctName :: CronTriggerMetadata -> TriggerName
ctWebhook :: CronTriggerMetadata -> InputWebhook
ctSchedule :: CronTriggerMetadata -> CronSchedule
ctPayload :: CronTriggerMetadata -> Maybe Value
ctRetryConf :: CronTriggerMetadata -> STRetryConf
ctHeaders :: CronTriggerMetadata -> [HeaderConf]
ctIncludeInMetadata :: CronTriggerMetadata -> Bool
ctComment :: CronTriggerMetadata -> Maybe Text
ctRequestTransform :: CronTriggerMetadata -> Maybe RequestTransform
ctResponseTransform :: CronTriggerMetadata -> Maybe MetadataResponseTransform
..} ->
    CronSchedule -> TriggerName -> m ()
forall (m :: * -> *).
(MonadIO m, MonadError QErr m, MonadMetadataStorage m) =>
CronSchedule -> TriggerName -> m ()
populateInitialCronTriggerEvents CronSchedule
ctSchedule TriggerName
ctName

  -- See Note [Cleanup for dropped triggers]
  Logger Hasura -> SchemaCache -> Sources -> Sources -> m ()
dropSourceSQLTriggers Logger Hasura
logger SchemaCache
oldSchemaCache (Metadata -> Sources
_metaSources Metadata
oldMetadata) (Metadata -> Sources
_metaSources Metadata
metadata)

  SchemaCache
newSchemaCache <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

  Logger Hasura
-> Sources -> Sources -> SchemaCache -> m (Either QErr ())
forall (m :: * -> *).
MonadEventLogCleanup m =>
Logger Hasura
-> Sources -> Sources -> SchemaCache -> m (Either QErr ())
updateTriggerCleanupSchedules Logger Hasura
logger (Metadata -> Sources
_metaSources Metadata
oldMetadata) (Metadata -> Sources
_metaSources Metadata
metadata) SchemaCache
newSchemaCache
    m (Either QErr ()) -> (Either QErr () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either QErr () -> (QErr -> m ()) -> m ()
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` QErr -> m ()
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError)

  let droppedSources :: Sources
droppedSources = Sources -> Sources -> Sources
forall k v w.
(Eq k, Hashable k) =>
InsOrdHashMap k v -> InsOrdHashMap k w -> InsOrdHashMap k v
InsOrdHashMap.difference Sources
oldSources Sources
newSources

  -- Clean up the sources that are not present in the new metadata
  [(SourceName, BackendSourceMetadata)]
-> ((SourceName, BackendSourceMetadata) -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Sources -> [(SourceName, BackendSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList Sources
droppedSources) (((SourceName, BackendSourceMetadata) -> m ()) -> m ())
-> ((SourceName, BackendSourceMetadata) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(SourceName
oldSource, BackendSourceMetadata
oldSourceBackendMetadata) ->
    SchemaCache -> SourceName -> AnyBackend SourceMetadata -> m ()
forall (m :: * -> *) r.
(MonadError QErr m, MonadIO m, MonadBaseControl IO m,
 MonadReader r m, Has (Logger Hasura) r, MonadWarnings m) =>
SchemaCache -> SourceName -> AnyBackend SourceMetadata -> m ()
postDropSourceHookHelper SchemaCache
oldSchemaCache SourceName
oldSource (BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata BackendSourceMetadata
oldSourceBackendMetadata)

  [InconsistentMetadata] -> m [InconsistentMetadata]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([InconsistentMetadata] -> m [InconsistentMetadata])
-> (SchemaCache -> [InconsistentMetadata])
-> SchemaCache
-> m [InconsistentMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaCache -> [InconsistentMetadata]
scInconsistentObjs (SchemaCache -> m [InconsistentMetadata])
-> SchemaCache -> m [InconsistentMetadata]
forall a b. (a -> b) -> a -> b
$ SchemaCache
newSchemaCache
  where
    {- Note [Cron triggers behaviour with replace metadata]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    When the metadata is replaced, we delete only the cron triggers
    that were deleted, instead of deleting all the old cron triggers (which
    existed in the metadata before it was replaced) and inserting all the
    new cron triggers. This is done this way, because when a cron trigger is
    dropped, the cron events associated with it will also be dropped from the DB
    and when a new cron trigger is added, new cron events are generated by the
    graphql-engine. So, this way we only delete and insert the data which has been changed.

    The cron triggers that were deleted is calculated by getting a diff
    of the old cron triggers and the new cron triggers. Note that we don't just
    check the name of the trigger to calculate the diff, the whole cron trigger
    definition is considered in the calculation.

    Note: Only cron triggers with `include_in_metadata` set to `true` can be updated/deleted
    via the replace metadata API. Cron triggers with `include_in_metadata` can only be modified
    via the `create_cron_trigger` and `delete_cron_trigger` APIs.

    -}
    processCronTriggers :: Metadata
-> m (CronTriggers, HashMap TriggerName CronTriggerMetadata)
processCronTriggers Metadata
oldMetadata = do
      let (CronTriggers
oldCronTriggersIncludedInMetadata, CronTriggers
oldCronTriggersNotIncludedInMetadata) =
            (CronTriggerMetadata -> Bool)
-> CronTriggers -> (CronTriggers, CronTriggers)
forall k v.
Hashable k =>
(v -> Bool)
-> InsOrdHashMap k v -> (InsOrdHashMap k v, InsOrdHashMap k v)
InsOrdHashMap.partition CronTriggerMetadata -> Bool
ctIncludeInMetadata (Metadata -> CronTriggers
_metaCronTriggers Metadata
oldMetadata)
          allNewCronTriggers :: CronTriggers
allNewCronTriggers =
            case ReplaceMetadataV1
_rmv2Metadata of
              RMWithoutSources MetadataNoSources
m -> MetadataNoSources -> CronTriggers
_mnsCronTriggers MetadataNoSources
m
              RMWithSources Metadata
m -> Metadata -> CronTriggers
_metaCronTriggers Metadata
m
          -- this function is intended to use with `HashMap.differenceWith`, it's used when two
          -- equal keys are encountered, then the values are compared to calculate the diff.
          -- see https://hackage.haskell.org/package/unordered-containers-0.2.14.0/docs/Data-HashMap-Internal.html#v:differenceWith
          leftIfDifferent :: a -> a -> Maybe a
leftIfDifferent a
l a
r
            | a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
r = Maybe a
forall a. Maybe a
Nothing
            | Bool
otherwise = a -> Maybe a
forall a. a -> Maybe a
Just a
l
          cronTriggersToBeAdded :: HashMap TriggerName CronTriggerMetadata
cronTriggersToBeAdded =
            (CronTriggerMetadata
 -> CronTriggerMetadata -> Maybe CronTriggerMetadata)
-> HashMap TriggerName CronTriggerMetadata
-> HashMap TriggerName CronTriggerMetadata
-> HashMap TriggerName CronTriggerMetadata
forall k v w.
(Eq k, Hashable k) =>
(v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
HashMap.differenceWith
              CronTriggerMetadata
-> CronTriggerMetadata -> Maybe CronTriggerMetadata
forall {a}. Eq a => a -> a -> Maybe a
leftIfDifferent
              (CronTriggers -> HashMap TriggerName CronTriggerMetadata
forall k v. InsOrdHashMap k v -> HashMap k v
InsOrdHashMap.toHashMap CronTriggers
allNewCronTriggers)
              (CronTriggers -> HashMap TriggerName CronTriggerMetadata
forall k v. InsOrdHashMap k v -> HashMap k v
InsOrdHashMap.toHashMap CronTriggers
oldCronTriggersIncludedInMetadata)
          cronTriggersToBeDropped :: HashMap TriggerName CronTriggerMetadata
cronTriggersToBeDropped =
            (CronTriggerMetadata
 -> CronTriggerMetadata -> Maybe CronTriggerMetadata)
-> HashMap TriggerName CronTriggerMetadata
-> HashMap TriggerName CronTriggerMetadata
-> HashMap TriggerName CronTriggerMetadata
forall k v w.
(Eq k, Hashable k) =>
(v -> w -> Maybe v) -> HashMap k v -> HashMap k w -> HashMap k v
HashMap.differenceWith
              CronTriggerMetadata
-> CronTriggerMetadata -> Maybe CronTriggerMetadata
forall {a}. Eq a => a -> a -> Maybe a
leftIfDifferent
              (CronTriggers -> HashMap TriggerName CronTriggerMetadata
forall k v. InsOrdHashMap k v -> HashMap k v
InsOrdHashMap.toHashMap CronTriggers
oldCronTriggersIncludedInMetadata)
              (CronTriggers -> HashMap TriggerName CronTriggerMetadata
forall k v. InsOrdHashMap k v -> HashMap k v
InsOrdHashMap.toHashMap CronTriggers
allNewCronTriggers)
      m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$ ClearCronEvents -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
ClearCronEvents -> m (Either QErr ())
dropFutureCronEvents (ClearCronEvents -> m (Either QErr ()))
-> ClearCronEvents -> m (Either QErr ())
forall a b. (a -> b) -> a -> b
$ [TriggerName] -> ClearCronEvents
MetadataCronTriggers ([TriggerName] -> ClearCronEvents)
-> [TriggerName] -> ClearCronEvents
forall a b. (a -> b) -> a -> b
$ HashMap TriggerName CronTriggerMetadata -> [TriggerName]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap TriggerName CronTriggerMetadata
cronTriggersToBeDropped
      CronTriggers
cronTriggers <- do
        -- traverse over the new cron triggers and check if any of them
        -- already exists as a cron trigger with "included_in_metadata: false"
        CronTriggers -> (CronTriggerMetadata -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ CronTriggers
allNewCronTriggers ((CronTriggerMetadata -> m ()) -> m ())
-> (CronTriggerMetadata -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \CronTriggerMetadata
ct ->
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CronTriggerMetadata -> TriggerName
ctName CronTriggerMetadata
ct TriggerName -> CronTriggers -> Bool
forall k a. (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool
`InsOrdHashMap.member` CronTriggers
oldCronTriggersNotIncludedInMetadata)
            (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyExists
            (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"cron trigger with name "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> CronTriggerMetadata -> TriggerName
ctName CronTriggerMetadata
ct
            TriggerName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" already exists as a cron trigger with \"included_in_metadata\" as false"
        -- we add the old cron triggers with included_in_metadata set to false with the
        -- newly added cron triggers
        CronTriggers -> m CronTriggers
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CronTriggers -> m CronTriggers) -> CronTriggers -> m CronTriggers
forall a b. (a -> b) -> a -> b
$ CronTriggers
allNewCronTriggers CronTriggers -> CronTriggers -> CronTriggers
forall a. Semigroup a => a -> a -> a
<> CronTriggers
oldCronTriggersNotIncludedInMetadata
      (CronTriggers, HashMap TriggerName CronTriggerMetadata)
-> m (CronTriggers, HashMap TriggerName CronTriggerMetadata)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CronTriggers, HashMap TriggerName CronTriggerMetadata)
 -> m (CronTriggers, HashMap TriggerName CronTriggerMetadata))
-> (CronTriggers, HashMap TriggerName CronTriggerMetadata)
-> m (CronTriggers, HashMap TriggerName CronTriggerMetadata)
forall a b. (a -> b) -> a -> b
$ (CronTriggers
cronTriggers, HashMap TriggerName CronTriggerMetadata
cronTriggersToBeAdded)

    dropSourceSQLTriggers ::
      HL.Logger HL.Hasura ->
      SchemaCache ->
      InsOrdHashMap SourceName BackendSourceMetadata ->
      InsOrdHashMap SourceName BackendSourceMetadata ->
      m ()
    dropSourceSQLTriggers :: Logger Hasura -> SchemaCache -> Sources -> Sources -> m ()
dropSourceSQLTriggers (HL.Logger forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger) SchemaCache
oldSchemaCache Sources
oldSources Sources
newSources = do
      -- NOTE: the current implementation of this function has an edge case.
      -- The edge case is that when a `SourceA` which contained some event triggers
      -- is modified to point to a new database, this function will try to drop the
      -- SQL triggers of the dropped event triggers on the new database which doesn't exist.
      -- In the current implementation, this doesn't throw an error because the trigger is dropped
      -- using `DROP IF EXISTS..` meaning this silently fails without throwing an error.
      [(SourceName, BackendSourceMetadata)]
-> ((SourceName, BackendSourceMetadata) -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (Sources -> [(SourceName, BackendSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList Sources
newSources) (((SourceName, BackendSourceMetadata) -> m ()) -> m ())
-> ((SourceName, BackendSourceMetadata) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(SourceName
source, BackendSourceMetadata
newBackendSourceMetadata) -> do
        Maybe BackendSourceMetadata
-> (BackendSourceMetadata -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (SourceName -> Sources -> Maybe BackendSourceMetadata
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup SourceName
source Sources
oldSources) ((BackendSourceMetadata -> m ()) -> m ())
-> (BackendSourceMetadata -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \BackendSourceMetadata
oldBackendSourceMetadata ->
          SourceName
-> AnyBackend SourceMetadata
-> AnyBackend SourceMetadata
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    SourceMetadata b -> SourceMetadata b -> m ())
-> m ()
forall (i :: BackendType -> *).
SourceName
-> AnyBackend i
-> AnyBackend i
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    i b -> i b -> m ())
-> m ()
compose SourceName
source (BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata BackendSourceMetadata
newBackendSourceMetadata) (BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata BackendSourceMetadata
oldBackendSourceMetadata) \(SourceMetadata b
newSourceMetadata :: SourceMetadata b) -> do
            BackendSourceMetadata
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    SourceMetadata b -> SourceMetadata b -> m ())
-> SourceMetadata b
-> m ()
forall {r}.
BackendSourceMetadata
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    SourceMetadata b -> r)
-> r
dispatch BackendSourceMetadata
oldBackendSourceMetadata \SourceMetadata b
oldSourceMetadata -> do
              let oldTriggersMap :: InsOrdHashMap TriggerName (EventTriggerConf b)
oldTriggersMap = SourceMetadata b -> InsOrdHashMap TriggerName (EventTriggerConf b)
forall (b :: BackendType).
SourceMetadata b -> InsOrdHashMap TriggerName (EventTriggerConf b)
getTriggersMap SourceMetadata b
oldSourceMetadata
                  newTriggersMap :: InsOrdHashMap TriggerName (EventTriggerConf b)
newTriggersMap = SourceMetadata b -> InsOrdHashMap TriggerName (EventTriggerConf b)
forall (b :: BackendType).
SourceMetadata b -> InsOrdHashMap TriggerName (EventTriggerConf b)
getTriggersMap SourceMetadata b
newSourceMetadata
                  droppedEventTriggers :: [TriggerName]
droppedEventTriggers = InsOrdHashMap TriggerName (EventTriggerConf b) -> [TriggerName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys (InsOrdHashMap TriggerName (EventTriggerConf b) -> [TriggerName])
-> InsOrdHashMap TriggerName (EventTriggerConf b) -> [TriggerName]
forall a b. (a -> b) -> a -> b
$ InsOrdHashMap TriggerName (EventTriggerConf b)
oldTriggersMap InsOrdHashMap TriggerName (EventTriggerConf b)
-> InsOrdHashMap TriggerName (EventTriggerConf b)
-> InsOrdHashMap TriggerName (EventTriggerConf b)
forall k v w.
(Eq k, Hashable k) =>
InsOrdHashMap k v -> InsOrdHashMap k w -> InsOrdHashMap k v
`InsOrdHashMap.difference` InsOrdHashMap TriggerName (EventTriggerConf b)
newTriggersMap
                  retainedNewTriggers :: InsOrdHashMap TriggerName (EventTriggerConf b)
retainedNewTriggers = InsOrdHashMap TriggerName (EventTriggerConf b)
newTriggersMap InsOrdHashMap TriggerName (EventTriggerConf b)
-> InsOrdHashMap TriggerName (EventTriggerConf b)
-> InsOrdHashMap TriggerName (EventTriggerConf b)
forall k v w.
(Eq k, Hashable k) =>
InsOrdHashMap k v -> InsOrdHashMap k w -> InsOrdHashMap k v
`InsOrdHashMap.intersection` InsOrdHashMap TriggerName (EventTriggerConf b)
oldTriggersMap
                  catcher :: QErr -> f ()
catcher e :: QErr
e@QErr {Code
qeCode :: Code
qeCode :: QErr -> Code
qeCode}
                    | Code
qeCode Code -> Code -> Bool
forall a. Eq a => a -> a -> Bool
== Code
Unexpected = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- NOTE: This information should be returned by the inconsistent_metadata response, so doesn't need additional logging.
                    | Bool
otherwise = QErr -> f ()
forall a. QErr -> f a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError QErr
e -- rethrow other errors
                  sourceObjID :: MetadataObjId
sourceObjID =
                    SourceName -> MetadataObjId
MOSource SourceName
source

              -- This will swallow Unexpected exceptions for sources if allow_inconsistent_metadata is enabled
              -- This should be ok since if the sources are already missing from the cache then they should
              -- not need to be removed.
              --
              -- TODO: Determine if any errors should be thrown from askSourceConfig at all if the errors are just being discarded
              m () -> SourceMetadata b -> m ()
forall a. a -> SourceMetadata b -> a
forall (m :: * -> *) a. Monad m => a -> m a
return
                (m () -> SourceMetadata b -> m ())
-> m () -> SourceMetadata b -> m ()
forall a b. (a -> b) -> a -> b
$ (m () -> (QErr -> m ()) -> m ()) -> (QErr -> m ()) -> m () -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip m () -> (QErr -> m ()) -> m ()
forall a. m a -> (QErr -> m a) -> m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError QErr -> m ()
forall {f :: * -> *}. MonadError QErr f => QErr -> f ()
catcher do
                  Maybe (SourceConfig b)
sourceConfigMaybe <- forall (b :: BackendType) (m :: * -> *).
(CacheRM m, Backend b) =>
SourceName -> m (Maybe (SourceConfig b))
askSourceConfigMaybe @b SourceName
source
                  case Maybe (SourceConfig b)
sourceConfigMaybe of
                    Maybe (SourceConfig b)
Nothing ->
                      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (InsOrdHashMap TriggerName (EventTriggerConf b) -> Bool
forall a. InsOrdHashMap TriggerName a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null InsOrdHashMap TriggerName (EventTriggerConf b)
oldTriggersMap) do
                        let message :: Text
message =
                              Text
"Could not drop SQL triggers present in the source '"
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
source
                                SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"' as it is inconsistent."
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" While creating an event trigger, Hasura creates SQL triggers on the table."
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Please refer https://hasura.io/docs/latest/graphql/core/event-triggers/remove-event-triggers/#clean-up-event-trigger-footprints-manually "
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to delete the sql triggers from the database manually."
                                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" For more details, please refer https://hasura.io/docs/latest/graphql/core/event-triggers/index.html "
                        MetadataWarning -> m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> m ()) -> MetadataWarning -> m ()
forall a b. (a -> b) -> a -> b
$ WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCSourceCleanupFailed MetadataObjId
sourceObjID Text
message
                        MetadataLog -> m ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger (MetadataLog -> m ()) -> MetadataLog -> m ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text -> Value -> MetadataLog
MetadataLog LogLevel
HL.LevelWarn Text
message Value
J.Null
                    Just SourceConfig b
sourceConfig -> do
                      [TriggerName] -> (TriggerName -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [TriggerName]
droppedEventTriggers \TriggerName
triggerName -> do
                        -- TODO: The `tableName` parameter could be computed while building
                        -- the triggers map and avoid the cache lookup.
                        case forall (b :: BackendType).
Backend b =>
SchemaCache -> SourceName -> TriggerName -> Maybe (TableName b)
getTableNameFromTrigger @b SchemaCache
oldSchemaCache SourceName
source TriggerName
triggerName of
                          Maybe (TableName b)
Nothing -> do
                            let message :: Text
message = TriggerName -> Text
sqlTriggerError TriggerName
triggerName
                            MetadataWarning -> m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> m ()) -> MetadataWarning -> m ()
forall a b. (a -> b) -> a -> b
$ WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCSourceCleanupFailed MetadataObjId
sourceObjID Text
message
                            MetadataLog -> m ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger (MetadataLog -> m ()) -> MetadataLog -> m ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text -> Value -> MetadataLog
MetadataLog LogLevel
HL.LevelWarn Text
message Value
J.Null
                          Just TableName b
tableName ->
                            forall (b :: BackendType) (m :: * -> *).
(BackendEventTrigger b, MonadIO m, MonadError QErr m) =>
SourceConfig b -> TriggerName -> TableName b -> m ()
dropTriggerAndArchiveEvents @b SourceConfig b
sourceConfig TriggerName
triggerName TableName b
tableName
                      [(TriggerName, EventTriggerConf b)]
-> ((TriggerName, EventTriggerConf b) -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (InsOrdHashMap TriggerName (EventTriggerConf b)
-> [(TriggerName, EventTriggerConf b)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList InsOrdHashMap TriggerName (EventTriggerConf b)
retainedNewTriggers) (((TriggerName, EventTriggerConf b) -> m ()) -> m ())
-> ((TriggerName, EventTriggerConf b) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(TriggerName
retainedNewTriggerName, EventTriggerConf b
retainedNewTriggerConf) ->
                        case TriggerName
-> InsOrdHashMap TriggerName (EventTriggerConf b)
-> Maybe (EventTriggerConf b)
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup TriggerName
retainedNewTriggerName InsOrdHashMap TriggerName (EventTriggerConf b)
oldTriggersMap of
                          Maybe (EventTriggerConf b)
Nothing -> do
                            let message :: Text
message = TriggerName -> Text
sqlTriggerError TriggerName
retainedNewTriggerName
                            MetadataWarning -> m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> m ()) -> MetadataWarning -> m ()
forall a b. (a -> b) -> a -> b
$ WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCSourceCleanupFailed MetadataObjId
sourceObjID Text
message
                            MetadataLog -> m ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger (MetadataLog -> m ()) -> MetadataLog -> m ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text -> Value -> MetadataLog
MetadataLog LogLevel
HL.LevelWarn Text
message Value
J.Null
                          Just EventTriggerConf b
oldTriggerConf -> do
                            let newTriggerOps :: TriggerOpsDef b
newTriggerOps = EventTriggerConf b -> TriggerOpsDef b
forall (b :: BackendType). EventTriggerConf b -> TriggerOpsDef b
etcDefinition EventTriggerConf b
retainedNewTriggerConf
                                oldTriggerOps :: TriggerOpsDef b
oldTriggerOps = EventTriggerConf b -> TriggerOpsDef b
forall (b :: BackendType). EventTriggerConf b -> TriggerOpsDef b
etcDefinition EventTriggerConf b
oldTriggerConf
                                isDroppedOp :: Maybe a -> Maybe a -> Bool
isDroppedOp Maybe a
old Maybe a
new = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
old Bool -> Bool -> Bool
&& Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
new
                                droppedOps :: [Maybe Ops]
droppedOps =
                                  [ (Maybe Ops -> Maybe Ops -> Bool -> Maybe Ops
forall a. a -> a -> Bool -> a
bool Maybe Ops
forall a. Maybe a
Nothing (Ops -> Maybe Ops
forall a. a -> Maybe a
Just Ops
INSERT) (Maybe (SubscribeOpSpec b) -> Maybe (SubscribeOpSpec b) -> Bool
forall {a} {a}. Maybe a -> Maybe a -> Bool
isDroppedOp (TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
forall (b :: BackendType).
TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
tdInsert TriggerOpsDef b
oldTriggerOps) (TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
forall (b :: BackendType).
TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
tdInsert TriggerOpsDef b
newTriggerOps))),
                                    (Maybe Ops -> Maybe Ops -> Bool -> Maybe Ops
forall a. a -> a -> Bool -> a
bool Maybe Ops
forall a. Maybe a
Nothing (Ops -> Maybe Ops
forall a. a -> Maybe a
Just Ops
UPDATE) (Maybe (SubscribeOpSpec b) -> Maybe (SubscribeOpSpec b) -> Bool
forall {a} {a}. Maybe a -> Maybe a -> Bool
isDroppedOp (TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
forall (b :: BackendType).
TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
tdUpdate TriggerOpsDef b
oldTriggerOps) (TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
forall (b :: BackendType).
TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
tdUpdate TriggerOpsDef b
newTriggerOps))),
                                    (Maybe Ops -> Maybe Ops -> Bool -> Maybe Ops
forall a. a -> a -> Bool -> a
bool Maybe Ops
forall a. Maybe a
Nothing (Ops -> Maybe Ops
forall a. a -> Maybe a
Just Ops
ET.DELETE) (Maybe (SubscribeOpSpec b) -> Maybe (SubscribeOpSpec b) -> Bool
forall {a} {a}. Maybe a -> Maybe a -> Bool
isDroppedOp (TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
forall (b :: BackendType).
TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
tdDelete TriggerOpsDef b
oldTriggerOps) (TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
forall (b :: BackendType).
TriggerOpsDef b -> Maybe (SubscribeOpSpec b)
tdDelete TriggerOpsDef b
newTriggerOps)))
                                  ]
                            case forall (b :: BackendType).
Backend b =>
SchemaCache -> SourceName -> TriggerName -> Maybe (TableName b)
getTableNameFromTrigger @b SchemaCache
oldSchemaCache SourceName
source TriggerName
retainedNewTriggerName of
                              Maybe (TableName b)
Nothing -> do
                                let message :: Text
message = TriggerName -> Text
sqlTriggerError TriggerName
retainedNewTriggerName
                                MetadataWarning -> m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn (MetadataWarning -> m ()) -> MetadataWarning -> m ()
forall a b. (a -> b) -> a -> b
$ WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCSourceCleanupFailed MetadataObjId
sourceObjID Text
message
                                MetadataLog -> m ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger (MetadataLog -> m ()) -> MetadataLog -> m ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> Text -> Value -> MetadataLog
MetadataLog LogLevel
HL.LevelWarn Text
message Value
J.Null
                              Just TableName b
tableName ->
                                forall (b :: BackendType) (m :: * -> *).
(BackendEventTrigger b, MonadIO m, MonadError QErr m) =>
SourceConfig b -> TriggerName -> TableName b -> HashSet Ops -> m ()
dropDanglingSQLTrigger @b SourceConfig b
sourceConfig TriggerName
retainedNewTriggerName TableName b
tableName ([Ops] -> HashSet Ops
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([Ops] -> HashSet Ops) -> [Ops] -> HashSet Ops
forall a b. (a -> b) -> a -> b
$ [Maybe Ops] -> [Ops]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe Ops]
droppedOps)
      where
        compose ::
          SourceName ->
          AB.AnyBackend i ->
          AB.AnyBackend i ->
          (forall b. (BackendEventTrigger b) => i b -> i b -> m ()) ->
          m ()
        compose :: forall (i :: BackendType -> *).
SourceName
-> AnyBackend i
-> AnyBackend i
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    i b -> i b -> m ())
-> m ()
compose SourceName
sourceName AnyBackend i
x AnyBackend i
y forall (b :: BackendType).
BackendEventTrigger b =>
i b -> i b -> m ()
f = forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
(forall (b :: BackendType). c b => i b -> i b -> r)
-> AnyBackend i -> AnyBackend i -> r -> r
AB.composeAnyBackend @BackendEventTrigger i b -> i b -> m ()
forall (b :: BackendType).
BackendEventTrigger b =>
i b -> i b -> m ()
f AnyBackend i
x AnyBackend i
y (UnstructuredLog -> m ()
forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger (UnstructuredLog -> m ()) -> UnstructuredLog -> m ()
forall a b. (a -> b) -> a -> b
$ LogLevel -> SerializableBlob -> UnstructuredLog
HL.UnstructuredLog LogLevel
HL.LevelInfo (SerializableBlob -> UnstructuredLog)
-> SerializableBlob -> UnstructuredLog
forall a b. (a -> b) -> a -> b
$ Text -> SerializableBlob
SB.fromText (Text -> SerializableBlob) -> Text -> SerializableBlob
forall a b. (a -> b) -> a -> b
$ Text
"Event trigger clean up couldn't be done on the source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" because it has changed its type")

        sqlTriggerError :: TriggerName -> Text
        sqlTriggerError :: TriggerName -> Text
sqlTriggerError TriggerName
triggerName =
          ( Text
"Could not drop SQL triggers associated with event trigger '"
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TriggerName
triggerName
              TriggerName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
"'. While creating an event trigger, Hasura creates SQL triggers on the table."
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Please refer https://hasura.io/docs/latest/graphql/core/event-triggers/remove-event-triggers/#clean-up-event-trigger-footprints-manually "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to delete the sql triggers from the database manually."
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" For more details, please refer https://hasura.io/docs/latest/graphql/core/event-triggers/index.html "
          )

    dispatch :: BackendSourceMetadata
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    SourceMetadata b -> r)
-> r
dispatch (BackendSourceMetadata AnyBackend SourceMetadata
bs) = forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @BackendEventTrigger AnyBackend SourceMetadata
bs

-- | Only includes the cron triggers with `included_in_metadata` set to `True`
processCronTriggersMetadata :: Metadata -> Metadata
processCronTriggersMetadata :: Metadata -> Metadata
processCronTriggersMetadata Metadata
metadata =
  let cronTriggersIncludedInMetadata :: CronTriggers
cronTriggersIncludedInMetadata = (CronTriggerMetadata -> Bool) -> CronTriggers -> CronTriggers
forall v k. (v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.filter CronTriggerMetadata -> Bool
ctIncludeInMetadata (CronTriggers -> CronTriggers) -> CronTriggers -> CronTriggers
forall a b. (a -> b) -> a -> b
$ Metadata -> CronTriggers
_metaCronTriggers Metadata
metadata
   in Metadata
metadata {_metaCronTriggers :: CronTriggers
_metaCronTriggers = CronTriggers
cronTriggersIncludedInMetadata}

runExportMetadata ::
  forall m.
  (QErrM m, MetadataM m) =>
  ExportMetadata ->
  m EncJSON
runExportMetadata :: forall (m :: * -> *).
(QErrM m, MetadataM m) =>
ExportMetadata -> m EncJSON
runExportMetadata ExportMetadata {} =
  Value -> EncJSON
encJFromOrderedValue (Value -> EncJSON) -> (Metadata -> Value) -> Metadata -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> Value
metadataToOrdJSON (Metadata -> EncJSON) -> m Metadata -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Metadata -> Metadata
processCronTriggersMetadata (Metadata -> Metadata) -> m Metadata -> m Metadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata)

runExportMetadataV2 ::
  forall m.
  (QErrM m, MetadataM m) =>
  MetadataResourceVersion ->
  ExportMetadata ->
  m EncJSON
runExportMetadataV2 :: forall (m :: * -> *).
(QErrM m, MetadataM m) =>
MetadataResourceVersion -> ExportMetadata -> m EncJSON
runExportMetadataV2 MetadataResourceVersion
currentResourceVersion ExportMetadata {} = do
  Metadata
exportMetadata <- Metadata -> Metadata
processCronTriggersMetadata (Metadata -> Metadata) -> m Metadata -> m Metadata
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Value -> EncJSON
encJFromOrderedValue
    (Value -> EncJSON) -> Value -> EncJSON
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Value
AO.object
      [ (Text
"resource_version", MetadataResourceVersion -> Value
forall a. ToJSON a => a -> Value
AO.toOrdered MetadataResourceVersion
currentResourceVersion),
        (Text
"metadata", Metadata -> Value
metadataToOrdJSON Metadata
exportMetadata)
      ]

runReloadMetadata :: (QErrM m, CacheRWM m, MetadataM m) => ReloadMetadata -> m EncJSON
runReloadMetadata :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
ReloadMetadata -> m EncJSON
runReloadMetadata (ReloadMetadata ReloadRemoteSchemas
reloadRemoteSchemas ReloadSources
reloadSources ReloadSources
reloadRecreateEventTriggers ReloadDataConnectors
reloadDataConnectors) = do
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  let allSources :: HashSet SourceName
allSources = [SourceName] -> HashSet SourceName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([SourceName] -> HashSet SourceName)
-> [SourceName] -> HashSet SourceName
forall a b. (a -> b) -> a -> b
$ Sources -> [SourceName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys (Sources -> [SourceName]) -> Sources -> [SourceName]
forall a b. (a -> b) -> a -> b
$ Metadata -> Sources
_metaSources Metadata
metadata
      allRemoteSchemas :: HashSet RemoteSchemaName
allRemoteSchemas = [RemoteSchemaName] -> HashSet RemoteSchemaName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([RemoteSchemaName] -> HashSet RemoteSchemaName)
-> [RemoteSchemaName] -> HashSet RemoteSchemaName
forall a b. (a -> b) -> a -> b
$ RemoteSchemas -> [RemoteSchemaName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys (RemoteSchemas -> [RemoteSchemaName])
-> RemoteSchemas -> [RemoteSchemaName]
forall a b. (a -> b) -> a -> b
$ Metadata -> RemoteSchemas
_metaRemoteSchemas Metadata
metadata
      allDataConnectors :: HashSet DataConnectorName
allDataConnectors =
        HashSet DataConnectorName
-> (BackendConfigWrapper 'DataConnector
    -> HashSet DataConnectorName)
-> Maybe (BackendConfigWrapper 'DataConnector)
-> HashSet DataConnectorName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashSet DataConnectorName
forall a. Monoid a => a
mempty ([DataConnectorName] -> HashSet DataConnectorName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([DataConnectorName] -> HashSet DataConnectorName)
-> (BackendConfigWrapper 'DataConnector -> [DataConnectorName])
-> BackendConfigWrapper 'DataConnector
-> HashSet DataConnectorName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map DataConnectorName DataConnectorOptions -> [DataConnectorName]
forall k a. Map k a -> [k]
Map.keys (Map DataConnectorName DataConnectorOptions -> [DataConnectorName])
-> (BackendConfigWrapper 'DataConnector
    -> Map DataConnectorName DataConnectorOptions)
-> BackendConfigWrapper 'DataConnector
-> [DataConnectorName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BackendConfigWrapper 'DataConnector
-> Map DataConnectorName DataConnectorOptions
BackendConfigWrapper 'DataConnector -> BackendConfig 'DataConnector
forall (b :: BackendType).
BackendConfigWrapper b -> BackendConfig b
unBackendConfigWrapper)
          (Maybe (BackendConfigWrapper 'DataConnector)
 -> HashSet DataConnectorName)
-> Maybe (BackendConfigWrapper 'DataConnector)
-> HashSet DataConnectorName
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
BackendMap i -> Maybe (i b)
BackendMap.lookup @'DataConnector
          (BackendMap BackendConfigWrapper
 -> Maybe (BackendConfigWrapper 'DataConnector))
-> BackendMap BackendConfigWrapper
-> Maybe (BackendConfigWrapper 'DataConnector)
forall a b. (a -> b) -> a -> b
$ Metadata -> BackendMap BackendConfigWrapper
_metaBackendConfigs Metadata
metadata
      checkRemoteSchema :: RemoteSchemaName -> m ()
checkRemoteSchema RemoteSchemaName
name =
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RemoteSchemaName -> HashSet RemoteSchemaName -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member RemoteSchemaName
name HashSet RemoteSchemaName
allRemoteSchemas)
          (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
          (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Remote schema with name "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RemoteSchemaName
name
          RemoteSchemaName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found in metadata"
      checkSource :: SourceName -> m ()
checkSource SourceName
name =
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SourceName -> HashSet SourceName -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member SourceName
name HashSet SourceName
allSources)
          (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
          (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Source with name "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
name
          SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found in metadata"
      checkDataConnector :: DataConnectorName -> m ()
checkDataConnector DataConnectorName
name =
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (DataConnectorName -> HashSet DataConnectorName -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member DataConnectorName
name HashSet DataConnectorName
allDataConnectors)
          (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotExists
          (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Data connector with name "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DataConnectorName
name
          DataConnectorName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found in metadata"

  HashSet RemoteSchemaName
remoteSchemaInvalidations <- case ReloadRemoteSchemas
reloadRemoteSchemas of
    ReloadRemoteSchemas
RSReloadAll -> HashSet RemoteSchemaName -> m (HashSet RemoteSchemaName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet RemoteSchemaName
allRemoteSchemas
    RSReloadList HashSet RemoteSchemaName
l -> (RemoteSchemaName -> m ()) -> HashSet RemoteSchemaName -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RemoteSchemaName -> m ()
checkRemoteSchema HashSet RemoteSchemaName
l m ()
-> m (HashSet RemoteSchemaName) -> m (HashSet RemoteSchemaName)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> HashSet RemoteSchemaName -> m (HashSet RemoteSchemaName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet RemoteSchemaName
l
  HashSet SourceName
sourcesInvalidations <- case ReloadSources
reloadSources of
    ReloadSources
RSReloadAll -> HashSet SourceName -> m (HashSet SourceName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet SourceName
allSources
    RSReloadList HashSet SourceName
l -> (SourceName -> m ()) -> HashSet SourceName -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SourceName -> m ()
checkSource HashSet SourceName
l m () -> m (HashSet SourceName) -> m (HashSet SourceName)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> HashSet SourceName -> m (HashSet SourceName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet SourceName
l
  HashSet SourceName
recreateEventTriggersSources <- case ReloadSources
reloadRecreateEventTriggers of
    ReloadSources
RSReloadAll -> HashSet SourceName -> m (HashSet SourceName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet SourceName
allSources
    RSReloadList HashSet SourceName
l -> (SourceName -> m ()) -> HashSet SourceName -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SourceName -> m ()
checkSource HashSet SourceName
l m () -> m (HashSet SourceName) -> m (HashSet SourceName)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> HashSet SourceName -> m (HashSet SourceName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet SourceName
l
  HashSet DataConnectorName
dataConnectorInvalidations <- case ReloadDataConnectors
reloadDataConnectors of
    ReloadDataConnectors
RSReloadAll -> HashSet DataConnectorName -> m (HashSet DataConnectorName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet DataConnectorName
allDataConnectors
    RSReloadList HashSet DataConnectorName
l -> (DataConnectorName -> m ()) -> HashSet DataConnectorName -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DataConnectorName -> m ()
checkDataConnector HashSet DataConnectorName
l m ()
-> m (HashSet DataConnectorName) -> m (HashSet DataConnectorName)
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> HashSet DataConnectorName -> m (HashSet DataConnectorName)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet DataConnectorName
l

  let cacheInvalidations :: CacheInvalidations
cacheInvalidations =
        CacheInvalidations
          { ciMetadata :: Bool
ciMetadata = Bool
True,
            ciRemoteSchemas :: HashSet RemoteSchemaName
ciRemoteSchemas = HashSet RemoteSchemaName
remoteSchemaInvalidations,
            ciSources :: HashSet SourceName
ciSources = HashSet SourceName
sourcesInvalidations,
            ciDataConnectors :: HashSet DataConnectorName
ciDataConnectors = HashSet DataConnectorName
dataConnectorInvalidations
          }

  BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> m ()
forall (m :: * -> *).
CacheRWM m =>
BuildReason
-> CacheInvalidations
-> Metadata
-> Maybe MetadataResourceVersion
-> m ()
buildSchemaCacheWithOptions (Maybe (HashSet SourceName) -> BuildReason
CatalogUpdate (Maybe (HashSet SourceName) -> BuildReason)
-> Maybe (HashSet SourceName) -> BuildReason
forall a b. (a -> b) -> a -> b
$ HashSet SourceName -> Maybe (HashSet SourceName)
forall a. a -> Maybe a
Just HashSet SourceName
recreateEventTriggersSources) CacheInvalidations
cacheInvalidations Metadata
metadata Maybe MetadataResourceVersion
forall a. Maybe a
Nothing
  [InconsistentMetadata]
inconsObjs <- SchemaCache -> [InconsistentMetadata]
scInconsistentObjs (SchemaCache -> [InconsistentMetadata])
-> m SchemaCache -> m [InconsistentMetadata]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (EncJSON -> m EncJSON)
-> ([Pair] -> EncJSON) -> [Pair] -> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue
    (Value -> EncJSON) -> ([Pair] -> Value) -> [Pair] -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
J.object
    ([Pair] -> m EncJSON) -> [Pair] -> m EncJSON
forall a b. (a -> b) -> a -> b
$ [ Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (Text
"success" :: Text),
        Key
"is_consistent" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= [InconsistentMetadata] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InconsistentMetadata]
inconsObjs
      ]
    [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Key
"inconsistent_objects" Key -> [InconsistentMetadata] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= [InconsistentMetadata]
inconsObjs | Bool -> Bool
not ([InconsistentMetadata] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InconsistentMetadata]
inconsObjs)]

runDumpInternalState ::
  (QErrM m, CacheRM m) =>
  DumpInternalState ->
  m EncJSON
runDumpInternalState :: forall (m :: * -> *).
(QErrM m, CacheRM m) =>
DumpInternalState -> m EncJSON
runDumpInternalState DumpInternalState
_ =
  SchemaCache -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (SchemaCache -> EncJSON) -> m SchemaCache -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache

runGetInconsistentMetadata ::
  (QErrM m, CacheRM m) =>
  GetInconsistentMetadata ->
  m EncJSON
runGetInconsistentMetadata :: forall (m :: * -> *).
(QErrM m, CacheRM m) =>
GetInconsistentMetadata -> m EncJSON
runGetInconsistentMetadata GetInconsistentMetadata
_ = do
  [InconsistentMetadata]
inconsObjs <- SchemaCache -> [InconsistentMetadata]
scInconsistentObjs (SchemaCache -> [InconsistentMetadata])
-> m SchemaCache -> m [InconsistentMetadata]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (Value -> EncJSON) -> Value -> EncJSON
forall a b. (a -> b) -> a -> b
$ [InconsistentMetadata] -> MetadataWarnings -> Value
formatInconsistentObjs [InconsistentMetadata]
inconsObjs MetadataWarnings
forall a. Monoid a => a
mempty

formatInconsistentObjs :: [InconsistentMetadata] -> MetadataWarnings -> J.Value
formatInconsistentObjs :: [InconsistentMetadata] -> MetadataWarnings -> Value
formatInconsistentObjs [InconsistentMetadata]
inconsObjs MetadataWarnings
metadataWarnings =
  [Pair] -> Value
J.object
    ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [ Key
"is_consistent" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= [InconsistentMetadata] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InconsistentMetadata]
inconsObjs,
        Key
"inconsistent_objects" Key -> [InconsistentMetadata] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= [InconsistentMetadata]
inconsObjs
      ]
    [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Key
"warnings" Key -> MetadataWarnings -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= MetadataWarnings
metadataWarnings | Bool -> Bool
not (MetadataWarnings -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null MetadataWarnings
metadataWarnings)]

runDropInconsistentMetadata ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  DropInconsistentMetadata ->
  m EncJSON
runDropInconsistentMetadata :: forall (m :: * -> *).
(QErrM m, CacheRWM m, MetadataM m) =>
DropInconsistentMetadata -> m EncJSON
runDropInconsistentMetadata DropInconsistentMetadata
_ = do
  SchemaCache
sc <- m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  let inconsSchObjs :: [MetadataObjId]
inconsSchObjs = [MetadataObjId] -> [MetadataObjId]
forall a. Eq a => [a] -> [a]
L.nub ([MetadataObjId] -> [MetadataObjId])
-> ([InconsistentMetadata] -> [MetadataObjId])
-> [InconsistentMetadata]
-> [MetadataObjId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InconsistentMetadata -> [MetadataObjId])
-> [InconsistentMetadata] -> [MetadataObjId]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap InconsistentMetadata -> [MetadataObjId]
imObjectIds ([InconsistentMetadata] -> [MetadataObjId])
-> [InconsistentMetadata] -> [MetadataObjId]
forall a b. (a -> b) -> a -> b
$ SchemaCache -> [InconsistentMetadata]
scInconsistentObjs SchemaCache
sc
  -- Note: when building the schema cache, we try to put dependents after their dependencies in the
  -- list of inconsistent objects, so reverse the list to start with dependents first. This is not
  -- perfect — a completely accurate solution would require performing a topological sort — but it
  -- seems to work well enough for now.
  MetadataModifier {Metadata -> Metadata
runMetadataModifier :: Metadata -> Metadata
runMetadataModifier :: MetadataModifier -> Metadata -> Metadata
..} <- WriterT MetadataModifier m () -> m MetadataModifier
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT MetadataModifier m () -> m MetadataModifier)
-> WriterT MetadataModifier m () -> m MetadataModifier
forall a b. (a -> b) -> a -> b
$ (MetadataObjId -> WriterT MetadataModifier m ())
-> [MetadataObjId] -> WriterT MetadataModifier m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (MetadataModifier -> WriterT MetadataModifier m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (MetadataModifier -> WriterT MetadataModifier m ())
-> (MetadataObjId -> MetadataModifier)
-> MetadataObjId
-> WriterT MetadataModifier m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetadataObjId -> MetadataModifier
purgeMetadataObj) ([MetadataObjId] -> [MetadataObjId]
forall a. [a] -> [a]
reverse [MetadataObjId]
inconsSchObjs)
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata (Metadata -> m ()) -> Metadata -> m ()
forall a b. (a -> b) -> a -> b
$ Metadata -> Metadata
runMetadataModifier Metadata
metadata
  MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache MetadataModifier
forall a. Monoid a => a
mempty
  -- after building the schema cache, we need to check the inconsistent metadata, if any
  -- are only those which are not droppable
  [InconsistentMetadata]
newInconsistentObjects <- SchemaCache -> [InconsistentMetadata]
scInconsistentObjs (SchemaCache -> [InconsistentMetadata])
-> m SchemaCache -> m [InconsistentMetadata]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m SchemaCache
forall (m :: * -> *). CacheRM m => m SchemaCache
askSchemaCache
  let droppableInconsistentObjects :: [InconsistentMetadata]
droppableInconsistentObjects = (InconsistentMetadata -> Bool)
-> [InconsistentMetadata] -> [InconsistentMetadata]
forall a. (a -> Bool) -> [a] -> [a]
filter InconsistentMetadata -> Bool
droppableInconsistentMetadata [InconsistentMetadata]
newInconsistentObjects
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([InconsistentMetadata] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InconsistentMetadata]
droppableInconsistentObjects)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ QErr -> m ()
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
      (Code -> Text -> QErr
err400 Code
Unexpected Text
"cannot continue due to new inconsistent metadata")
        { qeInternal :: Maybe QErrExtra
qeInternal = QErrExtra -> Maybe QErrExtra
forall a. a -> Maybe a
Just (QErrExtra -> Maybe QErrExtra) -> QErrExtra -> Maybe QErrExtra
forall a b. (a -> b) -> a -> b
$ Value -> QErrExtra
ExtraInternal (Value -> QErrExtra) -> Value -> QErrExtra
forall a b. (a -> b) -> a -> b
$ [InconsistentMetadata] -> Value
forall a. ToJSON a => a -> Value
J.toJSON [InconsistentMetadata]
newInconsistentObjects
        }
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg

purgeMetadataObj :: MetadataObjId -> MetadataModifier
purgeMetadataObj :: MetadataObjId -> MetadataModifier
purgeMetadataObj = \case
  MOSource SourceName
source -> (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> (Sources -> Sources) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SourceName -> Sources -> Sources
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete SourceName
source
  MOSourceObjId SourceName
source AnyBackend SourceMetadataObjId
exists -> forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @BackendMetadata AnyBackend SourceMetadataObjId
exists ((forall (b :: BackendType).
  BackendMetadata b =>
  SourceMetadataObjId b -> MetadataModifier)
 -> MetadataModifier)
-> (forall (b :: BackendType).
    BackendMetadata b =>
    SourceMetadataObjId b -> MetadataModifier)
-> MetadataModifier
forall a b. (a -> b) -> a -> b
$ SourceName -> SourceMetadataObjId b -> MetadataModifier
forall (b :: BackendType).
BackendMetadata b =>
SourceName -> SourceMetadataObjId b -> MetadataModifier
handleSourceObj SourceName
source
  MORemoteSchema RemoteSchemaName
rsn -> RemoteSchemaName -> MetadataModifier
dropRemoteSchemaInMetadata RemoteSchemaName
rsn
  MORemoteSchemaPermissions RemoteSchemaName
rsName RoleName
role -> RemoteSchemaName -> RoleName -> MetadataModifier
dropRemoteSchemaPermissionInMetadata RemoteSchemaName
rsName RoleName
role
  MORemoteSchemaRemoteRelationship RemoteSchemaName
rsName Name
typeName RelName
relName ->
    RemoteSchemaName -> Name -> RelName -> MetadataModifier
dropRemoteSchemaRemoteRelationshipInMetadata RemoteSchemaName
rsName Name
typeName RelName
relName
  MetadataObjId
MOCustomTypes -> MetadataModifier
clearCustomTypesInMetadata
  MOAction ActionName
action -> ActionName -> MetadataModifier
dropActionInMetadata ActionName
action -- Nothing
  MOActionPermission ActionName
action RoleName
role -> ActionName -> RoleName -> MetadataModifier
dropActionPermissionInMetadata ActionName
action RoleName
role
  MOCronTrigger TriggerName
ctName -> TriggerName -> MetadataModifier
dropCronTriggerInMetadata TriggerName
ctName
  MOEndpoint EndpointName
epName -> EndpointName -> MetadataModifier
dropEndpointInMetadata EndpointName
epName
  MOInheritedRole RoleName
role -> RoleName -> MetadataModifier
dropInheritedRoleInMetadata RoleName
role
  MOQueryCollectionsQuery CollectionName
cName ListedQuery
lq -> CollectionName -> ListedQuery -> MetadataModifier
dropListedQueryFromQueryCollections CollectionName
cName ListedQuery
lq
  MODataConnectorAgent DataConnectorName
agentName ->
    (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
      ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (BackendMap BackendConfigWrapper
 -> Identity (BackendMap BackendConfigWrapper))
-> Metadata -> Identity Metadata
Lens' Metadata (BackendMap BackendConfigWrapper)
metaBackendConfigs
      ((BackendMap BackendConfigWrapper
  -> Identity (BackendMap BackendConfigWrapper))
 -> Metadata -> Identity Metadata)
-> (BackendMap BackendConfigWrapper
    -> BackendMap BackendConfigWrapper)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (b :: BackendType) (i :: BackendType -> *).
(HasTag b, Monoid (i b)) =>
(i b -> i b) -> BackendMap i -> BackendMap i
BackendMap.modify @'DataConnector (Map DataConnectorName DataConnectorOptions
-> BackendConfigWrapper 'DataConnector
BackendConfig 'DataConnector -> BackendConfigWrapper 'DataConnector
forall (b :: BackendType).
BackendConfig b -> BackendConfigWrapper b
BackendConfigWrapper (Map DataConnectorName DataConnectorOptions
 -> BackendConfigWrapper 'DataConnector)
-> (BackendConfigWrapper 'DataConnector
    -> Map DataConnectorName DataConnectorOptions)
-> BackendConfigWrapper 'DataConnector
-> BackendConfigWrapper 'DataConnector
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataConnectorName
-> Map DataConnectorName DataConnectorOptions
-> Map DataConnectorName DataConnectorOptions
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete DataConnectorName
agentName (Map DataConnectorName DataConnectorOptions
 -> Map DataConnectorName DataConnectorOptions)
-> (BackendConfigWrapper 'DataConnector
    -> Map DataConnectorName DataConnectorOptions)
-> BackendConfigWrapper 'DataConnector
-> Map DataConnectorName DataConnectorOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BackendConfigWrapper 'DataConnector
-> Map DataConnectorName DataConnectorOptions
BackendConfigWrapper 'DataConnector -> BackendConfig 'DataConnector
forall (b :: BackendType).
BackendConfigWrapper b -> BackendConfig b
unBackendConfigWrapper)
  MOOpenTelemetry OpenTelemetryConfigSubobject
subobject ->
    case OpenTelemetryConfigSubobject
subobject of
      OpenTelemetryConfigSubobject
OtelSubobjectAll ->
        (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (OpenTelemetryConfig -> Identity OpenTelemetryConfig)
-> Metadata -> Identity Metadata
Lens' Metadata OpenTelemetryConfig
metaOpenTelemetryConfig ((OpenTelemetryConfig -> Identity OpenTelemetryConfig)
 -> Metadata -> Identity Metadata)
-> OpenTelemetryConfig -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OpenTelemetryConfig
emptyOpenTelemetryConfig
      OpenTelemetryConfigSubobject
OtelSubobjectExporterOtlp ->
        (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (OpenTelemetryConfig -> Identity OpenTelemetryConfig)
-> Metadata -> Identity Metadata
Lens' Metadata OpenTelemetryConfig
metaOpenTelemetryConfig ((OpenTelemetryConfig -> Identity OpenTelemetryConfig)
 -> Metadata -> Identity Metadata)
-> ((OtelExporterConfig -> Identity OtelExporterConfig)
    -> OpenTelemetryConfig -> Identity OpenTelemetryConfig)
-> (OtelExporterConfig -> Identity OtelExporterConfig)
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OtelExporterConfig -> Identity OtelExporterConfig)
-> OpenTelemetryConfig -> Identity OpenTelemetryConfig
Lens' OpenTelemetryConfig OtelExporterConfig
ocExporterOtlp ((OtelExporterConfig -> Identity OtelExporterConfig)
 -> Metadata -> Identity Metadata)
-> OtelExporterConfig -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OtelExporterConfig
defaultOtelExporterConfig
      OpenTelemetryConfigSubobject
OtelSubobjectBatchSpanProcessor ->
        (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (OpenTelemetryConfig -> Identity OpenTelemetryConfig)
-> Metadata -> Identity Metadata
Lens' Metadata OpenTelemetryConfig
metaOpenTelemetryConfig ((OpenTelemetryConfig -> Identity OpenTelemetryConfig)
 -> Metadata -> Identity Metadata)
-> ((OtelBatchSpanProcessorConfig
     -> Identity OtelBatchSpanProcessorConfig)
    -> OpenTelemetryConfig -> Identity OpenTelemetryConfig)
-> (OtelBatchSpanProcessorConfig
    -> Identity OtelBatchSpanProcessorConfig)
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OtelBatchSpanProcessorConfig
 -> Identity OtelBatchSpanProcessorConfig)
-> OpenTelemetryConfig -> Identity OpenTelemetryConfig
Lens' OpenTelemetryConfig OtelBatchSpanProcessorConfig
ocBatchSpanProcessor ((OtelBatchSpanProcessorConfig
  -> Identity OtelBatchSpanProcessorConfig)
 -> Metadata -> Identity Metadata)
-> OtelBatchSpanProcessorConfig -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ OtelBatchSpanProcessorConfig
defaultOtelBatchSpanProcessorConfig
  where
    handleSourceObj :: forall b. (BackendMetadata b) => SourceName -> SourceMetadataObjId b -> MetadataModifier
    handleSourceObj :: forall (b :: BackendType).
BackendMetadata b =>
SourceName -> SourceMetadataObjId b -> MetadataModifier
handleSourceObj SourceName
source = \case
      SMOTable TableName b
qt -> forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> MetadataModifier
dropTableInMetadata @b SourceName
source TableName b
qt
      SMOFunction FunctionName b
qf -> forall (b :: BackendType).
Backend b =>
SourceName -> FunctionName b -> MetadataModifier
dropFunctionInMetadata @b SourceName
source FunctionName b
qf
      SMOFunctionPermission FunctionName b
qf RoleName
rn -> forall (b :: BackendType).
BackendMetadata b =>
SourceName -> FunctionName b -> RoleName -> MetadataModifier
dropFunctionPermissionInMetadata @b SourceName
source FunctionName b
qf RoleName
rn
      SMONativeQuery NativeQueryName
nq -> forall (b :: BackendType).
BackendMetadata b =>
SourceName -> NativeQueryName -> MetadataModifier
dropNativeQueryInMetadata @b SourceName
source NativeQueryName
nq
      SMONativeQueryObj NativeQueryName
nativeQueryName NativeQueryMetadataObjId
nativeQueryMetadataObjId ->
        (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
          ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
SourceName
-> NativeQueryName -> ASetter' Metadata (NativeQueryMetadata b)
nativeQueryMetadataSetter @b SourceName
source NativeQueryName
nativeQueryName
          ASetter' Metadata (NativeQueryMetadata b)
-> (NativeQueryMetadata b -> NativeQueryMetadata b)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case NativeQueryMetadataObjId
nativeQueryMetadataObjId of
            NQMORel RelName
rn RelType
_ -> RelName -> NativeQueryMetadata b -> NativeQueryMetadata b
forall (b :: BackendType).
RelName -> NativeQueryMetadata b -> NativeQueryMetadata b
dropNativeQueryRelationshipInMetadata RelName
rn
            NQMOReferencedLogicalModel LogicalModelName
_ -> NativeQueryMetadata b -> NativeQueryMetadata b
forall a. a -> a
id
      SMOStoredProcedure FunctionName b
sp -> forall (b :: BackendType).
BackendMetadata b =>
SourceName -> FunctionName b -> MetadataModifier
dropStoredProcedureInMetadata @b SourceName
source FunctionName b
sp
      SMOLogicalModel LogicalModelName
lm -> forall (b :: BackendType).
BackendMetadata b =>
SourceName -> LogicalModelName -> MetadataModifier
dropLogicalModelInMetadata @b SourceName
source LogicalModelName
lm
      SMOLogicalModelObj LogicalModelName
logicalModelName LogicalModelMetadataObjId
logicalModelMetadataObjId ->
        (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
          ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
SourceName
-> LogicalModelName -> ASetter' Metadata (LogicalModelMetadata b)
logicalModelMetadataSetter @b SourceName
source LogicalModelName
logicalModelName
          ASetter' Metadata (LogicalModelMetadata b)
-> (LogicalModelMetadata b -> LogicalModelMetadata b)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case LogicalModelMetadataObjId
logicalModelMetadataObjId of
            LMMOPerm RoleName
roleName PermType
permType ->
              RoleName
-> PermType -> LogicalModelMetadata b -> LogicalModelMetadata b
forall (b :: BackendType).
RoleName
-> PermType -> LogicalModelMetadata b -> LogicalModelMetadata b
dropLogicalModelPermissionInMetadata RoleName
roleName PermType
permType
            LMMOReferencedLogicalModel LogicalModelName
_ -> LogicalModelMetadata b -> LogicalModelMetadata b
forall a. a -> a
id
      SMOTableObj TableName b
qt TableMetadataObjId
tableObj ->
        (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
          ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> ASetter' Metadata (TableMetadata b)
tableMetadataSetter @b SourceName
source TableName b
qt
          ASetter' Metadata (TableMetadata b)
-> (TableMetadata b -> TableMetadata b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case TableMetadataObjId
tableObj of
            MTORel RelName
rn RelType
_ -> RelName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RelName -> TableMetadata b -> TableMetadata b
dropRelationshipInMetadata RelName
rn
            MTOPerm RoleName
rn PermType
pt -> RoleName -> PermType -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RoleName -> PermType -> TableMetadata b -> TableMetadata b
dropPermissionInMetadata RoleName
rn PermType
pt
            MTOTrigger TriggerName
trn -> TriggerName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
TriggerName -> TableMetadata b -> TableMetadata b
dropEventTriggerInMetadata TriggerName
trn
            MTOComputedField ComputedFieldName
ccn -> ComputedFieldName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
ComputedFieldName -> TableMetadata b -> TableMetadata b
dropComputedFieldInMetadata ComputedFieldName
ccn
            MTORemoteRelationship RelName
rn -> RelName -> TableMetadata b -> TableMetadata b
forall (b :: BackendType).
RelName -> TableMetadata b -> TableMetadata b
dropRemoteRelationshipInMetadata RelName
rn

    dropListedQueryFromQueryCollections :: CollectionName -> ListedQuery -> MetadataModifier
    dropListedQueryFromQueryCollections :: CollectionName -> ListedQuery -> MetadataModifier
dropListedQueryFromQueryCollections CollectionName
cName ListedQuery
lq = (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ Metadata -> Metadata
removeAndCleanupMetadata
      where
        removeAndCleanupMetadata :: Metadata -> Metadata
removeAndCleanupMetadata Metadata
m =
          let newQueryCollection :: QueryCollections
newQueryCollection = QueryCollections -> QueryCollections
filteredCollection (Metadata -> QueryCollections
_metaQueryCollections Metadata
m)
              -- QueryCollections = InsOrdHashMap CollectionName CreateCollection
              filteredCollection :: QueryCollections -> QueryCollections
              filteredCollection :: QueryCollections -> QueryCollections
filteredCollection QueryCollections
qc = (CreateCollection -> Bool) -> QueryCollections -> QueryCollections
forall v k. (v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.filter (CreateCollection -> Bool
isNonEmptyCC) (QueryCollections -> QueryCollections)
-> QueryCollections -> QueryCollections
forall a b. (a -> b) -> a -> b
$ (CreateCollection -> CreateCollection)
-> CollectionName -> QueryCollections -> QueryCollections
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.adjust (CreateCollection -> CreateCollection
collectionModifier) (CollectionName
cName) QueryCollections
qc

              collectionModifier :: CreateCollection -> CreateCollection
              collectionModifier :: CreateCollection -> CreateCollection
collectionModifier cc :: CreateCollection
cc@CreateCollection {Maybe Text
CollectionDef
CollectionName
_ccName :: CollectionName
_ccDefinition :: CollectionDef
_ccComment :: Maybe Text
_ccName :: CreateCollection -> CollectionName
_ccDefinition :: CreateCollection -> CollectionDef
_ccComment :: CreateCollection -> Maybe Text
..} =
                CreateCollection
cc
                  { _ccDefinition :: CollectionDef
_ccDefinition =
                      let oldQueries :: [ListedQuery]
oldQueries = CollectionDef -> [ListedQuery]
_cdQueries CollectionDef
_ccDefinition
                       in CollectionDef
_ccDefinition
                            { _cdQueries :: [ListedQuery]
_cdQueries = (ListedQuery -> Bool) -> [ListedQuery] -> [ListedQuery]
forall a. (a -> Bool) -> [a] -> [a]
filter (ListedQuery -> ListedQuery -> Bool
forall a. Eq a => a -> a -> Bool
/= ListedQuery
lq) [ListedQuery]
oldQueries
                            }
                  }

              isNonEmptyCC :: CreateCollection -> Bool
              isNonEmptyCC :: CreateCollection -> Bool
isNonEmptyCC = Bool -> Bool
not (Bool -> Bool)
-> (CreateCollection -> Bool) -> CreateCollection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ListedQuery] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ListedQuery] -> Bool)
-> (CreateCollection -> [ListedQuery]) -> CreateCollection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CollectionDef -> [ListedQuery]
_cdQueries (CollectionDef -> [ListedQuery])
-> (CreateCollection -> CollectionDef)
-> CreateCollection
-> [ListedQuery]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateCollection -> CollectionDef
_ccDefinition

              cleanupAllowList :: MetadataAllowlist -> MetadataAllowlist
              cleanupAllowList :: MetadataAllowlist -> MetadataAllowlist
cleanupAllowList = (CollectionName -> AllowlistEntry -> Bool)
-> MetadataAllowlist -> MetadataAllowlist
forall k v.
(k -> v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.filterWithKey (\CollectionName
_ AllowlistEntry
_ -> CollectionName -> QueryCollections -> Bool
forall k a. (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool
InsOrdHashMap.member CollectionName
cName QueryCollections
newQueryCollection)

              cleanupRESTEndpoints :: Endpoints -> Endpoints
              cleanupRESTEndpoints :: Endpoints -> Endpoints
cleanupRESTEndpoints Endpoints
endpoints = (CreateEndpoint -> Bool) -> Endpoints -> Endpoints
forall v k. (v -> Bool) -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.filter (Bool -> Bool
not (Bool -> Bool)
-> (CreateEndpoint -> Bool) -> CreateEndpoint -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryReference -> Bool
isFaultyQuery (QueryReference -> Bool)
-> (CreateEndpoint -> QueryReference) -> CreateEndpoint -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndpointDef QueryReference -> QueryReference
forall query. EndpointDef query -> query
_edQuery (EndpointDef QueryReference -> QueryReference)
-> (CreateEndpoint -> EndpointDef QueryReference)
-> CreateEndpoint
-> QueryReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CreateEndpoint -> EndpointDef QueryReference
forall query. EndpointMetadata query -> EndpointDef query
_ceDefinition) Endpoints
endpoints

              isFaultyQuery :: QueryReference -> Bool
              isFaultyQuery :: QueryReference -> Bool
isFaultyQuery QueryReference {QueryName
CollectionName
_qrCollectionName :: CollectionName
_qrQueryName :: QueryName
_qrCollectionName :: QueryReference -> CollectionName
_qrQueryName :: QueryReference -> QueryName
..} = CollectionName
_qrCollectionName CollectionName -> CollectionName -> Bool
forall a. Eq a => a -> a -> Bool
== CollectionName
cName Bool -> Bool -> Bool
&& QueryName
_qrQueryName QueryName -> QueryName -> Bool
forall a. Eq a => a -> a -> Bool
== (ListedQuery -> QueryName
_lqName ListedQuery
lq)
           in Metadata
m
                { _metaQueryCollections :: QueryCollections
_metaQueryCollections = QueryCollections
newQueryCollection,
                  _metaAllowlist :: MetadataAllowlist
_metaAllowlist = MetadataAllowlist -> MetadataAllowlist
cleanupAllowList (Metadata -> MetadataAllowlist
_metaAllowlist Metadata
m),
                  _metaRestEndpoints :: Endpoints
_metaRestEndpoints = Endpoints -> Endpoints
cleanupRESTEndpoints (Metadata -> Endpoints
_metaRestEndpoints Metadata
m)
                }

runGetCatalogState ::
  (MonadMetadataStorage m, MonadError QErr m) => GetCatalogState -> m EncJSON
runGetCatalogState :: forall (m :: * -> *).
(MonadMetadataStorage m, MonadError QErr m) =>
GetCatalogState -> m EncJSON
runGetCatalogState GetCatalogState
_ =
  CatalogState -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (CatalogState -> EncJSON) -> m CatalogState -> m EncJSON
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Either QErr CatalogState) -> m CatalogState
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM m (Either QErr CatalogState)
forall (m :: * -> *).
MonadMetadataStorage m =>
m (Either QErr CatalogState)
fetchCatalogState

runSetCatalogState ::
  (MonadMetadataStorage m, MonadError QErr m) => SetCatalogState -> m EncJSON
runSetCatalogState :: forall (m :: * -> *).
(MonadMetadataStorage m, MonadError QErr m) =>
SetCatalogState -> m EncJSON
runSetCatalogState SetCatalogState {Value
CatalogStateType
_scsType :: CatalogStateType
_scsState :: Value
_scsType :: SetCatalogState -> CatalogStateType
_scsState :: SetCatalogState -> Value
..} = do
  m (Either QErr ()) -> m ()
forall e (m :: * -> *) a. MonadError e m => m (Either e a) -> m a
liftEitherM (m (Either QErr ()) -> m ()) -> m (Either QErr ()) -> m ()
forall a b. (a -> b) -> a -> b
$ CatalogStateType -> Value -> m (Either QErr ())
forall (m :: * -> *).
MonadMetadataStorage m =>
CatalogStateType -> Value -> m (Either QErr ())
updateCatalogState CatalogStateType
_scsType Value
_scsState
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runSetMetricsConfig ::
  (MonadIO m, CacheRWM m, MetadataM m, MonadError QErr m) =>
  MetricsConfig ->
  m EncJSON
runSetMetricsConfig :: forall (m :: * -> *).
(MonadIO m, CacheRWM m, MetadataM m, MonadError QErr m) =>
MetricsConfig -> m EncJSON
runSetMetricsConfig MetricsConfig
mc = do
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (MetricsConfig -> Identity MetricsConfig)
-> Metadata -> Identity Metadata
Lens' Metadata MetricsConfig
metaMetricsConfig
    ((MetricsConfig -> Identity MetricsConfig)
 -> Metadata -> Identity Metadata)
-> MetricsConfig -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MetricsConfig
mc
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runRemoveMetricsConfig ::
  (MonadIO m, CacheRWM m, MetadataM m, MonadError QErr m) =>
  m EncJSON
runRemoveMetricsConfig :: forall (m :: * -> *).
(MonadIO m, CacheRWM m, MetadataM m, MonadError QErr m) =>
m EncJSON
runRemoveMetricsConfig = do
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (MetricsConfig -> Identity MetricsConfig)
-> Metadata -> Identity Metadata
Lens' Metadata MetricsConfig
metaMetricsConfig
    ((MetricsConfig -> Identity MetricsConfig)
 -> Metadata -> Identity Metadata)
-> MetricsConfig -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ MetricsConfig
emptyMetricsConfig
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

data TestTransformError
  = RequestInitializationError HTTP.HttpException
  | RequestTransformationError HTTP.Request TransformErrorBundle

runTestWebhookTransform ::
  (QErrM m) =>
  TestWebhookTransform ->
  m EncJSON
runTestWebhookTransform :: forall (m :: * -> *). QErrM m => TestWebhookTransform -> m EncJSON
runTestWebhookTransform (TestWebhookTransform Environment
env [Header]
headers WebHookUrl
urlE Value
payload RequestTransform
rt Maybe MetadataResponseTransform
_ Maybe SessionVariables
sv) = do
  Text
url <- case WebHookUrl
urlE of
    URL Text
url' -> Environment -> Text -> m Text
forall (m :: * -> *).
MonadError QErr m =>
Environment -> Text -> m Text
interpolateFromEnv Environment
env Text
url'
    EnvVar String
var ->
      let err :: m a
err = QErr -> m a
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (QErr -> m a) -> QErr -> m a
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err400 Code
NotFound Text
"Missing Env Var"
       in m Text -> (String -> m Text) -> Maybe String -> m Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m Text
forall {a}. m a
err (Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> (String -> Text) -> String -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Maybe String -> m Text) -> Maybe String -> m Text
forall a b. (a -> b) -> a -> b
$ Environment -> String -> Maybe String
Env.lookupEnv Environment
env String
var

  [Header]
headers' <- (Header -> m Header) -> [Header] -> m [Header]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((ByteString -> m ByteString) -> Header -> m Header
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (HeaderName, a) -> f (HeaderName, b)
traverse ((Text -> ByteString) -> m Text -> m ByteString
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ByteString
TE.encodeUtf8 (m Text -> m ByteString)
-> (ByteString -> m Text) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Environment -> Text -> m Text
forall (m :: * -> *).
MonadError QErr m =>
Environment -> Text -> m Text
interpolateFromEnv Environment
env (Text -> m Text) -> (ByteString -> Text) -> ByteString -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8)) [Header]
headers

  Either TestTransformError Request
result <- ExceptT TestTransformError m Request
-> m (Either TestTransformError Request)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT TestTransformError m Request
 -> m (Either TestTransformError Request))
-> ExceptT TestTransformError m Request
-> m (Either TestTransformError Request)
forall a b. (a -> b) -> a -> b
$ do
    Request
initReq <- Either TestTransformError Request
-> ExceptT TestTransformError m Request
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> ExceptT e m a
hoistEither (Either TestTransformError Request
 -> ExceptT TestTransformError m Request)
-> Either TestTransformError Request
-> ExceptT TestTransformError m Request
forall a b. (a -> b) -> a -> b
$ (HttpException -> TestTransformError)
-> Either HttpException Request
-> Either TestTransformError Request
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HttpException -> TestTransformError
RequestInitializationError (Either HttpException Request -> Either TestTransformError Request)
-> Either HttpException Request
-> Either TestTransformError Request
forall a b. (a -> b) -> a -> b
$ Text -> Either HttpException Request
HTTP.mkRequestEither Text
url

    let req :: Request
req = Request
initReq Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& (RequestBody -> Identity RequestBody)
-> Request -> Identity Request
Lens' Request RequestBody
HTTP.body ((RequestBody -> Identity RequestBody)
 -> Request -> Identity Request)
-> RequestBody -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString -> RequestBody
HTTP.RequestBodyLBS (Value -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode Value
payload) Request -> (Request -> Request) -> Request
forall a b. a -> (a -> b) -> b
& ([Header] -> Identity [Header]) -> Request -> Identity Request
Lens' Request [Header]
HTTP.headers (([Header] -> Identity [Header]) -> Request -> Identity Request)
-> [Header] -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Header]
headers'
        reqTransform :: RequestFields (WithOptional TransformFn)
reqTransform = RequestTransform -> RequestFields (WithOptional TransformFn)
requestFields RequestTransform
rt
        engine :: TemplatingEngine
engine = RequestTransform -> TemplatingEngine
templateEngine RequestTransform
rt
        reqTransformCtx :: Request -> RequestContext
reqTransformCtx = (RequestTransformCtx -> RequestContext)
-> (Request -> RequestTransformCtx) -> Request -> RequestContext
forall a b. (a -> b) -> (Request -> a) -> Request -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RequestTransformCtx -> RequestContext
mkRequestContext ((Request -> RequestTransformCtx) -> Request -> RequestContext)
-> (Request -> RequestTransformCtx) -> Request -> RequestContext
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe SessionVariables
-> TemplatingEngine
-> Request
-> RequestTransformCtx
mkReqTransformCtx Text
url Maybe SessionVariables
sv TemplatingEngine
engine
    Either TestTransformError Request
-> ExceptT TestTransformError m Request
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> ExceptT e m a
hoistEither (Either TestTransformError Request
 -> ExceptT TestTransformError m Request)
-> Either TestTransformError Request
-> ExceptT TestTransformError m Request
forall a b. (a -> b) -> a -> b
$ (TransformErrorBundle -> TestTransformError)
-> Either TransformErrorBundle Request
-> Either TestTransformError Request
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Request -> TransformErrorBundle -> TestTransformError
RequestTransformationError Request
req) (Either TransformErrorBundle Request
 -> Either TestTransformError Request)
-> Either TransformErrorBundle Request
-> Either TestTransformError Request
forall a b. (a -> b) -> a -> b
$ (Request -> RequestContext)
-> RequestFields (WithOptional TransformFn)
-> Request
-> Either TransformErrorBundle Request
forall (m :: * -> *).
MonadError TransformErrorBundle m =>
(Request -> RequestContext)
-> RequestFields (WithOptional TransformFn) -> Request -> m Request
applyRequestTransform Request -> RequestContext
reqTransformCtx RequestFields (WithOptional TransformFn)
reqTransform Request
req

  case Either TestTransformError Request
result of
    Right Request
transformed ->
      Either TransformErrorBundle Request -> m EncJSON
forall (m :: * -> *).
MonadError QErr m =>
Either TransformErrorBundle Request -> m EncJSON
packTransformResult (Either TransformErrorBundle Request -> m EncJSON)
-> Either TransformErrorBundle Request -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Request -> Either TransformErrorBundle Request
forall a b. b -> Either a b
Right Request
transformed
    Left (RequestTransformationError Request
_ TransformErrorBundle
err) -> Either TransformErrorBundle Request -> m EncJSON
forall (m :: * -> *).
MonadError QErr m =>
Either TransformErrorBundle Request -> m EncJSON
packTransformResult (TransformErrorBundle -> Either TransformErrorBundle Request
forall a b. a -> Either a b
Left TransformErrorBundle
err)
    -- NOTE: In the following case we have failed before producing a valid request.
    Left (RequestInitializationError HttpException
err) ->
      let errorBundle :: TransformErrorBundle
errorBundle =
            [Value] -> TransformErrorBundle
TransformErrorBundle
              ([Value] -> TransformErrorBundle)
-> [Value] -> TransformErrorBundle
forall a b. (a -> b) -> a -> b
$ Value -> [Value]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              (Value -> [Value]) -> Value -> [Value]
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
J.object [Key
"error_code" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text -> Value
J.String Text
"Request Initialization Error", Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Text -> Value
J.String (HttpException -> Text
forall a. Show a => a -> Text
tshow HttpException
err)]
       in Code -> Text -> Value -> m EncJSON
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail Code
ValidationFailed Text
"request transform validation failed" (Value -> m EncJSON) -> Value -> m EncJSON
forall a b. (a -> b) -> a -> b
$ TransformErrorBundle -> Value
forall a. ToJSON a => a -> Value
J.toJSON TransformErrorBundle
errorBundle

interpolateFromEnv :: (MonadError QErr m) => Env.Environment -> Text -> m Text
interpolateFromEnv :: forall (m :: * -> *).
MonadError QErr m =>
Environment -> Text -> m Text
interpolateFromEnv Environment
env Text
url =
  case Parser [Either Text Text]
-> Text -> Either String [Either Text Text]
forall a. Parser a -> Text -> Either String a
AT.parseOnly Parser [Either Text Text]
parseEnvTemplate Text
url of
    Left String
_ -> QErr -> m Text
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (QErr -> m Text) -> QErr -> m Text
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err400 Code
ParseFailed Text
"Invalid Url Template"
    Right [Either Text Text]
xs ->
      let lookup' :: Text -> Either Text Text
lookup' Text
var = Either Text Text
-> (String -> Either Text Text) -> Maybe String -> Either Text Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Either Text Text
forall a b. a -> Either a b
Left Text
var) (Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text)
-> (String -> Text) -> String -> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) (Maybe String -> Either Text Text)
-> Maybe String -> Either Text Text
forall a b. (a -> b) -> a -> b
$ Environment -> String -> Maybe String
Env.lookupEnv Environment
env (Text -> String
T.unpack Text
var)
          result :: Either Text [Text]
result = (Either Text Text -> Either Text Text)
-> [Either Text Text] -> Either Text [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((Either Text Text -> Text)
-> Either Text (Either Text Text) -> Either Text Text
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either Text Text -> Text
forall a. Either a a -> a
indistinct (Either Text (Either Text Text) -> Either Text Text)
-> (Either Text Text -> Either Text (Either Text Text))
-> Either Text Text
-> Either Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either Text Text)
-> (Text -> Either Text Text)
-> Either Text Text
-> Either Text (Either Text Text)
forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse Text -> Either Text Text
lookup' Text -> Either Text Text
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) [Either Text Text]
xs
          err :: Text -> m a
err Text
e =
            QErr -> m a
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
              (QErr -> m a) -> QErr -> m a
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err400 Code
NotFound
              (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ Text
"Missing Env Var: "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". For security reasons when testing request options real environment variable values are not available. Please enter a mock value for "
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in the Sample Env Variables list. See https://hasura.io/docs/latest/graphql/core/actions/rest-connectors/#action-transforms-sample-context"
       in (Text -> m Text)
-> ([Text] -> m Text) -> Either Text [Text] -> m Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Text -> m Text
forall {m :: * -> *} {a}. MonadError QErr m => Text -> m a
err (Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> ([Text] -> Text) -> [Text] -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold) Either Text [Text]
result

-- | Deserialize a JSON or X-WWW-URL-FORMENCODED body from an
-- 'HTTP.Request' as 'J.Value'.
decodeBody :: Maybe BL.ByteString -> J.Value
decodeBody :: Maybe ByteString -> Value
decodeBody Maybe ByteString
Nothing = Value
J.Null
decodeBody (Just ByteString
bs) = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
J.Null (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Value
jsonToValue ByteString
bs Maybe Value -> Maybe Value -> Maybe Value
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Maybe Value
formUrlEncodedToValue ByteString
bs

-- | Attempt to encode a 'ByteString' as an Aeson 'Value'
jsonToValue :: BL.ByteString -> Maybe J.Value
jsonToValue :: ByteString -> Maybe Value
jsonToValue ByteString
bs = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
J.decode ByteString
bs

-- | Quote a 'ByteString' then attempt to encode it as a JSON
-- String. This is necessary for 'x-www-url-formencoded' bodies. They
-- are a list of key/value pairs encoded as a raw 'ByteString' with no
-- quoting whereas JSON Strings must be quoted.
formUrlEncodedToValue :: BL.ByteString -> Maybe J.Value
formUrlEncodedToValue :: ByteString -> Maybe Value
formUrlEncodedToValue ByteString
bs = ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
J.decode (ByteString
"\"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\"")

parseEnvTemplate :: AT.Parser [Either T.Text T.Text]
parseEnvTemplate :: Parser [Either Text Text]
parseEnvTemplate = Parser Text (Either Text Text) -> Parser [Either Text Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
AT.many1 (Parser Text (Either Text Text) -> Parser [Either Text Text])
-> Parser Text (Either Text Text) -> Parser [Either Text Text]
forall a b. (a -> b) -> a -> b
$ Parser Text (Either Text Text)
forall {b}. Parser Text (Either Text b)
pEnv Parser Text (Either Text Text)
-> Parser Text (Either Text Text) -> Parser Text (Either Text Text)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text (Either Text Text)
forall {a}. Parser Text (Either a Text)
pLit Parser Text (Either Text Text)
-> Parser Text (Either Text Text) -> Parser Text (Either Text Text)
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Either Text Text)
-> Parser Text Text -> Parser Text (Either Text Text)
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either Text Text
forall a b. b -> Either a b
Right Parser Text Text
"{"
  where
    pEnv :: Parser Text (Either Text b)
pEnv = (Text -> Either Text b)
-> Parser Text Text -> Parser Text (Either Text b)
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Either Text b
forall a b. a -> Either a b
Left) (Parser Text Text -> Parser Text (Either Text b))
-> Parser Text Text -> Parser Text (Either Text b)
forall a b. (a -> b) -> a -> b
$ Parser Text Text
"{{" Parser Text Text -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
AT.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'}') Parser Text Text -> Parser Text Text -> Parser Text Text
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Text
"}}"
    pLit :: Parser Text (Either a Text)
pLit = (Text -> Either a Text)
-> Parser Text Text -> Parser Text (Either a Text)
forall a b. (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Either a Text
forall a b. b -> Either a b
Right (Parser Text Text -> Parser Text (Either a Text))
-> Parser Text Text -> Parser Text (Either a Text)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text Text
AT.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'{')

indistinct :: Either a a -> a
indistinct :: forall a. Either a a -> a
indistinct = (a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id

packTransformResult :: (MonadError QErr m) => Either TransformErrorBundle HTTP.Request -> m EncJSON
packTransformResult :: forall (m :: * -> *).
MonadError QErr m =>
Either TransformErrorBundle Request -> m EncJSON
packTransformResult = \case
  Right Request
req ->
    EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (EncJSON -> m EncJSON) -> (Value -> EncJSON) -> Value -> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue
      (Value -> m EncJSON) -> Value -> m EncJSON
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
J.object
        [ Key
"webhook_url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (Request
req Request -> Getting Text Request Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Request Text
Lens' Request Text
HTTP.url),
          Key
"method" Key -> ByteString -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= (Request
req Request -> Getting ByteString Request ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString Request ByteString
Lens' Request ByteString
HTTP.method),
          Key
"headers" Key -> [(ByteString, ByteString)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= ((HeaderName -> ByteString) -> Header -> (ByteString, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first HeaderName -> ByteString
forall s. CI s -> s
CI.foldedCase (Header -> (ByteString, ByteString))
-> [Header] -> [(ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Request
req Request -> Getting [Header] Request [Header] -> [Header]
forall s a. s -> Getting a s a -> a
^. Getting [Header] Request [Header]
Lens' Request [Header]
HTTP.headers)),
          -- NOTE: We cannot decode IO based body types.
          Key
"body" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
J..= Maybe ByteString -> Value
decodeBody (Request
req Request
-> Getting (First ByteString) Request ByteString
-> Maybe ByteString
forall s a. s -> Getting (First a) s a -> Maybe a
^? (RequestBody -> Const (First ByteString) RequestBody)
-> Request -> Const (First ByteString) Request
Lens' Request RequestBody
HTTP.body ((RequestBody -> Const (First ByteString) RequestBody)
 -> Request -> Const (First ByteString) Request)
-> ((ByteString -> Const (First ByteString) ByteString)
    -> RequestBody -> Const (First ByteString) RequestBody)
-> Getting (First ByteString) Request ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Const (First ByteString) ByteString)
-> RequestBody -> Const (First ByteString) RequestBody
Prism' RequestBody ByteString
HTTP._RequestBodyLBS)
        ]
  Left TransformErrorBundle
err -> Code -> Text -> Value -> m EncJSON
forall (m :: * -> *) a. QErrM m => Code -> Text -> Value -> m a
throw400WithDetail Code
ValidationFailed Text
"request transform validation failed" (Value -> m EncJSON) -> Value -> m EncJSON
forall a b. (a -> b) -> a -> b
$ TransformErrorBundle -> Value
forall a. ToJSON a => a -> Value
J.toJSON TransformErrorBundle
err