graphql-engine/server/src-lib/Hasura/GraphQL/Parser/Internal/Scalars.hs

-- | This module defines all backend-agnostic scalars we use throughout the
-- schema. This includes GraphQL scalars, and several other custom ones.
module Hasura.GraphQL.Parser.Internal.Scalars
  ( -- built-in types
    boolean,
    int,
    float,
    string,
    identifier,
    -- custom extensions
    uuid,
    json,
    jsonb,
    nonNegativeInt,
    bigInt,
    -- internal
    unsafeRawScalar,
    jsonScalar,
  )
where

import Data.Aeson qualified as A
import Data.Aeson.Types qualified as A
import Data.Int (Int32, Int64)
import Data.Text.Read (decimal)
import Data.UUID qualified as UUID
import Hasura.Backends.Postgres.SQL.Value
import Hasura.Base.Error
import Hasura.GraphQL.Parser.Class.Parse
import Hasura.GraphQL.Parser.Internal.Convert
import Hasura.GraphQL.Parser.Internal.TypeChecking
import Hasura.GraphQL.Parser.Internal.Types
import Hasura.GraphQL.Parser.Schema
import Hasura.Prelude
import Hasura.RQL.Types.CustomTypes
import Language.GraphQL.Draft.Syntax hiding (Definition)

--------------------------------------------------------------------------------
-- Built-in scalars

boolean :: MonadParse m => Parser 'Both m Bool
boolean = mkScalar boolScalar Nothing \case
  GraphQLValue (VBoolean b) -> pure b
  JSONValue (A.Bool b) -> pure b
  v -> typeMismatch boolScalar "a boolean" v

int :: MonadParse m => Parser 'Both m Int32
int = mkScalar intScalar Nothing \case
  GraphQLValue (VInt i) -> convertWith scientificToInteger $ fromInteger i
  JSONValue (A.Number n) -> convertWith scientificToInteger n
  v -> typeMismatch intScalar "a 32-bit integer" v

float :: MonadParse m => Parser 'Both m Double
float = mkScalar floatScalar Nothing \case
  GraphQLValue (VFloat f) -> convertWith scientificToFloat f
  GraphQLValue (VInt i) -> convertWith scientificToFloat $ fromInteger i
  JSONValue (A.Number n) -> convertWith scientificToFloat n
  v -> typeMismatch floatScalar "a float" v

string :: MonadParse m => Parser 'Both m Text
string = mkScalar stringScalar Nothing \case
  GraphQLValue (VString s) -> pure s
  JSONValue (A.String s) -> pure s
  v -> typeMismatch stringScalar "a string" v

-- | As an input type, any string or integer input value should be coerced to ID as Text
-- https://spec.graphql.org/June2018/#sec-ID
identifier :: MonadParse m => Parser 'Both m Text
identifier = mkScalar idScalar Nothing \case
  GraphQLValue (VString s) -> pure s
  GraphQLValue (VInt i) -> pure $ tshow i
  JSONValue (A.String s) -> pure s
  JSONValue (A.Number n) -> parseScientific n
  v -> typeMismatch idScalar "a String or a 32-bit integer" v
  where
    parseScientific = convertWith $ fmap (tshow @Int) . scientificToInteger

--------------------------------------------------------------------------------
-- Custom scalars

uuid :: MonadParse m => Parser 'Both m UUID.UUID
uuid = mkScalar name Nothing \case
  GraphQLValue (VString s) -> convertWith A.parseJSON $ A.String s
  JSONValue v -> convertWith A.parseJSON v
  v -> typeMismatch name "a UUID" v
  where
    name = $$(litName "uuid")

json, jsonb :: MonadParse m => Parser 'Both m A.Value
json = jsonScalar $$(litName "json") Nothing
jsonb = jsonScalar $$(litName "jsonb") Nothing

-- | Additional validation on integers. We do keep the same type name in the schema for backwards
-- compatibility.
-- TODO: when we can do a breaking change, we can rename the type to "NonNegativeInt".
nonNegativeInt :: MonadParse m => Parser 'Both m Int32
nonNegativeInt = mkScalar intScalar Nothing \case
  GraphQLValue (VInt i) | i >= 0 -> convertWith scientificToInteger $ fromInteger i
  JSONValue (A.Number n) | n >= 0 -> convertWith scientificToInteger n
  v -> typeMismatch intScalar "a non-negative 32-bit integer" v

-- | GraphQL ints are 32-bit integers; but in some places we want to accept bigger ints. To do so,
-- we declare a cusom scalar that can represent 64-bit ints, which accepts both int literals and
-- string literals. We do keep the same type name in the schema for backwards compatibility.
-- TODO: when we can do a breaking change, we can rename the type to "BigInt".
bigInt :: MonadParse m => Parser 'Both m Int64
bigInt = mkScalar intScalar Nothing \case
  GraphQLValue (VInt i) -> convertWith scientificToInteger $ fromInteger i
  JSONValue (A.Number n) -> convertWith scientificToInteger n
  GraphQLValue (VString s)
    | Right (i, "") <- decimal s ->
      pure i
  JSONValue (A.String s)
    | Right (i, "") <- decimal s ->
      pure i
  v -> typeMismatch intScalar "a 32-bit integer, or a 64-bit integer represented as a string" v

--------------------------------------------------------------------------------
-- Internal tools

-- | Explicitly define any desired scalar type.
--
-- This was considered unsafe because, unlike all other scalar definitions, it
-- doesn't enforce that we properly peel variables, and let the caller decide
-- how they want to deal with potential variables. This allows the caller to
-- bypass type-checking and (deprecated) non-reusability semantics (see comment
-- about re-usability in TypeChecking).
--
-- In practice, this function isn't very dangerous, and preferable to an
-- explicit use of the Parser constructor.
unsafeRawScalar ::
  MonadParse n =>
  Name ->
  Maybe Description ->
  Parser 'Both n (InputValue Variable)
unsafeRawScalar name description =
  Parser
    { pType = NonNullable $ TNamed $ Definition name description TIScalar,
      pParser = pure
    }

-- | Creates a parser that transforms its input into a JSON value. 'valueToJSON'
-- does properly unpack variables.
jsonScalar :: MonadParse m => Name -> Maybe Description -> Parser 'Both m A.Value
jsonScalar name description =
  Parser
    { pType = schemaType,
      pParser = valueToJSON $ toGraphQLType schemaType
    }
  where
    schemaType = NonNullable $ TNamed $ Definition name description TIScalar

--------------------------------------------------------------------------------
-- Local helpers

mkScalar ::
  MonadParse m =>
  Name ->
  Maybe Description ->
  (InputValue Variable -> m a) ->
  Parser 'Both m a
mkScalar name description parser =
  Parser
    { pType = schemaType,
      pParser = peelVariable (toGraphQLType schemaType) >=> parser
    }
  where
    schemaType = NonNullable $ TNamed $ Definition name description TIScalar

convertWith ::
  MonadParse m =>
  (a -> A.Parser b) ->
  (a -> m b)
convertWith f x = runAesonParser f x `onLeft` (parseErrorWith ParseFailed . qeError)