refactor: Split up Types.hs and logically organize modules (#1793)

src/PostgREST/DbStructure/Identifiers.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric  #-}
+
+module PostgREST.DbStructure.Identifiers
+  ( QualifiedIdentifier(..)
+  , Schema
+  , TableName
+  , FieldName
+  ) where
+
+import qualified Data.Aeson as JSON
+
+import Protolude
+
+
+-- | Represents a pg identifier with a prepended schema name "schema.table".
+-- When qiSchema is "", the schema is defined by the pg search_path.
+data QualifiedIdentifier = QualifiedIdentifier
+  { qiSchema :: Schema
+  , qiName   :: TableName
+  }
+  deriving (Eq, Ord, Generic, JSON.ToJSON, JSON.ToJSONKey)
+
+instance Hashable QualifiedIdentifier
+
+type Schema = Text
+type TableName = Text
+type FieldName = Text

src/PostgREST/DbStructure/PgVersion.hs

@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric  #-}
+module PostgREST.DbStructure.PgVersion
+  ( PgVersion(..)
+  , minimumPgVersion
+  , pgVersion95
+  , pgVersion96
+  , pgVersion100
+  , pgVersion109
+  , pgVersion110
+  , pgVersion112
+  , pgVersion114
+  , pgVersion121
+  , pgVersion130
+  ) where
+
+import qualified Data.Aeson as JSON
+
+import Protolude
+
+
+data PgVersion = PgVersion
+  { pgvNum  :: Int32
+  , pgvName :: Text
+  }
+  deriving (Eq, Generic, JSON.ToJSON)
+
+instance Ord PgVersion where
+  (PgVersion v1 _) `compare` (PgVersion v2 _) = v1 `compare` v2
+
+-- | Tells the minimum PostgreSQL version required by this version of PostgREST
+minimumPgVersion :: PgVersion
+minimumPgVersion = pgVersion95
+
+pgVersion95 :: PgVersion
+pgVersion95 = PgVersion 90500 "9.5"
+
+pgVersion96 :: PgVersion
+pgVersion96 = PgVersion 90600 "9.6"
+
+pgVersion100 :: PgVersion
+pgVersion100 = PgVersion 100000 "10"
+
+pgVersion109 :: PgVersion
+pgVersion109 = PgVersion 100009 "10.9"
+
+pgVersion110 :: PgVersion
+pgVersion110 = PgVersion 110000 "11.0"
+
+pgVersion112 :: PgVersion
+pgVersion112 = PgVersion 110002 "11.2"
+
+pgVersion114 :: PgVersion
+pgVersion114 = PgVersion 110004 "11.4"
+
+pgVersion121 :: PgVersion
+pgVersion121 = PgVersion 120001 "12.1"
+
+pgVersion130 :: PgVersion
+pgVersion130 = PgVersion 130000 "13.0"

src/PostgREST/DbStructure/Proc.hs

@@ -0,0 +1,120 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric  #-}
+
+module PostgREST.DbStructure.Proc
+  ( PgArg(..)
+  , PgType(..)
+  , ProcDescription(..)
+  , ProcVolatility(..)
+  , ProcsMap
+  , RetType(..)
+  , findProc
+  , procReturnsScalar
+  , procReturnsSingle
+  , procTableName
+  , specifiedProcArgs
+  ) where
+
+import qualified Data.Aeson          as JSON
+import qualified Data.HashMap.Strict as M
+import qualified Data.Set            as S
+
+import PostgREST.DbStructure.Identifiers (FieldName,
+                                          QualifiedIdentifier (..),
+                                          Schema, TableName)
+
+import Protolude
+
+
+data PgArg = PgArg
+  { pgaName :: Text
+  , pgaType :: Text
+  , pgaReq  :: Bool
+  , pgaVar  :: Bool
+  }
+  deriving (Eq, Ord, Generic, JSON.ToJSON)
+
+data PgType
+  = Scalar
+  | Composite QualifiedIdentifier
+  deriving (Eq, Ord, Generic, JSON.ToJSON)
+
+data RetType
+  = Single PgType
+  | SetOf PgType
+  deriving (Eq, Ord, Generic, JSON.ToJSON)
+
+data ProcVolatility
+  = Volatile
+  | Stable
+  | Immutable
+  deriving (Eq, Ord, Generic, JSON.ToJSON)
+
+data ProcDescription = ProcDescription
+  { pdSchema      :: Schema
+  , pdName        :: Text
+  , pdDescription :: Maybe Text
+  , pdArgs        :: [PgArg]
+  , pdReturnType  :: RetType
+  , pdVolatility  :: ProcVolatility
+  , pdHasVariadic :: Bool
+  }
+  deriving (Eq, Generic, JSON.ToJSON)
+
+-- Order by least number of args in the case of overloaded functions
+instance Ord ProcDescription where
+  ProcDescription schema1 name1 des1 args1 rt1 vol1 hasVar1 `compare` ProcDescription schema2 name2 des2 args2 rt2 vol2 hasVar2
+    | schema1 == schema2 && name1 == name2 && length args1 < length args2  = LT
+    | schema2 == schema2 && name1 == name2 && length args1 > length args2  = GT
+    | otherwise = (schema1, name1, des1, args1, rt1, vol1, hasVar1) `compare` (schema2, name2, des2, args2, rt2, vol2, hasVar2)
+
+-- | A map of all procs, all of which can be overloaded(one entry will have more than one ProcDescription).
+-- | It uses a HashMap for a faster lookup.
+type ProcsMap = M.HashMap QualifiedIdentifier [ProcDescription]
+
+{-|
+  Search a pg procedure by its parameters. Since a function can be overloaded, the name is not enough to find it.
+  An overloaded function can have a different volatility or even a different return type.
+  Ideally, handling overloaded functions should be left to pg itself. But we need to know certain proc attributes in advance.
+-}
+findProc :: QualifiedIdentifier -> S.Set Text -> Bool -> ProcsMap -> ProcDescription
+findProc qi payloadKeys paramsAsSingleObject allProcs = fromMaybe fallback bestMatch
+  where
+    -- instead of passing Maybe ProcDescription around, we create a fallback description here when we can't find a matching function
+    -- args is empty, but because "specifiedProcArgs" will fill the missing arguments with default type text, this is not a problem
+    fallback = ProcDescription (qiSchema qi) (qiName qi) Nothing mempty (SetOf $ Composite $ QualifiedIdentifier mempty "record") Volatile False
+    bestMatch =
+      case M.lookup qi allProcs of
+        Nothing     -> Nothing
+        Just [proc] -> Just proc           -- if it's not an overloaded function then immediately get the ProcDescription
+        Just procs  -> find matches procs  -- Handle overloaded functions case
+    matches proc =
+      if paramsAsSingleObject
+        -- if the arg is not of json type let the db give the err
+        then length (pdArgs proc) == 1
+        else payloadKeys `S.isSubsetOf` S.fromList (pgaName <$> pdArgs proc)
+
+{-|
+  Search the procedure parameters by matching them with the specified keys.
+  If the key doesn't match a parameter, a parameter with a default type "text" is assumed.
+-}
+specifiedProcArgs :: S.Set FieldName -> ProcDescription -> [PgArg]
+specifiedProcArgs keys proc =
+  (\k -> fromMaybe (PgArg k "text" True False) (find ((==) k . pgaName) (pdArgs proc))) <$> S.toList keys
+
+procReturnsScalar :: ProcDescription -> Bool
+procReturnsScalar proc = case proc of
+  ProcDescription{pdReturnType = (Single Scalar)} -> True
+  ProcDescription{pdReturnType = (SetOf Scalar)}  -> True
+  _                                               -> False
+
+procReturnsSingle :: ProcDescription -> Bool
+procReturnsSingle proc = case proc of
+  ProcDescription{pdReturnType = (Single _)} -> True
+  _                                          -> False
+
+procTableName :: ProcDescription -> Maybe TableName
+procTableName proc = case pdReturnType proc of
+  SetOf  (Composite qi) -> Just $ qiName qi
+  Single (Composite qi) -> Just $ qiName qi
+  _                     -> Nothing

src/PostgREST/DbStructure/Relation.hs

@@ -0,0 +1,76 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric  #-}
+
+module PostgREST.DbStructure.Relation
+  ( Cardinality(..)
+  , Constraint
+  , ForeignKey(..)
+  , Link(..)
+  , PrimaryKey(..)
+  , Relation(..)
+  , isSelfReference
+  ) where
+
+import qualified Data.Aeson as JSON
+
+import PostgREST.DbStructure.Table (Column (..), ForeignKey (..),
+                                    Table (..))
+
+import qualified GHC.Show (show)
+
+import Protolude
+
+
+-- | "Relation"ship between two tables.
+--
+-- The order of the relColumns and relFColumns should be maintained to get the
+-- join conditions right.
+--
+-- TODO merge relColumns and relFColumns to a tuple or Data.Bimap
+data Relation = Relation
+  { relTable    :: Table
+  , relColumns  :: [Column]
+  , relFTable   :: Table
+  , relFColumns :: [Column]
+  , relType     :: Cardinality
+  , relLink     :: Link -- ^ Constraint on O2M/M2O, Junction for M2M Cardinality
+  }
+  deriving (Eq, Generic, JSON.ToJSON)
+
+type ConstraintName = Text
+
+-- | Junction table on an M2M relationship
+data Link
+  = Constraint
+      { constName :: ConstraintName }
+  | Junction
+      { junTable :: Table
+      , junLink1 :: Link
+      , junCols1 :: [Column]
+      , junLink2 :: Link
+      , junCols2 :: [Column]
+      }
+  deriving (Eq, Generic, JSON.ToJSON)
+
+data PrimaryKey = PrimaryKey
+  { pkTable :: Table
+  , pkName  :: Text
+  }
+  deriving (Generic, JSON.ToJSON)
+
+-- | The relationship
+-- [cardinality](https://en.wikipedia.org/wiki/Cardinality_(data_modeling)).
+-- TODO: missing one-to-one
+data Cardinality
+  = O2M -- ^ one-to-many,  previously known as Parent
+  | M2O -- ^ many-to-one,  previously known as Child
+  | M2M -- ^ many-to-many, previously known as Many
+  deriving (Eq, Generic, JSON.ToJSON)
+
+instance Show Cardinality where
+  show O2M = "o2m"
+  show M2O = "m2o"
+  show M2M = "m2m"
+
+isSelfReference :: Relation -> Bool
+isSelfReference r = relTable r == relFTable r

src/PostgREST/DbStructure/Table.hs

@@ -0,0 +1,58 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric  #-}
+
+module PostgREST.DbStructure.Table
+  ( Column(..)
+  , ForeignKey(..)
+  , Table(..)
+  , tableQi
+  ) where
+
+import qualified Data.Aeson as JSON
+
+import PostgREST.DbStructure.Identifiers (FieldName,
+                                          QualifiedIdentifier (..),
+                                          Schema, TableName)
+
+import Protolude
+
+
+data Table = Table
+  { tableSchema      :: Schema
+  , tableName        :: TableName
+  , tableDescription :: Maybe Text
+  , tableInsertable  :: Bool
+  }
+  deriving (Show, Ord, Generic, JSON.ToJSON)
+
+instance Eq Table where
+  Table{tableSchema=s1,tableName=n1} == Table{tableSchema=s2,tableName=n2} = s1 == s2 && n1 == n2
+
+tableQi :: Table -> QualifiedIdentifier
+tableQi Table{tableSchema=s, tableName=n} = QualifiedIdentifier s n
+
+newtype ForeignKey = ForeignKey
+  { fkCol :: Column }
+  deriving (Eq, Ord, Generic, JSON.ToJSON)
+
+data Column = Column
+  { colTable       :: Table
+  , colName        :: FieldName
+  , colDescription :: Maybe Text
+  , colNullable    :: Bool
+  , colType        :: Text
+  , colMaxLen      :: Maybe Int32
+  , colDefault     :: Maybe Text
+  , colEnum        :: [Text]
+  , colFK          :: Maybe ForeignKey
+  }
+  deriving (Ord, Generic, JSON.ToJSON)
+
+instance Eq Column where
+  Column{colTable=t1,colName=n1} == Column{colTable=t2,colName=n2} = t1 == t2 && n1 == n2
+
+data PrimaryKey = PrimaryKey
+  { pkTable :: Table
+  , pkName  :: Text
+  }
+  deriving (Generic, JSON.ToJSON)