hasura/graphql-engine
1
0
Fork 0
mirror of https://github.com/hasura/graphql-engine.git synced 2024-12-15 09:22:43 +03:00
Code Issues Projects Releases Wiki Activity

remove SQL.Text, clean text functions

Browse Source
This commit is contained in:
Antoine Leblanc 2020-10-21 17:35:06 +01:00
parent d9d2728a32
commit 91d8a7ab61
72 changed files with 381 additions and 391 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
server/graphql-engine.cabal
View File

@ -466,7 +466,6 @@ library
, Hasura.SQL.Error
, Hasura.SQL.GeoJSON
, Hasura.SQL.Rewrite
, Hasura.SQL.Text
, Hasura.SQL.Time
, Hasura.SQL.Types
, Hasura.SQL.Value

75
server/src-lib/Data/Text/Extended.hs
View File

@ -1,33 +1,84 @@
module Data.Text.Extended
( module DT
( ToTxt(..)
, bquote
, squote
, dquote
, dquoteList
, commaSeparated
, paren
, parenB
, (<->)
, (<~>)
, (<>>)
, (<<>)
) where
import Hasura.Prelude
import Data.Text as DT
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Text.Builder as TB
bquote :: DT.Text -> DT.Text
bquote t = DT.singleton '`' <> t <> DT.singleton '`'
import Data.Text as DT
class ToTxt a where
toTxt :: a -> Text
instance ToTxt Text where
toTxt = id
{-# INLINE toTxt #-}
instance ToTxt G.Name where
toTxt = G.unName
deriving instance ToTxt G.EnumValue
bquote :: ToTxt t => t -> Text
bquote t = DT.singleton '`' <> toTxt t <> DT.singleton '`'
{-# INLINE bquote #-}
squote :: DT.Text -> DT.Text
squote t = DT.singleton '\'' <> t <> DT.singleton '\''
squote :: ToTxt t => t -> Text
squote t = DT.singleton '\'' <> toTxt t <> DT.singleton '\''
{-# INLINE squote #-}
dquote :: DT.Text -> DT.Text
dquote t = DT.singleton '"' <> t <> DT.singleton '"'
dquote :: ToTxt t => t -> Text
dquote t = DT.singleton '"' <> toTxt t <> DT.singleton '"'
{-# INLINE dquote #-}
paren :: DT.Text -> DT.Text
paren t = "(" <> t <> ")"
paren :: ToTxt t => t -> Text
paren t = "(" <> toTxt t <> ")"
{-# INLINE paren #-}
parenB :: TB.Builder -> TB.Builder
parenB t = TB.char '(' <> t <> TB.char ')'
{-# INLINE parenB #-}
dquoteList :: (ToTxt t, Foldable f) => f t -> Text
dquoteList = DT.intercalate ", " . fmap dquote . toList
{-# INLINE dquoteList #-}
commaSeparated :: (ToTxt t, Foldable f) => f t -> Text
commaSeparated = DT.intercalate ", " . fmap toTxt . toList
{-# INLINE commaSeparated #-}
infixr 6 <->
(<->) :: DT.Text -> DT.Text -> DT.Text
(<->) l r = l <> DT.singleton ' ' <> r
(<->) :: ToTxt t => t -> t -> Text
(<->) l r = toTxt l <> DT.singleton ' ' <> toTxt r
{-# INLINE (<->) #-}
infixr 6 <>>
(<>>) :: ToTxt t => Text -> t -> Text
(<>>) lTxt a = lTxt <> dquote a
{-# INLINE (<>>) #-}
infixr 6 <<>
(<<>) :: ToTxt t => t -> Text -> Text
(<<>) a rTxt = dquote a <> rTxt
{-# INLINE (<<>) #-}
infixr 6 <~>
(<~>) :: TB.Builder -> TB.Builder -> TB.Builder
(<~>) l r = l <> TB.char ' ' <> r
{-# INLINE (<~>) #-}

5
server/src-lib/Data/URL/Template.hs
View File

@ -12,11 +12,12 @@ where
import Hasura.Prelude
import qualified Data.Text as T
import qualified Data.Environment as Env
import qualified Data.Text as T
import Data.Attoparsec.Combinator (lookAhead)
import Data.Attoparsec.Text
import Data.Text.Extended
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)
import Test.QuickCheck
@ -68,7 +69,7 @@ renderURLTemplate env template =
case errorVariables of
[] -> Right $ T.concat $ rights eitherResults
_ -> Left $ T.unpack $ "Value for environment variables not found: "
<> T.intercalate ", " errorVariables
<> commaSeparated errorVariables
where
eitherResults = map renderTemplateItem $ unURLTemplate template
errorVariables = lefts eitherResults

4
server/src-lib/Hasura/Eventing/EventTrigger.hs
View File

@ -51,6 +51,7 @@ import Data.Aeson.TH
import Data.Has
import Data.Int (Int64)
import Data.String
import Data.Text.Extended
import Data.Time.Clock
import Data.Word
import Hasura.Eventing.Common
@ -59,9 +60,8 @@ import Hasura.HTTP
import Hasura.Prelude
import Hasura.RQL.DDL.Headers
import Hasura.RQL.Types
import Hasura.Server.Version (HasVersion)
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Server.Version (HasVersion)
import qualified Hasura.Tracing as Tracing
import qualified Control.Concurrent.Async.Lifted.Safe as LA

8
server/src-lib/Hasura/GraphQL/Execute/Action.hs
View File

@ -28,8 +28,8 @@ import Control.Concurrent (threadDelay)
import Control.Exception (try)
import Control.Lens
import Data.Has
import Data.Int (Int64)
import Data.IORef
import Data.Int (Int64)
import qualified Hasura.RQL.DML.RemoteJoin as RJ
import qualified Hasura.RQL.DML.Select as RS
@ -41,6 +41,7 @@ import qualified Data.Environment as Env
import qualified Hasura.Logging as L
import qualified Hasura.Tracing as Tracing
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.GraphQL.Execute.Prepare
import Hasura.GraphQL.Parser hiding (column)
@ -51,12 +52,11 @@ import Hasura.RQL.DDL.Schema.Cache
import Hasura.RQL.DML.Select (asSingleRowJsonResp)
import Hasura.RQL.Types
import Hasura.RQL.Types.Run
import Hasura.SQL.Types
import Hasura.SQL.Value (PGScalarValue (..), toTxtValue)
import Hasura.Server.Utils (mkClientHeadersForward, mkSetCookieHeaders)
import Hasura.Server.Version (HasVersion)
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value (PGScalarValue (..), toTxtValue)
type ActionExecuteTx =
forall tx. (MonadIO tx, MonadTx tx, Tracing.MonadTrace tx) => tx EncJSON

2
server/src-lib/Hasura/GraphQL/Execute/Inline.hs
View File

@ -45,11 +45,11 @@ import qualified Data.List as L
import qualified Data.Text as T
import Control.Lens
import Data.Text.Extended
import Language.GraphQL.Draft.Syntax
import Hasura.RQL.Types.Error
import Hasura.Server.Utils
import Hasura.SQL.Text
-- | Internal bookkeeping used during inlining.
data InlineEnv = InlineEnv

8
server/src-lib/Hasura/GraphQL/Execute/Insert.hs
View File

@ -23,14 +23,14 @@ import qualified Hasura.RQL.GBoolExp as RQL
import qualified Hasura.SQL.DML as S
import qualified Hasura.Tracing as Tracing
import Data.Text.Extended
import Hasura.Db
import Hasura.EncJSON
import Hasura.GraphQL.Schema.Insert
import Hasura.RQL.Types
import Hasura.Server.Version (HasVersion)
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value
import Hasura.Server.Version (HasVersion)
traverseAnnInsert
@ -180,9 +180,9 @@ insertObject env singleObjIns additionalColumns remoteJoinCtx planVars stringify
return $ sum arrInsARows
asSingleObject = \case
[] -> pure Nothing
[] -> pure Nothing
[r] -> pure $ Just r
_ -> throw500 "more than one row returned"
_ -> throw500 "more than one row returned"
cannotInsArrRelErr =
"cannot proceed to insert array relations since insert to table "

7
server/src-lib/Hasura/GraphQL/Execute/Prepare.hs
View File

@ -19,21 +19,20 @@ import qualified Data.Aeson as J
import qualified Data.HashMap.Strict as Map
import qualified Data.HashSet as Set
import qualified Data.IntMap as IntMap
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
import qualified Hasura.SQL.DML as S
import Data.Text.Extended
import Hasura.GraphQL.Parser.Column
import Hasura.GraphQL.Parser.Schema
import Hasura.RQL.DML.Internal (currentSession)
import Hasura.RQL.Types
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value
import Hasura.Session
type PlanVariables = Map.HashMap G.Name Int
@ -127,7 +126,7 @@ validateSessionVariables :: MonadError QErr m => Set.HashSet SessionVariable ->
validateSessionVariables requiredVariables sessionVariables = do
let missingSessionVariables = requiredVariables `Set.difference` getSessionVariablesSet sessionVariables
unless (null missingSessionVariables) do
throw400 NotFound $ "missing session variables: " <> T.intercalate ", " (dquote . sessionVariableToText <$> toList missingSessionVariables)
throw400 NotFound $ "missing session variables: " <> dquoteList (sessionVariableToText <$> toList missingSessionVariables)
getVarArgNum :: (MonadState PlanningSt m) => G.Name -> m Int
getVarArgNum var = do

2
server/src-lib/Hasura/GraphQL/Execute/Resolve.hs
View File

@ -14,9 +14,9 @@ import qualified Language.GraphQL.Draft.Syntax as G
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
import Data.Text.Extended
import Hasura.GraphQL.Parser.Schema
import Hasura.RQL.Types.Error
import Hasura.SQL.Text
resolveVariables
:: forall m fragments

4
server/src-lib/Hasura/GraphQL/Explain.hs
View File

@ -11,16 +11,16 @@ import qualified Data.HashMap.Strict.InsOrd as OMap
import qualified Database.PG.Query as Q
import qualified Language.GraphQL.Draft.Syntax as G
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.GraphQL.Context
import Hasura.GraphQL.Parser
import Hasura.Prelude
import Hasura.RQL.DML.Internal
import Hasura.RQL.Types
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value
import Hasura.Session
import qualified Hasura.GraphQL.Execute as E
import qualified Hasura.GraphQL.Execute.Inline as E

28
server/src-lib/Hasura/GraphQL/Parser/Class.hs
View File

@ -1,23 +1,23 @@
-- | Classes for monads used during schema construction and query parsing.
module Hasura.GraphQL.Parser.Class where
import Hasura.Prelude
import Hasura.Prelude
import qualified Data.HashMap.Strict as Map
import qualified Language.Haskell.TH as TH
import qualified Data.HashMap.Strict as Map
import qualified Language.Haskell.TH as TH
import Data.Has
import Data.Parser.JSONPath
import Data.Tuple.Extended
import GHC.Stack (HasCallStack)
import Type.Reflection (Typeable)
import Data.Has
import Data.Parser.JSONPath
import Data.Tuple.Extended
import GHC.Stack (HasCallStack)
import Type.Reflection (Typeable)
import {-# SOURCE #-} Hasura.GraphQL.Parser.Internal.Parser
import Hasura.RQL.Types.Error
import Hasura.RQL.Types.Table (TableCache, TableInfo)
import Hasura.Session (RoleName)
import Hasura.SQL.Text
import Hasura.SQL.Types
import Data.Text.Extended
import {-# SOURCE #-} Hasura.GraphQL.Parser.Internal.Parser
import Hasura.RQL.Types.Error
import Hasura.RQL.Types.Table (TableCache, TableInfo)
import Hasura.SQL.Types
import Hasura.Session (RoleName)
{- Note [Tying the knot]
~~~~~~~~~~~~~~~~~~~~~~~~

20
server/src-lib/Hasura/GraphQL/Parser/Collect.hs
View File

@ -12,19 +12,19 @@ module Hasura.GraphQL.Parser.Collect
( collectFields
) where
import Hasura.Prelude
import Hasura.Prelude
import qualified Data.HashMap.Strict.Extended as Map
import qualified Data.HashMap.Strict.InsOrd as OMap
import qualified Data.HashMap.Strict.Extended as Map
import qualified Data.HashMap.Strict.InsOrd as OMap
import Data.List.Extended (duplicates)
import Language.GraphQL.Draft.Syntax
import Data.List.Extended (duplicates)
import Language.GraphQL.Draft.Syntax
import Hasura.GraphQL.Parser.Class
import {-# SOURCE #-} Hasura.GraphQL.Parser.Internal.Parser (boolean, runParser)
import Hasura.GraphQL.Parser.Schema
import Hasura.GraphQL.Utils (showNames)
import Hasura.SQL.Text
import Data.Text.Extended
import Hasura.GraphQL.Parser.Class
import {-# SOURCE #-} Hasura.GraphQL.Parser.Internal.Parser (boolean, runParser)
import Hasura.GraphQL.Parser.Schema
import Hasura.GraphQL.Utils (showNames)
-- | Collects the effective set of fields queried by a selection set by
-- flattening fragments and merging duplicate fields.

4
server/src-lib/Hasura/GraphQL/Parser/Column.hs
View File

@ -24,16 +24,16 @@ import Language.GraphQL.Draft.Syntax (Description (..), Name (
import qualified Hasura.RQL.Types.Column as RQL
import qualified Hasura.RQL.Types.CustomTypes as RQL
import Data.Text.Extended
import Hasura.GraphQL.Parser.Class
import Hasura.GraphQL.Parser.Internal.Parser
import Hasura.GraphQL.Parser.Schema
import Hasura.RQL.Types.Column hiding (EnumValue (..), EnumValueInfo (..))
import Hasura.RQL.Types.Error
import Hasura.Session (SessionVariable)
import Hasura.SQL.DML
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value
import Hasura.Session (SessionVariable)
-- -------------------------------------------------------------------------------------------------

17
server/src-lib/Hasura/GraphQL/Parser/Internal/Parser.hs
View File

@ -1,7 +1,6 @@
{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE ViewPatterns #-}
-- | Defines the 'Parser' type and its primitive combinators.
module Hasura.GraphQL.Parser.Internal.Parser where
@ -12,13 +11,14 @@ import qualified Data.Aeson as A
import qualified Data.HashMap.Strict.Extended as M
import qualified Data.HashMap.Strict.InsOrd as OMap
import qualified Data.HashSet as S
import qualified Data.Text as T
import qualified Data.List.Extended as LE
import qualified Data.Text as T
import Control.Lens.Extended hiding (enum, index)
import Data.Int (Int32, Int64)
import Data.Scientific (toBoundedInteger)
import Data.Parser.JSONPath
import Data.Scientific (toBoundedInteger)
import Data.Text.Extended
import Data.Type.Equality
import Language.GraphQL.Draft.Syntax hiding (Definition)
@ -27,9 +27,8 @@ import Hasura.GraphQL.Parser.Collect
import Hasura.GraphQL.Parser.Schema
import Hasura.RQL.Types.CustomTypes
import Hasura.RQL.Types.Error
import Hasura.Server.Utils (englishList)
import Hasura.SQL.Text
import Hasura.SQL.Value
import Hasura.Server.Utils (englishList)
-- -----------------------------------------------------------------------------
@ -247,9 +246,9 @@ scalar name description representation = Parser
JSONValue (A.Bool b) -> pure b
_ -> typeMismatch name "a boolean" v
SRInt -> case v of
GraphQLValue (VInt i) -> convertWith scientificToInteger $ fromInteger i
JSONValue (A.Number n) -> convertWith scientificToInteger n
_ -> typeMismatch name "a 32-bit integer" v
GraphQLValue (VInt i) -> convertWith scientificToInteger $ fromInteger i
JSONValue (A.Number n) -> convertWith scientificToInteger n
_ -> typeMismatch name "a 32-bit integer" v
SRFloat -> case v of
GraphQLValue (VFloat f) -> convertWith scientificToFloat f
GraphQLValue (VInt i) -> convertWith scientificToFloat $ fromInteger i
@ -688,7 +687,7 @@ safeSelectionSet
-> n (Parser 'Output m (OMap.InsOrdHashMap Name (ParsedSelection a)))
safeSelectionSet name desc fields
| S.null duplicates = pure $ selectionSetObject name desc fields []
| otherwise = throw500 $ "found duplicate fields in selection set: " <> T.intercalate ", " (unName <$> toList duplicates)
| otherwise = throw500 $ "found duplicate fields in selection set: " <> commaSeparated (unName <$> toList duplicates)
where
duplicates = LE.duplicates $ getName . fDefinition <$> fields

4
server/src-lib/Hasura/GraphQL/Schema.hs
View File

@ -19,6 +19,7 @@ import Data.List.Extended (duplicates)
import qualified Hasura.GraphQL.Parser as P
import Data.Text.Extended
import Hasura.GraphQL.Context
import Hasura.GraphQL.Execute.Types
import Hasura.GraphQL.Parser (Kind (..), Parser, Schema (..),
@ -33,9 +34,8 @@ import Hasura.GraphQL.Schema.Select
import Hasura.GraphQL.Schema.Table
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.Types
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Session
-- | Whether the request is sent with `x-hasura-use-backend-only-permissions` set to `true`.
data Scenario = Backend | Frontend deriving (Enum, Show, Eq)

6
server/src-lib/Hasura/GraphQL/Schema/Action.hs
View File

@ -4,8 +4,8 @@ module Hasura.GraphQL.Schema.Action
, actionAsyncQuery
) where
import Hasura.Prelude
import Data.Has
import Hasura.Prelude
import qualified Data.Aeson as J
import qualified Data.HashMap.Strict as Map
@ -16,16 +16,16 @@ import qualified Hasura.GraphQL.Parser.Internal.Parser as P
import qualified Hasura.RQL.DML.Internal as RQL
import qualified Hasura.RQL.DML.Select.Types as RQL
import Data.Text.Extended
import Hasura.GraphQL.Parser (FieldParser, InputFieldsParser, Kind (..),
Parser, UnpreparedValue (..))
import Hasura.GraphQL.Parser.Class
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Select
import Hasura.RQL.Types
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value
import Hasura.Session
-- | actionExecute is used to execute either a query action or a synchronous

2
server/src-lib/Hasura/GraphQL/Schema/BoolExp.hs
View File

@ -9,13 +9,13 @@ import qualified Language.GraphQL.Draft.Syntax as G
import qualified Hasura.GraphQL.Parser as P
import Data.Text.Extended
import Hasura.GraphQL.Parser (InputFieldsParser, Kind (..), Parser,
UnpreparedValue, mkParameter)
import Hasura.GraphQL.Parser.Class
import Hasura.GraphQL.Schema.Table
import Hasura.RQL.Types
import Hasura.SQL.DML
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value

2
server/src-lib/Hasura/GraphQL/Schema/Common.hs
View File

@ -12,8 +12,8 @@ import qualified Hasura.GraphQL.Execute.Types as ET (GraphQLQueryType)
import qualified Hasura.GraphQL.Parser as P
import qualified Hasura.RQL.DML.Select.Types as RQL (Fields)
import Data.Text.Extended
import Hasura.RQL.Types
import Hasura.SQL.Text
import Hasura.SQL.Types
data QueryContext =

6
server/src-lib/Hasura/GraphQL/Schema/Mutation.hs
View File

@ -27,6 +27,7 @@ import qualified Hasura.RQL.DML.Update as RQL
import qualified Hasura.RQL.DML.Update.Types as RQL
import qualified Hasura.SQL.DML as S
import Data.Text.Extended
import Hasura.GraphQL.Parser (FieldParser, InputFieldsParser, Kind (..),
Parser, UnpreparedValue (..), mkParameter)
import Hasura.GraphQL.Parser.Class
@ -36,7 +37,6 @@ import Hasura.GraphQL.Schema.Insert
import Hasura.GraphQL.Schema.Select
import Hasura.GraphQL.Schema.Table
import Hasura.RQL.Types
import Hasura.SQL.Text
import Hasura.SQL.Types
@ -387,14 +387,14 @@ updateOperators table updatePermissions = do
-- there needs to be at least one operator in the update, even if it is empty
let presetColumns = Map.toList $ RQL.UpdSet . partialSQLExpToUnpreparedValue <$> upiSet updatePermissions
when (null opExps && null presetColumns) $ parseError $
"at least any one of " <> T.intercalate ", " allowedOperators <> " is expected"
"at least any one of " <> commaSeparated allowedOperators <> " is expected"
-- no column should appear twice
let flattenedExps = concat opExps
erroneousExps = OMap.filter ((>1) . length) $ OMap.groupTuples flattenedExps
unless (OMap.null erroneousExps) $ parseError $
"column found in multiple operators; " <>
T.intercalate ". " [ dquote column <> " in " <> T.intercalate ", " (toList $ RQL.updateOperatorText <$> ops)
T.intercalate ". " [ dquote column <> " in " <> commaSeparated (RQL.updateOperatorText <$> ops)
| (column, ops) <- OMap.toList erroneousExps
]

2
server/src-lib/Hasura/GraphQL/Schema/OrderBy.hs
View File

@ -12,12 +12,12 @@ import qualified Hasura.RQL.DML.Select as RQL
import Hasura.RQL.Types as RQL
import Hasura.SQL.DML as SQL
import Data.Text.Extended
import Hasura.GraphQL.Parser (InputFieldsParser, Kind (..), Parser,
UnpreparedValue)
import Hasura.GraphQL.Parser.Class
import Hasura.GraphQL.Schema.Common
import Hasura.GraphQL.Schema.Table
import Hasura.SQL.Text
import Hasura.SQL.Types

22
server/src-lib/Hasura/GraphQL/Schema/Remote.hs
View File

@ -8,21 +8,21 @@ module Hasura.GraphQL.Schema.Remote
import Hasura.Prelude
import qualified Data.List.NonEmpty as NE
import qualified Data.HashMap.Strict as Map
import qualified Data.HashMap.Strict.Extended as Map
import qualified Data.HashMap.Strict.InsOrd as OMap
import qualified Data.List.NonEmpty as NE
import Language.GraphQL.Draft.Syntax as G
import Data.Type.Equality
import Data.Foldable (sequenceA_)
import Data.Type.Equality
import Language.GraphQL.Draft.Syntax as G
import qualified Hasura.GraphQL.Parser.Internal.Parser as P
import Data.Text.Extended
import Hasura.GraphQL.Context (RemoteField)
import Hasura.GraphQL.Parser as P
import Hasura.RQL.Types
import Hasura.SQL.Text
buildRemoteParser
@ -163,7 +163,7 @@ remoteSchemaObject schemaDoc defn@(G.ObjectTypeDefinition description name inter
validateSubType (G.TypeNamed nx x) (G.TypeNamed ny y) =
case (lookupType schemaDoc x , lookupType schemaDoc y) of
(Just x' , Just y') -> nx == ny && validateSubTypeDefinition x' y'
_ -> False
_ -> False
validateSubType _ _ = False
validateSubTypeDefinition x' y' | x' == y' = True
validateSubTypeDefinition (TypeDefinitionObject otd) (TypeDefinitionInterface itd)
@ -410,7 +410,7 @@ remoteFieldFromName
-> m (FieldParser n (Field NoFragments G.Name))
remoteFieldFromName sdoc fieldName description fieldTypeName argsDefns =
case lookupType sdoc fieldTypeName of
Nothing -> throw400 RemoteSchemaError $ "Could not find type with name " <>> fieldName
Nothing -> throw400 RemoteSchemaError $ "Could not find type with name " <>> fieldName
Just typeDef -> remoteField sdoc fieldName description argsDefns typeDef
-- | 'inputValuefinitionParser' accepts a 'G.InputValueDefinition' and will return an
@ -535,11 +535,11 @@ remoteFieldScalarParser
remoteFieldScalarParser (G.ScalarTypeDefinition description name _directives) =
case G.unName name of
"Boolean" -> P.boolean $> ()
"Int" -> P.int $> ()
"Float" -> P.float $> ()
"String" -> P.string $> ()
"ID" -> P.identifier $> ()
_ -> P.unsafeRawScalar name description $> ()
"Int" -> P.int $> ()
"Float" -> P.float $> ()
"String" -> P.string $> ()
"ID" -> P.identifier $> ()
_ -> P.unsafeRawScalar name description $> ()
remoteFieldEnumParser
:: MonadParse n

4
server/src-lib/Hasura/GraphQL/Schema/Select.hs
View File

@ -44,6 +44,7 @@ import qualified Hasura.RQL.DML.Select as RQL
import qualified Hasura.RQL.Types.BoolExp as RQL
import qualified Hasura.SQL.DML as SQL
import Data.Text.Extended
import Hasura.GraphQL.Parser (FieldParser, InputFieldsParser, Kind (..),
Parser, UnpreparedValue (..), mkParameter)
import Hasura.GraphQL.Parser.Class
@ -54,10 +55,9 @@ import Hasura.GraphQL.Schema.OrderBy
import Hasura.GraphQL.Schema.Remote
import Hasura.GraphQL.Schema.Table
import Hasura.RQL.Types
import Hasura.Server.Utils (executeJSONPath)
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value
import Hasura.Server.Utils (executeJSONPath)
type SelectExp = RQL.AnnSimpleSelG UnpreparedValue
type AggSelectExp = RQL.AnnAggregateSelectG UnpreparedValue

2
server/src-lib/Hasura/GraphQL/Schema/Table.hs
View File

@ -20,11 +20,11 @@ import qualified Language.GraphQL.Draft.Syntax as G
import qualified Hasura.GraphQL.Parser as P
import Data.Text.Extended
import Hasura.GraphQL.Parser (Kind (..), Parser)
import Hasura.GraphQL.Parser.Class
import Hasura.RQL.DML.Internal (getRolePermInfo)
import Hasura.RQL.Types
import Hasura.SQL.Text
import Hasura.SQL.Types
-- | Table select columns enum

8
server/src-lib/Hasura/GraphQL/Utils.hs
View File

@ -12,9 +12,10 @@ import Hasura.Prelude
import qualified Data.HashMap.Strict as Map
import qualified Data.List.NonEmpty as NE
import qualified Data.Text as T
import qualified Language.GraphQL.Draft.Syntax as G
import Data.Text.Extended
showName :: G.Name -> Text
showName name = "\"" <> G.unName name <> "\""
@ -55,9 +56,8 @@ mkMapWith f l =
mapG = groupListWith f l
dups = Map.keys $ Map.filter ((> 1) . length) mapG
showNames :: (Foldable t) => t G.Name -> Text
showNames names =
T.intercalate ", " $ map G.unName $ toList names
showNames :: (Functor t, Foldable t) => t G.Name -> Text
showNames = commaSeparated . fmap G.unName
-- A simple graphql query to be used in generators
simpleGraphQLQuery :: Text

4
server/src-lib/Hasura/Prelude.hs
View File

@ -44,10 +44,10 @@ import Data.Foldable as M (asum, fold, foldrM, for
traverse_)
import Data.Function as M (on, (&))
import Data.Functor as M (($>), (<&>))
import Data.Hashable as M (Hashable)
import Data.HashMap.Strict as M (HashMap)
import Data.HashMap.Strict.InsOrd as M (InsOrdHashMap)
import Data.HashSet as M (HashSet)
import Data.Hashable as M (Hashable)
import Data.List as M (find, findIndex, foldl', group,
intercalate, intersect, lookup, sort,
sortBy, sortOn, union, unionBy, (\\))
@ -74,8 +74,8 @@ import Text.Read as M (readEither, readMaybe)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64.Lazy as Base64
import Data.Coerce
import qualified Data.ByteString.Lazy as BL
import Data.Coerce
import qualified Data.HashMap.Strict as Map
import qualified Data.Set as Set
import qualified Data.Text as T

4
server/src-lib/Hasura/RQL/DDL/Action.hs
View File

@ -35,13 +35,13 @@ import qualified Language.GraphQL.Draft.Syntax as G
import Language.Haskell.TH.Syntax (Lift)
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.GraphQL.Utils
import Hasura.RQL.DDL.CustomTypes (lookupPGScalar)
import Hasura.RQL.Types
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Session
getActionInfo

6
server/src-lib/Hasura/RQL/DDL/ComputedField.hs
View File

@ -25,15 +25,15 @@ import Data.Aeson.Casing
import Data.Aeson.TH
import Language.Haskell.TH.Syntax (Lift)
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Deps
import Hasura.RQL.DDL.Permission.Internal
import Hasura.RQL.DDL.Schema.Function (RawFunctionInfo (..), mkFunctionArgs)
import Hasura.RQL.Types
import Hasura.Server.Utils (makeReasonMessage)
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Server.Utils (makeReasonMessage)
data ComputedFieldDefinition
@ -112,7 +112,7 @@ showError qf = \case
"the function " <> qf <<> " is of type VOLATILE; cannot be added as a computed field"
where
showFunctionTableArgument = \case
FTAFirst -> "first argument of the function " <>> qf
FTAFirst -> "first argument of the function " <>> qf
FTANamed argName _ -> argName <<> " argument of the function " <>> qf
showFunctionSessionArgument = \case
FunctionSessionArgument argName _ -> argName <<> " argument of the function " <>> qf

2
server/src-lib/Hasura/RQL/DDL/CustomTypes.hs
View File

@ -19,9 +19,9 @@ import qualified Language.GraphQL.Draft.Syntax as G
import Control.Monad.Validate
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.RQL.Types
import Hasura.SQL.Text
import Hasura.SQL.Types
{- Note [Postgres scalars in custom types]

10
server/src-lib/Hasura/RQL/DDL/Deps.hs
View File

@ -9,9 +9,11 @@ module Hasura.RQL.DDL.Deps
import Hasura.Prelude
import qualified Data.HashSet as HS
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import qualified Data.HashSet as HS
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import Data.Text.Extended
import Hasura.RQL.Types
import Hasura.SQL.Types
@ -36,7 +38,7 @@ reportDepsExt deps unknownDeps =
throw400 DependencyError $
"cannot drop due to the following dependent objects : " <> depObjsTxt
where
depObjsTxt = T.intercalate ", " (reportSchemaObjs deps:unknownDeps)
depObjsTxt = commaSeparated $ reportSchemaObjs deps:unknownDeps
parseDropNotice :: (QErrM m ) => T.Text -> m [Either T.Text SchemaObjId]
parseDropNotice t = do

4
server/src-lib/Hasura/RQL/DDL/Permission.hs
View File

@ -38,14 +38,14 @@ module Hasura.RQL.DDL.Permission
import Hasura.Prelude
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Permission.Internal
import Hasura.RQL.DML.Internal hiding (askPermInfo)
import Hasura.RQL.Types
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Session
import qualified Database.PG.Query as Q

8
server/src-lib/Hasura/RQL/DDL/Permission/Internal.hs
View File

@ -6,7 +6,7 @@ module Hasura.RQL.DDL.Permission.Internal where
import Hasura.Prelude
import qualified Data.HashMap.Strict as M
import qualified Data.Text.Extended as T
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import qualified Hasura.SQL.DML as S
@ -17,15 +17,15 @@ import Data.Aeson.Types
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.Incremental (Cacheable)
import Hasura.RQL.GBoolExp
import Hasura.RQL.Types
import Hasura.Server.Utils
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value
import Hasura.Server.Utils
import Hasura.Session
data PermColSpec

6
server/src-lib/Hasura/RQL/DDL/QueryCollection.hs
View File

@ -16,16 +16,14 @@ module Hasura.RQL.DDL.QueryCollection
import Hasura.Prelude
import qualified Data.Text as T
import qualified Data.Text.Extended as T
import qualified Database.PG.Query as Q
import Data.List.Extended (duplicates)
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.RQL.Types
import Hasura.RQL.Types.QueryCollection
import Hasura.SQL.Text
addCollectionP2
@ -35,7 +33,7 @@ addCollectionP2 (CollectionDef queryList) =
withPathK "queries" $
unless (null duplicateNames) $ throw400 NotSupported $
"found duplicate query names "
<> T.intercalate ", " (map (T.dquote . unNonEmptyText . unQueryName) $ toList duplicateNames)
<> dquoteList (unNonEmptyText . unQueryName <$> toList duplicateNames)
where
duplicateNames = duplicates $ map _lqName queryList

2
server/src-lib/Hasura/RQL/DDL/Relationship/Rename.hs
View File

@ -2,12 +2,12 @@ module Hasura.RQL.DDL.Relationship.Rename
(runRenameRel)
where
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DDL.Relationship.Types
import Hasura.RQL.DDL.Schema (renameRelInCatalog)
import Hasura.RQL.Types
import Hasura.SQL.Text
import Hasura.SQL.Types
import qualified Data.HashMap.Strict as Map

4
server/src-lib/Hasura/RQL/DDL/RemoteRelationship/Validate.hs
View File

@ -16,11 +16,11 @@ import qualified Language.GraphQL.Draft.Syntax as G
import Data.Foldable
import Data.Text.Extended
import Hasura.GraphQL.Parser.Column
import Hasura.GraphQL.Schema.Remote
import Hasura.GraphQL.Utils (getBaseTyWithNestedLevelsCount)
import Hasura.RQL.Types
import Hasura.SQL.Text
import Hasura.SQL.Types
@ -321,7 +321,7 @@ validateRemoteArguments expectedArguments providedArguments permittedVariables s
unwrapGraphQLType :: G.GType -> G.GType
unwrapGraphQLType = \case
G.TypeList _ lt -> lt
nt -> nt
nt -> nt
-- | Validate a value against a type.
validateType

2
server/src-lib/Hasura/RQL/DDL/RemoteSchema.hs
View File

@ -26,10 +26,10 @@ import Hasura.EncJSON
-- import Hasura.GraphQL.NormalForm
import Hasura.GraphQL.RemoteServer
-- import Hasura.GraphQL.Schema.Merge
import Data.Text.Extended
import Hasura.RQL.DDL.Deps
import Hasura.RQL.Types
import Hasura.Server.Version (HasVersion)
import Hasura.SQL.Text
runAddRemoteSchema

9
server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs
View File

@ -23,7 +23,6 @@ import Hasura.Prelude
import qualified Data.Environment as Env
import qualified Data.HashMap.Strict.Extended as M
import qualified Data.HashSet as HS
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import Control.Arrow.Extended
@ -34,6 +33,7 @@ import Data.List (nub)
import qualified Hasura.Incremental as Inc
import Data.Text.Extended
import Hasura.Db
import Hasura.GraphQL.Execute.Types
import Hasura.GraphQL.Schema (buildGQLContext)
@ -55,9 +55,8 @@ import Hasura.RQL.DDL.Schema.Table
import Hasura.RQL.DDL.Utils (clearHdbViews)
import Hasura.RQL.Types
import Hasura.RQL.Types.Catalog
import Hasura.Server.Version (HasVersion)
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Server.Version (HasVersion)
buildRebuildableSchemaCache
:: (HasVersion, MonadIO m, MonadUnique m, MonadTx m, HasHttpManager m, HasSQLGenCtx m)
@ -436,7 +435,7 @@ withMetadataCheck cascade action = do
-- Do not allow overloading functions
unless (null overloadedFuncs) $
throw400 NotSupported $ "the following tracked function(s) cannot be overloaded: "
<> reportFuncs overloadedFuncs
<> commaSeparated overloadedFuncs
indirectDeps <- getSchemaChangeDeps schemaDiff
@ -480,8 +479,6 @@ withMetadataCheck cascade action = do
return res
where
reportFuncs = T.intercalate ", " . map toTxt
processSchemaChanges :: (MonadTx m, CacheRM m) => SchemaDiff -> m ()
processSchemaChanges schemaDiff = do
-- Purge the dropped tables

2
server/src-lib/Hasura/RQL/DDL/Schema/Cache/Common.hs
View File

@ -16,10 +16,10 @@ import Control.Lens
import qualified Hasura.Incremental as Inc
import Data.Text.Extended
import Hasura.RQL.Types
import Hasura.RQL.Types.Catalog
import Hasura.RQL.Types.Run
import Hasura.SQL.Text
import Hasura.SQL.Types
-- | 'InvalidationKeys' used to apply requested 'CacheInvalidations'.

2
server/src-lib/Hasura/RQL/DDL/Schema/Cache/Dependencies.hs
View File

@ -13,9 +13,9 @@ import Data.Aeson
import Data.List (nub)
import Data.Monoid (First)
import Data.Text.Extended
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.Types
import Hasura.SQL.Text
-- | Processes collected 'CIDependency' values into a 'DepMap', performing integrity checking to
-- ensure the dependencies actually exist. If a dependency is missing, its transitive dependents are

2
server/src-lib/Hasura/RQL/DDL/Schema/Cache/Fields.hs
View File

@ -18,6 +18,7 @@ import Data.Aeson
import qualified Hasura.Incremental as Inc
import Data.Text.Extended
import Hasura.RQL.DDL.ComputedField
import Hasura.RQL.DDL.Relationship
import Hasura.RQL.DDL.RemoteRelationship
@ -25,7 +26,6 @@ import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.DDL.Schema.Function
import Hasura.RQL.Types
import Hasura.RQL.Types.Catalog
import Hasura.SQL.Text
import Hasura.SQL.Types
addNonColumnFields

4
server/src-lib/Hasura/RQL/DDL/Schema/Cache/Permission.hs
View File

@ -15,15 +15,15 @@ import Data.Aeson
import qualified Hasura.Incremental as Inc
import Data.Text.Extended
import Hasura.Db
import Hasura.RQL.DDL.Permission
import Hasura.RQL.DDL.Permission.Internal
import Hasura.RQL.DDL.Schema.Cache.Common
import Hasura.RQL.Types
import Hasura.RQL.Types.Catalog
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Session
buildTablePermissions
:: ( ArrowChoice arr, Inc.ArrowDistribute arr, Inc.ArrowCache m arr

10
server/src-lib/Hasura/RQL/DDL/Schema/Enum.hs
View File

@ -24,6 +24,7 @@ import qualified Data.List.NonEmpty as NE
import qualified Data.Sequence as Seq
import qualified Data.Sequence.NonEmpty as NESeq
import qualified Data.Text as T
import Data.Text.Extended
import qualified Database.PG.Query as Q
import qualified Language.GraphQL.Draft.Syntax as G
@ -31,9 +32,8 @@ import Hasura.Db
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Error
import Hasura.Server.Utils (makeReasonMessage)
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Server.Utils (makeReasonMessage)
import qualified Hasura.SQL.DML as S
@ -135,7 +135,7 @@ fetchAndValidateEnumValues tableName maybePrimaryKey columnInfos =
EnumTableMissingPrimaryKey -> "the table must have a primary key"
EnumTableMultiColumnPrimaryKey cols ->
"the table’s primary key must not span multiple columns ("
<> T.intercalate ", " (toTxt <$> sort cols) <> ")"
<> commaSeparated (sort cols) <> ")"
EnumTableNonTextualPrimaryKey colInfo -> typeMismatch "primary key" colInfo PGText
EnumTableNoEnumValues -> "the table must have at least one row"
EnumTableInvalidEnumValueNames values ->
@ -144,14 +144,14 @@ fetchAndValidateEnumValues tableName maybePrimaryKey columnInfos =
value NE.:| [] -> "value " <> value <<> " is not a valid GraphQL enum value name"
value2 NE.:| [value1] -> "values " <> value1 <<> " and " <> value2 <<> pluralString
lastValue NE.:| otherValues ->
"values " <> T.intercalate ", " (toTxt <$> reverse otherValues) <> ", and "
"values " <> commaSeparated (reverse otherValues) <> ", and "
<> lastValue <<> pluralString
in "the " <> valuesString
EnumTableNonTextualCommentColumn colInfo -> typeMismatch "comment column" colInfo PGText
EnumTableTooManyColumns cols ->
"the table must have exactly one primary key and optionally one comment column, not "
<> T.pack (show $ length cols) <> " columns ("
<> T.intercalate ", " (toTxt <$> sort cols) <> ")"
<> commaSeparated (sort cols) <> ")"
where
typeMismatch description colInfo expected =
"the table’s " <> description <> " (" <> prciName colInfo <<> ") must have type "

4
server/src-lib/Hasura/RQL/DDL/Schema/Function.hs
View File

@ -20,12 +20,12 @@ import Language.Haskell.TH.Syntax (Lift)
import qualified Language.GraphQL.Draft.Syntax as G
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Types
import Hasura.Server.Utils (englishList, makeReasonMessage)
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Server.Utils (englishList, makeReasonMessage)
data RawFunctionInfo

6
server/src-lib/Hasura/RQL/DDL/Schema/Rename.hs
View File

@ -12,15 +12,15 @@ where
import Control.Lens.Combinators
import Control.Lens.Operators
import Data.Text.Extended
import Hasura.Prelude
import Hasura.RQL.DDL.Permission
import Hasura.RQL.DDL.Permission.Internal
import Hasura.RQL.DDL.Relationship.Types
import Hasura.RQL.DDL.Schema.Catalog
import Hasura.RQL.Types
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Session
import qualified Hasura.RQL.DDL.EventTrigger as DS
import qualified Hasura.RQL.DDL.RemoteRelationship as RR
@ -426,7 +426,7 @@ updateColInObjRel
:: QualifiedTable -> QualifiedTable
-> RenameCol -> ObjRelUsing -> ObjRelUsing
updateColInObjRel fromQT toQT rnCol = \case
RUFKeyOn col -> RUFKeyOn $ getNewCol rnCol fromQT col
RUFKeyOn col -> RUFKeyOn $ getNewCol rnCol fromQT col
RUManual manConfig -> RUManual $ updateRelManualConfig fromQT toQT rnCol manConfig
updateColInArrRel

6
server/src-lib/Hasura/RQL/DDL/Schema/Table.hs
View File

@ -42,6 +42,7 @@ import Network.URI.Extended ()
import qualified Hasura.Incremental as Inc
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.GraphQL.Context
import Hasura.GraphQL.Schema.Common (textToName)
@ -53,9 +54,8 @@ import Hasura.RQL.DDL.Schema.Enum
import Hasura.RQL.DDL.Schema.Rename
import Hasura.RQL.Types
import Hasura.RQL.Types.Catalog
import Hasura.Server.Utils
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Server.Utils
data TrackTable
@ -488,7 +488,7 @@ buildTableCache = Inc.cache proc (catalogTables, reloadMetadataInvalidationKey)
Just enumReferences -> throw400 ConstraintViolation
$ "column " <> prciName rawInfo <<> " in table " <> tableName
<<> " references multiple enum tables ("
<> T.intercalate ", " (map (dquote . erTable) $ toList enumReferences) <> ")"
<> dquoteList (erTable <$> enumReferences) <> ")"
assertNoDuplicateFieldNames columns =
flip Map.traverseWithKey (Map.groupOn pgiName columns) \name columnsWithName ->

4
server/src-lib/Hasura/RQL/DML/Insert.hs
View File

@ -19,6 +19,7 @@ import qualified Database.PG.Query as Q
import qualified Hasura.SQL.DML as S
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.RQL.DML.Insert.Types
import Hasura.RQL.DML.Internal
@ -26,10 +27,9 @@ import Hasura.RQL.DML.Mutation
import Hasura.RQL.DML.Returning
import Hasura.RQL.GBoolExp
import Hasura.RQL.Types
import Hasura.SQL.Types
import Hasura.Server.Version (HasVersion)
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import qualified Data.Environment as Env

6
server/src-lib/Hasura/RQL/DML/Internal.hs
View File

@ -13,13 +13,13 @@ import Data.Aeson.Types
import qualified Hasura.SQL.DML as S
import Data.Text.Extended
import Hasura.RQL.GBoolExp
import Hasura.RQL.Types
import Hasura.Session
import Hasura.SQL.Error
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value
import Hasura.Session
newtype DMLP1T m a
@ -210,7 +210,7 @@ convPartialSQLExp
-> PartialSQLExp
-> f S.SQLExp
convPartialSQLExp f = \case
PSESQLExp sqlExp -> pure sqlExp
PSESQLExp sqlExp -> pure sqlExp
PSESessVar colTy sessionVariable -> f colTy sessionVariable
sessVarFromCurrentSetting

6
server/src-lib/Hasura/RQL/DML/Mutation.hs
View File

@ -21,6 +21,7 @@ import qualified Network.HTTP.Types as N
import qualified Hasura.SQL.DML as S
import qualified Hasura.Tracing as Tracing
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.RQL.DML.Internal
import Hasura.RQL.DML.RemoteJoin
@ -29,11 +30,10 @@ import Hasura.RQL.DML.Returning.Types
import Hasura.RQL.DML.Select
import Hasura.RQL.Instances ()
import Hasura.RQL.Types
import Hasura.Server.Version (HasVersion)
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value
import Hasura.Server.Version (HasVersion)
import Hasura.Session
type MutationRemoteJoinCtx = (HTTP.Manager, [N.Header], UserInfo)

18
server/src-lib/Hasura/RQL/DML/RemoteJoin.hs
View File

@ -16,6 +16,7 @@ import Hasura.Prelude
import Control.Lens
import Data.Validation
import Data.Text.Extended (commaSeparated, (<<>))
import Hasura.EncJSON
import Hasura.GraphQL.Parser hiding (field)
import Hasura.GraphQL.RemoteServer (execRemoteGQ')
@ -26,7 +27,6 @@ import Hasura.RQL.DML.Select.Types
import Hasura.RQL.Types
import Hasura.Server.Version (HasVersion)
import Hasura.Session
import Hasura.SQL.Text ((<<>))
import qualified Hasura.SQL.DML as S
@ -178,8 +178,8 @@ transformConnectionSelect path ConnectionSelect{..} = do
let connectionFields = _asnFields _csSelect
transformedFields <- forM connectionFields $ \(fieldName, field) ->
(fieldName,) <$> case field of
ConnectionTypename t -> pure $ ConnectionTypename t
ConnectionPageInfo p -> pure $ ConnectionPageInfo p
ConnectionTypename t -> pure $ ConnectionTypename t
ConnectionPageInfo p -> pure $ ConnectionPageInfo p
ConnectionEdges edges -> ConnectionEdges <$> transformEdges (appendPath fieldName path) edges
let select = _csSelect{_asnFields = transformedFields}
pure $ ConnectionSelect _csPrimaryKeyColumns _csSplit _csSlice select
@ -283,10 +283,10 @@ collectRemoteFields = toList
compositeValueToJSON :: CompositeValue AO.Value -> AO.Value
compositeValueToJSON = \case
CVOrdValue v -> v
CVObject obj -> AO.object $ OMap.toList $ OMap.map compositeValueToJSON obj
CVOrdValue v -> v
CVObject obj -> AO.object $ OMap.toList $ OMap.map compositeValueToJSON obj
CVObjectArray vals -> AO.array $ map compositeValueToJSON vals
CVFromRemote v -> v
CVFromRemote v -> v
-- | A 'RemoteJoinField' carries the minimal GraphQL AST of a remote relationship field.
-- All such 'RemoteJoinField's of a particular remote schema are batched together
@ -315,8 +315,8 @@ traverseQueryResponseJSON rjm =
=> FieldPath -> AO.Value -> m (CompositeValue RemoteJoinField)
traverseValue path = \case
AO.Object obj -> traverseObject obj
AO.Array arr -> CVObjectArray <$> mapM (traverseValue path) (toList arr)
v -> pure $ CVOrdValue v
AO.Array arr -> CVObjectArray <$> mapM (traverseValue path) (toList arr)
v -> pure $ CVOrdValue v
where
mkRemoteSchemaField siblingFields remoteJoin = do
@ -585,7 +585,7 @@ createArguments
-> m (HashMap G.Name (G.Value Void))
createArguments variables (RemoteArguments arguments) =
either
(throw400 Unexpected . \errors -> "Found errors: " <> T.intercalate ", " errors)
(throw400 Unexpected . \errors -> "Found errors: " <> commaSeparated errors)
pure
(toEither (substituteVariables variables arguments))

2
server/src-lib/Hasura/RQL/DML/Select.hs
View File

@ -17,12 +17,12 @@ import qualified Data.HashSet as HS
import qualified Data.List.NonEmpty as NE
import qualified Data.Sequence as DS
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DML.Internal
import Hasura.RQL.DML.Select.Internal
import Hasura.RQL.Types
import Hasura.SQL.Text
import Hasura.SQL.Types
import qualified Database.PG.Query as Q

16
server/src-lib/Hasura/RQL/DML/Select/Internal.hs
View File

@ -14,6 +14,7 @@ import qualified Data.Text as T
import Control.Lens hiding (op)
import Control.Monad.Writer.Strict
import Data.Text.Extended
import Instances.TH.Lift ()
import qualified Hasura.SQL.DML as S
@ -24,7 +25,6 @@ import Hasura.RQL.DML.Select.Types
import Hasura.RQL.GBoolExp
import Hasura.RQL.Types
import Hasura.SQL.Rewrite
import Hasura.SQL.Text
import Hasura.SQL.Types
@ -50,9 +50,9 @@ selectFromToFromItem pfx = \case
-- possible currently
selectFromToQual :: SelectFrom -> S.Qual
selectFromToQual = \case
FromTable tn -> S.QualTable tn
FromIden i -> S.QualIden i Nothing
FromFunction qf _ _ -> S.QualIden (functionToIden qf) Nothing
FromTable tn -> S.QualTable tn
FromIden i -> S.QualIden i Nothing
FromFunction qf _ _ -> S.QualIden (functionToIden qf) Nothing
aggregateFieldToExp :: AggregateFields -> S.SQLExp
aggregateFieldToExp aggFlds = jsonRow
@ -182,7 +182,7 @@ mkOrderByFieldName relName =
mkAggregateOrderByAlias :: AnnAggregateOrderBy -> S.Alias
mkAggregateOrderByAlias = (S.Alias . Iden) . \case
AAOCount -> "count"
AAOCount -> "count"
AAOOp opText col -> opText <> "." <> getPGColTxt (pgiColumn col)
mkArrayRelationSourcePrefix
@ -319,8 +319,8 @@ mkSimilarArrayFields annFields maybeOrderBys =
getArrayRelNameAndSelectArgs :: ArraySelectG v -> (RelName, SelectArgsG v)
getArrayRelNameAndSelectArgs = \case
ASSimple r -> (aarRelationshipName r, _asnArgs $ aarAnnSelect r)
ASAggregate r -> (aarRelationshipName r, _asnArgs $ aarAnnSelect r)
ASSimple r -> (aarRelationshipName r, _asnArgs $ aarAnnSelect r)
ASAggregate r -> (aarRelationshipName r, _asnArgs $ aarAnnSelect r)
ASConnection r -> (aarRelationshipName r, _asnArgs $ _csSelect $ aarAnnSelect r)
getAnnArr :: (a, AnnFieldG v) -> Maybe (a, ArraySelectG v)
@ -510,7 +510,7 @@ mkPermissionLimitSubQuery permLimit aggFields orderBys =
Just l -> flip any (concatMap toList $ toList l) $
\case
AOCArrayAggregation{} -> True
_ -> False
_ -> False
processArrayRelation
:: forall m. ( MonadReader Bool m

4
server/src-lib/Hasura/RQL/DML/Update.hs
View File

@ -12,6 +12,7 @@ import Instances.TH.Lift ()
import qualified Data.HashMap.Strict as M
import qualified Data.Sequence as DS
import Data.Text.Extended
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DML.Insert (insertCheckExpr)
@ -22,10 +23,9 @@ import Hasura.RQL.DML.Update.Types
import Hasura.RQL.GBoolExp
import Hasura.RQL.Instances ()
import Hasura.RQL.Types
import Hasura.SQL.Types
import Hasura.Server.Version (HasVersion)
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import qualified Data.Environment as Env
import qualified Database.PG.Query as Q

8
server/src-lib/Hasura/RQL/GBoolExp.hs
View File

@ -7,7 +7,7 @@ module Hasura.RQL.GBoolExp
import Hasura.Prelude
import qualified Data.HashMap.Strict as M
import qualified Data.Text.Extended as T
import qualified Data.Text as T
import Control.Lens (filtered, has)
import Data.Aeson
@ -15,8 +15,8 @@ import Data.Data.Lens (template)
import qualified Hasura.SQL.DML as S
import Data.Text.Extended
import Hasura.RQL.Types
import Hasura.SQL.Text
import Hasura.SQL.Types
type OpRhsParser m v =
@ -31,7 +31,7 @@ data ColumnReference
columnReferenceType :: ColumnReference -> PGColumnType
columnReferenceType = \case
ColumnReferenceColumn column -> pgiType column
ColumnReferenceColumn column -> pgiType column
ColumnReferenceCast _ targetType -> targetType
instance ToTxt ColumnReference where
@ -59,7 +59,7 @@ parseOperationsExpression rhsParser fim columnInfo =
where
columnType = PGTypeScalar $ columnReferenceType column
parseOperation :: ColumnReference -> (T.Text, Value) -> m (OpExpG v)
parseOperation :: ColumnReference -> (Text, Value) -> m (OpExpG v)
parseOperation column (opStr, val) = withPathK opStr $
case opStr of
"$cast" -> parseCast

4
server/src-lib/Hasura/RQL/Types.hs
View File

@ -46,6 +46,7 @@ import qualified Network.HTTP.Client as HTTP
import Control.Monad.Unique
import Data.Text.Extended
import Hasura.Db as R
import Hasura.RQL.Types.Action as R
import Hasura.RQL.Types.BoolExp as R
@ -66,9 +67,8 @@ import Hasura.RQL.Types.ScheduledTrigger as R
import Hasura.RQL.Types.SchemaCache as R
import Hasura.RQL.Types.SchemaCache.Build as R
import Hasura.RQL.Types.Table as R
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Session
import Hasura.Tracing (TraceT)

4
server/src-lib/Hasura/RQL/Types/Action.hs
View File

@ -61,6 +61,7 @@ import qualified Network.HTTP.Client as HTTP
import qualified Network.HTTP.Types as HTTP
import Control.Lens (makeLenses, makePrisms)
import Data.Text.Extended
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Incremental (Cacheable)
@ -68,9 +69,8 @@ import Hasura.RQL.DDL.Headers
import Hasura.RQL.DML.Select.Types
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.CustomTypes
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Session
newtype ActionName

13
server/src-lib/Hasura/RQL/Types/Column.hs
View File

@ -35,13 +35,14 @@ import Control.Lens.TH
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Instances ()
import Hasura.RQL.Types.Error
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.SQL.Value
import Language.Haskell.TH.Syntax (Lift)
newtype EnumValue
= EnumValue { getEnumValue :: G.Name }
@ -87,12 +88,12 @@ $(makePrisms ''PGColumnType)
instance ToTxt PGColumnType where
toTxt = \case
PGColumnScalar scalar -> toTxt scalar
PGColumnScalar scalar -> toTxt scalar
PGColumnEnumReference (EnumReference tableName _) -> toTxt tableName
isScalarColumnWhere :: (PGScalarType -> Bool) -> PGColumnType -> Bool
isScalarColumnWhere f = \case
PGColumnScalar scalar -> f scalar
PGColumnScalar scalar -> f scalar
PGColumnEnumReference _ -> False
-- | Gets the representation type associated with a 'PGColumnType'. Avoid using this if possible.
@ -101,7 +102,7 @@ isScalarColumnWhere f = \case
unsafePGColumnToRepresentation :: PGColumnType -> PGScalarType
unsafePGColumnToRepresentation = \case
PGColumnScalar scalarType -> scalarType
PGColumnEnumReference _ -> PGText
PGColumnEnumReference _ -> PGText
-- | Note: Unconditionally accepts null values and returns 'PGNull'.
parsePGScalarValue
@ -116,7 +117,7 @@ parsePGScalarValue columnType value = case columnType of
parseEnumValue enumValueName = do
let enums = map getEnumValue $ M.keys enumValues
unless (enumValueName `elem` enums) $ throw400 UnexpectedPayload
$ "expected one of the values " <> T.intercalate ", " (map dquote enums)
$ "expected one of the values " <> dquoteList enums
<> " for type " <> snakeCaseQualObject tableName <<> ", given " <>> enumValueName
pure $ PGValText $ G.unName enumValueName

4
server/src-lib/Hasura/RQL/Types/Common.hs
View File

@ -69,6 +69,7 @@ import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Bifunctor (bimap)
import Data.Scientific (toBoundedInteger)
import Data.Text.Extended
import Data.URL.Template
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift, Q, TExp)
@ -77,7 +78,6 @@ import Hasura.EncJSON
import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Headers ()
import Hasura.RQL.Types.Error
import Hasura.SQL.Text
import Hasura.SQL.Types
@ -158,7 +158,7 @@ instance Q.FromCol RelType where
fromCol bs = flip Q.fromColHelper bs $ PD.enum $ \case
"object" -> Just ObjRel
"array" -> Just ArrRel
_ -> Nothing
_ -> Nothing
data RelInfo
= RelInfo

2
server/src-lib/Hasura/RQL/Types/ComputedField.hs
View File

@ -14,13 +14,13 @@ import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Function
import Hasura.SQL.Text
import Hasura.SQL.Types

2
server/src-lib/Hasura/RQL/Types/CustomTypes.hs
View File

@ -33,6 +33,7 @@ module Hasura.RQL.Types.CustomTypes
) where
import Control.Lens.TH (makeLenses)
import Data.Text.Extended
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)
@ -52,7 +53,6 @@ import Hasura.Prelude
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common (RelType)
import Hasura.RQL.Types.Table
import Hasura.SQL.Text
import Hasura.SQL.Types
newtype GraphQLType

2
server/src-lib/Hasura/RQL/Types/EventTrigger.hs
View File

@ -34,12 +34,12 @@ import qualified Text.Regex.TDFA as TDFA
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Headers
import Hasura.RQL.Types.Common (InputWebhook, NonEmptyText (..))
import Hasura.SQL.Text
import Hasura.SQL.Types

2
server/src-lib/Hasura/RQL/Types/Function.hs
View File

@ -9,11 +9,11 @@ import Control.Lens
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Types.Common
import Hasura.SQL.Text
import Hasura.SQL.Types

6
server/src-lib/Hasura/RQL/Types/Metadata.hs
View File

@ -4,6 +4,7 @@ import qualified Data.HashMap.Strict.Extended as M
import Control.Lens hiding ((.=))
import Data.Aeson
import Data.Text.Extended
import Hasura.Prelude
import Hasura.Session
@ -14,7 +15,6 @@ import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.RemoteRelationship
import Hasura.RQL.Types.RemoteSchema
import Hasura.SQL.Text
import Hasura.SQL.Types
data TableMetadataObjId
@ -93,9 +93,9 @@ getInconsistentRemoteSchemas =
imObjectIds :: InconsistentMetadata -> [MetadataObjId]
imObjectIds = \case
InconsistentObject _ metadata -> [_moId metadata]
InconsistentObject _ metadata -> [_moId metadata]
ConflictingObjects _ metadatas -> map _moId metadatas
DuplicateObjects objectId _ -> [objectId]
DuplicateObjects objectId _ -> [objectId]
imReason :: InconsistentMetadata -> Text
imReason = \case

2
server/src-lib/Hasura/RQL/Types/QueryCollection.hs
View File

@ -24,12 +24,12 @@ import qualified Language.GraphQL.Draft.Syntax as G
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Instances ()
import Hasura.RQL.Types.Common (NonEmptyText)
import Hasura.SQL.Text

2
server/src-lib/Hasura/RQL/Types/RemoteRelationship.hs
View File

@ -27,13 +27,13 @@ import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Scientific
import Data.Set (Set)
import Data.Text.Extended
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.RemoteSchema
import Hasura.SQL.Text
import Hasura.SQL.Types

2
server/src-lib/Hasura/RQL/Types/RemoteSchema.hs
View File

@ -8,6 +8,7 @@ import qualified Data.Aeson.Casing as J
import qualified Data.Aeson.TH as J
import qualified Data.Environment as Env
import qualified Data.Text as T
import Data.Text.Extended
import qualified Database.PG.Query as Q
import qualified Network.URI.Extended as N
@ -15,7 +16,6 @@ import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Headers (HeaderConf (..))
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Error
import Hasura.SQL.Text
type UrlFromEnv = Text

6
server/src-lib/Hasura/RQL/Types/SchemaCache.hs
View File

@ -143,20 +143,20 @@ import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Function
import Hasura.RQL.Types.Metadata
--import Hasura.RQL.Types.Permission
import Data.Text.Extended
import Hasura.RQL.Types.QueryCollection
import Hasura.RQL.Types.RemoteSchema
import Hasura.RQL.Types.ScheduledTrigger
import Hasura.RQL.Types.SchemaCacheTypes
import Hasura.RQL.Types.Table
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
import Hasura.Session
import Hasura.Tracing (TraceT)
reportSchemaObjs :: [SchemaObjId] -> T.Text
reportSchemaObjs = T.intercalate ", " . sort . map reportSchemaObj
reportSchemaObjs = commaSeparated . sort . map reportSchemaObj
mkParentDep :: QualifiedTable -> SchemaDependency
mkParentDep tn = SchemaDependency (SOTable tn) DRTable

4
server/src-lib/Hasura/RQL/Types/SchemaCache/Build.hs
View File

@ -24,7 +24,6 @@ import Hasura.Prelude
import qualified Data.HashMap.Strict.Extended as M
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import Control.Arrow.Extended
import Control.Lens
@ -32,6 +31,7 @@ import Data.Aeson (toJSON)
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.List (nub)
import Data.Text.Extended
import Hasura.RQL.Types.Error
import Hasura.RQL.Types.Metadata
@ -148,7 +148,7 @@ buildSchemaCacheFor objectId = do
newInconsistentObjects = newSchemaCache `diffInconsistentObjects` oldSchemaCache
for_ (M.lookup objectId newInconsistentObjects) $ \matchingObjects -> do
let reasons = T.intercalate ", " $ map imReason $ toList matchingObjects
let reasons = commaSeparated $ imReason <$> matchingObjects
throwError (err400 ConstraintViolation reasons) { qeInternal = Just $ toJSON matchingObjects }
unless (null newInconsistentObjects) $

16
server/src-lib/Hasura/RQL/Types/Table.hs
View File

@ -95,6 +95,7 @@ import Data.Aeson.Casing
import Data.Aeson.TH
import Language.Haskell.TH.Syntax (Lift)
import Data.Text.Extended
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Types.BoolExp
import Hasura.RQL.Types.Column
@ -104,10 +105,9 @@ import Hasura.RQL.Types.Error
import Hasura.RQL.Types.EventTrigger
import Hasura.RQL.Types.Permission
import Hasura.RQL.Types.RemoteRelationship
import Hasura.SQL.Types
import Hasura.Server.Utils (duplicates, englishList)
import Hasura.Session
import Hasura.SQL.Text
import Hasura.SQL.Types
data TableCustomRootFields
@ -182,16 +182,16 @@ type FieldInfoMap = M.HashMap FieldName
fieldInfoName :: FieldInfo -> FieldName
fieldInfoName = \case
FIColumn info -> fromPGCol $ pgiColumn info
FIRelationship info -> fromRel $ riName info
FIComputedField info -> fromComputedField $ _cfiName info
FIColumn info -> fromPGCol $ pgiColumn info
FIRelationship info -> fromRel $ riName info
FIComputedField info -> fromComputedField $ _cfiName info
FIRemoteRelationship info -> fromRemoteRelationship $ _rfiName info
fieldInfoGraphQLName :: FieldInfo -> Maybe G.Name
fieldInfoGraphQLName = \case
FIColumn info -> Just $ pgiName info
FIRelationship info -> G.mkName $ relNameToTxt $ riName info
FIComputedField info -> G.mkName $ computedFieldNameToText $ _cfiName info
FIColumn info -> Just $ pgiName info
FIRelationship info -> G.mkName $ relNameToTxt $ riName info
FIComputedField info -> G.mkName $ computedFieldNameToText $ _cfiName info
FIRemoteRelationship info -> G.mkName $ remoteRelationshipNameToText $ _rfiName info
-- | Returns all the field names created for the given field. Columns, object relationships, and

200
server/src-lib/Hasura/SQL/DML.hs
View File

@ -4,14 +4,14 @@ import Hasura.Prelude
import qualified Data.Aeson as J
import qualified Data.HashMap.Strict as HM
import qualified Data.Text.Extended as T
import qualified Data.Text as T
import qualified Text.Builder as TB
import Data.String (fromString)
import Language.Haskell.TH.Syntax (Lift)
import Data.Text.Extended
import Hasura.Incremental (Cacheable)
import Hasura.SQL.Text
import Hasura.SQL.Types
@ -45,7 +45,7 @@ newtype LimitExp
instance ToSQL LimitExp where
toSQL (LimitExp se) =
"LIMIT" <-> toSQL se
"LIMIT" <~> toSQL se
newtype OffsetExp
= OffsetExp SQLExp
@ -53,7 +53,7 @@ newtype OffsetExp
instance ToSQL OffsetExp where
toSQL (OffsetExp se) =
"OFFSET" <-> toSQL se
"OFFSET" <~> toSQL se
newtype OrderByExp
= OrderByExp (NonEmpty OrderByItem)
@ -71,7 +71,7 @@ instance Hashable OrderByItem
instance ToSQL OrderByItem where
toSQL (OrderByItem e ot no) =
toSQL e <-> toSQL ot <-> toSQL no
toSQL e <~> toSQL ot <~> toSQL no
data OrderType = OTAsc | OTDesc
deriving (Show, Eq, Lift, Generic, Data)
@ -97,7 +97,7 @@ instance ToSQL NullsOrder where
instance ToSQL OrderByExp where
toSQL (OrderByExp l) =
"ORDER BY" <-> (", " <+> toList l)
"ORDER BY" <~> (", " <+> toList l)
newtype GroupByExp
= GroupByExp [SQLExp]
@ -105,7 +105,7 @@ newtype GroupByExp
instance ToSQL GroupByExp where
toSQL (GroupByExp idens) =
"GROUP BY" <-> (", " <+> idens)
"GROUP BY" <~> (", " <+> idens)
newtype FromExp
= FromExp [FromItem]
@ -113,7 +113,7 @@ newtype FromExp
instance ToSQL FromExp where
toSQL (FromExp items) =
"FROM" <-> (", " <+> items)
"FROM" <~> (", " <+> items)
mkIdenFromExp :: (IsIden a) => a -> FromExp
mkIdenFromExp a =
@ -153,7 +153,7 @@ newtype HavingExp
instance ToSQL HavingExp where
toSQL (HavingExp be) =
"HAVING" <-> toSQL be
"HAVING" <~> toSQL be
newtype WhereFrag
= WhereFrag { getWFBoolExp :: BoolExp }
@ -161,20 +161,20 @@ newtype WhereFrag
instance ToSQL WhereFrag where
toSQL (WhereFrag be) =
"WHERE" <-> paren (toSQL be)
"WHERE" <~> parenB (toSQL be)
instance ToSQL Select where
toSQL sel = case selCTEs sel of
[] -> "SELECT"
<-> toSQL (selDistinct sel)
<-> (", " <+> selExtr sel)
<-> toSQL (selFrom sel)
<-> toSQL (selWhere sel)
<-> toSQL (selGroupBy sel)
<-> toSQL (selHaving sel)
<-> toSQL (selOrderBy sel)
<-> toSQL (selLimit sel)
<-> toSQL (selOffset sel)
<~> toSQL (selDistinct sel)
<~> (", " <+> selExtr sel)
<~> toSQL (selFrom sel)
<~> toSQL (selWhere sel)
<~> toSQL (selGroupBy sel)
<~> toSQL (selHaving sel)
<~> toSQL (selOrderBy sel)
<~> toSQL (selLimit sel)
<~> toSQL (selOffset sel)
-- reuse SelectWith if there are any CTEs, since the generated SQL is the same
ctes -> toSQL $ SelectWith (map (CTESelect <$>) ctes) sel { selCTEs = [] }
@ -188,7 +188,7 @@ mkQIdenExp q t = SEQIden $ mkQIden q t
data Qual
= QualIden !Iden !(Maybe TypeAnn)
| QualTable !QualifiedTable
| QualVar !T.Text
| QualVar !Text
deriving (Show, Eq, Generic, Data)
instance NFData Qual
instance Cacheable Qual
@ -217,7 +217,7 @@ instance ToSQL QIden where
mconcat [toSQL qual, TB.char '.', toSQL iden]
newtype SQLOp
= SQLOp {sqlOpTxt :: T.Text}
= SQLOp {sqlOpTxt :: Text}
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
incOp :: SQLOp
@ -239,7 +239,7 @@ jsonbDeleteAtPathOp :: SQLOp
jsonbDeleteAtPathOp = SQLOp "#-"
newtype TypeAnn
= TypeAnn { unTypeAnn :: T.Text }
= TypeAnn { unTypeAnn :: Text }
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
instance ToSQL TypeAnn where
@ -281,9 +281,9 @@ instance Hashable CountType
instance ToSQL CountType where
toSQL CTStar = "*"
toSQL (CTSimple cols) =
paren $ ", " <+> cols
parenB $ ", " <+> cols
toSQL (CTDistinct cols) =
"DISTINCT" <-> paren (", " <+> cols)
"DISTINCT" <~> parenB (", " <+> cols)
newtype TupleExp
= TupleExp [SQLExp]
@ -291,13 +291,13 @@ newtype TupleExp
instance ToSQL TupleExp where
toSQL (TupleExp exps) =
paren $ ", " <+> exps
parenB $ ", " <+> exps
data SQLExp
= SEPrep !Int
| SENull
| SELit !T.Text
| SEUnsafe !T.Text
| SELit !Text
| SEUnsafe !Text
| SESelect !Select
| SEStar !(Maybe Qual)
-- ^ all fields (@*@) or all fields from relation (@iden.*@)
@ -305,7 +305,7 @@ data SQLExp
-- iden and row identifier are distinguished for easier rewrite rules
| SERowIden !Iden
| SEQIden !QIden
| SEFnApp !T.Text ![SQLExp] !(Maybe OrderByExp)
| SEFnApp !Text ![SQLExp] !(Maybe OrderByExp)
| SEOpApp !SQLOp ![SQLExp]
| SETyAnn !SQLExp !TypeAnn
| SECond !BoolExp !SQLExp !SQLExp
@ -336,7 +336,7 @@ instance IsIden Alias where
toIden (Alias iden) = iden
instance ToSQL Alias where
toSQL (Alias iden) = "AS" <-> toSQL iden
toSQL (Alias iden) = "AS" <~> toSQL iden
toAlias :: (IsIden a) => a -> Alias
toAlias = Alias . toIden
@ -354,11 +354,11 @@ instance ToSQL SQLExp where
toSQL (SEUnsafe t) =
TB.text t
toSQL (SESelect se) =
paren $ toSQL se
parenB $ toSQL se
toSQL (SEStar Nothing) =
TB.char '*'
toSQL (SEStar (Just qual)) =
mconcat [paren (toSQL qual), TB.char '.', TB.char '*']
mconcat [parenB (toSQL qual), TB.char '.', TB.char '*']
toSQL (SEIden iden) =
toSQL iden
toSQL (SERowIden iden) =
@ -367,15 +367,15 @@ instance ToSQL SQLExp where
toSQL qIden
-- https://www.postgresql.org/docs/10/static/sql-expressions.html#SYNTAX-AGGREGATES
toSQL (SEFnApp name args mObe) =
TB.text name <> paren ((", " <+> args) <-> toSQL mObe)
TB.text name <> parenB ((", " <+> args) <~> toSQL mObe)
toSQL (SEOpApp op args) =
paren (sqlOpTxt op <+> args)
parenB (sqlOpTxt op <+> args)
toSQL (SETyAnn e ty) =
paren (toSQL e) <> toSQL ty
parenB (toSQL e) <> toSQL ty
toSQL (SECond cond te fe) =
"CASE WHEN" <-> toSQL cond <->
"THEN" <-> toSQL te <->
"ELSE" <-> toSQL fe <->
"CASE WHEN" <~> toSQL cond <~>
"THEN" <~> toSQL te <~>
"ELSE" <~> toSQL fe <~>
"END"
toSQL (SEBool be) = toSQL be
toSQL (SEExcluded i) = "EXCLUDED."
@ -383,12 +383,12 @@ instance ToSQL SQLExp where
toSQL (SEArray exps) = "ARRAY" <> TB.char '['
<> (", " <+> exps) <> TB.char ']'
toSQL (SEArrayIndex arrayExp indexExp) =
paren (toSQL arrayExp)
parenB (toSQL arrayExp)
<> TB.char '[' <> toSQL indexExp <> TB.char ']'
toSQL (SETuple tup) = toSQL tup
toSQL (SECount ty) = "COUNT" <> paren (toSQL ty)
toSQL (SECount ty) = "COUNT" <> parenB (toSQL ty)
-- https://www.postgresql.org/docs/current/sql-syntax-calling-funcs.html
toSQL (SENamedArg arg val) = toSQL arg <-> "=>" <-> toSQL val
toSQL (SENamedArg arg val) = toSQL arg <~> "=>" <~> toSQL val
toSQL (SEFunction funcExp) = toSQL funcExp
intToSQLExp :: Int -> SQLExp
@ -443,7 +443,7 @@ mkExtr t = Extractor (mkSIdenExp t) Nothing
instance ToSQL Extractor where
toSQL (Extractor ce mal) =
toSQL ce <-> toSQL mal
toSQL ce <~> toSQL mal
data DistinctExpr
= DistinctSimple
@ -456,7 +456,7 @@ instance Hashable DistinctExpr
instance ToSQL DistinctExpr where
toSQL DistinctSimple = "DISTINCT"
toSQL (DistinctOn exps) =
"DISTINCT ON" <-> paren ("," <+> exps)
"DISTINCT ON" <~> parenB ("," <+> exps)
data FunctionArgs
= FunctionArgs
@ -471,7 +471,7 @@ instance ToSQL FunctionArgs where
toSQL (FunctionArgs positionalArgs namedArgsMap) =
let namedArgs = flip map (HM.toList namedArgsMap) $
\(argName, argVal) -> SENamedArg (Iden argName) argVal
in paren $ ", " <+> (positionalArgs <> namedArgs)
in parenB $ ", " <+> (positionalArgs <> namedArgs)
data DefinitionListItem
= DefinitionListItem
@ -484,7 +484,7 @@ instance Hashable DefinitionListItem
instance ToSQL DefinitionListItem where
toSQL (DefinitionListItem column columnType) =
toSQL column <-> toSQL columnType
toSQL column <~> toSQL columnType
data FunctionAlias
= FunctionAlias
@ -506,7 +506,7 @@ mkFunctionAlias identifier listM =
instance ToSQL FunctionAlias where
toSQL (FunctionAlias iden (Just definitionList)) =
toSQL iden <> paren ( ", " <+> definitionList)
toSQL iden <> parenB ( ", " <+> definitionList)
toSQL (FunctionAlias iden Nothing) =
toSQL iden
@ -522,7 +522,7 @@ instance Hashable FunctionExp
instance ToSQL FunctionExp where
toSQL (FunctionExp qf args alsM) =
toSQL qf <> toSQL args <-> toSQL alsM
toSQL qf <> toSQL args <~> toSQL alsM
data FromItem
= FISimple !QualifiedTable !(Maybe Alias)
@ -553,20 +553,20 @@ toColTupExp =
instance ToSQL FromItem where
toSQL (FISimple qt mal) =
toSQL qt <-> toSQL mal
toSQL qt <~> toSQL mal
toSQL (FIIden iden) =
toSQL iden
toSQL (FIFunc funcExp) = toSQL funcExp
-- unnest(expressions) alias(columns)
toSQL (FIUnnest args als cols) =
"UNNEST" <> paren (", " <+> args) <-> toSQL als <> paren (", " <+> cols)
"UNNEST" <> parenB (", " <+> args) <~> toSQL als <> parenB (", " <+> cols)
toSQL (FISelect mla sel al) =
toSQL mla <-> paren (toSQL sel) <-> toSQL al
toSQL mla <~> parenB (toSQL sel) <~> toSQL al
toSQL (FISelectWith mla selWith al) =
toSQL mla <-> paren (toSQL selWith) <-> toSQL al
toSQL mla <~> parenB (toSQL selWith) <~> toSQL al
toSQL (FIValues valsExp al mCols) =
paren (toSQL valsExp) <-> toSQL al
<-> toSQL (toColTupExp <$> mCols)
parenB (toSQL valsExp) <~> toSQL al
<~> toSQL (toColTupExp <$> mCols)
toSQL (FIJoin je) =
toSQL je
@ -591,9 +591,9 @@ instance Hashable JoinExpr
instance ToSQL JoinExpr where
toSQL je =
toSQL (tjeLeft je)
<-> toSQL (tjeType je)
<-> toSQL (tjeRight je)
<-> toSQL (tjeJC je)
<~> toSQL (tjeType je)
<~> toSQL (tjeRight je)
<~> toSQL (tjeJC je)
data JoinType
= Inner
@ -621,9 +621,9 @@ instance Hashable JoinCond
instance ToSQL JoinCond where
toSQL (JoinOn be) =
"ON" <-> paren (toSQL be)
"ON" <~> parenB (toSQL be)
toSQL (JoinUsing cols) =
"USING" <-> paren ("," <+> cols)
"USING" <~> parenB ("," <+> cols)
data BoolExp
= BELit !Bool
@ -652,14 +652,14 @@ simplifyBoolExp be = case be of
in if
| e1s == BELit True -> e2s
| e2s == BELit True -> e1s
| otherwise -> BEBin AndOp e1s e2s
| otherwise -> BEBin AndOp e1s e2s
BEBin OrOp e1 e2 ->
let e1s = simplifyBoolExp e1
e2s = simplifyBoolExp e2
in if
| e1s == BELit False -> e2s
| e2s == BELit False -> e1s
| otherwise -> BEBin OrOp e1s e2s
| otherwise -> BEBin OrOp e1s e2s
e -> e
mkExists :: FromItem -> BoolExp -> BoolExp
@ -671,27 +671,27 @@ mkExists fromItem whereFrag =
}
instance ToSQL BoolExp where
toSQL (BELit True) = TB.text $ T.squote "true"
toSQL (BELit False) = TB.text $ T.squote "false"
toSQL (BELit True) = TB.text "'true'"
toSQL (BELit False) = TB.text "'false'"
toSQL (BEBin bo bel ber) =
paren (toSQL bel) <-> toSQL bo <-> paren (toSQL ber)
parenB (toSQL bel) <~> toSQL bo <~> parenB (toSQL ber)
toSQL (BENot be) =
"NOT" <-> paren (toSQL be)
"NOT" <~> parenB (toSQL be)
toSQL (BECompare co vl vr) =
paren (toSQL vl) <-> toSQL co <-> paren (toSQL vr)
parenB (toSQL vl) <~> toSQL co <~> parenB (toSQL vr)
toSQL (BECompareAny co vl vr) =
paren (toSQL vl) <-> toSQL co <-> "ANY" <> paren (toSQL vr)
parenB (toSQL vl) <~> toSQL co <~> "ANY" <> parenB (toSQL vr)
toSQL (BENull v) =
paren (toSQL v) <-> "IS NULL"
parenB (toSQL v) <~> "IS NULL"
toSQL (BENotNull v) =
paren (toSQL v) <-> "IS NOT NULL"
parenB (toSQL v) <~> "IS NOT NULL"
toSQL (BEExists sel) =
"EXISTS " <-> paren (toSQL sel)
"EXISTS " <~> parenB (toSQL sel)
-- special case to handle lhs IN (exp1, exp2)
toSQL (BEIN vl exps) =
paren (toSQL vl) <-> toSQL SIN <-> paren (", " <+> exps)
parenB (toSQL vl) <~> toSQL SIN <~> parenB (", " <+> exps)
-- Any SQL expression which evaluates to bool value
toSQL (BEExp e) = paren $ toSQL e
toSQL (BEExp e) = parenB $ toSQL e
data BinOp = AndOp | OrOp
deriving (Show, Eq, Generic, Data)
@ -801,7 +801,7 @@ newtype UsingExp = UsingExp [TableName]
instance ToSQL UsingExp where
toSQL (UsingExp tables)
= "USING" <-> "," <+> tables
= "USING" <~> "," <+> tables
newtype RetExp = RetExp [Extractor]
deriving (Show, Eq)
@ -819,30 +819,30 @@ instance ToSQL RetExp where
toSQL (RetExp [])
= mempty
toSQL (RetExp exps)
= "RETURNING" <-> (", " <+> exps)
= "RETURNING" <~> (", " <+> exps)
instance ToSQL SQLDelete where
toSQL sd = "DELETE FROM"
<-> toSQL (delTable sd)
<-> toSQL (delUsing sd)
<-> toSQL (delWhere sd)
<-> toSQL (delRet sd)
<~> toSQL (delTable sd)
<~> toSQL (delUsing sd)
<~> toSQL (delWhere sd)
<~> toSQL (delRet sd)
instance ToSQL SQLUpdate where
toSQL a = "UPDATE"
<-> toSQL (upTable a)
<-> toSQL (upSet a)
<-> toSQL (upFrom a)
<-> toSQL (upWhere a)
<-> toSQL (upRet a)
<~> toSQL (upTable a)
<~> toSQL (upSet a)
<~> toSQL (upFrom a)
<~> toSQL (upWhere a)
<~> toSQL (upRet a)
instance ToSQL SetExp where
toSQL (SetExp cvs) =
"SET" <-> ("," <+> cvs)
"SET" <~> ("," <+> cvs)
instance ToSQL SetExpItem where
toSQL (SetExpItem (col, val)) =
toSQL col <-> "=" <-> toSQL val
toSQL col <~> "=" <~> toSQL val
data SQLConflictTarget
@ -852,10 +852,10 @@ data SQLConflictTarget
instance ToSQL SQLConflictTarget where
toSQL (SQLColumn cols) = "("
<-> ("," <+> cols)
<-> ")"
<~> ("," <+> cols)
<~> ")"
toSQL (SQLConstraint cons) = "ON CONSTRAINT" <-> toSQL cons
toSQL (SQLConstraint cons) = "ON CONSTRAINT" <~> toSQL cons
data SQLConflict
= DoNothing !(Maybe SQLConflictTarget)
@ -865,11 +865,11 @@ data SQLConflict
instance ToSQL SQLConflict where
toSQL (DoNothing Nothing) = "ON CONFLICT DO NOTHING"
toSQL (DoNothing (Just ct)) = "ON CONFLICT"
<-> toSQL ct
<-> "DO NOTHING"
<~> toSQL ct
<~> "DO NOTHING"
toSQL (Update ct set whr) = "ON CONFLICT"
<-> toSQL ct <-> "DO UPDATE"
<-> toSQL set <-> toSQL whr
<~> toSQL ct <~> "DO UPDATE"
<~> toSQL set <~> toSQL whr
newtype ValuesExp
= ValuesExp [TupleExp]
@ -877,7 +877,7 @@ newtype ValuesExp
instance ToSQL ValuesExp where
toSQL (ValuesExp tuples) =
"VALUES" <-> (", " <+> tuples)
"VALUES" <~> (", " <+> tuples)
data SQLInsert = SQLInsert
{ siTable :: !QualifiedTable
@ -890,13 +890,13 @@ data SQLInsert = SQLInsert
instance ToSQL SQLInsert where
toSQL si =
"INSERT INTO"
<-> toSQL (siTable si)
<-> "("
<-> (", " <+> siCols si)
<-> ")"
<-> toSQL (siValues si)
<-> maybe "" toSQL (siConflict si)
<-> toSQL (siRet si)
<~> toSQL (siTable si)
<~> "("
<~> (", " <+> siCols si)
<~> ")"
<~> toSQL (siValues si)
<~> maybe "" toSQL (siConflict si)
<~> toSQL (siRet si)
data CTE
= CTESelect !Select
@ -924,8 +924,8 @@ instance (Hashable v) => Hashable (SelectWithG v)
instance (ToSQL v) => ToSQL (SelectWithG v) where
toSQL (SelectWith ctes sel) =
"WITH " <> (", " <+> map f ctes) <-> toSQL sel
"WITH " <> (", " <+> map f ctes) <~> toSQL sel
where
f (Alias al, q) = toSQL al <-> "AS" <-> paren (toSQL q)
f (Alias al, q) = toSQL al <~> "AS" <~> parenB (toSQL q)
type SelectWith = SelectWithG CTE

57
server/src-lib/Hasura/SQL/Text.hs
View File

@ -1,57 +0,0 @@
module Hasura.SQL.Text where
import Hasura.Prelude
import qualified Data.Text.Extended as T
import qualified Language.GraphQL.Draft.Syntax as G
import qualified Text.Builder as TB
class ToTxt a where
toTxt :: a -> Text
instance ToTxt T.Text where
toTxt = id
{-# INLINE toTxt #-}
instance ToTxt G.Name where
toTxt = G.unName
deriving instance ToTxt G.EnumValue
dquote :: ToTxt a => a -> T.Text
dquote = T.dquote . toTxt
{-# INLINE dquote #-}
squote :: ToTxt a => a -> T.Text
squote = T.squote . toTxt
{-# INLINE squote #-}
bquote :: ToTxt a => a -> T.Text
bquote = T.bquote . toTxt
{-# INLINE bquote #-}
dquoteList :: (ToTxt a, Foldable t) => t a -> T.Text
dquoteList = T.intercalate ", " . map dquote . toList
{-# INLINE dquoteList #-}
infixr 6 <>>
(<>>) :: ToTxt a => T.Text -> a -> T.Text
(<>>) lTxt a = lTxt <> dquote a
{-# INLINE (<>>) #-}
infixr 6 <<>
(<<>) :: ToTxt a => a -> T.Text -> T.Text
(<<>) a rTxt = dquote a <> rTxt
{-# INLINE (<<>) #-}
infixr 6 <->
(<->) :: TB.Builder -> TB.Builder -> TB.Builder
(<->) l r = l <> TB.char ' ' <> r
{-# INLINE (<->) #-}
paren :: TB.Builder -> TB.Builder
paren t = TB.char '(' <> t <> TB.char ')'
{-# INLINE paren #-}

35
server/src-lib/Hasura/SQL/Types.hs
View File

@ -57,28 +57,28 @@ module Hasura.SQL.Types
)
where
import Hasura.Prelude
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import qualified Database.PG.Query.PTI as PTI
import Hasura.Prelude
import Hasura.RQL.Types.Error
import qualified Database.PostgreSQL.LibPQ as PQ
import qualified Language.GraphQL.Draft.Syntax as G
import qualified PostgreSQL.Binary.Decoding as PD
import qualified Text.Builder as TB
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.Encoding (text)
import Data.Aeson.TH
import Data.Aeson.Types (toJSONKeyText)
import Data.Text.Extended
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)
import qualified Data.Text.Extended as T
import qualified Database.PostgreSQL.LibPQ as PQ
import qualified Language.GraphQL.Draft.Syntax as G
import qualified PostgreSQL.Binary.Decoding as PD
import qualified Text.Builder as TB
import Hasura.Incremental (Cacheable)
import Hasura.SQL.Text
import Hasura.RQL.Types.Error
class ToSQL a where
toSQL :: a -> TB.Builder
@ -86,18 +86,18 @@ class ToSQL a where
instance ToSQL TB.Builder where
toSQL x = x
toSQLTxt :: (ToSQL a) => a -> T.Text
toSQLTxt :: (ToSQL a) => a -> Text
toSQLTxt = TB.run . toSQL
infixr 6 <+>
(<+>) :: (ToSQL a) => T.Text -> [a] -> TB.Builder
(<+>) :: (ToSQL a) => Text -> [a] -> TB.Builder
(<+>) _ [] = mempty
(<+>) kat (x:xs) =
toSQL x <> mconcat [ TB.text kat <> toSQL x' | x' <- xs ]
{-# INLINE (<+>) #-}
newtype Iden
= Iden { getIdenTxt :: T.Text }
= Iden { getIdenTxt :: Text }
deriving (Show, Eq, NFData, FromJSON, ToJSON, Hashable, Semigroup, Data, Cacheable)
instance ToSQL Iden where
@ -110,7 +110,7 @@ class IsIden a where
instance IsIden Iden where
toIden = id
pgFmtIden :: T.Text -> T.Text
pgFmtIden :: Text -> Text
pgFmtIden x =
"\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\""
@ -290,9 +290,8 @@ instance ToTxt PGCol where
unsafePGCol :: Text -> PGCol
unsafePGCol = PGCol
showPGCols :: (Foldable t) => t PGCol -> T.Text
showPGCols cols =
T.intercalate ", " $ map (T.dquote . getPGColTxt) $ toList cols
showPGCols :: (Foldable t, Functor t) => t PGCol -> T.Text
showPGCols = dquoteList . fmap getPGColTxt
data PGScalarType
= PGSmallInt
@ -531,7 +530,7 @@ instance (ToSQL a) => ToSQL (PGType a) where
toSQL = \case
PGTypeScalar ty -> toSQL ty
-- typename array is an sql standard way of declaring types
PGTypeArray ty -> toSQL ty <> " array"
PGTypeArray ty -> toSQL ty <> " array"
data PGTypeKind
= PGKindBase

3
server/src-lib/Hasura/Server/Utils.hs
View File

@ -6,6 +6,7 @@ import Control.Lens ((^..))
import Data.Aeson
import Data.Aeson.Internal
import Data.Char
import Data.Text.Extended
import Language.Haskell.TH.Syntax (Lift, Q, TExp)
import System.Environment
import System.Exit
@ -235,7 +236,7 @@ englishList joiner = \case
one :| [two] -> one <> " " <> joiner <> " " <> two
several ->
let final :| initials = NE.reverse several
in T.intercalate ", " (reverse initials) <> ", " <> joiner <> " " <> final
in commaSeparated (reverse initials) <> ", " <> joiner <> " " <> final
makeReasonMessage :: [a] -> (a -> Text) -> Text
makeReasonMessage errors showError =

2
server/src-lib/Hasura/Session.hs
View File

@ -32,10 +32,10 @@ import Hasura.RQL.Types.Common (NonEmptyText, adminText, mkNonEmpty
unNonEmptyText)
import Hasura.RQL.Types.Error
import Hasura.Server.Utils
import Hasura.SQL.Text
import Data.Aeson
import Data.Aeson.Types (Parser, toJSONKeyText)
import Data.Text.Extended
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)