From f169661ce6793d6032378e8761fe6b9948c2ad40 Mon Sep 17 00:00:00 2001 From: steve-chavez Date: Fri, 21 May 2021 00:39:24 -0500 Subject: [PATCH] refactor: move DbStructure.PgVersion to Config Now that PgVersion is not part of DbStructure, Config is a more apt module for it. Also rename getDbStructure to queryDbStructure. AppState also had a getDbStructure function for a record field. --- postgrest.cabal | 2 +- src/PostgREST/App.hs | 2 +- src/PostgREST/AppState.hs | 7 +++---- src/PostgREST/CLI.hs | 4 ++-- src/PostgREST/Config/Database.hs | 15 ++++++++++--- .../{DbStructure => Config}/PgVersion.hs | 2 +- src/PostgREST/Config/Proxy.hs | 1 - src/PostgREST/DbStructure.hs | 15 +++---------- src/PostgREST/Query/SqlFragment.hs | 2 +- src/PostgREST/Query/Statements.hs | 6 +++--- src/PostgREST/Workers.hs | 21 +++++++++---------- test/Feature/AndOrParamsSpec.hs | 2 +- test/Feature/AuthSpec.hs | 2 +- test/Feature/InsertSpec.hs | 4 ++-- test/Feature/JsonOperatorSpec.hs | 4 ++-- test/Feature/MultipleSchemaSpec.hs | 2 +- test/Feature/QuerySpec.hs | 6 +++--- test/Feature/RpcSpec.hs | 8 +++---- test/Main.hs | 17 ++++++++------- 19 files changed, 60 insertions(+), 62 deletions(-) rename src/PostgREST/{DbStructure => Config}/PgVersion.hs (96%) diff --git a/postgrest.cabal b/postgrest.cabal index 5b1829d3f..7b4ebffff 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -41,11 +41,11 @@ library PostgREST.Config PostgREST.Config.Database PostgREST.Config.JSPath + PostgREST.Config.PgVersion PostgREST.Config.Proxy PostgREST.ContentType PostgREST.DbStructure PostgREST.DbStructure.Identifiers - PostgREST.DbStructure.PgVersion PostgREST.DbStructure.Proc PostgREST.DbStructure.Relationship PostgREST.DbStructure.Table diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 6dd0134ba..82ddf21d7 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -54,13 +54,13 @@ import qualified PostgREST.Request.DbRequestBuilder as ReqBuilder import PostgREST.AppState (AppState) import PostgREST.Config (AppConfig (..), LogLevel (..)) +import PostgREST.Config.PgVersion (PgVersion (..)) import PostgREST.ContentType (ContentType (..)) import PostgREST.DbStructure (DbStructure (..), tablePKCols) import PostgREST.DbStructure.Identifiers (FieldName, QualifiedIdentifier (..), Schema) -import PostgREST.DbStructure.PgVersion (PgVersion (..)) import PostgREST.DbStructure.Proc (ProcDescription (..), ProcVolatility (..)) import PostgREST.DbStructure.Table (Table (..)) diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index f00496bc5..7440d5363 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -28,10 +28,9 @@ import Data.IORef (IORef, atomicWriteIORef, newIORef, readIORef) import Data.Time.Clock (UTCTime, getCurrentTime) -import PostgREST.Config (AppConfig (..)) -import PostgREST.DbStructure (DbStructure) -import PostgREST.DbStructure.PgVersion (PgVersion (..), - minimumPgVersion) +import PostgREST.Config (AppConfig (..)) +import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion) +import PostgREST.DbStructure (DbStructure) import Protolude hiding (toS) import Protolude.Conv (toS) diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index 4f000991d..de4020ed0 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -20,7 +20,7 @@ import Text.Heredoc (str) import PostgREST.AppState (AppState) import PostgREST.Config (AppConfig (..)) -import PostgREST.DbStructure (getDbStructure) +import PostgREST.DbStructure (queryDbStructure) import PostgREST.Version (prettyVersion) import PostgREST.Workers (reReadConfig) @@ -56,7 +56,7 @@ dumpSchema appState = do result <- P.use (AppState.getPool appState) $ HT.transaction HT.ReadCommitted HT.Read $ - getDbStructure + queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements diff --git a/src/PostgREST/Config/Database.hs b/src/PostgREST/Config/Database.hs index beecb4f5a..5cb208760 100644 --- a/src/PostgREST/Config/Database.hs +++ b/src/PostgREST/Config/Database.hs @@ -1,12 +1,16 @@ {-# LANGUAGE QuasiQuotes #-} module PostgREST.Config.Database - ( loadDbSettings + ( queryDbSettings + , queryPgVersion ) where +import PostgREST.Config.PgVersion (PgVersion (..)) + import qualified Hasql.Decoders as HD import qualified Hasql.Encoders as HE import qualified Hasql.Pool as P +import qualified Hasql.Session as H import qualified Hasql.Statement as H import qualified Hasql.Transaction as HT import qualified Hasql.Transaction.Sessions as HT @@ -16,9 +20,14 @@ import Text.InterpolatedString.Perl6 (q) import Protolude hiding (hPutStrLn) +queryPgVersion :: H.Session PgVersion +queryPgVersion = H.statement mempty $ H.Statement sql HE.noParams versionRow False + where + sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')" + versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text -loadDbSettings :: P.Pool -> IO [(Text, Text)] -loadDbSettings pool = do +queryDbSettings :: P.Pool -> IO [(Text, Text)] +queryDbSettings pool = do result <- P.use pool . HT.transaction HT.ReadCommitted HT.Read $ HT.statement mempty dbSettingsStatement diff --git a/src/PostgREST/DbStructure/PgVersion.hs b/src/PostgREST/Config/PgVersion.hs similarity index 96% rename from src/PostgREST/DbStructure/PgVersion.hs rename to src/PostgREST/Config/PgVersion.hs index 20616bba6..19e0f68b9 100644 --- a/src/PostgREST/DbStructure/PgVersion.hs +++ b/src/PostgREST/Config/PgVersion.hs @@ -1,6 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -module PostgREST.DbStructure.PgVersion +module PostgREST.Config.PgVersion ( PgVersion(..) , minimumPgVersion , pgVersion95 diff --git a/src/PostgREST/Config/Proxy.hs b/src/PostgREST/Config/Proxy.hs index b3d44792c..7d583ced5 100644 --- a/src/PostgREST/Config/Proxy.hs +++ b/src/PostgREST/Config/Proxy.hs @@ -1,4 +1,3 @@ - {-| Module : PostgREST.Private.ProxyUri Description : Proxy Uri validator diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index b1cd37a30..db752f169 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -20,11 +20,10 @@ These queries are executed once at startup or when PostgREST is reloaded. module PostgREST.DbStructure ( DbStructure(..) - , getDbStructure + , queryDbStructure , accessibleTables , accessibleProcs , schemaDescription - , getPgVersion , tableCols , tablePKCols ) where @@ -34,7 +33,6 @@ import qualified Data.HashMap.Strict as M import qualified Data.List as L import qualified Hasql.Decoders as HD import qualified Hasql.Encoders as HE -import qualified Hasql.Session as H import qualified Hasql.Statement as H import qualified Hasql.Transaction as HT @@ -45,7 +43,6 @@ import Text.InterpolatedString.Perl6 (q) import PostgREST.DbStructure.Identifiers (QualifiedIdentifier (..), Schema, TableName) -import PostgREST.DbStructure.PgVersion (PgVersion (..)) import PostgREST.DbStructure.Proc (PgArg (..), PgType (..), ProcDescription (..), ProcVolatility (..), @@ -85,8 +82,8 @@ type ViewColumn = Column -- | A SQL query that can be executed independently type SqlQuery = ByteString -getDbStructure :: [Schema] -> [Schema] -> Bool -> HT.Transaction DbStructure -getDbStructure schemas extraSearchPath prepared = do +queryDbStructure :: [Schema] -> [Schema] -> Bool -> HT.Transaction DbStructure +queryDbStructure schemas extraSearchPath prepared = do HT.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 tabs <- HT.statement mempty $ allTables prepared cols <- HT.statement schemas $ allColumns tabs prepared @@ -937,12 +934,6 @@ pfkSourceColumns cols = join pks_fks using (resorigtbl, resorigcol) order by view_schema, view_name, view_column_name; |] -getPgVersion :: H.Session PgVersion -getPgVersion = H.statement mempty $ H.Statement sql HE.noParams versionRow False - where - sql = "SELECT current_setting('server_version_num')::integer, current_setting('server_version')" - versionRow = HD.singleRow $ PgVersion <$> column HD.int4 <*> column HD.text - param :: HE.Value a -> HE.Params a param = HE.param . HE.nonNullable diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 26def5fa9..8f3489e21 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -46,9 +46,9 @@ import qualified Hasql.Encoders as HE import Data.Foldable (foldr1) import Text.InterpolatedString.Perl6 (qc) +import PostgREST.Config.PgVersion (PgVersion, pgVersion96) import PostgREST.DbStructure.Identifiers (FieldName, QualifiedIdentifier (..)) -import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion96) import PostgREST.RangeQuery (NonnegRange, allRange, rangeLimit, rangeOffset) import PostgREST.Request.Types (Alias, Field, Filter (..), diff --git a/src/PostgREST/Query/Statements.hs b/src/PostgREST/Query/Statements.hs index 1f01977a0..9848606d6 100644 --- a/src/PostgREST/Query/Statements.hs +++ b/src/PostgREST/Query/Statements.hs @@ -29,9 +29,9 @@ import Data.Maybe (fromJust) import Data.Text.Read (decimal) import Network.HTTP.Types.Status (Status) -import PostgREST.DbStructure.PgVersion (PgVersion) -import PostgREST.Error (Error (..)) -import PostgREST.GucHeader (GucHeader) +import PostgREST.Config.PgVersion (PgVersion) +import PostgREST.Error (Error (..)) +import PostgREST.GucHeader (GucHeader) import PostgREST.DbStructure.Identifiers (FieldName) import PostgREST.Query.SqlFragment diff --git a/src/PostgREST/Workers.hs b/src/PostgREST/Workers.hs index 6ca2af738..7240efcd9 100644 --- a/src/PostgREST/Workers.hs +++ b/src/PostgREST/Workers.hs @@ -17,14 +17,13 @@ import Control.Retry (RetryStatus, capDelay, exponentialBackoff, retrying, rsPreviousDelay) import Data.Text.IO (hPutStrLn) -import PostgREST.AppState (AppState) -import PostgREST.Config (AppConfig (..), readAppConfig) -import PostgREST.Config.Database (loadDbSettings) -import PostgREST.DbStructure (getDbStructure, getPgVersion) -import PostgREST.DbStructure.PgVersion (PgVersion (..), - minimumPgVersion) -import PostgREST.Error (PgError (PgError), - checkIsFatal, errorPayload) +import PostgREST.AppState (AppState) +import PostgREST.Config (AppConfig (..), readAppConfig) +import PostgREST.Config.Database (queryDbSettings, queryPgVersion) +import PostgREST.Config.PgVersion (PgVersion (..), minimumPgVersion) +import PostgREST.DbStructure (queryDbStructure) +import PostgREST.Error (PgError (PgError), checkIsFatal, + errorPayload) import qualified PostgREST.AppState as AppState @@ -117,7 +116,7 @@ connectionStatus pool = getConnectionStatus :: IO ConnectionStatus getConnectionStatus = do - pgVersion <- P.use pool getPgVersion + pgVersion <- P.use pool queryPgVersion case pgVersion of Left e -> do let err = PgError False e @@ -152,7 +151,7 @@ loadSchemaCache appState = do AppConfig{..} <- AppState.getConfig appState result <- P.use (AppState.getPool appState) . HT.transaction HT.ReadCommitted HT.Read $ - getDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements + queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements case result of Left e -> do let @@ -227,7 +226,7 @@ reReadConfig startingUp appState = do AppConfig{..} <- AppState.getConfig appState dbSettings <- if configDbConfig then - loadDbSettings (AppState.getPool appState) + queryDbSettings (AppState.getPool appState) else pure mempty readAppConfig dbSettings configFilePath (Just configDbUri) >>= \case diff --git a/test/Feature/AndOrParamsSpec.hs b/test/Feature/AndOrParamsSpec.hs index 0e4abea34..43e8ca33b 100644 --- a/test/Feature/AndOrParamsSpec.hs +++ b/test/Feature/AndOrParamsSpec.hs @@ -7,7 +7,7 @@ import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON -import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion112) +import PostgREST.Config.PgVersion (PgVersion, pgVersion112) import Protolude hiding (get) import SpecHelper diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index e843ee10f..dc65d50cf 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -7,7 +7,7 @@ import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON -import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion112) +import PostgREST.Config.PgVersion (PgVersion, pgVersion112) import Protolude hiding (get) import SpecHelper diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index 2904f0891..bdf75172e 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -11,8 +11,8 @@ import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Text.Heredoc -import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion112, - pgVersion130) +import PostgREST.Config.PgVersion (PgVersion, pgVersion112, + pgVersion130) import Protolude hiding (get) import SpecHelper diff --git a/test/Feature/JsonOperatorSpec.hs b/test/Feature/JsonOperatorSpec.hs index 3a032a17e..3ad0e6d7d 100644 --- a/test/Feature/JsonOperatorSpec.hs +++ b/test/Feature/JsonOperatorSpec.hs @@ -7,8 +7,8 @@ import Test.Hspec import Test.Hspec.Wai import Test.Hspec.Wai.JSON -import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion112, - pgVersion121, pgVersion95) +import PostgREST.Config.PgVersion (PgVersion, pgVersion112, + pgVersion121, pgVersion95) import Protolude hiding (get) import SpecHelper diff --git a/test/Feature/MultipleSchemaSpec.hs b/test/Feature/MultipleSchemaSpec.hs index 6c781fff8..58adcda38 100644 --- a/test/Feature/MultipleSchemaSpec.hs +++ b/test/Feature/MultipleSchemaSpec.hs @@ -15,7 +15,7 @@ import Test.Hspec.Wai.JSON import Protolude import SpecHelper -import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion96) +import PostgREST.Config.PgVersion (PgVersion, pgVersion96) spec :: PgVersion -> SpecWith ((), Application) spec actualPgVersion = diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 3733d3023..80826f3d4 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -8,9 +8,9 @@ import Test.Hspec hiding (pendingWith) import Test.Hspec.Wai import Test.Hspec.Wai.JSON -import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion112, - pgVersion121, pgVersion96) -import Protolude hiding (get) +import PostgREST.Config.PgVersion (PgVersion, pgVersion112, + pgVersion121, pgVersion96) +import Protolude hiding (get) import SpecHelper spec :: PgVersion -> SpecWith ((), Application) diff --git a/test/Feature/RpcSpec.hs b/test/Feature/RpcSpec.hs index 6b9481401..93727f3f3 100644 --- a/test/Feature/RpcSpec.hs +++ b/test/Feature/RpcSpec.hs @@ -11,10 +11,10 @@ import Test.Hspec.Wai import Test.Hspec.Wai.JSON import Text.Heredoc -import PostgREST.DbStructure.PgVersion (PgVersion, pgVersion100, - pgVersion109, pgVersion110, - pgVersion112, pgVersion114, - pgVersion96) +import PostgREST.Config.PgVersion (PgVersion, pgVersion100, + pgVersion109, pgVersion110, + pgVersion112, pgVersion114, + pgVersion96) import Protolude hiding (get) import SpecHelper diff --git a/test/Main.hs b/test/Main.hs index 166d92f04..b104cbbb2 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -8,12 +8,13 @@ import Data.List.NonEmpty (toList) import Test.Hspec -import PostgREST.App (postgrest) -import PostgREST.Config (AppConfig (..), LogLevel (..)) -import PostgREST.DbStructure (getDbStructure, getPgVersion) -import PostgREST.DbStructure.PgVersion (pgVersion96) -import Protolude hiding (toList, toS) -import Protolude.Conv (toS) +import PostgREST.App (postgrest) +import PostgREST.Config (AppConfig (..), LogLevel (..)) +import PostgREST.Config.Database (queryPgVersion) +import PostgREST.Config.PgVersion (pgVersion96) +import PostgREST.DbStructure (queryDbStructure) +import Protolude hiding (toList, toS) +import Protolude.Conv (toS) import SpecHelper import qualified PostgREST.AppState as AppState @@ -57,7 +58,7 @@ main = do pool <- P.acquire (3, 10, toS testDbConn) - actualPgVersion <- either (panic.show) id <$> P.use pool getPgVersion + actualPgVersion <- either (panic.show) id <$> P.use pool queryPgVersion baseDbStructure <- loadDbStructure pool @@ -204,4 +205,4 @@ main = do where loadDbStructure pool schemas extraSearchPath = - either (panic.show) id <$> P.use pool (HT.transaction HT.ReadCommitted HT.Read $ getDbStructure (toList schemas) extraSearchPath True) + either (panic.show) id <$> P.use pool (HT.transaction HT.ReadCommitted HT.Read $ queryDbStructure (toList schemas) extraSearchPath True)