{-# LANGUAGE UndecidableInstances #-}

module Hasura.LogicalModel.Metadata
  ( LogicalModelMetadata (..),
    LogicalModelName (..),
    WithLogicalModel (..),
  )
where

import Autodocodec (Autodocodec (Autodocodec), HasCodec)
import Autodocodec qualified as AC
import Data.Aeson (FromJSON (parseJSON), ToJSON, (.!=), (.:), (.:?))
import Data.Aeson qualified as J
import Data.HashMap.Strict.InsOrd qualified as InsOrdHashMap
import Data.HashMap.Strict.InsOrd.Autodocodec (sortedElemsCodec)
import Hasura.LogicalModel.Types
import Hasura.Prelude hiding (first)
import Hasura.RQL.Types.Backend (Backend (..))
import Hasura.RQL.Types.BackendTag (backendPrefix)
import Hasura.RQL.Types.BackendType (BackendType)
import Hasura.RQL.Types.Common (SourceName, ToAesonPairs (toAesonPairs), defaultSource)
import Hasura.RQL.Types.Permission (SelPermDef, _pdRole)
import Hasura.RQL.Types.Roles (RoleName)

-- | Description of a logical model for use in metadata (before schema cache)
data LogicalModelMetadata (b :: BackendType) = LogicalModelMetadata
  { forall (b :: BackendType).
LogicalModelMetadata b -> LogicalModelName
_lmmName :: LogicalModelName,
    forall (b :: BackendType).
LogicalModelMetadata b
-> InsOrdHashMap (Column b) (LogicalModelField b)
_lmmFields :: InsOrdHashMap.InsOrdHashMap (Column b) (LogicalModelField b),
    forall (b :: BackendType). LogicalModelMetadata b -> Maybe Text
_lmmDescription :: Maybe Text,
    forall (b :: BackendType).
LogicalModelMetadata b -> InsOrdHashMap RoleName (SelPermDef b)
_lmmSelectPermissions :: InsOrdHashMap RoleName (SelPermDef b)
  }
  deriving ((forall x.
 LogicalModelMetadata b -> Rep (LogicalModelMetadata b) x)
-> (forall x.
    Rep (LogicalModelMetadata b) x -> LogicalModelMetadata b)
-> Generic (LogicalModelMetadata b)
forall x. Rep (LogicalModelMetadata b) x -> LogicalModelMetadata b
forall x. LogicalModelMetadata b -> Rep (LogicalModelMetadata b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (b :: BackendType) x.
Rep (LogicalModelMetadata b) x -> LogicalModelMetadata b
forall (b :: BackendType) x.
LogicalModelMetadata b -> Rep (LogicalModelMetadata b) x
$cfrom :: forall (b :: BackendType) x.
LogicalModelMetadata b -> Rep (LogicalModelMetadata b) x
from :: forall x. LogicalModelMetadata b -> Rep (LogicalModelMetadata b) x
$cto :: forall (b :: BackendType) x.
Rep (LogicalModelMetadata b) x -> LogicalModelMetadata b
to :: forall x. Rep (LogicalModelMetadata b) x -> LogicalModelMetadata b
Generic)

instance (Backend b) => HasCodec (LogicalModelMetadata b) where
  codec :: JSONCodec (LogicalModelMetadata b)
codec =
    Text
-> JSONCodec (LogicalModelMetadata b)
-> JSONCodec (LogicalModelMetadata b)
forall input output.
Text -> ValueCodec input output -> ValueCodec input output
AC.CommentCodec
      (Text
"A return type.")
      (JSONCodec (LogicalModelMetadata b)
 -> JSONCodec (LogicalModelMetadata b))
-> JSONCodec (LogicalModelMetadata b)
-> JSONCodec (LogicalModelMetadata b)
forall a b. (a -> b) -> a -> b
$ Text
-> ObjectCodec (LogicalModelMetadata b) (LogicalModelMetadata b)
-> JSONCodec (LogicalModelMetadata b)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (forall (b :: BackendType). HasTag b => Text
backendPrefix @b Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"LogicalModelMetadata")
      (ObjectCodec (LogicalModelMetadata b) (LogicalModelMetadata b)
 -> JSONCodec (LogicalModelMetadata b))
-> ObjectCodec (LogicalModelMetadata b) (LogicalModelMetadata b)
-> JSONCodec (LogicalModelMetadata b)
forall a b. (a -> b) -> a -> b
$ LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> Maybe Text
-> InsOrdHashMap RoleName (SelPermDef b)
-> LogicalModelMetadata b
forall (b :: BackendType).
LogicalModelName
-> InsOrdHashMap (Column b) (LogicalModelField b)
-> Maybe Text
-> InsOrdHashMap RoleName (SelPermDef b)
-> LogicalModelMetadata b
LogicalModelMetadata
      (LogicalModelName
 -> InsOrdHashMap (Column b) (LogicalModelField b)
 -> Maybe Text
 -> InsOrdHashMap RoleName (SelPermDef b)
 -> LogicalModelMetadata b)
-> Codec Object (LogicalModelMetadata b) LogicalModelName
-> Codec
     Object
     (LogicalModelMetadata b)
     (InsOrdHashMap (Column b) (LogicalModelField b)
      -> Maybe Text
      -> InsOrdHashMap RoleName (SelPermDef b)
      -> LogicalModelMetadata b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> ObjectCodec LogicalModelName LogicalModelName
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec output output
AC.requiredField Text
"name" Text
nameDoc
      ObjectCodec LogicalModelName LogicalModelName
-> (LogicalModelMetadata b -> LogicalModelName)
-> Codec Object (LogicalModelMetadata b) LogicalModelName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= LogicalModelMetadata b -> LogicalModelName
forall (b :: BackendType).
LogicalModelMetadata b -> LogicalModelName
_lmmName
        Codec
  Object
  (LogicalModelMetadata b)
  (InsOrdHashMap (Column b) (LogicalModelField b)
   -> Maybe Text
   -> InsOrdHashMap RoleName (SelPermDef b)
   -> LogicalModelMetadata b)
-> Codec
     Object
     (LogicalModelMetadata b)
     (InsOrdHashMap (Column b) (LogicalModelField b))
-> Codec
     Object
     (LogicalModelMetadata b)
     (Maybe Text
      -> InsOrdHashMap RoleName (SelPermDef b) -> LogicalModelMetadata b)
forall a b.
Codec Object (LogicalModelMetadata b) (a -> b)
-> Codec Object (LogicalModelMetadata b) a
-> Codec Object (LogicalModelMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec
     (InsOrdHashMap (Column b) (LogicalModelField b))
     (InsOrdHashMap (Column b) (LogicalModelField b))
-> Text
-> ObjectCodec
     (InsOrdHashMap (Column b) (LogicalModelField b))
     (InsOrdHashMap (Column b) (LogicalModelField b))
forall input output.
Text -> ValueCodec input output -> Text -> ObjectCodec input output
AC.requiredFieldWith Text
"fields" ValueCodec
  (InsOrdHashMap (Column b) (LogicalModelField b))
  (InsOrdHashMap (Column b) (LogicalModelField b))
forall (b :: BackendType).
Backend b =>
Codec
  Value
  (InsOrdHashMap (Column b) (LogicalModelField b))
  (InsOrdHashMap (Column b) (LogicalModelField b))
logicalModelFieldMapCodec Text
fieldsDoc
      ObjectCodec
  (InsOrdHashMap (Column b) (LogicalModelField b))
  (InsOrdHashMap (Column b) (LogicalModelField b))
-> (LogicalModelMetadata b
    -> InsOrdHashMap (Column b) (LogicalModelField b))
-> Codec
     Object
     (LogicalModelMetadata b)
     (InsOrdHashMap (Column b) (LogicalModelField b))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= LogicalModelMetadata b
-> InsOrdHashMap (Column b) (LogicalModelField b)
forall (b :: BackendType).
LogicalModelMetadata b
-> InsOrdHashMap (Column b) (LogicalModelField b)
_lmmFields
        Codec
  Object
  (LogicalModelMetadata b)
  (Maybe Text
   -> InsOrdHashMap RoleName (SelPermDef b) -> LogicalModelMetadata b)
-> Codec Object (LogicalModelMetadata b) (Maybe Text)
-> Codec
     Object
     (LogicalModelMetadata b)
     (InsOrdHashMap RoleName (SelPermDef b) -> LogicalModelMetadata b)
forall a b.
Codec Object (LogicalModelMetadata b) (a -> b)
-> Codec Object (LogicalModelMetadata b) a
-> Codec Object (LogicalModelMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Text -> ObjectCodec (Maybe Text) (Maybe Text)
forall output.
HasCodec output =>
Text -> Text -> ObjectCodec (Maybe output) (Maybe output)
AC.optionalField Text
"description" Text
descriptionDoc
      ObjectCodec (Maybe Text) (Maybe Text)
-> (LogicalModelMetadata b -> Maybe Text)
-> Codec Object (LogicalModelMetadata b) (Maybe Text)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= LogicalModelMetadata b -> Maybe Text
forall (b :: BackendType). LogicalModelMetadata b -> Maybe Text
_lmmDescription
        Codec
  Object
  (LogicalModelMetadata b)
  (InsOrdHashMap RoleName (SelPermDef b) -> LogicalModelMetadata b)
-> Codec
     Object
     (LogicalModelMetadata b)
     (InsOrdHashMap RoleName (SelPermDef b))
-> ObjectCodec (LogicalModelMetadata b) (LogicalModelMetadata b)
forall a b.
Codec Object (LogicalModelMetadata b) (a -> b)
-> Codec Object (LogicalModelMetadata b) a
-> Codec Object (LogicalModelMetadata b) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> (SelPermDef b -> RoleName)
-> ObjectCodec
     (InsOrdHashMap RoleName (SelPermDef b))
     (InsOrdHashMap RoleName (SelPermDef b))
forall {k} {a}.
(Eq a, HasCodec a, Hashable k, Ord k, ToTxt k) =>
Text
-> (a -> k) -> ObjectCodec (InsOrdHashMap k a) (InsOrdHashMap k a)
optSortedList Text
"select_permissions" SelPermDef b -> RoleName
forall (b :: BackendType) (perm :: BackendType -> *).
PermDef b perm -> RoleName
_pdRole
      ObjectCodec
  (InsOrdHashMap RoleName (SelPermDef b))
  (InsOrdHashMap RoleName (SelPermDef b))
-> (LogicalModelMetadata b
    -> InsOrdHashMap RoleName (SelPermDef b))
-> Codec
     Object
     (LogicalModelMetadata b)
     (InsOrdHashMap RoleName (SelPermDef b))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= LogicalModelMetadata b -> InsOrdHashMap RoleName (SelPermDef b)
forall (b :: BackendType).
LogicalModelMetadata b -> InsOrdHashMap RoleName (SelPermDef b)
_lmmSelectPermissions
    where
      nameDoc :: Text
nameDoc = Text
"A name for a logical model"
      fieldsDoc :: Text
fieldsDoc = Text
"Return types for the logical model"
      descriptionDoc :: Text
descriptionDoc = Text
"Optional description text which appears in the GraphQL Schema."

      optSortedList :: Text
-> (a -> k) -> ObjectCodec (InsOrdHashMap k a) (InsOrdHashMap k a)
optSortedList Text
name a -> k
keyForElem =
        Text
-> JSONCodec (InsOrdHashMap k a)
-> InsOrdHashMap k a
-> ObjectCodec (InsOrdHashMap k a) (InsOrdHashMap k a)
forall output.
Eq output =>
Text -> JSONCodec output -> output -> ObjectCodec output output
AC.optionalFieldWithOmittedDefaultWith' Text
name ((a -> k) -> JSONCodec (InsOrdHashMap k a)
forall a k.
(HasCodec a, Hashable k, Ord k, ToTxt k) =>
(a -> k) -> JSONCodec (InsOrdHashMap k a)
sortedElemsCodec a -> k
keyForElem) InsOrdHashMap k a
forall a. Monoid a => a
mempty

deriving via
  (Autodocodec (LogicalModelMetadata b))
  instance
    (Backend b) => FromJSON (LogicalModelMetadata b)

deriving via
  (Autodocodec (LogicalModelMetadata b))
  instance
    (Backend b) => ToJSON (LogicalModelMetadata b)

deriving stock instance (Backend b) => Eq (LogicalModelMetadata b)

deriving stock instance (Backend b) => Show (LogicalModelMetadata b)

-- | A wrapper to tie something to a particular native query. Specifically, it
-- assumes the underlying '_wlmInfo' is represented as an object, and adds two
-- keys to that object: @source@ and @root_field_name@.
data WithLogicalModel a = WithLogicalModel
  { forall a. WithLogicalModel a -> SourceName
_wlmSource :: SourceName,
    forall a. WithLogicalModel a -> LogicalModelName
_wlmName :: LogicalModelName,
    forall a. WithLogicalModel a -> a
_wlmInfo :: a
  }
  deriving stock (WithLogicalModel a -> WithLogicalModel a -> Bool
(WithLogicalModel a -> WithLogicalModel a -> Bool)
-> (WithLogicalModel a -> WithLogicalModel a -> Bool)
-> Eq (WithLogicalModel a)
forall a. Eq a => WithLogicalModel a -> WithLogicalModel a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithLogicalModel a -> WithLogicalModel a -> Bool
== :: WithLogicalModel a -> WithLogicalModel a -> Bool
$c/= :: forall a. Eq a => WithLogicalModel a -> WithLogicalModel a -> Bool
/= :: WithLogicalModel a -> WithLogicalModel a -> Bool
Eq, Int -> WithLogicalModel a -> ShowS
[WithLogicalModel a] -> ShowS
WithLogicalModel a -> String
(Int -> WithLogicalModel a -> ShowS)
-> (WithLogicalModel a -> String)
-> ([WithLogicalModel a] -> ShowS)
-> Show (WithLogicalModel a)
forall a. Show a => Int -> WithLogicalModel a -> ShowS
forall a. Show a => [WithLogicalModel a] -> ShowS
forall a. Show a => WithLogicalModel a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithLogicalModel a -> ShowS
showsPrec :: Int -> WithLogicalModel a -> ShowS
$cshow :: forall a. Show a => WithLogicalModel a -> String
show :: WithLogicalModel a -> String
$cshowList :: forall a. Show a => [WithLogicalModel a] -> ShowS
showList :: [WithLogicalModel a] -> ShowS
Show)

-- | something to note here: if the `a` contains a `name` or `source` key then
-- this won't work anymore.
instance (FromJSON a) => FromJSON (WithLogicalModel a) where
  parseJSON :: Value -> Parser (WithLogicalModel a)
parseJSON = String
-> (Object -> Parser (WithLogicalModel a))
-> Value
-> Parser (WithLogicalModel a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"LogicalModel" \Object
obj -> do
    SourceName
_wlmSource <- Object
obj Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source" Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
    LogicalModelName
_wlmName <- Object
obj Object -> Key -> Parser LogicalModelName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
    a
_wlmInfo <- Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
J.Object Object
obj)

    WithLogicalModel a -> Parser (WithLogicalModel a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WithLogicalModel {a
SourceName
LogicalModelName
_wlmInfo :: a
_wlmSource :: SourceName
_wlmName :: LogicalModelName
_wlmSource :: SourceName
_wlmName :: LogicalModelName
_wlmInfo :: a
..}

instance (ToAesonPairs a) => ToJSON (WithLogicalModel a) where
  toJSON :: WithLogicalModel a -> Value
toJSON (WithLogicalModel SourceName
source LogicalModelName
name a
info) =
    [Pair] -> Value
J.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Key
"source", SourceName -> Value
forall a. ToJSON a => a -> Value
J.toJSON SourceName
source) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: (Key
"name", LogicalModelName -> Value
forall a. ToJSON a => a -> Value
J.toJSON LogicalModelName
name) Pair -> [Pair] -> [Pair]
forall a. a -> [a] -> [a]
: a -> [Pair]
forall v. KeyValue v => a -> [v]
forall a v. (ToAesonPairs a, KeyValue v) => a -> [v]
toAesonPairs a
info