这是indexloc提供的服务,不要输入任何密码
Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion server/src-lib/Hasura/Cache/Bounded.hs
Original file line number Diff line number Diff line change
Expand Up @@ -124,7 +124,7 @@ clearLocal (LocalCacheRef ref)=
-- | lookup for a key in the local cache
lookupLocal :: (Hashable k, Ord k) => LocalCacheRef k v -> k -> IO (Maybe v)
lookupLocal (LocalCacheRef ref) k =
-- | Return the result and replace the cache if needed
-- Return the result and replace the cache if needed
IORef.atomicModifyIORef' ref $ \currentCache ->
case lookupPure k currentCache of
Just (v, newCache) -> (newCache, Just v)
Expand Down
6 changes: 2 additions & 4 deletions server/src-lib/Hasura/RQL/DDL/Metadata.hs
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
{-# LANGUAGE TypeApplications #-}
module Hasura.RQL.DDL.Metadata
( runReplaceMetadata
, runExportMetadata
Expand Down Expand Up @@ -126,18 +125,16 @@ applyQP2
=> ReplaceMetadata
-> m EncJSON
applyQP2 (ReplaceMetadata _ tables functionsMeta schemas collections allowlist) = do

liftTx clearMetadata
buildSchemaCacheStrict

systemDefined <- askSystemDefined
withPathK "tables" $ do
-- tables and views
indexedForM_ tables $ \tableMeta -> do
let tableName = tableMeta ^. tmTable
isEnum = tableMeta ^. tmIsEnum
config = tableMeta ^. tmConfiguration
void $ Schema.trackExistingTableOrViewP2 tableName systemDefined isEnum config
void $ Schema.trackExistingTableOrViewP2 tableName isEnum config

indexedForM_ tables $ \table -> do
-- Relationships
Expand Down Expand Up @@ -180,6 +177,7 @@ applyQP2 (ReplaceMetadata _ tables functionsMeta schemas collections allowlist)
\(Schema.TrackFunctionV2 function config) -> void $ Schema.trackFunctionP2 function config

-- query collections
systemDefined <- askSystemDefined
withPathK "query_collections" $
indexedForM_ collections $ \c -> liftTx $ Collection.addCollectionToCatalog c systemDefined

Expand Down
8 changes: 1 addition & 7 deletions server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs
Original file line number Diff line number Diff line change
Expand Up @@ -66,7 +66,7 @@ instance Arbitrary GC.TableCustomRootFields where
instance Arbitrary TableConfig where
arbitrary = genericArbitrary

instance (Arbitrary a, Arbitrary b) => Arbitrary (Relationship.RelUsing a b) where
instance (Arbitrary a) => Arbitrary (Relationship.RelUsing a) where
arbitrary = genericArbitrary

instance (Arbitrary a) => Arbitrary (Relationship.RelDef a) where
Expand All @@ -75,12 +75,6 @@ instance (Arbitrary a) => Arbitrary (Relationship.RelDef a) where
instance Arbitrary Relationship.RelManualConfig where
arbitrary = genericArbitrary

instance Arbitrary Relationship.ObjRelManualConfig where
arbitrary = genericArbitrary

instance Arbitrary Relationship.ArrRelManualConfig where
arbitrary = genericArbitrary

instance Arbitrary Relationship.ArrRelUsingFKeyOn where
arbitrary = genericArbitrary

Expand Down
4 changes: 2 additions & 2 deletions server/src-lib/Hasura/RQL/DDL/Relationship.hs
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ objRelP2Setup
-> RelDef ObjRelUsing
-> m (RelInfo, [SchemaDependency])
objRelP2Setup qt foreignKeys (RelDef rn ru _) = case ru of
RUManual (ObjRelManualConfig rm) -> do
RUManual rm -> do
let refqt = rmTable rm
(lCols, rCols) = unzip $ HM.toList $ rmColumns rm
mkDependency tableName reason col = SchemaDependency (SOTableObj tableName $ TOCol col) reason
Expand All @@ -115,7 +115,7 @@ arrRelP2Setup
-> ArrRelDef
-> m (RelInfo, [SchemaDependency])
arrRelP2Setup foreignKeys qt (RelDef rn ru _) = case ru of
RUManual (ArrRelManualConfig rm) -> do
RUManual rm -> do
let refqt = rmTable rm
(lCols, rCols) = unzip $ HM.toList $ rmColumns rm
deps = map (\c -> SchemaDependency (SOTableObj qt $ TOCol c) DRLeftColumn) lCols
Expand Down
25 changes: 8 additions & 17 deletions server/src-lib/Hasura/RQL/DDL/Relationship/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,22 +52,22 @@ instance ToJSON RelManualConfig where
, "column_mapping" .= cm
]

data RelUsing a b
= RUFKeyOn a
| RUManual b
data RelUsing a
= RUFKeyOn !a
| RUManual !RelManualConfig
deriving (Show, Eq, Lift, Generic)

instance (ToJSON a, ToJSON b) => ToJSON (RelUsing a b) where
instance (ToJSON a) => ToJSON (RelUsing a) where
toJSON (RUFKeyOn fkey) =
object [ "foreign_key_constraint_on" .= fkey ]
toJSON (RUManual manual) =
object [ "manual_configuration" .= manual ]

instance (FromJSON a, FromJSON b) => FromJSON (RelUsing a b) where
instance (FromJSON a) => FromJSON (RelUsing a) where
parseJSON (Object o) = do
let fkeyOnM = HM.lookup "foreign_key_constraint_on" o
manualM = HM.lookup "manual_configuration" o
let msgFrag = "one of foreign_key_constraint_on/manual_configuration should be present"
msgFrag = "one of foreign_key_constraint_on/manual_configuration should be present"
case (fkeyOnM, manualM) of
(Nothing, Nothing) -> fail $ "atleast " <> msgFrag
(Just a, Nothing) -> RUFKeyOn <$> parseJSON a
Expand All @@ -76,10 +76,6 @@ instance (FromJSON a, FromJSON b) => FromJSON (RelUsing a b) where
parseJSON _ =
fail "using should be an object"

newtype ArrRelManualConfig =
ArrRelManualConfig { getArrRelMapping :: RelManualConfig }
deriving (Show, Eq, FromJSON, ToJSON, Lift, Generic)

data ArrRelUsingFKeyOn
= ArrRelUsingFKeyOn
{ arufTable :: !QualifiedTable
Expand All @@ -88,17 +84,12 @@ data ArrRelUsingFKeyOn

$(deriveJSON (aesonDrop 4 snakeCase){omitNothingFields=True} ''ArrRelUsingFKeyOn)

type ArrRelUsing = RelUsing ArrRelUsingFKeyOn ArrRelManualConfig
type ArrRelUsing = RelUsing ArrRelUsingFKeyOn
type ArrRelDef = RelDef ArrRelUsing
type CreateArrRel = WithTable ArrRelDef

newtype ObjRelManualConfig =
ObjRelManualConfig { getObjRelMapping :: RelManualConfig }
deriving (Show, Eq, FromJSON, ToJSON, Lift, Generic)

type ObjRelUsing = RelUsing PGCol ObjRelManualConfig
type ObjRelUsing = RelUsing PGCol
type ObjRelDef = RelDef ObjRelUsing

type CreateObjRel = WithTable ObjRelDef

data DropRel
Expand Down
30 changes: 15 additions & 15 deletions server/src-lib/Hasura/RQL/DDL/Schema/Catalog.hs
Original file line number Diff line number Diff line change
Expand Up @@ -22,19 +22,28 @@ import Hasura.RQL.DDL.EventTrigger
import Hasura.RQL.DDL.Permission.Internal
import Hasura.RQL.DDL.Relationship
import Hasura.RQL.DDL.Schema.Function
import Hasura.RQL.Types
import Hasura.RQL.Types.Catalog
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Error
import Hasura.RQL.Types.SchemaCache
import Hasura.SQL.Types

fetchCatalogData :: (MonadTx m) => m CatalogMetadata
fetchCatalogData = liftTx $ Q.getAltJ . runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler
$(Q.sqlFromFile "src-rsr/catalog_metadata.sql") () True

saveTableToCatalog :: (MonadTx m) => QualifiedTable -> SystemDefined -> Bool -> TableConfig -> m ()
saveTableToCatalog (QualifiedObject sn tn) systemDefined isEnum config = liftTx $
Q.unitQE defaultTxErrorHandler [Q.sql|
purgeDependentObject :: (MonadTx m) => SchemaObjId -> m ()
purgeDependentObject = \case
SOTableObj tn (TOPerm rn pt) -> liftTx $ dropPermFromCatalog tn rn pt
SOTableObj qt (TORel rn) -> liftTx $ delRelFromCatalog qt rn
SOFunction qf -> liftTx $ delFunctionFromCatalog qf
SOTableObj _ (TOTrigger trn) -> liftTx $ delEventTriggerFromCatalog trn
SOTableObj qt (TOComputedField ccn) -> dropComputedFieldFromCatalog qt ccn
schemaObjId -> throw500 $ "unexpected dependent object: " <> reportSchemaObj schemaObjId

saveTableToCatalog
:: (MonadTx m, HasSystemDefined m) => QualifiedTable -> Bool -> TableConfig -> m ()
saveTableToCatalog (QualifiedObject sn tn) isEnum config = do
systemDefined <- askSystemDefined
liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql|
INSERT INTO "hdb_catalog"."hdb_table"
(table_schema, table_name, is_system_defined, is_enum, configuration)
VALUES ($1, $2, $3, $4, $5)
Expand Down Expand Up @@ -72,12 +81,3 @@ getTableConfig (QualifiedObject sn tn) = liftTx $
SELECT configuration::json FROM hdb_catalog.hdb_table
WHERE table_schema = $1 AND table_name = $2
|] (sn, tn) True

purgeDependentObject :: (MonadTx m) => SchemaObjId -> m ()
purgeDependentObject = \case
SOTableObj tn (TOPerm rn pt) -> liftTx $ dropPermFromCatalog tn rn pt
SOTableObj qt (TORel rn) -> liftTx $ delRelFromCatalog qt rn
SOFunction qf -> liftTx $ delFunctionFromCatalog qf
SOTableObj _ (TOTrigger trn) -> liftTx $ delEventTriggerFromCatalog trn
SOTableObj qt (TOComputedField ccn) -> dropComputedFieldFromCatalog qt ccn
schemaObjId -> throw500 $ "unexpected dependent object: " <> reportSchemaObj schemaObjId
16 changes: 6 additions & 10 deletions server/src-lib/Hasura/RQL/DDL/Schema/Rename.hs
Original file line number Diff line number Diff line change
Expand Up @@ -155,9 +155,9 @@ updateObjRelDef qt rn (oldQT, newQT) = do
oldDef :: ObjRelUsing <- decodeValue oldDefV
let newDef = case oldDef of
RUFKeyOn _ -> oldDef
RUManual (ObjRelManualConfig (RelManualConfig dbQT rmCols)) ->
RUManual (RelManualConfig dbQT rmCols) ->
let updQT = bool oldQT newQT $ oldQT == dbQT
in RUManual $ ObjRelManualConfig $ RelManualConfig updQT rmCols
in RUManual $ RelManualConfig updQT rmCols
liftTx $ updateRel qt rn $ toJSON newDef

updateArrRelDef
Expand All @@ -170,9 +170,9 @@ updateArrRelDef qt rn (oldQT, newQT) = do
RUFKeyOn (ArrRelUsingFKeyOn dbQT c) ->
let updQT = getUpdQT dbQT
in RUFKeyOn $ ArrRelUsingFKeyOn updQT c
RUManual (ArrRelManualConfig (RelManualConfig dbQT rmCols)) ->
RUManual (RelManualConfig dbQT rmCols) ->
let updQT = getUpdQT dbQT
in RUManual $ ArrRelManualConfig $ RelManualConfig updQT rmCols
in RUManual $ RelManualConfig updQT rmCols
liftTx $ updateRel qt rn $ toJSON newDef
where
getUpdQT dbQT = bool oldQT newQT $ oldQT == dbQT
Expand Down Expand Up @@ -376,9 +376,7 @@ updateColInObjRel
-> RenameCol -> ObjRelUsing -> ObjRelUsing
updateColInObjRel fromQT toQT rnCol = \case
RUFKeyOn col -> RUFKeyOn $ getNewCol rnCol fromQT col
RUManual (ObjRelManualConfig manConfig) ->
RUManual $ ObjRelManualConfig $
updateRelManualConfig fromQT toQT rnCol manConfig
RUManual manConfig -> RUManual $ updateRelManualConfig fromQT toQT rnCol manConfig

updateColInArrRel
:: QualifiedTable -> QualifiedTable
Expand All @@ -387,9 +385,7 @@ updateColInArrRel fromQT toQT rnCol = \case
RUFKeyOn (ArrRelUsingFKeyOn t c) ->
let updCol = getNewCol rnCol toQT c
in RUFKeyOn $ ArrRelUsingFKeyOn t updCol
RUManual (ArrRelManualConfig manConfig) ->
RUManual $ ArrRelManualConfig $
updateRelManualConfig fromQT toQT rnCol manConfig
RUManual manConfig -> RUManual $ updateRelManualConfig fromQT toQT rnCol manConfig

type ColMap = HashMap PGCol PGCol

Expand Down
14 changes: 6 additions & 8 deletions server/src-lib/Hasura/RQL/DDL/Schema/Table.hs
Original file line number Diff line number Diff line change
Expand Up @@ -101,22 +101,21 @@ trackExistingTableOrViewP1 qt = do
throw400 NotSupported $ "function with name " <> qt <<> " already exists"

trackExistingTableOrViewP2
:: (MonadTx m, CacheRWM m)
=> QualifiedTable -> SystemDefined -> Bool -> TableConfig -> m EncJSON
trackExistingTableOrViewP2 tableName systemDefined isEnum config = do
:: (MonadTx m, CacheRWM m, HasSystemDefined m)
=> QualifiedTable -> Bool -> TableConfig -> m EncJSON
trackExistingTableOrViewP2 tableName isEnum config = do
sc <- askSchemaCache
let defGCtx = scDefaultRemoteGCtx sc
GS.checkConflictingNode defGCtx $ GS.qualObjectToName tableName
saveTableToCatalog tableName systemDefined isEnum config
saveTableToCatalog tableName isEnum config
buildSchemaCacheFor (MOTable tableName)
return successMsg

runTrackTableQ
:: (MonadTx m, CacheRWM m, HasSystemDefined m) => TrackTable -> m EncJSON
runTrackTableQ (TrackTable qt isEnum) = do
trackExistingTableOrViewP1 qt
systemDefined <- askSystemDefined
trackExistingTableOrViewP2 qt systemDefined isEnum emptyTableConfig
trackExistingTableOrViewP2 qt isEnum emptyTableConfig

data TrackTableV2
= TrackTableV2
Expand All @@ -129,8 +128,7 @@ runTrackTableV2Q
:: (MonadTx m, CacheRWM m, HasSystemDefined m) => TrackTableV2 -> m EncJSON
runTrackTableV2Q (TrackTableV2 (TrackTable qt isEnum) config) = do
trackExistingTableOrViewP1 qt
systemDefined <- askSystemDefined
trackExistingTableOrViewP2 qt systemDefined isEnum config
trackExistingTableOrViewP2 qt isEnum config

runSetExistingTableIsEnumQ :: (MonadTx m, CacheRWM m) => SetTableIsEnum -> m EncJSON
runSetExistingTableIsEnumQ (SetTableIsEnum tableName isEnum) = do
Expand Down
11 changes: 7 additions & 4 deletions server/src-lib/Hasura/RQL/Types/Common.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,6 +26,7 @@ module Hasura.RQL.Types.Common
, NonEmptyText
, mkNonEmptyText
, unNonEmptyText
, nonEmptyText
, adminText
, rootText

Expand All @@ -41,9 +42,8 @@ import Control.Lens (makeLenses)
import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Aeson.Types
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)
import Language.Haskell.TH.Syntax (Q, TExp, Lift)

import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
Expand All @@ -52,7 +52,7 @@ import qualified Language.GraphQL.Draft.Syntax as G
import qualified PostgreSQL.Binary.Decoding as PD
import qualified Test.QuickCheck as QC

newtype NonEmptyText = NonEmptyText {unNonEmptyText :: T.Text}
newtype NonEmptyText = NonEmptyText { unNonEmptyText :: T.Text }
deriving (Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, Lift, Q.ToPrepArg, DQuote, Generic, NFData, Cacheable)

instance Arbitrary NonEmptyText where
Expand All @@ -62,11 +62,14 @@ mkNonEmptyText :: T.Text -> Maybe NonEmptyText
mkNonEmptyText "" = Nothing
mkNonEmptyText text = Just $ NonEmptyText text

parseNonEmptyText :: T.Text -> Parser NonEmptyText
parseNonEmptyText :: MonadFail m => Text -> m NonEmptyText
parseNonEmptyText text = case mkNonEmptyText text of
Nothing -> fail "empty string not allowed"
Just neText -> return neText

nonEmptyText :: Text -> Q (TExp NonEmptyText)
nonEmptyText = parseNonEmptyText >=> \text -> [|| text ||]

instance FromJSON NonEmptyText where
parseJSON = withText "String" parseNonEmptyText

Expand Down
8 changes: 5 additions & 3 deletions server/src-lib/Hasura/SQL/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -163,7 +163,7 @@ class ToTxt a where
newtype TableName
= TableName { getTableTxt :: T.Text }
deriving ( Show, Eq, Ord, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, Lift, Data
, Generic, Arbitrary, NFData, Cacheable )
, Generic, Arbitrary, NFData, Cacheable, IsString )

instance IsIden TableName where
toIden (TableName t) = Iden t
Expand Down Expand Up @@ -233,7 +233,8 @@ instance ToTxt FunctionName where

newtype SchemaName
= SchemaName { getSchemaTxt :: T.Text }
deriving (Show, Eq, Ord, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, Lift, Data, Generic, Arbitrary, NFData, Cacheable)
deriving ( Show, Eq, Ord, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, Lift, Data, Generic
, Arbitrary, NFData, Cacheable, IsString )

publicSchema :: SchemaName
publicSchema = SchemaName "public"
Expand Down Expand Up @@ -307,7 +308,8 @@ newtype PGDescription

newtype PGCol
= PGCol { getPGColTxt :: T.Text }
deriving (Show, Eq, Ord, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, ToJSONKey, FromJSONKey, Lift, Data, Generic, Arbitrary, NFData, Cacheable)
deriving ( Show, Eq, Ord, FromJSON, ToJSON, Hashable, Q.ToPrepArg, Q.FromCol, ToJSONKey
, FromJSONKey, Lift, Data, Generic, Arbitrary, NFData, Cacheable, IsString )

instance IsIden PGCol where
toIden (PGCol t) = Iden t
Expand Down
Loading