mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 20:41:49 +03:00
178 lines
4.2 KiB
Haskell
178 lines
4.2 KiB
Haskell
module Hasura.GraphQL.Resolve.Context
|
|
( FieldMap
|
|
, RelationInfoMap
|
|
, FuncArgItem(..)
|
|
, OrdByCtx
|
|
, OrdByItemMap
|
|
, OrdByItem(..)
|
|
, FuncArgSeq
|
|
, PGColArgMap
|
|
, UpdPermForIns(..)
|
|
, InsCtx(..)
|
|
, InsCtxMap
|
|
, RespTx
|
|
, LazyRespTx
|
|
, AnnPGVal(..)
|
|
, PrepFn
|
|
, InsertTxConflictCtx(..)
|
|
, getFldInfo
|
|
, getPGColInfo
|
|
, getArg
|
|
, withArg
|
|
, withArgM
|
|
, nameAsPath
|
|
, PrepArgs
|
|
, Convert
|
|
, runConvert
|
|
, withPrepArgs
|
|
, prepare
|
|
, prepareColVal
|
|
, txtConverter
|
|
, module Hasura.GraphQL.Utils
|
|
) where
|
|
|
|
import Data.Has
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.Aeson.Casing as J
|
|
import qualified Data.Aeson.TH as J
|
|
import qualified Data.HashMap.Strict as Map
|
|
import qualified Data.Sequence as Seq
|
|
import qualified Database.PG.Query as Q
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
|
|
import Hasura.GraphQL.Resolve.ContextTypes
|
|
|
|
import Hasura.EncJSON
|
|
import Hasura.GraphQL.Utils
|
|
import Hasura.GraphQL.Validate.Field
|
|
import Hasura.GraphQL.Validate.Types
|
|
import Hasura.RQL.Types
|
|
import Hasura.SQL.Types
|
|
import Hasura.SQL.Value
|
|
|
|
import qualified Hasura.SQL.DML as S
|
|
|
|
data InsResp
|
|
= InsResp
|
|
{ _irAffectedRows :: !Int
|
|
, _irResponse :: !(Maybe J.Object)
|
|
} deriving (Show, Eq)
|
|
$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''InsResp)
|
|
|
|
type RespTx = Q.TxE QErr EncJSON
|
|
|
|
type LazyRespTx = LazyTx QErr EncJSON
|
|
|
|
type PrepFn m = AnnPGVal -> m S.SQLExp
|
|
|
|
data AnnPGVal
|
|
= AnnPGVal
|
|
{ _apvVariable :: !(Maybe G.Variable)
|
|
, _apvIsNullable :: !Bool
|
|
, _apvType :: !PGColType
|
|
, _apvValue :: !PGColValue
|
|
} deriving (Show, Eq)
|
|
|
|
getFldInfo
|
|
:: (MonadError QErr m, MonadReader r m, Has FieldMap r)
|
|
=> G.NamedType -> G.Name
|
|
-> m (Either PGColInfo (RelInfo, Bool, AnnBoolExpSQL, Maybe Int))
|
|
getFldInfo nt n = do
|
|
fldMap <- asks getter
|
|
onNothing (Map.lookup (nt,n) fldMap) $
|
|
throw500 $ "could not lookup " <> showName n <> " in " <>
|
|
showNamedTy nt
|
|
|
|
getPGColInfo
|
|
:: (MonadError QErr m, MonadReader r m, Has FieldMap r)
|
|
=> G.NamedType -> G.Name -> m PGColInfo
|
|
getPGColInfo nt n = do
|
|
fldInfo <- getFldInfo nt n
|
|
case fldInfo of
|
|
Left pgColInfo -> return pgColInfo
|
|
Right _ -> throw500 $
|
|
"found relinfo when expecting pgcolinfo for "
|
|
<> showNamedTy nt <> ":" <> showName n
|
|
|
|
getArg
|
|
:: (MonadError QErr m)
|
|
=> ArgsMap
|
|
-> G.Name
|
|
-> m AnnInpVal
|
|
getArg args arg =
|
|
onNothing (Map.lookup arg args) $
|
|
throw500 $ "missing argument: " <> showName arg
|
|
|
|
prependArgsInPath
|
|
:: (MonadError QErr m)
|
|
=> m a -> m a
|
|
prependArgsInPath = withPathK "args"
|
|
|
|
nameAsPath
|
|
:: (MonadError QErr m)
|
|
=> G.Name -> m a -> m a
|
|
nameAsPath name = withPathK (G.unName name)
|
|
|
|
withArg
|
|
:: (MonadError QErr m)
|
|
=> ArgsMap
|
|
-> G.Name
|
|
-> (AnnInpVal -> m a)
|
|
-> m a
|
|
withArg args arg f = prependArgsInPath $ nameAsPath arg $
|
|
getArg args arg >>= f
|
|
|
|
withArgM
|
|
:: (MonadError QErr m)
|
|
=> ArgsMap
|
|
-> G.Name
|
|
-> (AnnInpVal -> m a)
|
|
-> m (Maybe a)
|
|
withArgM args arg f = prependArgsInPath $ nameAsPath arg $
|
|
mapM f $ handleNull =<< Map.lookup arg args
|
|
where
|
|
handleNull v = bool (Just v) Nothing $
|
|
hasNullVal $ _aivValue v
|
|
|
|
type PrepArgs = Seq.Seq Q.PrepArg
|
|
|
|
type Convert =
|
|
(ReaderT ( FieldMap
|
|
, OrdByCtx
|
|
, InsCtxMap
|
|
, SQLGenCtx
|
|
) (Except QErr)
|
|
)
|
|
|
|
prepare
|
|
:: (MonadState PrepArgs m) => PrepFn m
|
|
prepare (AnnPGVal _ _ colTy colVal) =
|
|
prepareColVal colTy colVal
|
|
|
|
prepareColVal
|
|
:: (MonadState PrepArgs m)
|
|
=> PGColType -> PGColValue -> m S.SQLExp
|
|
prepareColVal colTy colVal = do
|
|
preparedArgs <- get
|
|
put (preparedArgs Seq.|> binEncoder colVal)
|
|
return $ toPrepParam (Seq.length preparedArgs + 1) colTy
|
|
|
|
|
|
txtConverter :: Monad m => PrepFn m
|
|
txtConverter (AnnPGVal _ _ a b) =
|
|
return $ toTxtValue a b
|
|
|
|
withPrepArgs :: StateT PrepArgs Convert a -> Convert (a, PrepArgs)
|
|
withPrepArgs m = runStateT m Seq.empty
|
|
|
|
runConvert
|
|
:: (MonadError QErr m)
|
|
=> (FieldMap, OrdByCtx, InsCtxMap, SQLGenCtx)
|
|
-> Convert a
|
|
-> m a
|
|
runConvert ctx m =
|
|
either throwError return $
|
|
runExcept $ runReaderT m ctx
|