module Hasura.LogicalModel.Common
  ( toFieldInfo,
    columnsFromFields,
    logicalModelFieldsToFieldInfo,
    getSelPermInfoForLogicalModel,
  )
where

import Data.Bifunctor (bimap)
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.Text.Extended (ToTxt (toTxt))
import Hasura.LogicalModel.Cache
import Hasura.LogicalModel.NullableScalarType (NullableScalarType (..))
import Hasura.LogicalModel.Types (LogicalModelField (..), LogicalModelType (..), LogicalModelTypeScalar (..))
import Hasura.Prelude
import Hasura.RQL.IR.BoolExp (AnnRedactionExp (..), gBoolExpTrue)
import Hasura.RQL.Types.Backend (Backend (..))
import Hasura.RQL.Types.Column (ColumnInfo (..), ColumnMutability (..), ColumnType (..), StructuredColumnInfo (..), fromCol)
import Hasura.RQL.Types.Permission (AllowedRootFields (..))
import Hasura.RQL.Types.Roles (RoleName, adminRoleName)
import Hasura.Table.Cache (FieldInfo (..), FieldInfoMap, RolePermInfo (..), SelPermInfo (..))
import Language.GraphQL.Draft.Syntax qualified as G

columnsFromFields ::
  InsOrdHashMap.InsOrdHashMap k (LogicalModelField b) ->
  InsOrdHashMap.InsOrdHashMap k (NullableScalarType b)
columnsFromFields :: forall k (b :: BackendType).
InsOrdHashMap k (LogicalModelField b)
-> InsOrdHashMap k (NullableScalarType b)
columnsFromFields =
  (LogicalModelField b -> Maybe (NullableScalarType b))
-> InsOrdHashMap k (LogicalModelField b)
-> InsOrdHashMap k (NullableScalarType b)
forall v1 v2 k.
(v1 -> Maybe v2) -> InsOrdHashMap k v1 -> InsOrdHashMap k v2
InsOrdHashMap.mapMaybe
    ( \case
        LogicalModelField
          { lmfType :: forall (b :: BackendType).
LogicalModelField b -> LogicalModelType b
lmfType =
              LogicalModelTypeScalar
                ( LogicalModelTypeScalarC
                    { lmtsScalar :: forall (b :: BackendType). LogicalModelTypeScalar b -> ScalarType b
lmtsScalar = ScalarType b
nstType,
                      lmtsNullable :: forall (b :: BackendType). LogicalModelTypeScalar b -> Bool
lmtsNullable = Bool
nstNullable
                    }
                  ),
            lmfDescription :: forall (b :: BackendType). LogicalModelField b -> Maybe Text
lmfDescription = Maybe Text
nstDescription
          } ->
            NullableScalarType b -> Maybe (NullableScalarType b)
forall a. a -> Maybe a
Just (NullableScalarType {Bool
Maybe Text
ScalarType b
nstType :: ScalarType b
nstNullable :: Bool
nstDescription :: Maybe Text
nstType :: ScalarType b
nstNullable :: Bool
nstDescription :: Maybe Text
..})
        LogicalModelField b
_ -> Maybe (NullableScalarType b)
forall a. Maybe a
Nothing
    )

toFieldInfo :: forall b. (Backend b) => InsOrdHashMap.InsOrdHashMap (Column b) (NullableScalarType b) -> Maybe [FieldInfo b]
toFieldInfo :: forall (b :: BackendType).
Backend b =>
InsOrdHashMap (Column b) (NullableScalarType b)
-> Maybe [FieldInfo b]
toFieldInfo InsOrdHashMap (Column b) (NullableScalarType b)
fields =
  (Int -> (Column b, NullableScalarType b) -> Maybe (FieldInfo b))
-> [(Column b, NullableScalarType b)] -> Maybe [FieldInfo b]
forall (m :: * -> *) aa bb.
Applicative m =>
(Int -> aa -> m bb) -> [aa] -> m [bb]
traverseWithIndex
    (\Int
i -> (StructuredColumnInfo b -> FieldInfo b)
-> Maybe (StructuredColumnInfo b) -> Maybe (FieldInfo b)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StructuredColumnInfo b -> FieldInfo b
forall (b :: BackendType). StructuredColumnInfo b -> FieldInfo b
FIColumn (Maybe (StructuredColumnInfo b) -> Maybe (FieldInfo b))
-> ((Column b, NullableScalarType b)
    -> Maybe (StructuredColumnInfo b))
-> (Column b, NullableScalarType b)
-> Maybe (FieldInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> (Column b, NullableScalarType b)
-> Maybe (StructuredColumnInfo b)
forall (b :: BackendType).
Backend b =>
Int
-> (Column b, NullableScalarType b)
-> Maybe (StructuredColumnInfo b)
logicalModelToColumnInfo Int
i)
    (InsOrdHashMap (Column b) (NullableScalarType b)
-> [(Column b, NullableScalarType b)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList InsOrdHashMap (Column b) (NullableScalarType b)
fields)

traverseWithIndex :: (Applicative m) => (Int -> aa -> m bb) -> [aa] -> m [bb]
traverseWithIndex :: forall (m :: * -> *) aa bb.
Applicative m =>
(Int -> aa -> m bb) -> [aa] -> m [bb]
traverseWithIndex Int -> aa -> m bb
f = (Int -> aa -> m bb) -> [Int] -> [aa] -> m [bb]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM Int -> aa -> m bb
f [Int
0 ..]

logicalModelToColumnInfo :: forall b. (Backend b) => Int -> (Column b, NullableScalarType b) -> Maybe (StructuredColumnInfo b)
logicalModelToColumnInfo :: forall (b :: BackendType).
Backend b =>
Int
-> (Column b, NullableScalarType b)
-> Maybe (StructuredColumnInfo b)
logicalModelToColumnInfo Int
i (Column b
column, NullableScalarType {Bool
Maybe Text
ScalarType b
nstType :: forall (b :: BackendType). NullableScalarType b -> ScalarType b
nstNullable :: forall (b :: BackendType). NullableScalarType b -> Bool
nstDescription :: forall (b :: BackendType). NullableScalarType b -> Maybe Text
nstType :: ScalarType b
nstNullable :: Bool
nstDescription :: Maybe Text
..}) = do
  Name
name <- Text -> Maybe Name
G.mkName (Column b -> Text
forall a. ToTxt a => a -> Text
toTxt Column b
column)
  StructuredColumnInfo b -> Maybe (StructuredColumnInfo b)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (StructuredColumnInfo b -> Maybe (StructuredColumnInfo b))
-> StructuredColumnInfo b -> Maybe (StructuredColumnInfo b)
forall a b. (a -> b) -> a -> b
$
    -- TODO(dmoverton): handle object and array columns
    ColumnInfo b -> StructuredColumnInfo b
forall (b :: BackendType). ColumnInfo b -> StructuredColumnInfo b
SCIScalarColumn
    (ColumnInfo b -> StructuredColumnInfo b)
-> ColumnInfo b -> StructuredColumnInfo b
forall a b. (a -> b) -> a -> b
$ ColumnInfo
      { ciColumn :: Column b
ciColumn = Column b
column,
        ciName :: Name
ciName = Name
name,
        ciPosition :: Int
ciPosition = Int
i,
        ciType :: ColumnType b
ciType = ScalarType b -> ColumnType b
forall (b :: BackendType). ScalarType b -> ColumnType b
ColumnScalar ScalarType b
nstType,
        ciIsNullable :: Bool
ciIsNullable = Bool
nstNullable,
        ciDescription :: Maybe Description
ciDescription = Text -> Description
G.Description (Text -> Description) -> Maybe Text -> Maybe Description
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
nstDescription,
        ciMutability :: ColumnMutability
ciMutability = ColumnMutability {_cmIsInsertable :: Bool
_cmIsInsertable = Bool
False, _cmIsUpdatable :: Bool
_cmIsUpdatable = Bool
False}
      }

logicalModelFieldsToFieldInfo ::
  forall b.
  (Backend b) =>
  InsOrdHashMap.InsOrdHashMap (Column b) (LogicalModelField b) ->
  FieldInfoMap (FieldInfo b)
logicalModelFieldsToFieldInfo :: forall (b :: BackendType).
Backend b =>
InsOrdHashMap (Column b) (LogicalModelField b)
-> FieldInfoMap (FieldInfo b)
logicalModelFieldsToFieldInfo =
  [(FieldName, FieldInfo b)] -> FieldInfoMap (FieldInfo b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
    ([(FieldName, FieldInfo b)] -> FieldInfoMap (FieldInfo b))
-> (InsOrdHashMap (Column b) (LogicalModelField b)
    -> [(FieldName, FieldInfo b)])
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> FieldInfoMap (FieldInfo b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Column b, StructuredColumnInfo b) -> (FieldName, FieldInfo b))
-> [(Column b, StructuredColumnInfo b)]
-> [(FieldName, FieldInfo b)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Column b -> FieldName)
-> (StructuredColumnInfo b -> FieldInfo b)
-> (Column b, StructuredColumnInfo b)
-> (FieldName, FieldInfo b)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall (b :: BackendType). Backend b => Column b -> FieldName
fromCol @b) StructuredColumnInfo b -> FieldInfo b
forall (b :: BackendType). StructuredColumnInfo b -> FieldInfo b
FIColumn)
    ([(Column b, StructuredColumnInfo b)]
 -> [(FieldName, FieldInfo b)])
-> (InsOrdHashMap (Column b) (LogicalModelField b)
    -> [(Column b, StructuredColumnInfo b)])
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> [(FieldName, FieldInfo b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Column b, StructuredColumnInfo b)]
-> Maybe [(Column b, StructuredColumnInfo b)]
-> [(Column b, StructuredColumnInfo b)]
forall a. a -> Maybe a -> a
fromMaybe [(Column b, StructuredColumnInfo b)]
forall a. Monoid a => a
mempty
    (Maybe [(Column b, StructuredColumnInfo b)]
 -> [(Column b, StructuredColumnInfo b)])
-> (InsOrdHashMap (Column b) (LogicalModelField b)
    -> Maybe [(Column b, StructuredColumnInfo b)])
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> [(Column b, StructuredColumnInfo b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
 -> (Column b, NullableScalarType b)
 -> Maybe (Column b, StructuredColumnInfo b))
-> [(Column b, NullableScalarType b)]
-> Maybe [(Column b, StructuredColumnInfo b)]
forall (m :: * -> *) aa bb.
Applicative m =>
(Int -> aa -> m bb) -> [aa] -> m [bb]
traverseWithIndex
      (\Int
i (Column b
column, NullableScalarType b
lmf) -> (,) Column b
column (StructuredColumnInfo b -> (Column b, StructuredColumnInfo b))
-> Maybe (StructuredColumnInfo b)
-> Maybe (Column b, StructuredColumnInfo b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int
-> (Column b, NullableScalarType b)
-> Maybe (StructuredColumnInfo b)
forall (b :: BackendType).
Backend b =>
Int
-> (Column b, NullableScalarType b)
-> Maybe (StructuredColumnInfo b)
logicalModelToColumnInfo Int
i (Column b
column, NullableScalarType b
lmf))
    ([(Column b, NullableScalarType b)]
 -> Maybe [(Column b, StructuredColumnInfo b)])
-> (InsOrdHashMap (Column b) (LogicalModelField b)
    -> [(Column b, NullableScalarType b)])
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> Maybe [(Column b, StructuredColumnInfo b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap (Column b) (NullableScalarType b)
-> [(Column b, NullableScalarType b)]
forall k v. InsOrdHashMap k v -> [(k, v)]
InsOrdHashMap.toList
    (InsOrdHashMap (Column b) (NullableScalarType b)
 -> [(Column b, NullableScalarType b)])
-> (InsOrdHashMap (Column b) (LogicalModelField b)
    -> InsOrdHashMap (Column b) (NullableScalarType b))
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> [(Column b, NullableScalarType b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InsOrdHashMap (Column b) (LogicalModelField b)
-> InsOrdHashMap (Column b) (NullableScalarType b)
forall k (b :: BackendType).
InsOrdHashMap k (LogicalModelField b)
-> InsOrdHashMap k (NullableScalarType b)
columnsFromFields

getSelPermInfoForLogicalModel ::
  (Backend b) =>
  RoleName ->
  LogicalModelInfo b ->
  Maybe (SelPermInfo b)
getSelPermInfoForLogicalModel :: forall (b :: BackendType).
Backend b =>
RoleName -> LogicalModelInfo b -> Maybe (SelPermInfo b)
getSelPermInfoForLogicalModel RoleName
role LogicalModelInfo b
logicalModel =
  if RoleName
role RoleName -> RoleName -> Bool
forall a. Eq a => a -> a -> Bool
== RoleName
adminRoleName
    then SelPermInfo b -> Maybe (SelPermInfo b)
forall a. a -> Maybe a
Just (SelPermInfo b -> Maybe (SelPermInfo b))
-> SelPermInfo b -> Maybe (SelPermInfo b)
forall a b. (a -> b) -> a -> b
$ LogicalModelInfo b -> SelPermInfo b
forall (b :: BackendType).
Backend b =>
LogicalModelInfo b -> SelPermInfo b
mkAdminSelPermInfo LogicalModelInfo b
logicalModel
    else RoleName
-> HashMap RoleName (RolePermInfo b) -> Maybe (RolePermInfo b)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup RoleName
role (LogicalModelInfo b -> HashMap RoleName (RolePermInfo b)
forall (b :: BackendType). LogicalModelInfo b -> RolePermInfoMap b
_lmiPermissions LogicalModelInfo b
logicalModel) Maybe (RolePermInfo b)
-> (RolePermInfo b -> Maybe (SelPermInfo b))
-> Maybe (SelPermInfo b)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RolePermInfo b -> Maybe (SelPermInfo b)
forall (b :: BackendType). RolePermInfo b -> Maybe (SelPermInfo b)
_permSel

mkAdminSelPermInfo :: (Backend b) => LogicalModelInfo b -> SelPermInfo b
mkAdminSelPermInfo :: forall (b :: BackendType).
Backend b =>
LogicalModelInfo b -> SelPermInfo b
mkAdminSelPermInfo LogicalModelInfo {Maybe Text
RolePermInfoMap b
InsOrdHashMap (Column b) (LogicalModelField b)
LogicalModelName
_lmiPermissions :: forall (b :: BackendType). LogicalModelInfo b -> RolePermInfoMap b
_lmiName :: LogicalModelName
_lmiFields :: InsOrdHashMap (Column b) (LogicalModelField b)
_lmiDescription :: Maybe Text
_lmiPermissions :: RolePermInfoMap b
_lmiName :: forall (b :: BackendType). LogicalModelInfo b -> LogicalModelName
_lmiFields :: forall (b :: BackendType).
LogicalModelInfo b
-> InsOrdHashMap (Column b) (LogicalModelField b)
_lmiDescription :: forall (b :: BackendType). LogicalModelInfo b -> Maybe Text
..} =
  SelPermInfo
    { spiCols :: HashMap (Column b) (AnnRedactionExpPartialSQL b)
spiCols = [(Column b, AnnRedactionExpPartialSQL b)]
-> HashMap (Column b) (AnnRedactionExpPartialSQL b)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Column b, AnnRedactionExpPartialSQL b)]
 -> HashMap (Column b) (AnnRedactionExpPartialSQL b))
-> [(Column b, AnnRedactionExpPartialSQL b)]
-> HashMap (Column b) (AnnRedactionExpPartialSQL b)
forall a b. (a -> b) -> a -> b
$ (,AnnRedactionExpPartialSQL b
forall (b :: BackendType) v. AnnRedactionExp b v
NoRedaction) (Column b -> (Column b, AnnRedactionExpPartialSQL b))
-> [Column b] -> [(Column b, AnnRedactionExpPartialSQL b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InsOrdHashMap (Column b) (LogicalModelField b) -> [Column b]
forall k v. InsOrdHashMap k v -> [k]
InsOrdHashMap.keys InsOrdHashMap (Column b) (LogicalModelField b)
_lmiFields,
      spiComputedFields :: HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
spiComputedFields = HashMap ComputedFieldName (AnnRedactionExpPartialSQL b)
forall a. Monoid a => a
mempty,
      spiFilter :: AnnBoolExpPartialSQL b
spiFilter = AnnBoolExpPartialSQL b
forall (backend :: BackendType) field. GBoolExp backend field
gBoolExpTrue,
      spiLimit :: Maybe Int
spiLimit = Maybe Int
forall a. Maybe a
Nothing,
      spiAllowAgg :: Bool
spiAllowAgg = Bool
True,
      spiRequiredHeaders :: HashSet Text
spiRequiredHeaders = HashSet Text
forall a. Monoid a => a
mempty,
      spiAllowedQueryRootFields :: AllowedRootFields QueryRootFieldType
spiAllowedQueryRootFields = AllowedRootFields QueryRootFieldType
forall rootFieldType. AllowedRootFields rootFieldType
ARFAllowAllRootFields,
      spiAllowedSubscriptionRootFields :: AllowedRootFields SubscriptionRootFieldType
spiAllowedSubscriptionRootFields = AllowedRootFields SubscriptionRootFieldType
forall rootFieldType. AllowedRootFields rootFieldType
ARFAllowAllRootFields
    }