mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-16 01:44:03 +03:00
cdac24c79f
What is the `Cacheable` type class about? ```haskell class Eq a => Cacheable a where unchanged :: Accesses -> a -> a -> Bool default unchanged :: (Generic a, GCacheable (Rep a)) => Accesses -> a -> a -> Bool unchanged accesses a b = gunchanged (from a) (from b) accesses ``` Its only method is an alternative to `(==)`. The added value of `unchanged` (and the additional `Accesses` argument) arises _only_ for one type, namely `Dependency`. Indeed, the `Cacheable (Dependency a)` instance is non-trivial, whereas every other `Cacheable` instance is completely boilerplate (and indeed either generated from `Generic`, or simply `unchanged _ = (==)`). The `Cacheable (Dependency a)` instance is the only one where the `Accesses` argument is not just passed onwards. The only callsite of the `unchanged` method is in the `ArrowCache (Rule m)` method. That is to say that the `Cacheable` type class is used to decide when we can re-use parts of the schema cache between Metadata operations. So what is the `Cacheable (Dependency a)` instance about? Normally, the output of a `Rule m a b` is re-used when the new input (of type `a`) is equal to the old one. But sometimes, that's too coarse: it might be that a certain `Rule m a b` only depends on a small part of its input of type `a`. A `Dependency` allows us to spell out what parts of `a` are being depended on, and these parts are recorded as values of types `Access a` in the state `Accesses`. If the input `a` changes, but not in a way that touches the recorded `Accesses`, then the output `b` of that rule can be re-used without recomputing. So now you understand _why_ we're passing `Accesses` to the `unchanged` method: `unchanged` is an equality check in disguise that just needs some additional context. But we don't need to pass `Accesses` as a function argument. We can use the `reflection` package to pass it as type-level context. So the core of this PR is that we change the instance declaration from ```haskell instance (Cacheable a) => Cacheable (Dependency a) where ``` to ```haskell instance (Given Accesses, Eq a) => Eq (Dependency a) where ``` and use `(==)` instead of `unchanged`. If you haven't seen `reflection` before: it's like a `MonadReader`, but it doesn't require a `Monad`. In order to pass the current `Accesses` value, instead of simply passing the `Accesses` as a function argument, we need to instantiate the `Given Accesses` context. We use the `give` method from the `reflection` package for that. ```haskell give :: forall r. Accesses -> (Given Accesses => r) -> r unchanged :: (Given Accesses => Eq a) => Accesses -> a -> a -> Bool unchanged accesses a b = give accesses (a == b) ``` With these three components in place, we can delete the `Cacheable` type class entirely. The remainder of this PR is just to remove the `Cacheable` type class and its instances. PR-URL: https://github.com/hasura/graphql-engine-mono/pull/6877 GitOrigin-RevId: 7125f5e11d856e7672ab810a23d5bf5ad176e77f
108 lines
3.7 KiB
Haskell
108 lines
3.7 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
{-# LANGUAGE UndecidableInstances #-}
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
module Hasura.RemoteSchema.Metadata.Core
|
|
( RemoteSchemaDef (..),
|
|
RemoteSchemaName (..),
|
|
UrlFromEnv,
|
|
getUrlFromEnv,
|
|
RemoteSchemaMetadataG (..),
|
|
rsmComment,
|
|
rsmDefinition,
|
|
rsmName,
|
|
rsmPermissions,
|
|
rsmRemoteRelationships,
|
|
)
|
|
where
|
|
|
|
import Control.Lens (makeLenses)
|
|
import Data.Aeson qualified as J
|
|
import Data.Aeson.TH qualified as J
|
|
import Data.Environment qualified as Env
|
|
import Data.HashMap.Strict.InsOrd.Extended qualified as OM
|
|
import Data.Text qualified as T
|
|
import Hasura.Base.Error
|
|
import Hasura.Prelude
|
|
import Hasura.RQL.DDL.Headers (HeaderConf (..))
|
|
import Hasura.RQL.Types.Common
|
|
import Hasura.RemoteSchema.Metadata.Base
|
|
import Hasura.RemoteSchema.Metadata.Customization
|
|
import Hasura.RemoteSchema.Metadata.Permission
|
|
import Hasura.RemoteSchema.Metadata.RemoteRelationship
|
|
import Network.URI.Extended qualified as N
|
|
|
|
type UrlFromEnv = Text
|
|
|
|
-- | Unvalidated remote schema config, from the user's API request
|
|
data RemoteSchemaDef = RemoteSchemaDef
|
|
{ _rsdUrl :: Maybe InputWebhook,
|
|
_rsdUrlFromEnv :: Maybe UrlFromEnv,
|
|
_rsdHeaders :: Maybe [HeaderConf],
|
|
_rsdForwardClientHeaders :: Bool,
|
|
_rsdTimeoutSeconds :: Maybe Int,
|
|
_rsdCustomization :: Maybe RemoteSchemaCustomization
|
|
-- NOTE: In the future we might extend this API to support a small DSL of
|
|
-- name transformations; this might live at a different layer, and be part of
|
|
-- the schema customization story.
|
|
--
|
|
-- See: https://github.com/hasura/graphql-engine-mono/issues/144
|
|
-- TODO we probably want to move this into a sub-field "transformations"?
|
|
}
|
|
deriving (Show, Eq, Generic)
|
|
|
|
instance NFData RemoteSchemaDef
|
|
|
|
$(J.deriveToJSON hasuraJSON {J.omitNothingFields = True} ''RemoteSchemaDef)
|
|
|
|
instance J.FromJSON RemoteSchemaDef where
|
|
parseJSON = J.withObject "Object" $ \o ->
|
|
RemoteSchemaDef
|
|
<$> o J..:? "url"
|
|
<*> o J..:? "url_from_env"
|
|
<*> o J..:? "headers"
|
|
<*> o J..:? "forward_client_headers" J..!= False
|
|
<*> o J..:? "timeout_seconds"
|
|
<*> o J..:? "customization"
|
|
|
|
getUrlFromEnv :: (MonadIO m, MonadError QErr m) => Env.Environment -> Text -> m (EnvRecord N.URI)
|
|
getUrlFromEnv env urlFromEnv = do
|
|
let mEnv = Env.lookupEnv env $ T.unpack urlFromEnv
|
|
uri <- onNothing mEnv (throw400 InvalidParams $ envNotFoundMsg urlFromEnv)
|
|
case (N.parseURI uri) of
|
|
Just uri' -> pure $ EnvRecord urlFromEnv uri'
|
|
Nothing -> throw400 InvalidParams $ invalidUri urlFromEnv
|
|
where
|
|
invalidUri x = "not a valid URI in environment variable: " <> x
|
|
envNotFoundMsg e = "environment variable '" <> e <> "' not set"
|
|
|
|
data RemoteSchemaMetadataG r = RemoteSchemaMetadata
|
|
{ _rsmName :: RemoteSchemaName,
|
|
_rsmDefinition :: RemoteSchemaDef,
|
|
_rsmComment :: Maybe Text,
|
|
_rsmPermissions :: [RemoteSchemaPermissionMetadata],
|
|
_rsmRemoteRelationships :: (SchemaRemoteRelationships r)
|
|
}
|
|
deriving (Show, Eq, Generic)
|
|
|
|
instance J.FromJSON (RemoteRelationshipG r) => J.FromJSON (RemoteSchemaMetadataG r) where
|
|
parseJSON = J.withObject "RemoteSchemaMetadata" \obj ->
|
|
RemoteSchemaMetadata
|
|
<$> obj J..: "name"
|
|
<*> obj J..: "definition"
|
|
<*> obj J..:? "comment"
|
|
<*> obj J..:? "permissions" J..!= mempty
|
|
<*> (oMapFromL _rstrsName <$> obj J..:? "remote_relationships" J..!= [])
|
|
|
|
instance J.ToJSON (RemoteRelationshipG r) => J.ToJSON (RemoteSchemaMetadataG r) where
|
|
toJSON RemoteSchemaMetadata {..} =
|
|
J.object
|
|
[ "name" J..= _rsmName,
|
|
"definition" J..= _rsmDefinition,
|
|
"comment" J..= _rsmComment,
|
|
"permissions" J..= _rsmPermissions,
|
|
"remote_relationships" J..= OM.elems _rsmRemoteRelationships
|
|
]
|
|
|
|
$(makeLenses ''RemoteSchemaMetadataG)
|