graphql-engine/server/src-lib/Hasura/GraphQL/Schema/Table.hs

-- | Helper functions for generating the schema of database tables
module Hasura.GraphQL.Schema.Table
  ( tableSelectColumnsEnum
  , tableUpdateColumnsEnum
  , tablePermissions
  , tableSelectPermissions
  , tableUpdatePermissions
  , tableDeletePermissions
  , tableSelectFields
  , tableColumns
  , tableSelectColumns
  , tableUpdateColumns
  ) where

import           Hasura.Prelude

import qualified Data.HashMap.Strict                as Map
import qualified Data.HashSet                       as Set
import qualified Language.GraphQL.Draft.Syntax      as G

import           Data.Text.Extended

import qualified Hasura.GraphQL.Parser              as P

import           Hasura.Backends.Postgres.SQL.Types
import           Hasura.GraphQL.Parser              (Kind (..), Parser)
import           Hasura.GraphQL.Parser.Class
import           Hasura.RQL.DML.Internal            (getRolePermInfo)
import           Hasura.RQL.Types

-- | Table select columns enum
--
-- Parser for an enum type that matches the columns of the given
-- table. Used as a parameter for "distinct", among others. Maps to
-- the table_select_column object.
--
-- Return Nothing if there's no column the current user has "select"
-- permissions for.
tableSelectColumnsEnum
  :: (MonadSchema n m, MonadRole r m, MonadTableInfo r m)
  => QualifiedTable
  -> SelPermInfo 'Postgres
  -> m (Maybe (Parser 'Both n PGCol))
tableSelectColumnsEnum table selectPermissions = do
  tableName <- qualifiedObjectToName table
  columns   <- tableSelectColumns table selectPermissions
  let enumName    = tableName <> $$(G.litName "_select_column")
      description = Just $ G.Description $
        "select columns of table " <>> table
  pure $ P.enum enumName description <$> nonEmpty
    [ ( define $ pgiName column
      , pgiColumn column
      )
    | column <- columns
    ]
  where
    define name =
      P.mkDefinition name (Just $ G.Description "column name") P.EnumValueInfo

-- | Table update columns enum
--
-- Parser for an enum type that matches the columns of the given
-- table. Used for conflict resolution in "insert" mutations, among
-- others. Maps to the table_update_column object.
--
-- Return Nothing if there's no column the current user has "update"
-- permissions for.
tableUpdateColumnsEnum
  :: (MonadSchema n m, MonadRole r m, MonadTableInfo r m)
  => QualifiedTable
  -> UpdPermInfo 'Postgres
  -> m (Maybe (Parser 'Both n PGCol))
tableUpdateColumnsEnum table updatePermissions = do
  tableName <- qualifiedObjectToName table
  columns   <- tableUpdateColumns table updatePermissions
  let enumName    = tableName <> $$(G.litName "_update_column")
      description = Just $ G.Description $
        "update columns of table " <>> table
  pure $ P.enum enumName description <$> nonEmpty
    [ ( define $ pgiName column
      , pgiColumn column
      )
    | column <- columns
    ]
  where
    define name =
      P.mkDefinition name (Just $ G.Description "column name") P.EnumValueInfo

tablePermissions
  :: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
  => QualifiedTable
  -> m (Maybe (RolePermInfo 'Postgres))
tablePermissions table = do
  roleName  <- askRoleName
  tableInfo <- askTableInfo table
  pure $ getRolePermInfo roleName tableInfo

tableSelectPermissions
  :: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
  => QualifiedTable
  -> m (Maybe (SelPermInfo 'Postgres))
tableSelectPermissions table = (_permSel =<<) <$> tablePermissions table

tableUpdatePermissions
  :: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
  => QualifiedTable
  -> m (Maybe (UpdPermInfo 'Postgres))
tableUpdatePermissions table = (_permUpd =<<) <$> tablePermissions table

tableDeletePermissions
  :: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
  => QualifiedTable
  -> m (Maybe (DelPermInfo 'Postgres))
tableDeletePermissions table = (_permDel =<<) <$> tablePermissions table

tableSelectFields
  :: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
  => QualifiedTable
  -> SelPermInfo 'Postgres
  -> m [FieldInfo 'Postgres]
tableSelectFields table permissions = do
  tableFields <- _tciFieldInfoMap . _tiCoreInfo <$> askTableInfo table
  filterM canBeSelected $ Map.elems tableFields
  where
    canBeSelected (FIColumn columnInfo) =
      pure $ Set.member (pgiColumn columnInfo) (spiCols permissions)
    canBeSelected (FIRelationship relationshipInfo) =
      isJust <$> tableSelectPermissions (riRTable relationshipInfo)
    canBeSelected (FIComputedField computedFieldInfo) =
      case _cfiReturnType computedFieldInfo of
        CFRScalar _ ->
          pure $ Set.member (_cfiName computedFieldInfo) $ spiScalarComputedFields permissions
        CFRSetofTable tableName ->
          isJust <$> tableSelectPermissions tableName
    -- TODO (from master): Derive permissions for remote relationships
    canBeSelected (FIRemoteRelationship _) = pure True

tableColumns
  :: forall m n r. (MonadSchema n m, MonadTableInfo r m)
  => QualifiedTable
  -> m [ColumnInfo 'Postgres]
tableColumns table =
  mapMaybe columnInfo . Map.elems . _tciFieldInfoMap . _tiCoreInfo <$> askTableInfo table
  where
    columnInfo (FIColumn ci) = Just ci
    columnInfo _             = Nothing

tableSelectColumns
  :: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
  => QualifiedTable
  -> SelPermInfo 'Postgres
  -> m [ColumnInfo 'Postgres]
tableSelectColumns table permissions =
  mapMaybe columnInfo <$> tableSelectFields table permissions
  where
    columnInfo (FIColumn ci) = Just ci
    columnInfo _             = Nothing

tableUpdateColumns
  :: forall m n r. (MonadSchema n m, MonadTableInfo r m)
  => QualifiedTable
  -> UpdPermInfo 'Postgres
  -> m [ColumnInfo 'Postgres]
tableUpdateColumns table permissions = do
  tableFields <- _tciFieldInfoMap . _tiCoreInfo <$> askTableInfo table
  pure $ mapMaybe isUpdatable $ Map.elems tableFields
  where
    isUpdatable (FIColumn columnInfo) =
      if Set.member (pgiColumn columnInfo) (upiCols permissions)
         && not (Map.member (pgiColumn columnInfo) (upiSet permissions))
      then Just columnInfo
      else Nothing
    isUpdatable _ = Nothing