server: implement codecs for table permissions

This PR implements the remaining codecs for table permissions. However the codec for boolean expressions delegates to Aeson instances because Autodocodec doesn't currently have the necessary feature to write a codec for boolean expressions that will reliably parse valid data.

Boolean expressions are objects with keys like `_and`, `_or`, `_exists`, or `<field name>`. The parsing rules for each value depend on the key, so we need to be able to select different codecs for each key. We could do that with an `object` codec, but that doesn't account for the arbitrary field name keys that can be provided. OpenAPI supports object types with "additional properties", but I don't know if we can declare a specific type for those properties. There might or might not be a reasonable path to extending Autodocodec to handle this case.

Ticket: [GDC-585](https://hasurahq.atlassian.net/browse/GDC-585)

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6978
GitOrigin-RevId: 0b0dcfd59ebd1d5022ff2ab86dd8d4c6f93bd039

server/src-lib/Hasura/RQL/IR/BoolExp.hs

@@ -47,6 +47,7 @@ module Hasura.RQL.IR.BoolExp
   )
 where
 
+import Autodocodec (Codec (CommentCodec), HasCodec (codec), JSONCodec, bimapCodec, dimapCodec, named, valueCodec)
 import Control.Lens.Plated
 import Control.Lens.TH
 import Data.Aeson.Extended
@@ -54,9 +55,11 @@ import Data.Aeson.Internal
 import Data.Aeson.Key qualified as K
 import Data.Aeson.KeyMap qualified as KM
 import Data.Aeson.TH
+import Data.Aeson.Types (parseEither)
 import Data.HashMap.Strict qualified as M
 import Data.Monoid
 import Data.Text.Extended
+import Hasura.Metadata.DTO.Utils (codecNamePrefix)
 import Hasura.Prelude
 import Hasura.RQL.Types.Backend
 import Hasura.RQL.Types.Column
@@ -196,6 +199,23 @@ instance ToJSONKeyValue ColExp where
 newtype BoolExp (b :: BackendType) = BoolExp {unBoolExp :: GBoolExp b ColExp}
   deriving newtype (Show, Eq, Generic, NFData, ToJSON, FromJSON)
 
+-- TODO: This implementation delegates to Aeson instances for encoding and
+-- decoding GBoolExp. To accurately represent GBoolExp with a codec we will need
+-- Autodocodec to gain support for expressing an object type with "additional
+-- properties" for fields.
+instance Backend b => HasCodec (BoolExp b) where
+  codec = CommentCodec doc $ named (codecNamePrefix @b <> "BoolExp") $ dimapCodec BoolExp unBoolExp jsonCodec
+    where
+      jsonCodec :: JSONCodec (GBoolExp b ColExp)
+      jsonCodec = bimapCodec (parseEither parseJSON) toJSON valueCodec
+      doc =
+        "Recursive object type with keys \"_and\", \"_or\", \"_not\", \"_exists\", or \"<field name>\". "
+          <> "Values for \"_and\" and \"_or\" are arrays of nested expressions. "
+          <> "A value for \"_not\" is a single nested expression. "
+          <> "A value for \"_exists\" is an object with \"table\" and \"where\" properties where \"table\" is a table name, "
+          <> "and \"where\" is another BoolExp expression. "
+          <> "All other properties represent fields where the property name represents a column name, and the value represents a row value."
+
 $(makeWrapped ''BoolExp)
 
 makePrisms ''GBoolExp

server/src-lib/Hasura/RQL/Types/Permission.hs

@@ -30,7 +30,7 @@ where
 
 import Autodocodec hiding (object, (.=))
 import Autodocodec qualified as AC
-import Autodocodec.Extended (optionalFieldOrIncludedNullWith')
+import Autodocodec.Extended (optionalFieldOrIncludedNull')
 import Control.Lens (makeLenses)
 import Data.Aeson
 import Data.Aeson.Casing (snakeCase)
@@ -41,7 +41,6 @@ import Data.Kind (Type)
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Text qualified as T
 import Database.PG.Query qualified as PG
-import Hasura.Metadata.DTO.Placeholder (placeholderCodecViaJSON)
 import Hasura.Metadata.DTO.Utils (codecNamePrefix)
 import Hasura.Prelude
 import Hasura.RQL.IR.BoolExp
@@ -102,6 +101,13 @@ deriving instance (Backend b) => Show (PermColSpec b)
 
 deriving instance (Backend b) => Eq (PermColSpec b)
 
+instance (Backend b) => HasCodec (PermColSpec b) where
+  codec =
+    dimapCodec
+      (either (const PCStar) PCCols)
+      (\case PCStar -> Left "*"; PCCols cols -> Right cols)
+      $ disjointEitherCodec (literalTextCodec "*") (listCodec $ codec @(Column b))
+
 instance (Backend b) => FromJSON (PermColSpec b) where
   parseJSON (String "*") = return PCStar
   parseJSON x = PCCols <$> parseJSON x
@@ -275,12 +281,10 @@ instance Backend b => HasCodec (InsPerm b) where
   codec =
     AC.object (codecNamePrefix @b <> "InsPerm") $
       InsPerm
-        <$> requiredFieldWith' "check" placeholderCodecViaJSON .== ipCheck
-        <*> optionalFieldWith' "set" placeholderCodecViaJSON .== ipSet
-        <*> optionalFieldWith' "columns" placeholderCodecViaJSON .== ipColumns
-        <*> optionalFieldWithDefault' "backend_only" False .== ipBackendOnly
-    where
-      (.==) = (AC..=)
+        <$> requiredField' "check" AC..= ipCheck
+        <*> optionalField' "set" AC..= ipSet
+        <*> optionalField' "columns" AC..= ipColumns
+        <*> optionalFieldWithDefault' "backend_only" False AC..= ipBackendOnly
 
 type InsPermDef b = PermDef b InsPerm
 
@@ -391,15 +395,13 @@ instance Backend b => HasCodec (SelPerm b) where
   codec =
     AC.object (codecNamePrefix @b <> "SelPerm") $
       SelPerm
-        <$> requiredFieldWith' "columns" placeholderCodecViaJSON .== spColumns
-        <*> requiredFieldWith' "filter" placeholderCodecViaJSON .== spFilter
-        <*> optionalField' "limit" .== spLimit
-        <*> optionalFieldWithOmittedDefault' "allow_aggregations" False .== spAllowAggregations
-        <*> optionalFieldWithOmittedDefaultWith' "computed_fields" placeholderCodecViaJSON [] .== spComputedFields
-        <*> optionalFieldWithOmittedDefault' "query_root_fields" ARFAllowAllRootFields .== spAllowedQueryRootFields
-        <*> optionalFieldWithOmittedDefault' "subscription_root_fields" ARFAllowAllRootFields .== spAllowedSubscriptionRootFields
-    where
-      (.==) = (AC..=)
+        <$> requiredField' "columns" AC..= spColumns
+        <*> requiredField' "filter" AC..= spFilter
+        <*> optionalField' "limit" AC..= spLimit
+        <*> optionalFieldWithOmittedDefault' "allow_aggregations" False AC..= spAllowAggregations
+        <*> optionalFieldWithOmittedDefault' "computed_fields" [] AC..= spComputedFields
+        <*> optionalFieldWithOmittedDefault' "query_root_fields" ARFAllowAllRootFields AC..= spAllowedQueryRootFields
+        <*> optionalFieldWithOmittedDefault' "subscription_root_fields" ARFAllowAllRootFields AC..= spAllowedSubscriptionRootFields
 
 type SelPermDef b = PermDef b SelPerm
 
@@ -423,7 +425,7 @@ instance Backend b => HasCodec (DelPerm b) where
   codec =
     AC.object (codecNamePrefix @b <> "DelPerm") $
       DelPerm
-        <$> requiredFieldWith' "filter" placeholderCodecViaJSON .== dcFilter
+        <$> requiredField' "filter" .== dcFilter
         <*> optionalFieldWithOmittedDefault' "backend_only" False .== dcBackendOnly
     where
       (.==) = (AC..=)
@@ -461,15 +463,13 @@ instance Backend b => HasCodec (UpdPerm b) where
   codec =
     AC.object (codecNamePrefix @b <> "UpdPerm") $
       UpdPerm
-        <$> requiredFieldWith "columns" placeholderCodecViaJSON "Allowed columns" .== ucColumns
-        <*> optionalFieldWith "set" placeholderCodecViaJSON "Preset columns" .== ucSet
-        <*> requiredFieldWith' "filter" placeholderCodecViaJSON .== ucFilter
+        <$> requiredField "columns" "Allowed columns" AC..= ucColumns
+        <*> optionalField "set" "Preset columns" AC..= ucSet
+        <*> requiredField' "filter" AC..= ucFilter
         -- Include @null@ in serialized output for this field because that is
         -- the way the @toOrdJSON@ serialization is written.
-        <*> optionalFieldOrIncludedNullWith' "check" placeholderCodecViaJSON .== ucCheck
-        <*> optionalFieldWithOmittedDefault' "backend_only" False .== ucBackendOnly
-    where
-      (.==) = (AC..=)
+        <*> optionalFieldOrIncludedNull' "check" AC..= ucCheck
+        <*> optionalFieldWithOmittedDefault' "backend_only" False AC..= ucBackendOnly
 
 type UpdPermDef b = PermDef b UpdPerm