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 Map
import Data.HashMap.Strict.InsOrd.Extended qualified as OMap
import Data.HashSet qualified as HS
import Data.HashSet qualified as Set
import Data.List qualified as L
import Data.SerializableBlob qualified as SB
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Text.Extended (dquoteList, (<<>))
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Logging qualified as HL
import Hasura.Metadata.Class
import Hasura.Prelude hiding (first)
import Hasura.RQL.DDL.Action
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.Network
import Hasura.RQL.DDL.Permission
import Hasura.RQL.DDL.Relationship
import Hasura.RQL.DDL.RemoteRelationship
import Hasura.RQL.DDL.RemoteSchema
import Hasura.RQL.DDL.ScheduledTrigger
import Hasura.RQL.DDL.Schema
import Hasura.RQL.DDL.Schema.Source
import Hasura.RQL.DDL.Webhook.Transform
import Hasura.RQL.DDL.Webhook.Transform.Class (mkReqTransformCtx)
import Hasura.RQL.Types.Allowlist
import Hasura.RQL.Types.ApiLimit
import Hasura.RQL.Types.Backend
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.Eventing.Backend (BackendEventTrigger (..))
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Network
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.SourceCustomization
import Hasura.SQL.AnyBackend qualified as AB
import Network.HTTP.Client.Transformable qualified as HTTP

runClearMetadata ::
  forall m r.
  ( QErrM m,
    MonadIO m,
    CacheRWM m,
    MetadataM m,
    MonadMetadataStorageQueryAPI m,
    MonadBaseControl IO m,
    MonadReader r m,
    Has (HL.Logger HL.Hasura) r
  ) =>
  ClearMetadata ->
  m EncJSON
runClearMetadata :: ClearMetadata -> m EncJSON
runClearMetadata ClearMetadata
_ = do
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  -- Clean up all sources, drop hdb_catalog schema from source
  [(SourceName, BackendSourceMetadata)]
-> ((SourceName, BackendSourceMetadata) -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (InsOrdHashMap SourceName BackendSourceMetadata
-> [(SourceName, BackendSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList (InsOrdHashMap SourceName BackendSourceMetadata
 -> [(SourceName, BackendSourceMetadata)])
-> InsOrdHashMap SourceName BackendSourceMetadata
-> [(SourceName, BackendSourceMetadata)]
forall a b. (a -> b) -> a -> b
$ Metadata -> InsOrdHashMap SourceName BackendSourceMetadata
_metaSources Metadata
metadata) (((SourceName, BackendSourceMetadata) -> m ()) -> m ())
-> ((SourceName, BackendSourceMetadata) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(SourceName
sourceName, BackendSourceMetadata
backendSourceMetadata) ->
    AnyBackend SourceMetadata
-> (forall (b :: BackendType).
    BackendMetadata b =>
    SourceMetadata b -> m ())
-> m ()
forall (c :: BackendType -> Constraint) (i :: BackendType -> *) r.
AllBackendsSatisfy c =>
AnyBackend i -> (forall (b :: BackendType). c b => i b -> r) -> r
AB.dispatchAnyBackend @BackendMetadata (BackendSourceMetadata -> AnyBackend SourceMetadata
unBackendSourceMetadata BackendSourceMetadata
backendSourceMetadata) \(SourceMetadata b
_sourceMetadata :: SourceMetadata b) -> do
      SourceInfo b
sourceInfo <- SourceName -> m (SourceInfo b)
forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MetadataM m, MonadError QErr m, Backend b) =>
SourceName -> m (SourceInfo b)
askSourceInfo @b SourceName
sourceName
      -- We do not bother dropping all dependencies on the source, because the
      -- metadata is going to be replaced with an empty metadata. And dropping the
      -- depdencies would lead to rebuilding of schema cache which is of no use here
      -- since we do not use the rebuilt schema cache. Hence, we only clean up the
      -- 'hdb_catalog' tables from the source.
      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
sourceName SourceInfo b
sourceInfo

  -- 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
^? (InsOrdHashMap SourceName BackendSourceMetadata
 -> Const
      (First (AnyBackend SourceMetadata))
      (InsOrdHashMap SourceName BackendSourceMetadata))
-> Metadata -> Const (First (AnyBackend SourceMetadata)) Metadata
Lens' Metadata (InsOrdHashMap SourceName BackendSourceMetadata)
metaSources ((InsOrdHashMap SourceName BackendSourceMetadata
  -> Const
       (First (AnyBackend SourceMetadata))
       (InsOrdHashMap SourceName BackendSourceMetadata))
 -> Metadata -> Const (First (AnyBackend SourceMetadata)) Metadata)
-> ((AnyBackend SourceMetadata
     -> Const
          (First (AnyBackend SourceMetadata)) (AnyBackend SourceMetadata))
    -> InsOrdHashMap SourceName BackendSourceMetadata
    -> Const
         (First (AnyBackend SourceMetadata))
         (InsOrdHashMap SourceName BackendSourceMetadata))
-> Getting
     (First (AnyBackend SourceMetadata))
     Metadata
     (AnyBackend SourceMetadata)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap SourceName BackendSourceMetadata)
-> Traversal'
     (InsOrdHashMap SourceName BackendSourceMetadata)
     (IxValue (InsOrdHashMap SourceName BackendSourceMetadata))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (InsOrdHashMap SourceName BackendSourceMetadata)
SourceName
defaultSource ((BackendSourceMetadata
  -> Const (First (AnyBackend SourceMetadata)) BackendSourceMetadata)
 -> InsOrdHashMap SourceName BackendSourceMetadata
 -> Const
      (First (AnyBackend SourceMetadata))
      (InsOrdHashMap SourceName BackendSourceMetadata))
-> ((AnyBackend SourceMetadata
     -> Const
          (First (AnyBackend SourceMetadata)) (AnyBackend SourceMetadata))
    -> BackendSourceMetadata
    -> Const (First (AnyBackend SourceMetadata)) BackendSourceMetadata)
-> (AnyBackend SourceMetadata
    -> Const
         (First (AnyBackend SourceMetadata)) (AnyBackend SourceMetadata))
-> InsOrdHashMap SourceName BackendSourceMetadata
-> Const
     (First (AnyBackend SourceMetadata))
     (InsOrdHashMap SourceName BackendSourceMetadata)
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 =
                AnyBackend SourceMetadata
-> (forall (b :: BackendType).
    Backend b =>
    SourceMetadata b -> BackendSourceMetadata)
-> BackendSourceMetadata
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 \(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
forall (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
$
                      SourceName
-> BackendSourceKind b
-> Tables b
-> Functions b
-> SourceConnConfiguration b
-> Maybe QueryTagsConfig
-> SourceCustomization
-> SourceMetadata b
forall (b :: BackendType).
SourceName
-> BackendSourceKind b
-> Tables b
-> Functions b
-> SourceConnConfiguration b
-> Maybe QueryTagsConfig
-> SourceCustomization
-> SourceMetadata b
SourceMetadata
                        @b
                        SourceName
defaultSource
                        (SourceMetadata b -> BackendSourceKind b
forall (b :: BackendType). SourceMetadata b -> BackendSourceKind b
_smKind @b SourceMetadata b
s)
                        Tables b
forall a. Monoid a => a
mempty
                        Functions b
forall a. Monoid a => a
mempty
                        (SourceMetadata b -> SourceConnConfiguration b
forall (b :: BackendType).
SourceMetadata b -> SourceConnConfiguration b
_smConfiguration @b SourceMetadata b
s)
                        Maybe QueryTagsConfig
forall a. Maybe a
Nothing
                        SourceCustomization
emptySourceCustomization
           in Metadata
emptyMetadata
                Metadata -> (Metadata -> Metadata) -> Metadata
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap SourceName BackendSourceMetadata
 -> Identity (InsOrdHashMap SourceName BackendSourceMetadata))
-> Metadata -> Identity Metadata
Lens' Metadata (InsOrdHashMap SourceName BackendSourceMetadata)
metaSources ((InsOrdHashMap SourceName BackendSourceMetadata
  -> Identity (InsOrdHashMap SourceName BackendSourceMetadata))
 -> Metadata -> Identity Metadata)
-> (InsOrdHashMap SourceName BackendSourceMetadata
    -> InsOrdHashMap SourceName BackendSourceMetadata)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SourceName
-> BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.insert SourceName
defaultSource BackendSourceMetadata
emptyDefaultSource
  ReplaceMetadataV1 -> m EncJSON
forall (m :: * -> *) r.
(QErrM m, CacheRWM m, MetadataM m, MonadIO m,
 MonadMetadataStorageQueryAPI m, MonadReader r m,
 Has (Logger Hasura) r) =>
ReplaceMetadataV1 -> m EncJSON
runReplaceMetadataV1 (ReplaceMetadataV1 -> m EncJSON) -> ReplaceMetadataV1 -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Metadata -> ReplaceMetadataV1
RMWithSources Metadata
emptyMetadata'

{- 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,
    MonadMetadataStorageQueryAPI m,
    MonadReader r m,
    Has (HL.Logger HL.Hasura) r
  ) =>
  ReplaceMetadata ->
  m EncJSON
runReplaceMetadata :: ReplaceMetadata -> m EncJSON
runReplaceMetadata = \case
  RMReplaceMetadataV1 ReplaceMetadataV1
v1args -> ReplaceMetadataV1 -> m EncJSON
forall (m :: * -> *) r.
(QErrM m, CacheRWM m, MetadataM m, MonadIO m,
 MonadMetadataStorageQueryAPI m, MonadReader r m,
 Has (Logger Hasura) r) =>
ReplaceMetadataV1 -> m EncJSON
runReplaceMetadataV1 ReplaceMetadataV1
v1args
  RMReplaceMetadataV2 ReplaceMetadataV2
v2args -> ReplaceMetadataV2 -> m EncJSON
forall (m :: * -> *) r.
(QErrM m, CacheRWM m, MetadataM m, MonadIO m,
 MonadMetadataStorageQueryAPI m, MonadReader r m,
 Has (Logger Hasura) r) =>
ReplaceMetadataV2 -> m EncJSON
runReplaceMetadataV2 ReplaceMetadataV2
v2args

runReplaceMetadataV1 ::
  ( QErrM m,
    CacheRWM m,
    MetadataM m,
    MonadIO m,
    MonadMetadataStorageQueryAPI m,
    MonadReader r m,
    Has (HL.Logger HL.Hasura) r
  ) =>
  ReplaceMetadataV1 ->
  m EncJSON
runReplaceMetadataV1 :: ReplaceMetadataV1 -> m EncJSON
runReplaceMetadataV1 =
  (EncJSON
successMsg EncJSON -> m EncJSON -> m EncJSON
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (m EncJSON -> m EncJSON)
-> (ReplaceMetadataV1 -> m EncJSON)
-> ReplaceMetadataV1
-> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReplaceMetadataV2 -> m EncJSON
forall (m :: * -> *) r.
(QErrM m, CacheRWM m, MetadataM m, MonadIO m,
 MonadMetadataStorageQueryAPI m, MonadReader r m,
 Has (Logger Hasura) r) =>
ReplaceMetadataV2 -> m EncJSON
runReplaceMetadataV2 (ReplaceMetadataV2 -> m EncJSON)
-> (ReplaceMetadataV1 -> ReplaceMetadataV2)
-> ReplaceMetadataV1
-> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowInconsistentMetadata -> ReplaceMetadataV1 -> ReplaceMetadataV2
ReplaceMetadataV2 AllowInconsistentMetadata
NoAllowInconsistentMetadata

runReplaceMetadataV2 ::
  forall m r.
  ( QErrM m,
    CacheRWM m,
    MetadataM m,
    MonadIO m,
    MonadMetadataStorageQueryAPI m,
    MonadReader r m,
    Has (HL.Logger HL.Hasura) r
  ) =>
  ReplaceMetadataV2 ->
  m EncJSON
runReplaceMetadataV2 :: ReplaceMetadataV2 -> m EncJSON
runReplaceMetadataV2 ReplaceMetadataV2 {ReplaceMetadataV1
AllowInconsistentMetadata
_rmv2Metadata :: ReplaceMetadataV2 -> ReplaceMetadataV1
_rmv2AllowInconsistentMetadata :: ReplaceMetadataV2 -> AllowInconsistentMetadata
_rmv2Metadata :: ReplaceMetadataV1
_rmv2AllowInconsistentMetadata :: AllowInconsistentMetadata
..} = 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 (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
Tables ('Postgres 'Vanilla)
Functions ('Postgres 'Vanilla)
CronTriggers
RemoteSchemas
Actions
CustomTypes
_mnsCronTriggers :: MetadataNoSources -> CronTriggers
_mnsActions :: MetadataNoSources -> Actions
_mnsCustomTypes :: MetadataNoSources -> CustomTypes
_mnsAllowlist :: MetadataNoSources -> MetadataAllowlist
_mnsQueryCollections :: MetadataNoSources -> QueryCollections
_mnsRemoteSchemas :: MetadataNoSources -> RemoteSchemas
_mnsFunctions :: MetadataNoSources -> Functions ('Postgres 'Vanilla)
_mnsTables :: MetadataNoSources -> Tables ('Postgres 'Vanilla)
_mnsCronTriggers :: CronTriggers
_mnsActions :: Actions
_mnsCustomTypes :: CustomTypes
_mnsAllowlist :: MetadataAllowlist
_mnsQueryCollections :: QueryCollections
_mnsRemoteSchemas :: RemoteSchemas
_mnsFunctions :: Functions ('Postgres 'Vanilla)
_mnsTables :: Tables ('Postgres 'Vanilla)
..} -> 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
^? (InsOrdHashMap SourceName BackendSourceMetadata
 -> Const
      (First (SourceMetadata ('Postgres 'Vanilla)))
      (InsOrdHashMap SourceName BackendSourceMetadata))
-> Metadata
-> Const (First (SourceMetadata ('Postgres 'Vanilla))) Metadata
Lens' Metadata (InsOrdHashMap SourceName BackendSourceMetadata)
metaSources ((InsOrdHashMap SourceName BackendSourceMetadata
  -> Const
       (First (SourceMetadata ('Postgres 'Vanilla)))
       (InsOrdHashMap SourceName BackendSourceMetadata))
 -> Metadata
 -> Const (First (SourceMetadata ('Postgres 'Vanilla))) Metadata)
-> ((SourceMetadata ('Postgres 'Vanilla)
     -> Const
          (First (SourceMetadata ('Postgres 'Vanilla)))
          (SourceMetadata ('Postgres 'Vanilla)))
    -> InsOrdHashMap SourceName BackendSourceMetadata
    -> Const
         (First (SourceMetadata ('Postgres 'Vanilla)))
         (InsOrdHashMap SourceName BackendSourceMetadata))
-> Getting
     (First (SourceMetadata ('Postgres 'Vanilla)))
     Metadata
     (SourceMetadata ('Postgres 'Vanilla))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (InsOrdHashMap SourceName BackendSourceMetadata)
-> Traversal'
     (InsOrdHashMap SourceName BackendSourceMetadata)
     (IxValue (InsOrdHashMap SourceName BackendSourceMetadata))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (InsOrdHashMap SourceName BackendSourceMetadata)
SourceName
defaultSource ((BackendSourceMetadata
  -> Const
       (First (SourceMetadata ('Postgres 'Vanilla)))
       BackendSourceMetadata)
 -> InsOrdHashMap SourceName BackendSourceMetadata
 -> Const
      (First (SourceMetadata ('Postgres 'Vanilla)))
      (InsOrdHashMap SourceName BackendSourceMetadata))
-> ((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)))
-> InsOrdHashMap SourceName BackendSourceMetadata
-> Const
     (First (SourceMetadata ('Postgres 'Vanilla)))
     (InsOrdHashMap SourceName BackendSourceMetadata)
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)
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 (f :: * -> *) a. Applicative f => a -> f a
pure (Metadata -> m Metadata) -> Metadata -> m Metadata
forall a b. (a -> b) -> a -> b
$
        InsOrdHashMap SourceName BackendSourceMetadata
-> RemoteSchemas
-> QueryCollections
-> MetadataAllowlist
-> CustomTypes
-> Actions
-> CronTriggers
-> Endpoints
-> ApiLimit
-> MetricsConfig
-> InheritedRoles
-> SetGraphqlIntrospectionOptions
-> Network
-> BackendMap BackendConfigWrapper
-> Metadata
Metadata
          (SourceName
-> BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
OMap.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
  Metadata -> m ()
forall (m :: * -> *). MetadataM m => Metadata -> m ()
putMetadata Metadata
metadata

  -- Check for duplicate trigger names in the new source metadata
  let oldSources :: InsOrdHashMap SourceName BackendSourceMetadata
oldSources = (Metadata -> InsOrdHashMap SourceName BackendSourceMetadata
_metaSources Metadata
oldMetadata)
  let newSources :: InsOrdHashMap SourceName BackendSourceMetadata
newSources = (Metadata -> InsOrdHashMap SourceName BackendSourceMetadata
_metaSources Metadata
metadata)
  [(SourceName, BackendSourceMetadata)]
-> ((SourceName, BackendSourceMetadata) -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (InsOrdHashMap SourceName BackendSourceMetadata
-> [(SourceName, BackendSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList InsOrdHashMap SourceName BackendSourceMetadata
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 (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
onJust (SourceName
-> InsOrdHashMap SourceName BackendSourceMetadata
-> Maybe BackendSourceMetadata
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
OMap.lookup SourceName
source InsOrdHashMap SourceName BackendSourceMetadata
oldSources) ((BackendSourceMetadata -> m ()) -> m ())
-> (BackendSourceMetadata -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \BackendSourceMetadata
_oldBackendSourceMetadata ->
      BackendSourceMetadata
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    SourceMetadata b -> m ())
-> m ()
forall r.
BackendSourceMetadata
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    SourceMetadata b -> r)
-> r
dispatch 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]
OMap.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]
OMap.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. (Hashable a, Eq a) => [a] -> [a]
hashNub [TriggerName]
newTriggerNames)
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([TriggerName] -> 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))

  case AllowInconsistentMetadata
_rmv2AllowInconsistentMetadata of
    AllowInconsistentMetadata
AllowInconsistentMetadata ->
      MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache MetadataModifier
forall a. Monoid a => a
mempty
    AllowInconsistentMetadata
NoAllowInconsistentMetadata ->
      m ()
forall (m :: * -> *). (QErrM m, CacheRWM m, MetadataM m) => m ()
buildSchemaCacheStrict

  -- 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 Value
Maybe Text
Maybe MetadataResponseTransform
Maybe RequestTransform
CronSchedule
InputWebhook
TriggerName
STRetryConf
ctResponseTransform :: CronTriggerMetadata -> Maybe MetadataResponseTransform
ctRequestTransform :: CronTriggerMetadata -> Maybe RequestTransform
ctComment :: CronTriggerMetadata -> Maybe Text
ctIncludeInMetadata :: CronTriggerMetadata -> Bool
ctHeaders :: CronTriggerMetadata -> [HeaderConf]
ctRetryConf :: CronTriggerMetadata -> STRetryConf
ctPayload :: CronTriggerMetadata -> Maybe Value
ctSchedule :: CronTriggerMetadata -> CronSchedule
ctWebhook :: CronTriggerMetadata -> InputWebhook
ctName :: CronTriggerMetadata -> TriggerName
ctResponseTransform :: Maybe MetadataResponseTransform
ctRequestTransform :: Maybe RequestTransform
ctComment :: Maybe Text
ctIncludeInMetadata :: Bool
ctHeaders :: [HeaderConf]
ctRetryConf :: STRetryConf
ctPayload :: Maybe Value
ctSchedule :: CronSchedule
ctWebhook :: InputWebhook
ctName :: TriggerName
..} ->
    CronSchedule -> TriggerName -> m ()
forall (m :: * -> *).
(MonadIO m, MonadMetadataStorageQueryAPI m) =>
CronSchedule -> TriggerName -> m ()
populateInitialCronTriggerEvents CronSchedule
ctSchedule TriggerName
ctName

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

  Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (Value -> EncJSON)
-> (SchemaCache -> Value) -> SchemaCache -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [InconsistentMetadata] -> Value
formatInconsistentObjs ([InconsistentMetadata] -> Value)
-> (SchemaCache -> [InconsistentMetadata]) -> SchemaCache -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaCache -> [InconsistentMetadata]
scInconsistentObjs (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
  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.
(Eq k, Hashable k) =>
(v -> Bool)
-> InsOrdHashMap k v -> (InsOrdHashMap k v, InsOrdHashMap k v)
OMap.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 `Map.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
Map.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
OMap.toHashMap CronTriggers
allNewCronTriggers)
              (CronTriggers -> HashMap TriggerName CronTriggerMetadata
forall k v. InsOrdHashMap k v -> HashMap k v
OMap.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
Map.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
OMap.toHashMap CronTriggers
oldCronTriggersIncludedInMetadata)
              (CronTriggers -> HashMap TriggerName CronTriggerMetadata
forall k v. InsOrdHashMap k v -> HashMap k v
OMap.toHashMap CronTriggers
allNewCronTriggers)
      ClearCronEvents -> m ()
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
ClearCronEvents -> m ()
dropFutureCronEvents (ClearCronEvents -> m ()) -> ClearCronEvents -> m ()
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]
Map.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
`OMap.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 (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 (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
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
-> m ()
dropSourceSQLTriggers (HL.Logger forall a (m :: * -> *).
(ToEngineLog a Hasura, MonadIO m) =>
a -> m ()
logger) SchemaCache
oldSchemaCache InsOrdHashMap SourceName BackendSourceMetadata
oldSources InsOrdHashMap SourceName BackendSourceMetadata
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_ (InsOrdHashMap SourceName BackendSourceMetadata
-> [(SourceName, BackendSourceMetadata)]
forall k v. InsOrdHashMap k v -> [(k, v)]
OMap.toList InsOrdHashMap SourceName BackendSourceMetadata
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 (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
onJust (SourceName
-> InsOrdHashMap SourceName BackendSourceMetadata
-> Maybe BackendSourceMetadata
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
OMap.lookup SourceName
source InsOrdHashMap SourceName BackendSourceMetadata
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]
OMap.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
`OMap.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
`OMap.intersection` InsOrdHashMap TriggerName (EventTriggerConf b)
oldTriggersMap
                  catcher :: QErr -> f ()
catcher e :: QErr
e@QErr {Code
qeCode :: QErr -> Code
qeCode :: Code
qeCode}
                    | Code
qeCode Code -> Code -> Bool
forall a. Eq a => a -> a -> Bool
== Code
Unexpected = () -> f ()
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 e (m :: * -> *) a. MonadError e m => e -> m a
throwError QErr
e -- rethrow other errors

              -- 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 (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 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
                  SourceConfig b
sourceConfig <- SourceName -> m (SourceConfig b)
forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @b SourceName
source
                  [TriggerName] -> (TriggerName -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [TriggerName]
droppedEventTriggers ((TriggerName -> m ()) -> m ()) -> (TriggerName -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
                    \TriggerName
triggerName -> do
                      TableName b
tableName <- SchemaCache -> SourceName -> TriggerName -> m (TableName b)
forall (b :: BackendType) (m :: * -> *).
(Backend b, QErrM m) =>
SchemaCache -> SourceName -> TriggerName -> m (TableName b)
getTableNameFromTrigger @b SchemaCache
oldSchemaCache SourceName
source TriggerName
triggerName
                      SourceConfig b -> TriggerName -> TableName b -> m ()
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)]
OMap.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
OMap.lookup TriggerName
retainedNewTriggerName InsOrdHashMap TriggerName (EventTriggerConf b)
oldTriggersMap of
                      Maybe (EventTriggerConf b)
Nothing -> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                      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)))
                              ]
                        TableName b
tableName <- SchemaCache -> SourceName -> TriggerName -> m (TableName b)
forall (b :: BackendType) (m :: * -> *).
(Backend b, QErrM m) =>
SchemaCache -> SourceName -> TriggerName -> m (TableName b)
getTableNameFromTrigger @b SchemaCache
oldSchemaCache SourceName
source TriggerName
retainedNewTriggerName
                        SourceConfig b -> TriggerName -> TableName b -> HashSet Ops -> m ()
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
Set.fromList ([Ops] -> HashSet Ops) -> [Ops] -> HashSet Ops
forall a b. (a -> b) -> a -> b
$ [Maybe Ops] -> [Ops]
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 :: 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 (b :: BackendType).
 BackendEventTrigger b =>
 i b -> i b -> m ())
-> AnyBackend i -> AnyBackend i -> m () -> m ()
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 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")

    dispatch :: BackendSourceMetadata
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    SourceMetadata b -> r)
-> r
dispatch (BackendSourceMetadata AnyBackend SourceMetadata
bs) = AnyBackend SourceMetadata
-> (forall (b :: BackendType).
    BackendEventTrigger b =>
    SourceMetadata b -> r)
-> r
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
OMap.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 :: 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 :: 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 (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 :: ReloadMetadata -> m EncJSON
runReloadMetadata (ReloadMetadata ReloadRemoteSchemas
reloadRemoteSchemas ReloadSources
reloadSources ReloadSources
reloadRecreateEventTriggers) = 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
$ InsOrdHashMap SourceName BackendSourceMetadata -> [SourceName]
forall k v. InsOrdHashMap k v -> [k]
OMap.keys (InsOrdHashMap SourceName BackendSourceMetadata -> [SourceName])
-> InsOrdHashMap SourceName BackendSourceMetadata -> [SourceName]
forall a b. (a -> b) -> a -> b
$ Metadata -> InsOrdHashMap SourceName BackendSourceMetadata
_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]
OMap.keys (RemoteSchemas -> [RemoteSchemaName])
-> RemoteSchemas -> [RemoteSchemaName]
forall a b. (a -> b) -> a -> b
$ Metadata -> RemoteSchemas
_metaRemoteSchemas 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"

  HashSet RemoteSchemaName
remoteSchemaInvalidations <- case ReloadRemoteSchemas
reloadRemoteSchemas of
    ReloadRemoteSchemas
RSReloadAll -> HashSet RemoteSchemaName -> m (HashSet RemoteSchemaName)
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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> HashSet RemoteSchemaName -> m (HashSet RemoteSchemaName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet RemoteSchemaName
l
  HashSet SourceName
pgSourcesInvalidations <- case ReloadSources
reloadSources of
    ReloadSources
RSReloadAll -> HashSet SourceName -> m (HashSet SourceName)
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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> HashSet SourceName -> m (HashSet SourceName)
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 (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 (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> HashSet SourceName -> m (HashSet SourceName)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashSet SourceName
l

  let cacheInvalidations :: CacheInvalidations
cacheInvalidations =
        CacheInvalidations :: Bool
-> HashSet RemoteSchemaName
-> HashSet SourceName
-> CacheInvalidations
CacheInvalidations
          { ciMetadata :: Bool
ciMetadata = Bool
True,
            ciRemoteSchemas :: HashSet RemoteSchemaName
ciRemoteSchemas = HashSet RemoteSchemaName
remoteSchemaInvalidations,
            ciSources :: HashSet SourceName
ciSources = HashSet SourceName
pgSourcesInvalidations
          }

  BuildReason -> CacheInvalidations -> Metadata -> m ()
forall (m :: * -> *).
CacheRWM m =>
BuildReason -> CacheInvalidations -> Metadata -> 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
  [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 (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
J..= (Text
"success" :: Text),
      Key
"is_consistent" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= [InconsistentMetadata] -> 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
J..= [InconsistentMetadata]
inconsObjs | Bool -> Bool
not ([InconsistentMetadata] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [InconsistentMetadata]
inconsObjs)]

runDumpInternalState ::
  (QErrM m, CacheRM m) =>
  DumpInternalState ->
  m EncJSON
runDumpInternalState :: 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 :: 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 (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] -> Value
formatInconsistentObjs [InconsistentMetadata]
inconsObjs

formatInconsistentObjs :: [InconsistentMetadata] -> J.Value
formatInconsistentObjs :: [InconsistentMetadata] -> Value
formatInconsistentObjs [InconsistentMetadata]
inconsObjs =
  [Pair] -> Value
J.object
    [ Key
"is_consistent" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= [InconsistentMetadata] -> 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
J..= [InconsistentMetadata]
inconsObjs
    ]

runDropInconsistentMetadata ::
  (QErrM m, CacheRWM m, MetadataM m) =>
  DropInconsistentMetadata ->
  m EncJSON
runDropInconsistentMetadata :: 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 :: MetadataModifier -> Metadata -> Metadata
runMetadataModifier :: 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [InconsistentMetadata]
droppableInconsistentObjects) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    QErr -> m ()
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 (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
$ (InsOrdHashMap SourceName BackendSourceMetadata
 -> Identity (InsOrdHashMap SourceName BackendSourceMetadata))
-> Metadata -> Identity Metadata
Lens' Metadata (InsOrdHashMap SourceName BackendSourceMetadata)
metaSources ((InsOrdHashMap SourceName BackendSourceMetadata
  -> Identity (InsOrdHashMap SourceName BackendSourceMetadata))
 -> Metadata -> Identity Metadata)
-> (InsOrdHashMap SourceName BackendSourceMetadata
    -> InsOrdHashMap SourceName BackendSourceMetadata)
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ SourceName
-> InsOrdHashMap SourceName BackendSourceMetadata
-> InsOrdHashMap SourceName BackendSourceMetadata
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
OMap.delete SourceName
source
  MOSourceObjId SourceName
source AnyBackend SourceMetadataObjId
exists -> AnyBackend SourceMetadataObjId
-> (forall (b :: BackendType).
    BackendMetadata b =>
    SourceMetadataObjId b -> MetadataModifier)
-> MetadataModifier
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
  MOHostTlsAllowlist String
host -> String -> MetadataModifier
dropHostFromAllowList String
host
  MOQueryCollectionsQuery CollectionName
cName ListedQuery
lq -> CollectionName -> ListedQuery -> MetadataModifier
dropListedQueryFromQueryCollections CollectionName
cName ListedQuery
lq
  where
    handleSourceObj :: forall b. BackendMetadata b => SourceName -> SourceMetadataObjId b -> MetadataModifier
    handleSourceObj :: SourceName -> SourceMetadataObjId b -> MetadataModifier
handleSourceObj SourceName
source = \case
      SMOTable TableName b
qt -> SourceName -> TableName b -> MetadataModifier
forall (b :: BackendType).
Backend b =>
SourceName -> TableName b -> MetadataModifier
dropTableInMetadata @b SourceName
source TableName b
qt
      SMOFunction FunctionName b
qf -> SourceName -> FunctionName b -> MetadataModifier
forall (b :: BackendType).
Backend b =>
SourceName -> FunctionName b -> MetadataModifier
dropFunctionInMetadata @b SourceName
source FunctionName b
qf
      SMOFunctionPermission FunctionName b
qf RoleName
rn -> SourceName -> FunctionName b -> RoleName -> MetadataModifier
forall (b :: BackendType).
BackendMetadata b =>
SourceName -> FunctionName b -> RoleName -> MetadataModifier
dropFunctionPermissionInMetadata @b SourceName
source FunctionName b
qf RoleName
rn
      SMOTableObj TableName b
qt TableMetadataObjId
tableObj ->
        (Metadata -> Metadata) -> MetadataModifier
MetadataModifier ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$
          SourceName -> TableName b -> ASetter' Metadata (TableMetadata 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
OMap.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
OMap.adjust (CreateCollection -> CreateCollection
collectionModifier) (CollectionName
cName) QueryCollections
qc

              collectionModifier :: CreateCollection -> CreateCollection
              collectionModifier :: CreateCollection -> CreateCollection
collectionModifier cc :: CreateCollection
cc@CreateCollection {Maybe Text
CollectionName
CollectionDef
_ccComment :: CreateCollection -> Maybe Text
_ccDefinition :: CreateCollection -> CollectionDef
_ccName :: CreateCollection -> CollectionName
_ccComment :: Maybe Text
_ccDefinition :: CollectionDef
_ccName :: CollectionName
..} =
                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 (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
OMap.filterWithKey (\CollectionName
_ AllowlistEntry
_ -> CollectionName -> QueryCollections -> Bool
forall k a. (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool
OMap.member CollectionName
cName QueryCollections
newQueryCollection)

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

              isFaultyQuery :: QueryReference -> Bool
              isFaultyQuery :: QueryReference -> Bool
isFaultyQuery QueryReference {QueryName
CollectionName
_qrQueryName :: QueryReference -> QueryName
_qrCollectionName :: QueryReference -> CollectionName
_qrQueryName :: QueryName
_qrCollectionName :: CollectionName
..} = 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 ::
  (MonadMetadataStorageQueryAPI m) => GetCatalogState -> m EncJSON
runGetCatalogState :: 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 CatalogState
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
m CatalogState
fetchCatalogState

runSetCatalogState ::
  (MonadMetadataStorageQueryAPI m) => SetCatalogState -> m EncJSON
runSetCatalogState :: SetCatalogState -> m EncJSON
runSetCatalogState SetCatalogState {Value
CatalogStateType
_scsState :: SetCatalogState -> Value
_scsType :: SetCatalogState -> CatalogStateType
_scsState :: Value
_scsType :: CatalogStateType
..} = do
  CatalogStateType -> Value -> m ()
forall (m :: * -> *).
MonadMetadataStorageQueryAPI m =>
CatalogStateType -> Value -> m ()
updateCatalogState CatalogStateType
_scsType Value
_scsState
  EncJSON -> m EncJSON
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 :: 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 (f :: * -> *) a. Applicative f => a -> f a
pure EncJSON
successMsg

runRemoveMetricsConfig ::
  (MonadIO m, CacheRWM m, MetadataM m, MonadError QErr m) =>
  m EncJSON
runRemoveMetricsConfig :: 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 (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 :: 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 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 (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)
traverse ((ByteString -> m ByteString) -> Header -> m Header
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Text -> ByteString) -> m Text -> m ByteString
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 (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
& (Maybe ByteString -> Identity (Maybe ByteString))
-> Request -> Identity Request
Lens' Request (Maybe ByteString)
HTTP.body ((Maybe ByteString -> Identity (Maybe ByteString))
 -> Request -> Identity Request)
-> Maybe ByteString -> Request -> Request
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ByteString -> Maybe ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 -> RequestTransformCtx
reqTransformCtx = 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 (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 -> RequestTransformCtx)
-> RequestFields (WithOptional TransformFn)
-> Request
-> Either TransformErrorBundle Request
forall (m :: * -> *).
MonadError TransformErrorBundle m =>
(Request -> RequestTransformCtx)
-> RequestFields (WithOptional TransformFn) -> Request -> m Request
applyRequestTransform Request -> RequestTransformCtx
reqTransformCtx RequestFields (WithOptional TransformFn)
reqTransform Request
req

  case Either TestTransformError Request
result of
    Right Request
transformed ->
      EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Either TransformErrorBundle Request -> EncJSON
packTransformResult (Either TransformErrorBundle Request -> EncJSON)
-> Either TransformErrorBundle Request -> 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) -> EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ Either TransformErrorBundle Request -> 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 (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
J..= Text -> Value
J.String Text
"Request Initialization Error", Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Text -> Value
J.String (HttpException -> Text
forall a. Show a => a -> Text
tshow HttpException
err)]
       in EncJSON -> m EncJSON
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
$ TransformErrorBundle -> Value
forall a. ToJSON a => a -> Value
J.toJSON TransformErrorBundle
errorBundle

interpolateFromEnv :: MonadError QErr m => Env.Environment -> Text -> m Text
interpolateFromEnv :: 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 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)
traverse ((Either Text Text -> Text)
-> Either Text (Either Text Text) -> Either Text Text
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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure) [Either Text Text]
xs
          err :: Text -> m a
err Text
e =
            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 (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 (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 (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 (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Either Text Text)
-> Parser Text Text -> Parser Text (Either Text Text)
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 (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 (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 (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 (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 :: 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 :: Either TransformErrorBundle HTTP.Request -> EncJSON
packTransformResult :: Either TransformErrorBundle Request -> EncJSON
packTransformResult = \case
  Right Request
req ->
    Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (Value -> EncJSON) -> Value -> 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
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
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
J..= ((CI ByteString -> ByteString) -> Header -> (ByteString, ByteString)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CI ByteString -> 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)),
          Key
"body" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
J..= Maybe ByteString -> Value
decodeBody (Request
req Request
-> Getting (Maybe ByteString) Request (Maybe ByteString)
-> Maybe ByteString
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ByteString) Request (Maybe ByteString)
Lens' Request (Maybe ByteString)
HTTP.body)
        ]
  Left TransformErrorBundle
err -> Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (Value -> EncJSON) -> Value -> EncJSON
forall a b. (a -> b) -> a -> b
$ TransformErrorBundle -> Value
forall a. ToJSON a => a -> Value
J.toJSON TransformErrorBundle
err