{-# LANGUAGE UndecidableInstances #-}

-- | Define and handle v1/metadata API operations to track, untrack, and get native queries.
module Hasura.NativeQuery.API
  ( GetNativeQuery (..),
    TrackNativeQuery (..),
    UntrackNativeQuery (..),
    runGetNativeQuery,
    execTrackNativeQuery,
    execUntrackNativeQuery,
    dropNativeQueryInMetadata,
    module Hasura.NativeQuery.Types,
  )
where

import Autodocodec (HasCodec)
import Autodocodec qualified as AC
import Control.Lens (Traversal', has, preview, (^?))
import Data.Aeson
import Data.HashMap.Strict.InsOrd.Extended qualified as InsOrdHashMap
import Data.Text.Extended (toTxt, (<<>))
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.LogicalModelResolver.Codec (nativeQueryRelationshipsCodec)
import Hasura.LogicalModelResolver.Metadata (LogicalModelIdentifier)
import Hasura.NativeQuery.Metadata (ArgumentName, NativeQueryMetadata (..), parseInterpolatedQuery)
import Hasura.NativeQuery.Types (NativeQueryName, NullableScalarType)
import Hasura.Prelude
import Hasura.RQL.Types.Backend (Backend)
import Hasura.RQL.Types.BackendTag
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Common
  ( RelName,
    SourceName,
    sourceNameToText,
  )
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Backend
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.Relationships.Local (RelDef, RelManualNativeQueryConfig)
import Hasura.SQL.AnyBackend qualified as AB

-- | Default implementation of the 'track_native_query' request payload.
data TrackNativeQuery (b :: BackendType) = TrackNativeQuery
  { forall (b :: BackendType). TrackNativeQuery b -> SourceName
tnqSource :: SourceName,
    forall (b :: BackendType). TrackNativeQuery b -> NativeQueryName
tnqRootFieldName :: NativeQueryName,
    forall (b :: BackendType). TrackNativeQuery b -> Text
tnqCode :: Text,
    forall (b :: BackendType).
TrackNativeQuery b -> HashMap ArgumentName (NullableScalarType b)
tnqArguments :: HashMap ArgumentName (NullableScalarType b),
    forall (b :: BackendType).
TrackNativeQuery b
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
tnqArrayRelationships :: InsOrdHashMap.InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)),
    forall (b :: BackendType).
TrackNativeQuery b
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
tnqObjectRelationships :: InsOrdHashMap.InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)),
    forall (b :: BackendType). TrackNativeQuery b -> Maybe Text
tnqDescription :: Maybe Text,
    forall (b :: BackendType).
TrackNativeQuery b -> LogicalModelIdentifier b
tnqReturns :: LogicalModelIdentifier b
  }

instance (Backend b) => HasCodec (TrackNativeQuery b) where
  codec :: JSONCodec (TrackNativeQuery b)
codec =
    Text
-> JSONCodec (TrackNativeQuery b) -> JSONCodec (TrackNativeQuery b)
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
AC.CommentCodec
      (Text
"A request to track a native query")
      (JSONCodec (TrackNativeQuery b) -> JSONCodec (TrackNativeQuery b))
-> JSONCodec (TrackNativeQuery b) -> JSONCodec (TrackNativeQuery b)
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec (TrackNativeQuery b) (TrackNativeQuery b)
-> JSONCodec (TrackNativeQuery b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (forall (b :: BackendType). HasTag b => Text
backendPrefix @b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"TrackNativeQuery")
      (ObjectCodec (TrackNativeQuery b) (TrackNativeQuery b)
 -> JSONCodec (TrackNativeQuery b))
-> ObjectCodec (TrackNativeQuery b) (TrackNativeQuery b)
-> JSONCodec (TrackNativeQuery b)
forall a b. (a -> b) -> a -> b
$ SourceName
-> NativeQueryName
-> Text
-> HashMap ArgumentName (NullableScalarType b)
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
-> Maybe Text
-> LogicalModelIdentifier b
-> TrackNativeQuery b
forall (b :: BackendType).
SourceName
-> NativeQueryName
-> Text
-> HashMap ArgumentName (NullableScalarType b)
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
-> Maybe Text
-> LogicalModelIdentifier b
-> TrackNativeQuery b
TrackNativeQuery
      (SourceName
 -> NativeQueryName
 -> Text
 -> HashMap ArgumentName (NullableScalarType b)
 -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
 -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
 -> Maybe Text
 -> LogicalModelIdentifier b
 -> TrackNativeQuery b)
-> Codec Object (TrackNativeQuery b) SourceName
-> Codec
     Object
     (TrackNativeQuery b)
     (NativeQueryName
      -> Text
      -> HashMap ArgumentName (NullableScalarType b)
      -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
      -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
      -> Maybe Text
      -> LogicalModelIdentifier b
      -> TrackNativeQuery b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec SourceName SourceName
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
AC.requiredField Text
"source" Text
sourceDoc
      ObjectCodec SourceName SourceName
-> (TrackNativeQuery b -> SourceName)
-> Codec Object (TrackNativeQuery b) SourceName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TrackNativeQuery b -> SourceName
forall (b :: BackendType). TrackNativeQuery b -> SourceName
tnqSource
        Codec
  Object
  (TrackNativeQuery b)
  (NativeQueryName
   -> Text
   -> HashMap ArgumentName (NullableScalarType b)
   -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
   -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
   -> Maybe Text
   -> LogicalModelIdentifier b
   -> TrackNativeQuery b)
-> Codec Object (TrackNativeQuery b) NativeQueryName
-> Codec
     Object
     (TrackNativeQuery b)
     (Text
      -> HashMap ArgumentName (NullableScalarType b)
      -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
      -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
      -> Maybe Text
      -> LogicalModelIdentifier b
      -> TrackNativeQuery b)
forall a b.
Codec Object (TrackNativeQuery b) (a -> b)
-> Codec Object (TrackNativeQuery b) a
-> Codec Object (TrackNativeQuery b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec NativeQueryName NativeQueryName
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
AC.requiredField Text
"root_field_name" Text
rootFieldDoc
      ObjectCodec NativeQueryName NativeQueryName
-> (TrackNativeQuery b -> NativeQueryName)
-> Codec Object (TrackNativeQuery b) NativeQueryName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TrackNativeQuery b -> NativeQueryName
forall (b :: BackendType). TrackNativeQuery b -> NativeQueryName
tnqRootFieldName
        Codec
  Object
  (TrackNativeQuery b)
  (Text
   -> HashMap ArgumentName (NullableScalarType b)
   -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
   -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
   -> Maybe Text
   -> LogicalModelIdentifier b
   -> TrackNativeQuery b)
-> Codec Object (TrackNativeQuery b) Text
-> Codec
     Object
     (TrackNativeQuery b)
     (HashMap ArgumentName (NullableScalarType b)
      -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
      -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
      -> Maybe Text
      -> LogicalModelIdentifier b
      -> TrackNativeQuery b)
forall a b.
Codec Object (TrackNativeQuery b) (a -> b)
-> Codec Object (TrackNativeQuery b) a
-> Codec Object (TrackNativeQuery b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec Text Text
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
AC.requiredField Text
"code" Text
codeDoc
      ObjectCodec Text Text
-> (TrackNativeQuery b -> Text)
-> Codec Object (TrackNativeQuery b) Text
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TrackNativeQuery b -> Text
forall (b :: BackendType). TrackNativeQuery b -> Text
tnqCode
        Codec
  Object
  (TrackNativeQuery b)
  (HashMap ArgumentName (NullableScalarType b)
   -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
   -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
   -> Maybe Text
   -> LogicalModelIdentifier b
   -> TrackNativeQuery b)
-> Codec
     Object
     (TrackNativeQuery b)
     (HashMap ArgumentName (NullableScalarType b))
-> Codec
     Object
     (TrackNativeQuery b)
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
      -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
      -> Maybe Text
      -> LogicalModelIdentifier b
      -> TrackNativeQuery b)
forall a b.
Codec Object (TrackNativeQuery b) (a -> b)
-> Codec Object (TrackNativeQuery b) a
-> Codec Object (TrackNativeQuery b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> HashMap ArgumentName (NullableScalarType b)
-> Text
-> ObjectCodec
     (HashMap ArgumentName (NullableScalarType b))
     (HashMap ArgumentName (NullableScalarType b))
forall output.
HasCodec output =>
Text -> output -> Text -> ObjectCodec output output
AC.optionalFieldWithDefault Text
"arguments" HashMap ArgumentName (NullableScalarType b)
forall a. Monoid a => a
mempty Text
argumentsDoc
      ObjectCodec
  (HashMap ArgumentName (NullableScalarType b))
  (HashMap ArgumentName (NullableScalarType b))
-> (TrackNativeQuery b
    -> HashMap ArgumentName (NullableScalarType b))
-> Codec
     Object
     (TrackNativeQuery b)
     (HashMap ArgumentName (NullableScalarType b))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TrackNativeQuery b -> HashMap ArgumentName (NullableScalarType b)
forall (b :: BackendType).
TrackNativeQuery b -> HashMap ArgumentName (NullableScalarType b)
tnqArguments
        Codec
  Object
  (TrackNativeQuery b)
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
   -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
   -> Maybe Text
   -> LogicalModelIdentifier b
   -> TrackNativeQuery b)
-> Codec
     Object
     (TrackNativeQuery b)
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
-> Codec
     Object
     (TrackNativeQuery b)
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
      -> Maybe Text -> LogicalModelIdentifier b -> TrackNativeQuery b)
forall a b.
Codec Object (TrackNativeQuery b) (a -> b)
-> Codec Object (TrackNativeQuery b) a
-> Codec Object (TrackNativeQuery b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
-> Text
-> ObjectCodec
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
forall output.
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
AC.optionalFieldWithDefaultWith Text
"array_relationships" JSONCodec
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
forall (b :: BackendType).
Backend b =>
Codec
  Value
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
nativeQueryRelationshipsCodec InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
forall a. Monoid a => a
mempty Text
arrayRelationshipsDoc
      ObjectCodec
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
-> (TrackNativeQuery b
    -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
-> Codec
     Object
     (TrackNativeQuery b)
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TrackNativeQuery b
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
forall (b :: BackendType).
TrackNativeQuery b
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
tnqArrayRelationships
        Codec
  Object
  (TrackNativeQuery b)
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
   -> Maybe Text -> LogicalModelIdentifier b -> TrackNativeQuery b)
-> Codec
     Object
     (TrackNativeQuery b)
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
-> Codec
     Object
     (TrackNativeQuery b)
     (Maybe Text -> LogicalModelIdentifier b -> TrackNativeQuery b)
forall a b.
Codec Object (TrackNativeQuery b) (a -> b)
-> Codec Object (TrackNativeQuery b) a
-> Codec Object (TrackNativeQuery b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> JSONCodec
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
-> Text
-> ObjectCodec
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
forall output.
Text
-> JSONCodec output -> output -> Text -> ObjectCodec output output
AC.optionalFieldWithDefaultWith Text
"object_relationships" JSONCodec
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
forall (b :: BackendType).
Backend b =>
Codec
  Value
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
nativeQueryRelationshipsCodec InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
forall a. Monoid a => a
mempty Text
objectRelationshipsDoc
      ObjectCodec
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
  (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
-> (TrackNativeQuery b
    -> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
-> Codec
     Object
     (TrackNativeQuery b)
     (InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b)))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TrackNativeQuery b
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
forall (b :: BackendType).
TrackNativeQuery b
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
tnqObjectRelationships
        Codec
  Object
  (TrackNativeQuery b)
  (Maybe Text -> LogicalModelIdentifier b -> TrackNativeQuery b)
-> Codec Object (TrackNativeQuery b) (Maybe Text)
-> Codec
     Object
     (TrackNativeQuery b)
     (LogicalModelIdentifier b -> TrackNativeQuery b)
forall a b.
Codec Object (TrackNativeQuery b) (a -> b)
-> Codec Object (TrackNativeQuery b) a
-> Codec Object (TrackNativeQuery b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Text) (Maybe Text)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
AC.optionalField Text
"description" Text
descriptionDoc
      ObjectCodec (Maybe Text) (Maybe Text)
-> (TrackNativeQuery b -> Maybe Text)
-> Codec Object (TrackNativeQuery b) (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TrackNativeQuery b -> Maybe Text
forall (b :: BackendType). TrackNativeQuery b -> Maybe Text
tnqDescription
        Codec
  Object
  (TrackNativeQuery b)
  (LogicalModelIdentifier b -> TrackNativeQuery b)
-> Codec Object (TrackNativeQuery b) (LogicalModelIdentifier b)
-> ObjectCodec (TrackNativeQuery b) (TrackNativeQuery b)
forall a b.
Codec Object (TrackNativeQuery b) (a -> b)
-> Codec Object (TrackNativeQuery b) a
-> Codec Object (TrackNativeQuery b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> Text
-> ObjectCodec
     (LogicalModelIdentifier b) (LogicalModelIdentifier b)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
AC.requiredField Text
"returns" Text
returnsDoc
      ObjectCodec (LogicalModelIdentifier b) (LogicalModelIdentifier b)
-> (TrackNativeQuery b -> LogicalModelIdentifier b)
-> Codec Object (TrackNativeQuery b) (LogicalModelIdentifier b)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TrackNativeQuery b -> LogicalModelIdentifier b
forall (b :: BackendType).
TrackNativeQuery b -> LogicalModelIdentifier b
tnqReturns
    where
      arrayRelationshipsDoc :: Text
arrayRelationshipsDoc = Text
"Any relationships between an output value and multiple values in another data source"
      objectRelationshipsDoc :: Text
objectRelationshipsDoc = Text
"Any relationships between an output value and a single value in another data source"
      sourceDoc :: Text
sourceDoc = Text
"The source in which this native query should be tracked"
      rootFieldDoc :: Text
rootFieldDoc = Text
"Root field name for the native query"
      codeDoc :: Text
codeDoc = Text
"Native code expression (SQL) to run"
      argumentsDoc :: Text
argumentsDoc = Text
"Free variables in the expression and their types"
      returnsDoc :: Text
returnsDoc = Text
"Return type (table) of the expression"
      descriptionDoc :: Text
descriptionDoc = Text
"A description of the query which appears in the graphql schema"

deriving via
  (AC.Autodocodec (TrackNativeQuery b))
  instance
    (Backend b) => FromJSON (TrackNativeQuery b)

deriving via
  (AC.Autodocodec (TrackNativeQuery b))
  instance
    (Backend b) => ToJSON (TrackNativeQuery b)

-- | Validate a native query and extract the native query info from the request.
nativeQueryTrackToMetadata ::
  forall b m.
  ( MonadError QErr m
  ) =>
  TrackNativeQuery b ->
  m (NativeQueryMetadata b)
nativeQueryTrackToMetadata :: forall (b :: BackendType) (m :: * -> *).
MonadError QErr m =>
TrackNativeQuery b -> m (NativeQueryMetadata b)
nativeQueryTrackToMetadata TrackNativeQuery {Maybe Text
Text
HashMap ArgumentName (NullableScalarType b)
InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
SourceName
NativeQueryName
LogicalModelIdentifier b
tnqSource :: forall (b :: BackendType). TrackNativeQuery b -> SourceName
tnqRootFieldName :: forall (b :: BackendType). TrackNativeQuery b -> NativeQueryName
tnqCode :: forall (b :: BackendType). TrackNativeQuery b -> Text
tnqArguments :: forall (b :: BackendType).
TrackNativeQuery b -> HashMap ArgumentName (NullableScalarType b)
tnqArrayRelationships :: forall (b :: BackendType).
TrackNativeQuery b
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
tnqObjectRelationships :: forall (b :: BackendType).
TrackNativeQuery b
-> InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
tnqDescription :: forall (b :: BackendType). TrackNativeQuery b -> Maybe Text
tnqReturns :: forall (b :: BackendType).
TrackNativeQuery b -> LogicalModelIdentifier b
tnqSource :: SourceName
tnqRootFieldName :: NativeQueryName
tnqCode :: Text
tnqArguments :: HashMap ArgumentName (NullableScalarType b)
tnqArrayRelationships :: InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
tnqObjectRelationships :: InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
tnqDescription :: Maybe Text
tnqReturns :: LogicalModelIdentifier b
..} = do
  InterpolatedQuery ArgumentName
code <- Text -> Either Text (InterpolatedQuery ArgumentName)
parseInterpolatedQuery Text
tnqCode Either Text (InterpolatedQuery ArgumentName)
-> (Text -> m (InterpolatedQuery ArgumentName))
-> m (InterpolatedQuery ArgumentName)
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` \Text
e -> Code -> Text -> m (InterpolatedQuery ArgumentName)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
ParseFailed Text
e

  NativeQueryMetadata b -> m (NativeQueryMetadata b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    NativeQueryMetadata
      { _nqmRootFieldName :: NativeQueryName
_nqmRootFieldName = NativeQueryName
tnqRootFieldName,
        _nqmCode :: InterpolatedQuery ArgumentName
_nqmCode = InterpolatedQuery ArgumentName
code,
        _nqmReturns :: LogicalModelIdentifier b
_nqmReturns = LogicalModelIdentifier b
tnqReturns,
        _nqmArguments :: HashMap ArgumentName (NullableScalarType b)
_nqmArguments = HashMap ArgumentName (NullableScalarType b)
tnqArguments,
        _nqmArrayRelationships :: InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
_nqmArrayRelationships = InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
tnqArrayRelationships,
        _nqmObjectRelationships :: InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
_nqmObjectRelationships = InsOrdHashMap RelName (RelDef (RelManualNativeQueryConfig b))
tnqObjectRelationships,
        _nqmDescription :: Maybe Text
_nqmDescription = Maybe Text
tnqDescription
      }

-- | API payload for the 'get_native_query' endpoint.
data GetNativeQuery (b :: BackendType) = GetNativeQuery
  { forall (b :: BackendType). GetNativeQuery b -> SourceName
gnqSource :: SourceName
  }

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

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

instance (Backend b) => FromJSON (GetNativeQuery b) where
  parseJSON :: Value -> Parser (GetNativeQuery b)
parseJSON = String
-> (Object -> Parser (GetNativeQuery b))
-> Value
-> Parser (GetNativeQuery b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GetNativeQuery" ((Object -> Parser (GetNativeQuery b))
 -> Value -> Parser (GetNativeQuery b))
-> (Object -> Parser (GetNativeQuery b))
-> Value
-> Parser (GetNativeQuery b)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    SourceName
gnqSource <- Object
o Object -> Key -> Parser SourceName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
    GetNativeQuery b -> Parser (GetNativeQuery b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure GetNativeQuery {SourceName
gnqSource :: SourceName
gnqSource :: SourceName
..}

instance (Backend b) => ToJSON (GetNativeQuery b) where
  toJSON :: GetNativeQuery b -> Value
toJSON GetNativeQuery {SourceName
gnqSource :: forall (b :: BackendType). GetNativeQuery b -> SourceName
gnqSource :: SourceName
..} =
    [Pair] -> Value
object
      [ Key
"source" Key -> SourceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SourceName
gnqSource
      ]

-- | Handler for the 'get_native_query' endpoint.
runGetNativeQuery ::
  forall b m.
  ( BackendMetadata b,
    MetadataM m,
    MonadError QErr m
  ) =>
  GetNativeQuery b ->
  m EncJSON
runGetNativeQuery :: forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MetadataM m, MonadError QErr m) =>
GetNativeQuery b -> m EncJSON
runGetNativeQuery GetNativeQuery b
q = do
  m ()
-> (SourceMetadata b -> m ()) -> Maybe (SourceMetadata b) -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
    ( Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound
        (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Source '"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText (GetNativeQuery b -> SourceName
forall (b :: BackendType). GetNativeQuery b -> SourceName
gnqSource GetNativeQuery b
q)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' of kind "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BackendType -> Text
forall a. ToTxt a => a -> Text
toTxt (BackendTag b -> BackendType
forall (b :: BackendType). BackendTag b -> BackendType
reify (forall (b :: BackendType). HasTag b => BackendTag b
backendTag @b))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found."
    )
    (m () -> SourceMetadata b -> m ()
forall a b. a -> b -> a
const (m () -> SourceMetadata b -> m ())
-> m () -> SourceMetadata b -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
    (Maybe (SourceMetadata b) -> m ())
-> (Metadata -> Maybe (SourceMetadata b)) -> Metadata -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First (SourceMetadata b)) Metadata (SourceMetadata b)
-> Metadata -> Maybe (SourceMetadata b)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Sources -> Const (First (SourceMetadata b)) Sources)
-> Metadata -> Const (First (SourceMetadata b)) Metadata
Lens' Metadata Sources
metaSources ((Sources -> Const (First (SourceMetadata b)) Sources)
 -> Metadata -> Const (First (SourceMetadata b)) Metadata)
-> ((SourceMetadata b
     -> Const (First (SourceMetadata b)) (SourceMetadata b))
    -> Sources -> Const (First (SourceMetadata b)) Sources)
-> Getting (First (SourceMetadata b)) Metadata (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (GetNativeQuery b -> SourceName
forall (b :: BackendType). GetNativeQuery b -> SourceName
gnqSource GetNativeQuery b
q) ((BackendSourceMetadata
  -> Const (First (SourceMetadata b)) BackendSourceMetadata)
 -> Sources -> Const (First (SourceMetadata b)) Sources)
-> ((SourceMetadata b
     -> Const (First (SourceMetadata b)) (SourceMetadata b))
    -> BackendSourceMetadata
    -> Const (First (SourceMetadata b)) BackendSourceMetadata)
-> (SourceMetadata b
    -> Const (First (SourceMetadata b)) (SourceMetadata b))
-> Sources
-> Const (First (SourceMetadata b)) Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata @b)
    (Metadata -> m ()) -> m Metadata -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata
  Metadata
metadata <- m Metadata
forall (m :: * -> *). MetadataM m => m Metadata
getMetadata

  let nativeQuery :: Maybe (NativeQueries b)
      nativeQuery :: Maybe (NativeQueries b)
nativeQuery = Metadata
metadata Metadata
-> Getting (First (NativeQueries b)) Metadata (NativeQueries b)
-> Maybe (NativeQueries b)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Sources -> Const (First (NativeQueries b)) Sources)
-> Metadata -> Const (First (NativeQueries b)) Metadata
Lens' Metadata Sources
metaSources ((Sources -> Const (First (NativeQueries b)) Sources)
 -> Metadata -> Const (First (NativeQueries b)) Metadata)
-> ((NativeQueries b
     -> Const (First (NativeQueries b)) (NativeQueries b))
    -> Sources -> Const (First (NativeQueries b)) Sources)
-> Getting (First (NativeQueries b)) Metadata (NativeQueries b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (GetNativeQuery b -> SourceName
forall (b :: BackendType). GetNativeQuery b -> SourceName
gnqSource GetNativeQuery b
q) ((BackendSourceMetadata
  -> Const (First (NativeQueries b)) BackendSourceMetadata)
 -> Sources -> Const (First (NativeQueries b)) Sources)
-> ((NativeQueries b
     -> Const (First (NativeQueries b)) (NativeQueries b))
    -> BackendSourceMetadata
    -> Const (First (NativeQueries b)) BackendSourceMetadata)
-> (NativeQueries b
    -> Const (First (NativeQueries b)) (NativeQueries b))
-> Sources
-> Const (First (NativeQueries b)) Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SourceMetadata b
 -> Const (First (NativeQueries b)) (SourceMetadata b))
-> BackendSourceMetadata
-> Const (First (NativeQueries b)) BackendSourceMetadata
forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata ((SourceMetadata b
  -> Const (First (NativeQueries b)) (SourceMetadata b))
 -> BackendSourceMetadata
 -> Const (First (NativeQueries b)) BackendSourceMetadata)
-> ((NativeQueries b
     -> Const (First (NativeQueries b)) (NativeQueries b))
    -> SourceMetadata b
    -> Const (First (NativeQueries b)) (SourceMetadata b))
-> (NativeQueries b
    -> Const (First (NativeQueries b)) (NativeQueries b))
-> BackendSourceMetadata
-> Const (First (NativeQueries b)) BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType) (f :: * -> *).
Functor f =>
(NativeQueries b -> f (NativeQueries b))
-> SourceMetadata b -> f (SourceMetadata b)
smNativeQueries @b

  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [NativeQueryMetadata b] -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (NativeQueries b -> [NativeQueryMetadata b]
forall k v. InsOrdHashMap k v -> [v]
InsOrdHashMap.elems (NativeQueries b -> [NativeQueryMetadata b])
-> Maybe (NativeQueries b) -> Maybe [NativeQueryMetadata b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NativeQueries b)
nativeQuery))

-- | Handler for the 'track_native_query' endpoint. The type 'TrackNativeQuery b'
-- (appearing here in wrapped as 'BackendTrackNativeQuery b' for 'AnyBackend'
-- compatibility) is defined in 'class NativeQueryMetadata'.
execTrackNativeQuery ::
  forall b m.
  ( BackendMetadata b,
    MonadError QErr m
  ) =>
  TrackNativeQuery b ->
  Metadata ->
  m (MetadataObjId, MetadataModifier)
execTrackNativeQuery :: forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
TrackNativeQuery b
-> Metadata -> m (MetadataObjId, MetadataModifier)
execTrackNativeQuery TrackNativeQuery b
trackNativeQueryRequest Metadata
metadata = do
  SourceMetadata b
sourceMetadata <-
    m (SourceMetadata b)
-> (SourceMetadata b -> m (SourceMetadata b))
-> Maybe (SourceMetadata b)
-> m (SourceMetadata b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      ( Code -> Text -> m (SourceMetadata b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound
          (Text -> m (SourceMetadata b)) -> Text -> m (SourceMetadata b)
forall a b. (a -> b) -> a -> b
$ Text
"Source '"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName -> Text
sourceNameToText SourceName
source
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' of kind "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> BackendType -> Text
forall a. ToTxt a => a -> Text
toTxt (BackendTag b -> BackendType
forall (b :: BackendType). BackendTag b -> BackendType
reify (forall (b :: BackendType). HasTag b => BackendTag b
backendTag @b))
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" not found."
      )
      SourceMetadata b -> m (SourceMetadata b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (Maybe (SourceMetadata b) -> m (SourceMetadata b))
-> (Metadata -> Maybe (SourceMetadata b))
-> Metadata
-> m (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First (SourceMetadata b)) Metadata (SourceMetadata b)
-> Metadata -> Maybe (SourceMetadata b)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((Sources -> Const (First (SourceMetadata b)) Sources)
-> Metadata -> Const (First (SourceMetadata b)) Metadata
Lens' Metadata Sources
metaSources ((Sources -> Const (First (SourceMetadata b)) Sources)
 -> Metadata -> Const (First (SourceMetadata b)) Metadata)
-> ((SourceMetadata b
     -> Const (First (SourceMetadata b)) (SourceMetadata b))
    -> Sources -> Const (First (SourceMetadata b)) Sources)
-> Getting (First (SourceMetadata b)) Metadata (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source ((BackendSourceMetadata
  -> Const (First (SourceMetadata b)) BackendSourceMetadata)
 -> Sources -> Const (First (SourceMetadata b)) Sources)
-> ((SourceMetadata b
     -> Const (First (SourceMetadata b)) (SourceMetadata b))
    -> BackendSourceMetadata
    -> Const (First (SourceMetadata b)) BackendSourceMetadata)
-> (SourceMetadata b
    -> Const (First (SourceMetadata b)) (SourceMetadata b))
-> Sources
-> Const (First (SourceMetadata b)) Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata @b)
      (Metadata -> m (SourceMetadata b))
-> Metadata -> m (SourceMetadata b)
forall a b. (a -> b) -> a -> b
$ Metadata
metadata

  (NativeQueryMetadata b
nqMetadata :: NativeQueryMetadata b) <- do
    forall (b :: BackendType) (m :: * -> *).
MonadError QErr m =>
TrackNativeQuery b -> m (NativeQueryMetadata b)
nativeQueryTrackToMetadata @b TrackNativeQuery b
trackNativeQueryRequest

  let fieldName :: NativeQueryName
fieldName = NativeQueryMetadata b -> NativeQueryName
forall (b :: BackendType). NativeQueryMetadata b -> NativeQueryName
_nqmRootFieldName NativeQueryMetadata b
nqMetadata
      metadataObj :: MetadataObjId
metadataObj =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source
          (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). NativeQueryName -> SourceMetadataObjId b
SMONativeQuery @b NativeQueryName
fieldName
      existingNativeQueries :: [NativeQueryName]
existingNativeQueries = InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
-> [NativeQueryName]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys (SourceMetadata b
-> InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
forall (b :: BackendType). SourceMetadata b -> NativeQueries b
_smNativeQueries SourceMetadata b
sourceMetadata)

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NativeQueryName
fieldName NativeQueryName -> [NativeQueryName] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [NativeQueryName]
existingNativeQueries) do
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
AlreadyTracked (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Native query '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NativeQueryName -> Text
forall a. ToTxt a => a -> Text
toTxt NativeQueryName
fieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' is already tracked."

  let metadataModifier :: MetadataModifier
metadataModifier =
        (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
          ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ ((Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> ((InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
     -> Identity
          (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)))
    -> Sources -> Identity Sources)
-> (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
    -> Identity
         (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> Sources -> Identity Sources)
-> ((InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
     -> Identity
          (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
    -> Identity
         (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)))
-> Sources
-> Identity Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata @b ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
     -> Identity
          (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
    -> Identity
         (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
 -> Identity
      (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)))
-> SourceMetadata b -> Identity (SourceMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(NativeQueries b -> f (NativeQueries b))
-> SourceMetadata b -> f (SourceMetadata b)
smNativeQueries)
          ((InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
  -> Identity
       (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)))
 -> Metadata -> Identity Metadata)
-> (InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
    -> InsOrdHashMap NativeQueryName (NativeQueryMetadata b))
-> Metadata
-> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ NativeQueryName
-> NativeQueryMetadata b
-> InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
-> InsOrdHashMap NativeQueryName (NativeQueryMetadata b)
forall k v.
(Eq k, Hashable k) =>
k -> v -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.insert NativeQueryName
fieldName NativeQueryMetadata b
nqMetadata

  (MetadataObjId, MetadataModifier)
-> m (MetadataObjId, MetadataModifier)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataObjId
metadataObj, MetadataModifier
metadataModifier)
  where
    source :: SourceName
source = TrackNativeQuery b -> SourceName
forall (b :: BackendType). TrackNativeQuery b -> SourceName
tnqSource TrackNativeQuery b
trackNativeQueryRequest

-- | API payload for the 'untrack_native_query' endpoint.
data UntrackNativeQuery (b :: BackendType) = UntrackNativeQuery
  { forall (b :: BackendType). UntrackNativeQuery b -> SourceName
utnqSource :: SourceName,
    forall (b :: BackendType). UntrackNativeQuery b -> NativeQueryName
utnqRootFieldName :: NativeQueryName
  }

deriving instance Show (UntrackNativeQuery b)

deriving instance Eq (UntrackNativeQuery b)

instance FromJSON (UntrackNativeQuery b) where
  parseJSON :: Value -> Parser (UntrackNativeQuery b)
parseJSON = String
-> (Object -> Parser (UntrackNativeQuery b))
-> Value
-> Parser (UntrackNativeQuery b)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"UntrackNativeQuery" ((Object -> Parser (UntrackNativeQuery b))
 -> Value -> Parser (UntrackNativeQuery b))
-> (Object -> Parser (UntrackNativeQuery b))
-> Value
-> Parser (UntrackNativeQuery b)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    SourceName
utnqSource <- Object
o Object -> Key -> Parser SourceName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"source"
    NativeQueryName
utnqRootFieldName <- Object
o Object -> Key -> Parser NativeQueryName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"root_field_name"
    UntrackNativeQuery b -> Parser (UntrackNativeQuery b)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UntrackNativeQuery {SourceName
NativeQueryName
utnqSource :: SourceName
utnqRootFieldName :: NativeQueryName
utnqSource :: SourceName
utnqRootFieldName :: NativeQueryName
..}

instance ToJSON (UntrackNativeQuery b) where
  toJSON :: UntrackNativeQuery b -> Value
toJSON UntrackNativeQuery {SourceName
NativeQueryName
utnqSource :: forall (b :: BackendType). UntrackNativeQuery b -> SourceName
utnqRootFieldName :: forall (b :: BackendType). UntrackNativeQuery b -> NativeQueryName
utnqSource :: SourceName
utnqRootFieldName :: NativeQueryName
..} =
    [Pair] -> Value
object
      [ Key
"source" Key -> SourceName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SourceName
utnqSource,
        Key
"root_field_name" Key -> NativeQueryName -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= NativeQueryName
utnqRootFieldName
      ]

-- | Handler for the 'untrack_native_query' endpoint.
execUntrackNativeQuery ::
  forall b m.
  ( BackendMetadata b,
    MonadError QErr m
  ) =>
  UntrackNativeQuery b ->
  Metadata ->
  m (MetadataObjId, MetadataModifier)
execUntrackNativeQuery :: forall (b :: BackendType) (m :: * -> *).
(BackendMetadata b, MonadError QErr m) =>
UntrackNativeQuery b
-> Metadata -> m (MetadataObjId, MetadataModifier)
execUntrackNativeQuery UntrackNativeQuery b
q Metadata
metadata = do
  -- we do not check for feature flag here as we always want users to be able
  -- to remove native queries if they'd like
  forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
SourceName -> NativeQueryName -> Metadata -> m ()
assertNativeQueryExists @b SourceName
source NativeQueryName
fieldName Metadata
metadata

  let metadataObj :: MetadataObjId
metadataObj =
        SourceName -> AnyBackend SourceMetadataObjId -> MetadataObjId
MOSourceObjId SourceName
source
          (AnyBackend SourceMetadataObjId -> MetadataObjId)
-> AnyBackend SourceMetadataObjId -> MetadataObjId
forall a b. (a -> b) -> a -> b
$ SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall (b :: BackendType) (i :: BackendType -> *).
HasTag b =>
i b -> AnyBackend i
AB.mkAnyBackend
          (SourceMetadataObjId b -> AnyBackend SourceMetadataObjId)
-> SourceMetadataObjId b -> AnyBackend SourceMetadataObjId
forall a b. (a -> b) -> a -> b
$ forall (b :: BackendType). NativeQueryName -> SourceMetadataObjId b
SMONativeQuery @b NativeQueryName
fieldName

  (MetadataObjId, MetadataModifier)
-> m (MetadataObjId, MetadataModifier)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MetadataObjId
metadataObj, forall (b :: BackendType).
BackendMetadata b =>
SourceName -> NativeQueryName -> MetadataModifier
dropNativeQueryInMetadata @b SourceName
source NativeQueryName
fieldName)
  where
    source :: SourceName
source = UntrackNativeQuery b -> SourceName
forall (b :: BackendType). UntrackNativeQuery b -> SourceName
utnqSource UntrackNativeQuery b
q
    fieldName :: NativeQueryName
fieldName = UntrackNativeQuery b -> NativeQueryName
forall (b :: BackendType). UntrackNativeQuery b -> NativeQueryName
utnqRootFieldName UntrackNativeQuery b
q

dropNativeQueryInMetadata :: forall b. (BackendMetadata b) => SourceName -> NativeQueryName -> MetadataModifier
dropNativeQueryInMetadata :: forall (b :: BackendType).
BackendMetadata b =>
SourceName -> NativeQueryName -> MetadataModifier
dropNativeQueryInMetadata SourceName
source NativeQueryName
rootFieldName = do
  (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (Sources -> Identity Sources) -> Metadata -> Identity Metadata
Lens' Metadata Sources
metaSources
    ((Sources -> Identity Sources) -> Metadata -> Identity Metadata)
-> ((NativeQueries b -> Identity (NativeQueries b))
    -> Sources -> Identity Sources)
-> (NativeQueries b -> Identity (NativeQueries b))
-> Metadata
-> Identity Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
source
    ((BackendSourceMetadata -> Identity BackendSourceMetadata)
 -> Sources -> Identity Sources)
-> ((NativeQueries b -> Identity (NativeQueries b))
    -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> (NativeQueries b -> Identity (NativeQueries b))
-> Sources
-> Identity Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata @b
    ((SourceMetadata b -> Identity (SourceMetadata b))
 -> BackendSourceMetadata -> Identity BackendSourceMetadata)
-> ((NativeQueries b -> Identity (NativeQueries b))
    -> SourceMetadata b -> Identity (SourceMetadata b))
-> (NativeQueries b -> Identity (NativeQueries b))
-> BackendSourceMetadata
-> Identity BackendSourceMetadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NativeQueries b -> Identity (NativeQueries b))
-> SourceMetadata b -> Identity (SourceMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(NativeQueries b -> f (NativeQueries b))
-> SourceMetadata b -> f (SourceMetadata b)
smNativeQueries
    ((NativeQueries b -> Identity (NativeQueries b))
 -> Metadata -> Identity Metadata)
-> (NativeQueries b -> NativeQueries b) -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ NativeQueryName -> NativeQueries b -> NativeQueries b
forall k v.
(Eq k, Hashable k) =>
k -> InsOrdHashMap k v -> InsOrdHashMap k v
InsOrdHashMap.delete NativeQueryName
rootFieldName

-- | Check whether a native query with the given root field name exists for
-- the given source.
assertNativeQueryExists ::
  forall b m. (Backend b, MonadError QErr m) => SourceName -> NativeQueryName -> Metadata -> m ()
assertNativeQueryExists :: forall (b :: BackendType) (m :: * -> *).
(Backend b, MonadError QErr m) =>
SourceName -> NativeQueryName -> Metadata -> m ()
assertNativeQueryExists SourceName
sourceName NativeQueryName
rootFieldName Metadata
metadata = do
  let sourceMetadataTraversal :: Traversal' Metadata (SourceMetadata b)
      sourceMetadataTraversal :: Traversal' Metadata (SourceMetadata b)
sourceMetadataTraversal = (Sources -> f Sources) -> Metadata -> f Metadata
Lens' Metadata Sources
metaSources ((Sources -> f Sources) -> Metadata -> f Metadata)
-> ((SourceMetadata b -> f (SourceMetadata b))
    -> Sources -> f Sources)
-> (SourceMetadata b -> f (SourceMetadata b))
-> Metadata
-> f Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index Sources -> Traversal' Sources (IxValue Sources)
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index Sources
SourceName
sourceName ((BackendSourceMetadata -> f BackendSourceMetadata)
 -> Sources -> f Sources)
-> ((SourceMetadata b -> f (SourceMetadata b))
    -> BackendSourceMetadata -> f BackendSourceMetadata)
-> (SourceMetadata b -> f (SourceMetadata b))
-> Sources
-> f Sources
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: BackendType).
Backend b =>
Prism' BackendSourceMetadata (SourceMetadata b)
toSourceMetadata @b

  SourceMetadata b
sourceMetadata <-
    Getting (First (SourceMetadata b)) Metadata (SourceMetadata b)
-> Metadata -> Maybe (SourceMetadata b)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First (SourceMetadata b)) Metadata (SourceMetadata b)
Traversal' Metadata (SourceMetadata b)
sourceMetadataTraversal Metadata
metadata
      Maybe (SourceMetadata b)
-> m (SourceMetadata b) -> m (SourceMetadata b)
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m (SourceMetadata b)
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"Source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found.")

  let desiredNativeQuery :: Traversal' (SourceMetadata b) (NativeQueryMetadata b)
      desiredNativeQuery :: Traversal' (SourceMetadata b) (NativeQueryMetadata b)
desiredNativeQuery = (NativeQueries b -> f (NativeQueries b))
-> SourceMetadata b -> f (SourceMetadata b)
forall (b :: BackendType) (f :: * -> *).
Functor f =>
(NativeQueries b -> f (NativeQueries b))
-> SourceMetadata b -> f (SourceMetadata b)
smNativeQueries ((NativeQueries b -> f (NativeQueries b))
 -> SourceMetadata b -> f (SourceMetadata b))
-> ((NativeQueryMetadata b -> f (NativeQueryMetadata b))
    -> NativeQueries b -> f (NativeQueries b))
-> (NativeQueryMetadata b -> f (NativeQueryMetadata b))
-> SourceMetadata b
-> f (SourceMetadata b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (NativeQueries b)
-> Traversal' (NativeQueries b) (IxValue (NativeQueries b))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (NativeQueries b)
NativeQueryName
rootFieldName

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Getting Any (SourceMetadata b) (NativeQueryMetadata b)
-> SourceMetadata b -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any (SourceMetadata b) (NativeQueryMetadata b)
Traversal' (SourceMetadata b) (NativeQueryMetadata b)
desiredNativeQuery SourceMetadata b
sourceMetadata) do
    Code -> Text -> m ()
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"Native query " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NativeQueryName
rootFieldName NativeQueryName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
" not found in source " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SourceName
sourceName SourceName -> Text -> Text
forall t. ToTxt t => t -> Text -> Text
<<> Text
".")