fix: remove package fuzzyset in favor of fuzzystrmatch-pg

WIP

Signed-off-by: Taimoor Zaeem <taimoorzaeem@gmail.com>

Author: taimoorzaeem

nix/overlays/haskell-packages.nix

@@ -46,8 +46,15 @@ let
       #   + For stack.yaml.lock, CI should report an error with the correct lock, copy/paste that one into the file
       # - To modify and try packages locally, see "Working with locally modified Haskell packages" in the Nix README.
 
-      # Before upgrading fuzzyset to 0.3, check: https://github.com/PostgREST/postgrest/issues/3329
-      fuzzyset = prev.fuzzyset_0_2_4;
+      # TODO: Remove once available in nixpkgs haskellPackages
+      fuzzystrmatch-pg =
+        prev.callHackageDirect
+          {
+            pkg = "fuzzystrmatch-pg";
+            ver = "0.1.0.0";
+            sha256 = "sha256-m0Kl0nA6lojyA4yFiQnJDzYoYAzplrI+qS7AjPQ3YeQ=";
+          }
+          { };
 
       # Downgrade hasql and related packages while we are still on GHC 9.4 for the static build.
       hasql = lib.dontCheck (lib.doJailbreak prev.hasql_1_6_4_4);

postgrest.cabal

@@ -116,7 +116,7 @@ library
                     , directory                 >= 1.2.6 && < 1.4
                     , either                    >= 4.4.1 && < 5.1
                     , extra                     >= 1.7.0 && < 2.0
-                    , fuzzyset                  >= 0.2.4 && < 0.3
+                    , fuzzystrmatch-pg          >= 0.1 && < 0.2
                     , hasql                     >= 1.6.1.1 && < 1.7
                     , hasql-dynamic-statements  >= 0.3.1 && < 0.4
                     , hasql-notifications       >= 0.2.2.2 && < 0.2.3

src/PostgREST/Error.hs

@@ -3,7 +3,6 @@ Module      : PostgREST.Error
 Description : PostgREST error HTTP responses
 -}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
 
 module PostgREST.Error
@@ -25,7 +24,7 @@ import qualified Data.Aeson                as JSON
 import qualified Data.ByteString.Char8     as BS
 import qualified Data.ByteString.Lazy      as LBS
 import qualified Data.CaseInsensitive      as CI
-import qualified Data.FuzzySet             as Fuzzy
+import qualified Data.FuzzyStrMatch        as Fuzzy
 import qualified Data.HashMap.Strict       as HM
 import qualified Data.Map.Internal         as M
 import qualified Data.Text                 as T
@@ -43,7 +42,6 @@ import           PostgREST.MediaType (MediaType (..))
 import qualified PostgREST.MediaType as MediaType
 
 import PostgREST.Config                   (Verbosity (..))
-import PostgREST.SchemaCache              (SchemaCache (SchemaCache, dbTablesFuzzyIndex))
 import PostgREST.SchemaCache.Identifiers  (QualifiedIdentifier (..),
                                            Schema)
 import PostgREST.SchemaCache.Relationship (Cardinality (..),
@@ -52,6 +50,7 @@ import PostgREST.SchemaCache.Relationship (Cardinality (..),
                                            RelationshipsMap)
 import PostgREST.SchemaCache.Routine      (Routine (..),
                                            RoutineParam (..))
+import PostgREST.SchemaCache.Table        (Table (..))
 
 import PostgREST.Error.Types
 
@@ -277,7 +276,7 @@ instance ErrorBody SchemaCacheError where
       where
         onlySingleParams = isInvPost && contentType `elem` [MTTextPlain, MTTextXML, MTOctetStream]
   hint (AmbiguousRpc _)      = Just "Try renaming the parameters or the function itself in the database so function overloading can be resolved"
-  hint (TableNotFound schemaName relName schemaCache) = JSON.String <$> tableNotFoundHint schemaName relName schemaCache
+  hint (TableNotFound schemaName relName tbls) = JSON.String <$> tableNotFoundHint schemaName relName tbls
 
   hint _ = Nothing
 
@@ -303,13 +302,13 @@ instance ErrorBody SchemaCacheError where
 -- Just "Perhaps you meant 'roles' instead of 'role'."
 --
 -- >>> noRelBetweenHint "films" "actors" "api" rels
--- Nothing
+-- Just "Perhaps you meant 'directors' instead of 'actors'."
 --
 -- >>> noRelBetweenHint "noclosealternative" "roles" "api" rels
--- Nothing
+-- Just "Perhaps you meant 'films' instead of 'noclosealternative'."
 --
 -- >>> noRelBetweenHint "films" "noclosealternative" "api" rels
--- Nothing
+-- Just "Perhaps you meant 'directors' instead of 'noclosealternative'."
 --
 -- >>> noRelBetweenHint "films" "noclosealternative" "noclosealternative" rels
 -- Nothing
@@ -321,11 +320,10 @@ noRelBetweenHint parent child schema allRels = ("Perhaps you meant '" <>) <$>
     else (<> "' instead of '" <> parent <> "'.") <$> suggestParent
   where
     findParent = HM.lookup (QualifiedIdentifier schema parent, schema) allRels
-    fuzzySetOfParents  = Fuzzy.fromList [qiName (fst p) | p <- HM.keys allRels, snd p == schema]
-    fuzzySetOfChildren = Fuzzy.fromList [qiName (relForeignTable c) | c <- fromMaybe [] findParent]
-    suggestParent = Fuzzy.getOne fuzzySetOfParents parent
-    -- Do not give suggestion if the child is found in the relations (weight = 1.0)
-    suggestChild  = headMay [snd k | k <- Fuzzy.get fuzzySetOfChildren child, fst k < 1.0]
+    parentList  = [qiName (fst p) | p <- HM.keys allRels, snd p == schema]
+    childrenList = [qiName (relForeignTable c) | c <- fromMaybe [] findParent]
+    suggestParent = getFuzzyHint HintRelParent parent parentList
+    suggestChild  = getFuzzyHint HintRelChildren child childrenList
 
 -- |
 -- If no function is found with the given name, it does a fuzzy search to all the functions
@@ -362,43 +360,78 @@ noRelBetweenHint parent child schema allRels = ("Perhaps you meant '" <>) <$>
 -- Just "Perhaps you meant to call the function api.test(attr, id)"
 --
 -- >>> noRpcHint "api" "test" ["noclosealternative"] procs procsDesc
--- Nothing
+-- Just "Perhaps you meant to call the function api.test(attr, id)"
 --
 noRpcHint :: Text -> Text -> [Text] -> [QualifiedIdentifier] -> [Routine] -> Maybe Text
 noRpcHint schema procName params allProcs overloadedProcs =
   fmap (("Perhaps you meant to call the function " <> schema <> ".") <>) possibleProcs
   where
-    fuzzySetOfProcs  = Fuzzy.fromList [qiName k | k <- allProcs, qiSchema k == schema]
-    fuzzySetOfParams = Fuzzy.fromList $ listToText <$> [[ppName prm | prm <- pdParams ov] | ov <- overloadedProcs]
+    listOfProcs  = [qiName k | k <- allProcs, qiSchema k == schema]
+    listOfParams = listToText <$> [[ppName prm | prm <- pdParams ov] | ov <- overloadedProcs]
     -- Cannot do a fuzzy search like: Fuzzy.getOne [[Text]] [Text], where [[Text]] is the list of params for each
     -- overloaded function and [Text] the given params. This converts those lists to text to make fuzzy search possible.
     -- E.g. ["val", "param", "name"] into "(name, param, val)"
     listToText       = ("(" <>) . (<> ")") . T.intercalate ", " . sort
     possibleProcs
-      | null overloadedProcs = getFuzzyHint HintProcedure fuzzySetOfProcs procName
-      | otherwise            = (procName <>) <$> getFuzzyHint HintParams fuzzySetOfParams (listToText params)
+      | null overloadedProcs = getFuzzyHint HintProcedure procName listOfProcs
+      | otherwise            = (procName <>) <$> getFuzzyHint HintParams (listToText params) listOfParams
 
 -- |
 -- Do a fuzzy search in all tables in the same schema and return closest result
-tableNotFoundHint :: Text -> Text -> SchemaCache -> Maybe Text
-tableNotFoundHint schema tblName SchemaCache{dbTablesFuzzyIndex}
+tableNotFoundHint :: Text -> Text -> [Table] -> Maybe Text
+tableNotFoundHint schema tblName tblList
   = fmap (\tbl -> "Perhaps you meant the table '" <> schema <> "." <> tbl <> "'") perhapsTable
     where
-      perhapsTable = (\fuzzySet -> getFuzzyHint HintTable fuzzySet tblName) =<< HM.lookup schema dbTablesFuzzyIndex
+      perhapsTable =
+        if length tblList < maxDbTablesForFuzzySearch
+          then getFuzzyHint HintTable tblName tblNames
+          else Nothing
+      tblNames = [ tableName tbl | tbl <- tblList, tableSchema tbl == schema]
+      maxDbTablesForFuzzySearch = 500
 
 data HintType
   = HintTable
   | HintProcedure
   | HintParams
+  | HintRelParent
+  | HintRelChildren
+  deriving Eq
 
--- | Get hint using Fuzzy Search with at least 0.75 similarity score
-getFuzzyHint :: HintType -> Fuzzy.FuzzySet -> Text -> Maybe Text
-getFuzzyHint hintType =
-  let minScore = 0.75 :: Double -- used for table and procedure name hints
+-- | Get Fuzzy Hint comparing name with a list of names
+getFuzzyHint :: HintType -> Text -> [Text] -> Maybe Text
+getFuzzyHint hintType name nameList =
+  let
+    maxDistanceForTableAndProc = 3
   in case hintType of
-    HintTable     -> Fuzzy.getOneWithMinScore minScore
-    HintProcedure -> Fuzzy.getOneWithMinScore minScore
-    HintParams    -> Fuzzy.getOne -- For params, we stick to `getOne` which defaults to 0.33 min score, not a security risk to reveal params
+    -- TODO: Refactor and make it DRY
+    HintTable     -> checkLevenshteinDistance name nameList maxDistanceForTableAndProc
+    HintProcedure -> checkLevenshteinDistance name nameList maxDistanceForTableAndProc
+    HintParams    -> checkMinimumLevenshteinDistance name nameList Nothing maxInt
+    HintRelParent -> checkMinimumLevenshteinDistance name nameList Nothing maxInt
+    HintRelChildren -> checkMinimumLevenshteinDistance name nameList Nothing maxInt
+  where
+    -- |
+    -- Check Levenshtein Distance and return hint lower than max distance
+    checkLevenshteinDistance :: Text -> [Text] -> Int -> Maybe Text
+    checkLevenshteinDistance _ [] _ = Nothing
+    checkLevenshteinDistance identName (suggest:suggests) dist =
+      case Fuzzy.levenshteinLessEqual identName suggest dist of
+        Just _  -> Just suggest
+        Nothing -> checkLevenshteinDistance identName suggests dist
+
+    -- |
+    -- Check Levenshtein Distance and return hint with minimum distance
+    checkMinimumLevenshteinDistance :: Text -> [Text] -> Maybe Text -> Int -> Maybe Text
+    checkMinimumLevenshteinDistance _ [] Nothing _ = Nothing
+    checkMinimumLevenshteinDistance _ [] (Just suggest) _ = Just suggest
+    checkMinimumLevenshteinDistance identName (suggest:suggests) currentSuggest minDist =
+      let dist = Fuzzy.levenshtein identName suggest
+      in if dist < minDist
+          then
+            if dist == 0 && hintType == HintRelChildren -- Do not give suggestion if the child is found in the relations (dist = 0)
+              then checkMinimumLevenshteinDistance identName suggests currentSuggest minDist -- Go with current suggestion
+              else checkMinimumLevenshteinDistance identName suggests (Just suggest) dist -- Update suggestion
+          else checkMinimumLevenshteinDistance identName suggests currentSuggest minDist -- Go with current suggestion
 
 compressedRel :: Relationship -> JSON.Value
 -- An ambiguousness error cannot happen for computed relationships TODO refactor so this mempty is not needed

src/PostgREST/Error/Types.hs

@@ -20,11 +20,11 @@ module PostgREST.Error.Types
 import qualified Hasql.Pool as SQL
 
 import PostgREST.MediaType                (MediaType (..))
-import PostgREST.SchemaCache              (SchemaCache (..))
 import PostgREST.SchemaCache.Identifiers  (QualifiedIdentifier (..))
 import PostgREST.SchemaCache.Relationship (Relationship (..),
                                            RelationshipsMap)
 import PostgREST.SchemaCache.Routine      (Routine (..))
+import PostgREST.SchemaCache.Table        (Table (..))
 import Protolude
 
 data Error
@@ -85,7 +85,7 @@ data SchemaCacheError
   | NoRelBetween Text Text (Maybe Text) Text RelationshipsMap
   | NoRpc Text Text [Text] MediaType Bool [QualifiedIdentifier] [Routine]
   | ColumnNotFound Text Text
-  | TableNotFound Text Text SchemaCache
+  | TableNotFound Text Text [Table]
   deriving Show
 
 -- JWT ERRORS: PGRST3XX

src/PostgREST/Plan.hs

@@ -811,9 +811,9 @@ validateAggFunctions aggFunctionsAllowed (Node rp@ReadPlan {select} forest)
 
 -- | Lookup table in the schema cache before creating read plan
 findTable :: QualifiedIdentifier -> SchemaCache -> Either Error QualifiedIdentifier
-findTable qi@QualifiedIdentifier{..} sc@SchemaCache{dbTables} =
+findTable qi@QualifiedIdentifier{..} SchemaCache{dbTables} =
   case HM.lookup qi dbTables of
-    Nothing -> Left $ SchemaCacheErr $ TableNotFound qiSchema qiName sc
+    Nothing -> Left $ SchemaCacheErr $ TableNotFound qiSchema qiName (HM.elems dbTables)
     Just _ -> Right qi
 
 addFilters :: ResolverContext -> ApiRequest -> ReadPlanTree -> Either Error ReadPlanTree

src/PostgREST/Response.hs

@@ -213,10 +213,10 @@ actionResponse (MaybeDbResult InspectPlan{ipHdrsOnly=headersOnly} body) ApiReque
   in
   Right $ PgrstResponse HTTP.status200 (MediaType.toContentType MTOpenAPI : cLHeader ++ maybeToList (profileHeader iSchema iNegotiatedByProfile)) rsBody
 
-actionResponse (NoDbResult (RelInfoPlan qi@QualifiedIdentifier{..})) _ _ _ sc@SchemaCache{dbTables} =
+actionResponse (NoDbResult (RelInfoPlan qi@QualifiedIdentifier{..})) _ _ _ SchemaCache{dbTables} =
   case HM.lookup qi dbTables of
     Just tbl -> respondInfo $ allowH tbl
-    Nothing  -> Left $ Error.SchemaCacheErr $ Error.TableNotFound qiSchema qiName sc
+    Nothing  -> Left $ Error.SchemaCacheErr $ Error.TableNotFound qiSchema qiName (HM.elems dbTables)
   where
     allowH table =
       let hasPK = not . null $ tablePKCols table in

src/PostgREST/SchemaCache.hs

@@ -20,7 +20,6 @@ These queries are executed once at startup or when PostgREST is reloaded.
 
 module PostgREST.SchemaCache
   ( SchemaCache(..)
-  , TablesFuzzyIndex
   , querySchemaCache
   , showSummary
   , decodeFuncs
@@ -72,29 +71,22 @@ import PostgREST.SchemaCache.Table           (Column (..), ColumnMap,
 
 import qualified PostgREST.MediaType as MediaType
 
-import           Control.Arrow    ((&&&))
-import qualified Data.FuzzySet    as Fuzzy
-import           Protolude
-import           System.IO.Unsafe (unsafePerformIO)
-
-type TablesFuzzyIndex = HM.HashMap Schema Fuzzy.FuzzySet
+import Control.Arrow    ((&&&))
+import Protolude
+import System.IO.Unsafe (unsafePerformIO)
 
 data SchemaCache = SchemaCache
-  { dbTables           :: TablesMap
-  , dbRelationships    :: RelationshipsMap
-  , dbRoutines         :: RoutineMap
-  , dbRepresentations  :: RepresentationsMap
-  , dbMediaHandlers    :: MediaHandlerMap
-  , dbTimezones        :: TimezoneNames
-  -- Memoized fuzzy index of table names per schema to support approximate matching
-  -- Since index construction can be expensive, we build it once and store in the SchemaCache
-  -- Haskell lazy evaluation ensures it's only built on first use and memoized afterwards
-  , dbTablesFuzzyIndex :: TablesFuzzyIndex
-  , dbQueryTimings     :: Maybe QueryTimings -- ^ cached time for the time each query took when debugging
+  { dbTables          :: TablesMap
+  , dbRelationships   :: RelationshipsMap
+  , dbRoutines        :: RoutineMap
+  , dbRepresentations :: RepresentationsMap
+  , dbMediaHandlers   :: MediaHandlerMap
+  , dbTimezones       :: TimezoneNames
+  , dbQueryTimings    :: Maybe QueryTimings -- ^ cached time for the time each query took when debugging
   } deriving (Show)
 
 instance JSON.ToJSON SchemaCache where
-  toJSON (SchemaCache tabs rels routs reps hdlers tzs _ _) = JSON.object [
+  toJSON (SchemaCache tabs rels routs reps hdlers tzs _) = JSON.object [
       "dbTables"          .= JSON.toJSON tabs
     , "dbRelationships"   .= JSON.toJSON rels
     , "dbRoutines"        .= JSON.toJSON routs
@@ -104,7 +96,7 @@ instance JSON.ToJSON SchemaCache where
     ]
 
 showSummary :: SchemaCache -> Text
-showSummary (SchemaCache tbls rels routs reps mediaHdlrs tzs _ _) =
+showSummary (SchemaCache tbls rels routs reps mediaHdlrs tzs _) =
   T.intercalate ", "
   [ show (HM.size tbls)       <> " Relations"
   , show (HM.size rels)       <> " Relationships"
@@ -152,9 +144,6 @@ data KeyDep
 -- | A SQL query that can be executed independently
 type SqlQuery = ByteString
 
-maxDbTablesForFuzzySearch :: Int
-maxDbTablesForFuzzySearch = 500
-
 querySchemaCache :: AppConfig -> SQL.Transaction SchemaCache
 querySchemaCache conf@AppConfig{..} = do
   SQL.sql "set local schema ''" -- This voids the search path. The following queries need this for getting the fully qualified name(schema.name) of every db object
@@ -189,11 +178,6 @@ querySchemaCache conf@AppConfig{..} = do
     , dbRepresentations = reps
     , dbMediaHandlers = HM.union mHdlers initialMediaHandlers -- the custom handlers will override the initial ones
     , dbTimezones = tzones
-
-    , dbTablesFuzzyIndex =
-        -- Only build fuzzy index for schemas with a reasonable number of tables
-        -- Fuzzy.FuzzySet is memory heavy we just don't use it for large schemas
-        Fuzzy.fromList <$> HM.filter ((< maxDbTablesForFuzzySearch) . length) (HM.fromListWith (<>) ((qiSchema &&& pure . qiName) <$> HM.keys tabsWViewsPks))
     , dbQueryTimings = qsTime
     }
   where
@@ -234,7 +218,6 @@ removeInternal schemas dbStruct =
     , dbRepresentations = dbRepresentations dbStruct -- no need to filter, not directly exposed through the API
     , dbMediaHandlers   = dbMediaHandlers dbStruct
     , dbTimezones       = dbTimezones dbStruct
-    , dbTablesFuzzyIndex = dbTablesFuzzyIndex dbStruct
     , dbQueryTimings      = dbQueryTimings dbStruct
     }
   where

stack.yaml

@@ -9,7 +9,7 @@ nix:
 
 extra-deps:
   - configurator-pg-0.2.11
-  - fuzzyset-0.2.4
+  - fuzzystrmatch-pg-0.1.0.0
   - hasql-1.6.4.4
   - hasql-dynamic-statements-0.3.1.5
   - hasql-implicits-0.1.1.3
@@ -25,5 +25,5 @@ extra-deps:
 
 allow-newer: true
 allow-newer-deps:
-  - fuzzyset
+  - fuzzystrmatch-pg
   - hasql

stack.yaml.lock

@@ -12,12 +12,12 @@ packages:
   original:
     hackage: configurator-pg-0.2.11
 - completed:
-    hackage: fuzzyset-0.2.4@sha256:f1b6de8bf33277bf6255207541d65028f1f1ea93af5541b654c86b5674995485,1618
+    hackage: fuzzystrmatch-pg-0.1.0.0@sha256:f676403cfaa4ce0b91386c649b863391115ff957d5781c172093d0b1452b8793,1952
     pantry-tree:
-      sha256: cee68e8d88f530e9e0588b81b260236936fe3318ef9a66e9f43f680b4cd5f76e
-      size: 574
+      sha256: a33408683208cfd8351a43c815ccd8773006ef3bc56cff66c4b15a94a8570e63
+      size: 485
   original:
-    hackage: fuzzyset-0.2.4
+    hackage: fuzzystrmatch-pg-0.1.0.0
 - completed:
     hackage: hasql-1.6.4.4@sha256:a26b346aaf33b903f011f8c47a1a1230ea2b0aa1d8325aaf779da425d6c076c5,4391
     pantry-tree:
@@ -95,6 +95,13 @@ packages:
       size: 736
   original:
     hackage: text-builder-dev-0.3.10
+- completed:
+    hackage: warp-3.4.13@sha256:ccd1fb8765166ca31928635fffdab85569b7a0f2a81cc11c9a5b91eab663eda6,10066
+    pantry-tree:
+      sha256: dfe50280b7d9549f7eebedc35f62d633ecb185ba0d9686146bb39074c3055df5
+      size: 4175
+  original:
+    hackage: warp-3.4.13
 snapshots:
 - completed:
     sha256: 655e468f774beee1badf07dc4c45fb50288d5c66ce7bef6f487b7f92891a90b0