module Database.HamSql.Internal.InquireDeployed where
import Data.Text (stripPrefix)
import Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.Types (PGArray (..), fromPGArray)
import Database.HamSql.Internal.DbUtils
import Database.HamSql.Internal.Utils
import Database.HamSql.Setup
import Database.YamSql
sqlManageSchemaJoin :: Text -> Text
sqlManageSchemaJoin schemaid =
" JOIN pg_namespace AS n " <\> " ON" <-> schemaid <-> "= n.oid AND " <\>
" NOT n.nspname LIKE 'pg_%' AND " <\>
" n.nspname NOT IN ('information_schema') "
deployedTableConstrIds :: Connection
-> IO [SqlObj SQL_TABLE_CONSTRAINT (SqlName, SqlName, SqlName)]
deployedTableConstrIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (schema, table, constraint) =
SqlObj SQL_TABLE_CONSTRAINT (schema, table, constraint)
qry =
toQry $
"SELECT n.nspname, t.relname, c.conname" <\> "FROM pg_constraint AS c" <\>
"JOIN pg_class AS t" <\>
" ON c.conrelid = t.oid" <->
sqlManageSchemaJoin "c.connamespace"
deployedDomainConstrIds :: Connection
-> IO [SqlObj SQL_DOMAIN_CONSTRAINT (SqlName, SqlName)]
deployedDomainConstrIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (schema, table, constraint) =
SqlObj SQL_DOMAIN_CONSTRAINT (schema <.> table, constraint)
qry =
toQry $
"SELECT n.nspname, d.typname, c.conname" <\> "FROM pg_constraint AS c " <\>
"JOIN pg_type AS d " <\>
" ON c.contypid = d.oid" <->
sqlManageSchemaJoin "c.connamespace"
deployedSchemaIds :: Connection -> IO [SqlObj SQL_SCHEMA SqlName]
deployedSchemaIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (Only s) = SqlObj SQL_SCHEMA s
qry =
toQry $
"SELECT s.nspname FROM pg_namespace AS s" <\> sqlManageSchemaJoin "s.oid"
deployedSequenceIds :: Connection -> IO [SqlObj SQL_SEQUENCE SqlName]
deployedSequenceIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (s, t) = SqlObj SQL_SEQUENCE (s <.> t)
qry =
toQry $
"SELECT sequence_schema, sequence_name" <\>
"FROM information_schema.sequences"
deployedTableIds :: Connection -> IO [SqlObj SQL_TABLE SqlName]
deployedTableIds conn = do
dat <-
query_ conn $
toQry $
"SELECT table_schema, table_name" <\> "FROM information_schema.tables" <\>
"WHERE table_type = 'BASE TABLE'" <\>
" AND table_schema NOT IN ('information_schema', 'pg_catalog')"
return $ map toSqlCodeId dat
where
toSqlCodeId (s, t) = SqlObj SQL_TABLE (s <.> t)
deployedTableColumnIds :: Connection
-> IO [SqlObj SQL_COLUMN (SqlName, SqlName)]
deployedTableColumnIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (s, t, u) = SqlObj SQL_COLUMN (s <.> t, u)
qry =
toQry $
"SELECT table_schema, table_name, column_name" <\>
" FROM information_schema.columns" <\>
" WHERE table_schema NOT IN ('information_schema', 'pg_catalog')"
deployedTypeIds :: Connection -> IO [SqlObj SQL_TYPE SqlName]
deployedTypeIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (s, t) = SqlObj SQL_TYPE (s <.> t)
qry =
toQry $
"SELECT user_defined_type_schema, user_defined_type_name" <\>
" FROM information_schema.user_defined_types" <\>
" WHERE user_defined_type_schema NOT IN ('information_schema', 'pg_catalog')"
deployedRoleIds :: Setup -> Connection -> IO [SqlObj SQL_ROLE SqlName]
deployedRoleIds setup conn =
map toSqlCodeId <$> query conn qry (Only $ prefix <> "%")
where
qry = "SELECT rolname FROM pg_roles WHERE rolname LIKE ?"
prefix = setupRolePrefix' setup
unprefixed =
fromJustReason "Retrived role without prefix from database" .
stripPrefix prefix
toSqlCodeId (Only role) = SqlObj SQL_ROLE (SqlName $ unprefixed role)
deployedRoleMemberIds :: Setup
-> Connection
-> IO [SqlObj SQL_ROLE_MEMBERSHIP (SqlName, SqlName)]
deployedRoleMemberIds setup conn =
map toSqlCodeId <$> query conn qry (prefix <> "%", prefix <> "%")
where
prefix = setupRolePrefix' setup
unprefixed =
fromJustReason "Retrived role without prefix from database" .
stripPrefix prefix
toSqlCodeId (role, member) =
SqlObj
SQL_ROLE_MEMBERSHIP
(SqlName $ unprefixed role, SqlName $ unprefixed member)
qry =
toQry $
"SELECT a.rolname, b.rolname FROM pg_catalog.pg_auth_members AS m" <\>
" INNER JOIN pg_catalog.pg_roles AS a ON a.oid=m.roleid" <\>
" INNER JOIN pg_catalog.pg_roles AS b ON b.oid=m.member" <\>
"WHERE a.rolname LIKE ? AND b.rolname LIKE ?"
deployedDomainIds :: Connection -> IO [SqlObj SQL_DOMAIN SqlName]
deployedDomainIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (schema, domain) = SqlObj SQL_DOMAIN $ schema <.> domain
qry =
toQry $
"SELECT domain_schema, domain_name" <\> " FROM information_schema.domains" <\>
" WHERE domain_schema NOT IN ('information_schema', 'pg_catalog')"
deployedFunctionIds :: Connection
-> IO [SqlObj SQL_FUNCTION (SqlName, [SqlType])]
deployedFunctionIds conn = map toSqlCodeId <$> query_ conn qry
where
toSqlCodeId (schema, function, args) =
SqlObj SQL_FUNCTION (schema <.> function, fromPGArray args)
qry =
toQry $
"SELECT n.nspname, p.proname, " <>
"ARRAY(SELECT UNNEST(p.proargtypes::regtype[]::varchar[]))" <\>
"FROM pg_proc AS p" <->
sqlManageSchemaJoin "p.pronamespace" <\>
"WHERE p.probin IS NULL"