-- | Generic validation of native queries while tracking them.
module Hasura.NativeQuery.Validation
  ( validateArgumentDeclaration,
  )
where

import Data.HashMap.Strict qualified as HashMap
import Data.Set (Set)
import Data.Set qualified as Set
import Hasura.Base.Error
import Hasura.Base.ErrorMessage (fromErrorMessage)
import Hasura.Base.ToErrorValue (toErrorValue)
import Hasura.NativeQuery.InterpolatedQuery
import Hasura.NativeQuery.Metadata
import Hasura.Prelude hiding (first)

-- | Check that the set of declared arguments and the set of used arguments (in the code)
--   is the same.
validateArgumentDeclaration ::
  (MonadIO m, MonadError QErr m) =>
  NativeQueryMetadata b ->
  m ()
validateArgumentDeclaration :: forall (m :: * -> *) (b :: BackendType).
(MonadIO m, MonadError QErr m) =>
NativeQueryMetadata b -> m ()
validateArgumentDeclaration NativeQueryMetadata {InterpolatedQuery ArgumentName
_nqmCode :: InterpolatedQuery ArgumentName
_nqmCode :: forall (b :: BackendType).
NativeQueryMetadata b -> InterpolatedQuery ArgumentName
_nqmCode, HashMap ArgumentName (NullableScalarType b)
_nqmArguments :: HashMap ArgumentName (NullableScalarType b)
_nqmArguments :: forall (b :: BackendType).
NativeQueryMetadata b
-> HashMap ArgumentName (NullableScalarType b)
_nqmArguments} = do
  let occurringArguments :: Set ArgumentName
      occurringArguments :: Set ArgumentName
occurringArguments = InterpolatedQuery ArgumentName -> Set ArgumentName
forall var. Ord var => InterpolatedQuery var -> Set var
getUniqueVariables InterpolatedQuery ArgumentName
_nqmCode

      declaredArguments :: Set ArgumentName
      declaredArguments :: Set ArgumentName
declaredArguments = [ArgumentName] -> Set ArgumentName
forall a. Ord a => [a] -> Set a
Set.fromList ([ArgumentName] -> Set ArgumentName)
-> [ArgumentName] -> Set ArgumentName
forall a b. (a -> b) -> a -> b
$ HashMap ArgumentName (NullableScalarType b) -> [ArgumentName]
forall k v. HashMap k v -> [k]
HashMap.keys HashMap ArgumentName (NullableScalarType b)
_nqmArguments

      undeclaredArguments :: Set ArgumentName
      undeclaredArguments :: Set ArgumentName
undeclaredArguments = Set ArgumentName
occurringArguments Set ArgumentName -> Set ArgumentName -> Set ArgumentName
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set ArgumentName
declaredArguments

      unusedArguments :: Set ArgumentName
      unusedArguments :: Set ArgumentName
unusedArguments = Set ArgumentName
declaredArguments Set ArgumentName -> Set ArgumentName -> Set ArgumentName
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set ArgumentName
occurringArguments
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set ArgumentName -> Bool
forall a. Set a -> Bool
Set.null Set ArgumentName
undeclaredArguments)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ QErr -> m ()
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    (QErr -> m ()) -> QErr -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err400 Code
ValidationFailed
    (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> Text
fromErrorMessage
    (ErrorMessage -> Text) -> ErrorMessage -> Text
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"The following columns are used in the query, but are not declared as arguments: "
    ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> Set ArgumentName -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue Set ArgumentName
undeclaredArguments

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set ArgumentName -> Bool
forall a. Set a -> Bool
Set.null Set ArgumentName
unusedArguments)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ QErr -> m ()
forall a. QErr -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
    (QErr -> m ()) -> QErr -> m ()
forall a b. (a -> b) -> a -> b
$ Code -> Text -> QErr
err400 Code
ValidationFailed
    (Text -> QErr) -> Text -> QErr
forall a b. (a -> b) -> a -> b
$ ErrorMessage -> Text
fromErrorMessage
    (ErrorMessage -> Text) -> ErrorMessage -> Text
forall a b. (a -> b) -> a -> b
$ ErrorMessage
"The following columns are declared as arguments, but are not used in the query: "
    ErrorMessage -> ErrorMessage -> ErrorMessage
forall a. Semigroup a => a -> a -> a
<> Set ArgumentName -> ErrorMessage
forall a. ToErrorValue a => a -> ErrorMessage
toErrorValue Set ArgumentName
unusedArguments