Skip to content

Commit 37c2350

Browse files
hdgarroodhdgarrood
committed
Switch to pg_catalog for FK constraints
1 parent ff11100 commit 37c2350

File tree

4 files changed

+125
-56
lines changed

4 files changed

+125
-56
lines changed

‎persistent-postgresql/Database/Persist/Postgresql/Internal/Migration.hs‎

Lines changed: 23 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
{-# LANGUAGE FlexibleContexts #-}
22
{-# LANGUAGE NamedFieldPuns #-}
33
{-# LANGUAGE OverloadedStrings #-}
4+
{-# LANGUAGE TemplateHaskell #-}
45
{-# LANGUAGE TupleSections #-}
56
{-# LANGUAGE ViewPatterns #-}
67

@@ -16,11 +17,13 @@ import Data.Acquire (with)
1617
import Data.Conduit
1718
import qualified Data.Conduit.List as CL
1819
import Data.Either (partitionEithers)
20+
import Data.FileEmbed (embedFileRelative)
1921
import Data.List as List
2022
import qualified Data.List.NonEmpty as NEL
2123
import Data.Map (Map)
2224
import qualified Data.Map as Map
2325
import Data.Maybe
26+
import Data.Set (Set)
2427
import qualified Data.Set as Set
2528
import Data.Text (Text)
2629
import qualified Data.Text as T
@@ -97,7 +100,7 @@ data EntitySchemaState
97100

98101
-- | Information about an existing table in the database
99102
data ExistingEntitySchemaState = ExistingEntitySchemaState
100-
{ essColumns :: Map FieldNameDB (Column, [ColumnReference])
103+
{ essColumns :: Map FieldNameDB (Column, (Set ColumnReference))
101104
-- ^ The columns in this entity, together with the set of foreign key
102105
-- constraints that they are subject to. Usually the ColumnReference list
103106
-- will contain 0-1 elements, but in the event that there are multiple FK
@@ -141,7 +144,7 @@ collectSchemaState getStmt entityNames = runExceptT $ do
141144
( cName c
142145
,
143146
( c
144-
, fromMaybe [] $
147+
, fromMaybe Set.empty $
145148
Map.lookup (cName c) =<< Map.lookup entityNameDB foreignKeyReferences
146149
)
147150
)
@@ -441,7 +444,7 @@ getConstraints getStmt entityNames = do
441444
getForeignKeyReferences
442445
:: (Text -> IO Statement)
443446
-> [EntityNameDB]
444-
-> ExceptT Text IO (Map EntityNameDB (Map FieldNameDB [ColumnReference]))
447+
-> ExceptT Text IO (Map EntityNameDB (Map FieldNameDB (Set ColumnReference)))
445448
getForeignKeyReferences getStmt entityNames = do
446449
results <-
447450
liftIO $
@@ -451,37 +454,14 @@ getForeignKeyReferences getStmt entityNames = do
451454
[PersistArray (map (PersistText . unEntityNameDB) entityNames)]
452455
processForeignKeyReference
453456
case partitionEithers results of
454-
([], xs) -> pure $ Map.unionsWith (Map.unionWith (<>)) xs
457+
([], xs) -> pure $ Map.unionsWith (Map.unionWith Set.union) xs
455458
(errs, _) -> throwError (T.intercalate "\n" errs)
456459
where
457-
-- TODO: should this filter by schema?
458-
getForeignKeyReferencesSql =
459-
T.concat
460-
[ "SELECT DISTINCT "
461-
, "kcu.table_name, "
462-
, "kcu.column_name, "
463-
, "ccu.table_name, "
464-
, "tc.constraint_name, "
465-
, "rc.update_rule, "
466-
, "rc.delete_rule "
467-
, "FROM information_schema.constraint_column_usage ccu "
468-
, "INNER JOIN information_schema.key_column_usage kcu "
469-
, " ON ccu.constraint_name = kcu.constraint_name "
470-
, "INNER JOIN information_schema.table_constraints tc "
471-
, " ON tc.constraint_name = kcu.constraint_name "
472-
, "LEFT JOIN information_schema.referential_constraints AS rc"
473-
, " ON rc.constraint_name = ccu.constraint_name "
474-
, "WHERE tc.constraint_type='FOREIGN KEY' "
475-
, "AND kcu.ordinal_position=1 "
476-
, "AND kcu.table_name=ANY (?) "
477-
, -- Define an explicit ordering just to be sure that in the event we
478-
-- have bugs here, they can be reproduced consistently
479-
"ORDER BY 1, 2, 3, 4"
480-
]
460+
getForeignKeyReferencesSql = T.decodeUtf8 $(embedFileRelative "sql/getForeignKeyReferences.sql")
481461

482462
processForeignKeyReference
483463
:: [PersistValue]
484-
-> Either Text (Map EntityNameDB (Map FieldNameDB [ColumnReference]))
464+
-> Either Text (Map EntityNameDB (Map FieldNameDB (Set ColumnReference)))
485465
processForeignKeyReference resultRow = do
486466
( sourceTableName
487467
, sourceColumnName
@@ -491,18 +471,19 @@ getForeignKeyReferences getStmt entityNames = do
491471
, delRule
492472
) <-
493473
case resultRow of
494-
[ PersistText srcTable
495-
, PersistText srcColumn
474+
[ PersistText constrName
475+
, PersistText srcTable
496476
, PersistText refTable
497-
, PersistText constraint
477+
, PersistText srcColumn
478+
, PersistText _refColumn
498479
, PersistText updRule
499480
, PersistText delRule
500481
] ->
501482
pure
502483
( EntityNameDB srcTable
503484
, FieldNameDB srcColumn
504485
, EntityNameDB refTable
505-
, ConstraintNameDB constraint
486+
, ConstraintNameDB constrName
506487
, updRule
507488
, delRule
508489
)
@@ -525,20 +506,23 @@ getForeignKeyReferences getStmt entityNames = do
525506
}
526507

527508
pure $
528-
Map.singleton sourceTableName (Map.singleton sourceColumnName [columnRef])
509+
Map.singleton
510+
sourceTableName
511+
(Map.singleton sourceColumnName (Set.singleton columnRef))
529512

513+
-- Parse a cascade action as represented in pg_constraint
530514
parseCascade :: Text -> Either Text CascadeAction
531515
parseCascade txt =
532516
case txt of
533-
"NO ACTION" ->
517+
"a" ->
534518
Right NoAction
535-
"CASCADE" ->
519+
"c" ->
536520
Right Cascade
537-
"SET NULL" ->
521+
"n" ->
538522
Right SetNull
539-
"SET DEFAULT" ->
523+
"d" ->
540524
Right SetDefault
541-
"RESTRICT" ->
525+
"r" ->
542526
Right Restrict
543527
_ ->
544528
Left $ "Unexpected value in parseCascade: " <> txt

‎persistent-postgresql/persistent-postgresql.cabal‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ cabal-version: >=1.10
1212
build-type: Simple
1313
homepage: http://www.yesodweb.com/book/persistent
1414
bug-reports: https://github.com/yesodweb/persistent/issues
15-
extra-source-files: ChangeLog.md
15+
extra-source-files: ChangeLog.md sql/*.sql
1616

1717
library
1818
build-depends:
@@ -23,6 +23,7 @@ library
2323
, bytestring >=0.10
2424
, conduit >=1.2.12
2525
, containers >=0.5
26+
, file-embed >=0.0.16
2627
, monad-logger >=0.3.25
2728
, mtl
2829
, persistent >=2.18 && <3

‎persistent-postgresql/sql/getForeignKeyReferences.sql‎

Lines changed: 84 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,84 @@
1+
-- Get all foreign key references among the given set of table names in the
2+
-- current namespace/schema. This query is used by the migrator to check whether
3+
-- foreign key definitions are up to date.
4+
--
5+
-- This query takes one parameter: an array of table names.
6+
with
7+
foreign_constraints as (
8+
select
9+
c.*
10+
from
11+
pg_constraint AS c
12+
inner join pg_class src_table
13+
on src_table.oid = c.conrelid
14+
inner join pg_namespace ns
15+
on ns.oid = c.connamespace
16+
where
17+
-- f = foreign key constraint
18+
c.contype = 'f'
19+
and src_table.relname = ANY (?)
20+
and ns.nspname = current_schema()
21+
),
22+
foreign_constraint_with_source_columns as (
23+
select
24+
c.oid,
25+
array_agg(
26+
a.attname::text
27+
ORDER BY
28+
k.n ASC
29+
) as column_names
30+
from
31+
foreign_constraints AS c
32+
-- conkey is a list of the column indices on the source
33+
-- table
34+
CROSS JOIN LATERAL unnest(c.conkey) WITH ORDINALITY AS k (attnum, n)
35+
INNER JOIN pg_attribute AS a
36+
-- conrelid is the id of the source table
37+
ON k.attnum = a.attnum AND c.conrelid = a.attrelid
38+
group by
39+
c.oid
40+
),
41+
foreign_constraint_with_foreign_columns as (
42+
select
43+
c.oid,
44+
array_agg(
45+
a.attname::text
46+
ORDER BY
47+
k.n ASC
48+
) as foreign_column_names
49+
from
50+
foreign_constraints AS c
51+
-- confkey is a list of the column indices on the foreign
52+
-- table
53+
CROSS JOIN LATERAL unnest(c.confkey) WITH ORDINALITY AS k (attnum, n)
54+
JOIN pg_attribute AS a
55+
-- confrelid is the id of the foreign table
56+
ON k.attnum = a.attnum AND c.confrelid = a.attrelid
57+
group by
58+
c.oid
59+
)
60+
SELECT
61+
fkey_constraint.conname::text as fkey_name,
62+
src_table.relname::text AS source_table,
63+
foreign_table.relname::text AS referenced_table,
64+
-- NB: postgres arrays are one-indexed!
65+
src_columns.column_names[1],
66+
foreign_columns.foreign_column_names[1],
67+
fkey_constraint.confupdtype,
68+
fkey_constraint.confdeltype
69+
from
70+
foreign_constraints AS fkey_constraint
71+
inner join foreign_constraint_with_source_columns src_columns
72+
on src_columns.oid = fkey_constraint.oid
73+
inner join foreign_constraint_with_foreign_columns foreign_columns
74+
on foreign_columns.oid = fkey_constraint.oid
75+
inner join pg_class src_table
76+
on src_table.oid = fkey_constraint.conrelid
77+
inner join pg_class foreign_table
78+
on foreign_table.oid = fkey_constraint.confrelid
79+
80+
-- In the future, we may want to look at multi-column FK constraints too. but
81+
-- for now we only care about single-column constraints.
82+
where
83+
array_length(src_columns.column_names, 1) = 1
84+
and array_length(foreign_columns.foreign_column_names, 1) = 1;

‎persistent-postgresql/test/MigrationSpec.hs‎

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ import PgInit
1919

2020
import Data.Foldable (traverse_)
2121
import qualified Data.Map as Map
22+
import qualified Data.Set as Set
2223
import Data.Proxy
2324
import qualified Data.Text as T
2425
import Database.Persist.Postgresql.Internal.Migration
@@ -185,7 +186,7 @@ spec = describe "MigrationSpec" $ do
185186

186187
let
187188
expected =
188-
( SchemaState
189+
SchemaState
189190
( Map.fromList
190191
[
191192
( EntityNameDB{unEntityNameDB = "admin_users"}
@@ -206,7 +207,7 @@ spec = describe "MigrationSpec" $ do
206207
, cMaxLen = Nothing
207208
, cReference = Nothing
208209
}
209-
,
210+
, Set.fromList
210211
[ ColumnReference
211212
{ crTableName = EntityNameDB{unEntityNameDB = "users"}
212213
, crConstraintName =
@@ -230,7 +231,7 @@ spec = describe "MigrationSpec" $ do
230231
, cMaxLen = Nothing
231232
, cReference = Nothing
232233
}
233-
,
234+
, Set.fromList
234235
[ ColumnReference
235236
{ crTableName = EntityNameDB{unEntityNameDB = "users"}
236237
, crConstraintName =
@@ -272,7 +273,7 @@ spec = describe "MigrationSpec" $ do
272273
, cMaxLen = Nothing
273274
, cReference = Nothing
274275
}
275-
, []
276+
, Set.fromList []
276277
)
277278
)
278279
,
@@ -288,7 +289,7 @@ spec = describe "MigrationSpec" $ do
288289
, cMaxLen = Nothing
289290
, cReference = Nothing
290291
}
291-
, []
292+
, Set.fromList []
292293
)
293294
)
294295
,
@@ -304,7 +305,7 @@ spec = describe "MigrationSpec" $ do
304305
, cMaxLen = Nothing
305306
, cReference = Nothing
306307
}
307-
,
308+
, Set.fromList
308309
[ ColumnReference
309310
{ crTableName = EntityNameDB{unEntityNameDB = "users"}
310311
, crConstraintName =
@@ -345,7 +346,7 @@ spec = describe "MigrationSpec" $ do
345346
, cMaxLen = Nothing
346347
, cReference = Nothing
347348
}
348-
, []
349+
, Set.fromList []
349350
)
350351
)
351352
,
@@ -361,7 +362,7 @@ spec = describe "MigrationSpec" $ do
361362
, cMaxLen = Nothing
362363
, cReference = Nothing
363364
}
364-
, []
365+
, Set.fromList []
365366
)
366367
)
367368
,
@@ -377,7 +378,7 @@ spec = describe "MigrationSpec" $ do
377378
, cMaxLen = Nothing
378379
, cReference = Nothing
379380
}
380-
,
381+
, Set.fromList
381382
[ ColumnReference
382383
{ crTableName = EntityNameDB{unEntityNameDB = "users"}
383384
, crConstraintName =
@@ -425,7 +426,7 @@ spec = describe "MigrationSpec" $ do
425426
, cMaxLen = Nothing
426427
, cReference = Nothing
427428
}
428-
, []
429+
, Set.fromList []
429430
)
430431
)
431432
,
@@ -441,7 +442,7 @@ spec = describe "MigrationSpec" $ do
441442
, cMaxLen = Nothing
442443
, cReference = Nothing
443444
}
444-
,
445+
, Set.fromList
445446
[ ColumnReference
446447
{ crTableName = EntityNameDB{unEntityNameDB = "users"}
447448
, crConstraintName =
@@ -465,7 +466,7 @@ spec = describe "MigrationSpec" $ do
465466
, cMaxLen = Nothing
466467
, cReference = Nothing
467468
}
468-
,
469+
, Set.fromList
469470
[ ColumnReference
470471
{ crTableName = EntityNameDB{unEntityNameDB = "users"}
471472
, crConstraintName =
@@ -500,7 +501,7 @@ spec = describe "MigrationSpec" $ do
500501
, cMaxLen = Nothing
501502
, cReference = Nothing
502503
}
503-
, []
504+
, Set.fromList []
504505
)
505506
)
506507
,
@@ -516,7 +517,7 @@ spec = describe "MigrationSpec" $ do
516517
, cMaxLen = Nothing
517518
, cReference = Nothing
518519
}
519-
, []
520+
, Set.fromList []
520521
)
521522
)
522523
,
@@ -532,7 +533,7 @@ spec = describe "MigrationSpec" $ do
532533
, cMaxLen = Nothing
533534
, cReference = Nothing
534535
}
535-
, []
536+
, Set.fromList []
536537
)
537538
)
538539
]
@@ -542,7 +543,6 @@ spec = describe "MigrationSpec" $ do
542543
)
543544
]
544545
)
545-
)
546546

547547
actual `shouldBe` Right expected
548548

0 commit comments

Comments
 (0)