fixup! Normalize index identifiers on construction

Author: crtschin

src/Database/PostgreSQL/PQTypes/Checks.hs

@@ -752,7 +752,7 @@ checkDBStructure options tables = fmap mconcat . forM tables $ \(table, version)
                 <> map localIndexInfo localIndexes
           where
             checkIndexName (idx, name)
-              | name `elem` indexNames tblName idx = mempty
+              | acceptsIndexName tblName idx name = mempty
               | otherwise =
                   validationError . mconcat $
                     [ "Property "

src/Database/PostgreSQL/PQTypes/Model/Index.hs

@@ -14,7 +14,7 @@ module Database.PostgreSQL.PQTypes.Model.Index
   , uniqueIndexOnColumnWithCondition
   , uniqueIndexOnColumns
   , indexName
-  , indexNames
+  , acceptsIndexName
   , IncludeColumn (unIncludeColumn)
   , includeColumn
   , sqlCreateIndexMaybeDowntime
@@ -185,34 +185,43 @@ uniqueIndexOnColumnWithCondition column whereC =
 
 -- | Canonical auto-generated name for an index.
 indexName :: RawSQL () -> TableIndex -> RawSQL ()
-indexName = indexNameImpl id
-
--- | Index names accepted by 'Database.PostgreSQL.PQTypes.Checks.checkDatabase'.
-indexNames :: RawSQL () -> TableIndex -> [RawSQL ()]
-indexNames tname idx =
-  [ indexName tname idx
-  , -- The legacy entry, reconstructed the name that older versions produced for
-    -- keyword columns.
-    indexNameImpl (\t -> "\"" <> t <> "\"") tname idx
-  ]
-
-indexNameImpl :: (T.Text -> T.Text) -> RawSQL () -> TableIndex -> RawSQL ()
-indexNameImpl preSanitize tname TableIndex {..} =
+indexName = indexNameWith []
+
+-- | True if @dbName@ is an acceptable index name for @idx@ on @tname@.
+-- Also accepts the legacy form where quoted identifiers appeared as
+-- @$ident$@ in the name.
+acceptsIndexName :: RawSQL () -> TableIndex -> RawSQL () -> Bool
+acceptsIndexName tname idx@TableIndex {..} dbName =
+  indexNameWith mask tname idx == dbName
+  where
+    dbNameText = unRawSQL dbName
+    wasQuoted ident = T.isInfixOf ("$" <> unRawSQL ident <> "$") dbNameText
+    mask =
+      map (wasQuoted . indexColumnName) idxColumns
+        ++ map (wasQuoted . unIncludeColumn) idxInclude
+
+-- | Generate an index name where each identifier (key columns first, then
+-- include columns) is wrapped in double quotes if the corresponding entry
+-- in the mask is 'True'. Positions beyond the mask default to bare.
+indexNameWith :: [Bool] -> RawSQL () -> TableIndex -> RawSQL ()
+indexNameWith mask tname TableIndex {..} =
   flip rawSQL () $
     T.take 63 . unRawSQL $
       mconcat
         [ if idxUnique then "unique_idx__" else "idx__"
         , tname
         , "__"
-        , mintercalate "__" $ map (asText normalize . indexColumnName) idxColumns
+        , mintercalate "__" $ zipWith renderIdent colMask (map indexColumnName idxColumns)
         , if null idxInclude
             then ""
-            else "$$" <> mintercalate "__" (map (asText normalize . unIncludeColumn) idxInclude)
+            else "$$" <> mintercalate "__" (zipWith renderIdent incMask (map unIncludeColumn idxInclude))
         , maybe "" (("__" <>) . hashWhere) idxWhere
         ]
   where
-    asText f = flip rawSQL () . f . unRawSQL
-    normalize = sanitize . preSanitize
+    (colMask, incMask) = splitAt (length idxColumns) (mask ++ repeat False)
+    renderIdent quoted ident =
+      flip rawSQL () . sanitize $
+        if quoted then "\"" <> unRawSQL ident <> "\"" else unRawSQL ident
     -- See http://www.postgresql.org/docs/9.4/static/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS.
     -- Remove all unallowed characters and replace them by at most one adjacent dollar sign.
     sanitize = T.pack . foldr go [] . T.unpack
@@ -226,12 +235,13 @@ indexNameImpl preSanitize tname TableIndex {..} =
     -- hash WHERE clause and add it to index name so that indexes
     -- with the same columns, but different constraints can coexist
     hashWhere =
-      asText $
-        T.decodeUtf8
-          . B16.encode
-          . BS.take 10
-          . RIPEMD160.hash
-          . T.encodeUtf8
+      flip rawSQL ()
+        . T.decodeUtf8
+        . B16.encode
+        . BS.take 10
+        . RIPEMD160.hash
+        . T.encodeUtf8
+        . unRawSQL
 
 -- | Create an index. Warning: if the affected table is large, this will prevent
 -- the table from being modified during the creation. If this is not acceptable,