From 5cd7d35966b8e8481215ca181c7629191e7e470e Mon Sep 17 00:00:00 2001 From: monacoremo <59358383+monacoremo@users.noreply.github.com> Date: Wed, 3 Nov 2021 18:17:15 +0100 Subject: [PATCH] refactor: Make import aliases consistent across the codebase --- src/PostgREST/App.hs | 22 ++-- src/PostgREST/AppState.hs | 14 +-- src/PostgREST/CLI.hs | 16 +-- src/PostgREST/Config.hs | 9 +- src/PostgREST/Config/Database.hs | 26 ++--- src/PostgREST/DbStructure.hs | 56 +++++----- src/PostgREST/Error.hs | 162 ++++++++++++++-------------- src/PostgREST/Middleware.hs | 26 ++--- src/PostgREST/OpenAPI.hs | 6 +- src/PostgREST/Query/QueryBuilder.hs | 72 ++++++------- src/PostgREST/Query/SqlFragment.hs | 72 ++++++------- src/PostgREST/Query/Statements.hs | 42 ++++---- src/PostgREST/Request/ApiRequest.hs | 14 +-- src/PostgREST/Request/Types.hs | 8 +- src/PostgREST/Workers.hs | 26 ++--- 15 files changed, 285 insertions(+), 286 deletions(-) diff --git a/src/PostgREST/App.hs b/src/PostgREST/App.hs index 8a5240c57..89e2ccb6f 100644 --- a/src/PostgREST/App.hs +++ b/src/PostgREST/App.hs @@ -26,10 +26,10 @@ import Network.Wai.Handler.Warp (defaultSettings, setHost, setPort, setServerName) import System.Posix.Types (FileMode) -import qualified Data.ByteString.Char8 as BS8 +import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy as LBS -import qualified Data.HashMap.Strict as Map -import qualified Data.Set as Set +import qualified Data.HashMap.Strict as M +import qualified Data.Set as S import qualified Hasql.DynamicStatements.Snippet as SQL import qualified Hasql.Pool as SQL import qualified Hasql.Transaction as SQL @@ -163,7 +163,7 @@ postgrest logLev appState connWorker = addRetryHint :: Bool -> AppState -> Wai.Response -> IO Wai.Response addRetryHint shouldAdd appState response = do delay <- AppState.getRetryNextIn appState - let h = ("Retry-After", BS8.pack $ show delay) + let h = ("Retry-After", BS.pack $ show delay) return $ Wai.mapResponseHeaders (\hs -> if shouldAdd then h:hs else hs) response postgrestResponse @@ -271,7 +271,7 @@ handleRead headersOnly identifier context@RequestContext{..} = do , ( "Content-Location" , "/" <> toS (qiName identifier) - <> if BS8.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS + <> if BS.null iCanonicalQS then mempty else "?" <> toS iCanonicalQS ) ] ++ contentTypeHeaders context @@ -322,7 +322,7 @@ handleCreate identifier@QualifiedIdentifier{..} context@RequestContext{..} = do , if null pkCols && isNothing iOnConflict then Nothing else - (\x -> ("Preference-Applied", BS8.pack $ show x)) <$> iPreferResolution + (\x -> ("Preference-Applied", BS.pack $ show x)) <$> iPreferResolution ] failNotSingular iAcceptContentType resQueryTotal $ @@ -338,7 +338,7 @@ handleUpdate identifier context@(RequestContext _ _ ApiRequest{..} _) = do let response = gucResponse resGucStatus resGucHeaders fullRepr = iPreferRepresentation == Full - updateIsNoOp = Set.null iColumns + updateIsNoOp = S.null iColumns status | resQueryTotal == 0 && not updateIsNoOp = HTTP.status404 | fullRepr = HTTP.status200 @@ -406,7 +406,7 @@ handleInfo identifier RequestContext{..} = allOrigins = ("Access-Control-Allow-Origin", "*") allowH table = ( HTTP.hAllow - , BS8.intercalate "," $ + , BS.intercalate "," $ ["OPTIONS,GET,HEAD"] ++ ["POST" | tableInsertable table] ++ ["PUT" | tableInsertable table && tableUpdatable table && hasPK] @@ -473,7 +473,7 @@ handleOpenApi headersOnly tSchema (RequestContext conf@AppConfig{..} dbStructure OAIgnorePriv -> OpenAPI.encode conf dbStructure (filter (\x -> tableSchema x == tSchema) $ DbStructure.dbTables dbStructure) - (Map.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure) + (M.filterWithKey (\(QualifiedIdentifier sch _) _ -> sch == tSchema) $ DbStructure.dbProcs dbStructure) <$> SQL.statement tSchema (DbStructure.schemaDescription configDbPreparedStatements) OADisabled -> pure mempty @@ -609,6 +609,6 @@ profileHeader ApiRequest{..} = splitKeyValue :: ByteString -> (ByteString, ByteString) splitKeyValue kv = - (k, BS8.tail v) + (k, BS.tail v) where - (k, v) = BS8.break (== '=') kv + (k, v) = BS.break (== '=') kv diff --git a/src/PostgREST/AppState.hs b/src/PostgREST/AppState.hs index 964f9b461..2caebbe49 100644 --- a/src/PostgREST/AppState.hs +++ b/src/PostgREST/AppState.hs @@ -25,7 +25,7 @@ module PostgREST.AppState , waitListener ) where -import qualified Hasql.Pool as P +import qualified Hasql.Pool as SQL import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction) @@ -44,7 +44,7 @@ import Protolude.Conv (toS) data AppState = AppState - { statePool :: P.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError' + { statePool :: SQL.Pool -- | Connection pool, either a 'Connection' or a 'ConnectionError' , statePgVersion :: IORef PgVersion -- | No schema cache at the start. Will be filled in by the connectionWorker , stateDbStructure :: IORef (Maybe DbStructure) @@ -71,7 +71,7 @@ init conf = do newPool <- initPool conf initWithPool newPool conf -initWithPool :: P.Pool -> AppConfig -> IO AppState +initWithPool :: SQL.Pool -> AppConfig -> IO AppState initWithPool newPool conf = AppState newPool <$> newIORef minimumPgVersion -- assume we're in a supported version when starting, this will be corrected on a later step @@ -85,15 +85,15 @@ initWithPool newPool conf = <*> myThreadId <*> newIORef 0 -initPool :: AppConfig -> IO P.Pool +initPool :: AppConfig -> IO SQL.Pool initPool AppConfig{..} = - P.acquire (configDbPoolSize, configDbPoolTimeout, toS configDbUri) + SQL.acquire (configDbPoolSize, configDbPoolTimeout, toS configDbUri) -getPool :: AppState -> P.Pool +getPool :: AppState -> SQL.Pool getPool = statePool releasePool :: AppState -> IO () -releasePool AppState{..} = P.release statePool >> throwTo stateMainThreadId UserInterrupt +releasePool AppState{..} = SQL.release statePool >> throwTo stateMainThreadId UserInterrupt getPgVersion :: AppState -> IO PgVersion getPgVersion = readIORef . statePgVersion diff --git a/src/PostgREST/CLI.hs b/src/PostgREST/CLI.hs index f70183b1b..621318e50 100644 --- a/src/PostgREST/CLI.hs +++ b/src/PostgREST/CLI.hs @@ -8,10 +8,10 @@ module PostgREST.CLI , readCLIShowHelp ) where -import qualified Data.Aeson as Aeson +import qualified Data.Aeson as JSON import qualified Data.ByteString.Lazy as LBS -import qualified Hasql.Pool as P -import qualified Hasql.Transaction.Sessions as HT +import qualified Hasql.Pool as SQL +import qualified Hasql.Transaction.Sessions as SQL import qualified Options.Applicative as O import qualified Protolude.Conv as Conv @@ -54,19 +54,19 @@ dumpSchema :: AppState -> IO LBS.ByteString dumpSchema appState = do AppConfig{..} <- AppState.getConfig appState result <- - let transaction = if configDbPreparedStatements then HT.transaction else HT.unpreparedTransaction in - P.use (AppState.getPool appState) $ - transaction HT.ReadCommitted HT.Read $ + let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in + SQL.use (AppState.getPool appState) $ + transaction SQL.ReadCommitted SQL.Read $ queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements - P.release $ AppState.getPool appState + SQL.release $ AppState.getPool appState case result of Left e -> do hPutStrLn stderr $ "An error ocurred when loading the schema cache:\n" <> show e exitFailure - Right dbStructure -> return $ Aeson.encode dbStructure + Right dbStructure -> return $ JSON.encode dbStructure -- | Command line interface options data CLI = CLI diff --git a/src/PostgREST/Config.hs b/src/PostgREST/Config.hs index a852e53b0..f6e6fea89 100644 --- a/src/PostgREST/Config.hs +++ b/src/PostgREST/Config.hs @@ -29,9 +29,8 @@ module PostgREST.Config import qualified Crypto.JOSE.Types as JOSE import qualified Crypto.JWT as JWT import qualified Data.Aeson as JSON -import qualified Data.ByteString as B +import qualified Data.ByteString as BS import qualified Data.ByteString.Base64 as B64 -import qualified Data.ByteString.Char8 as BS import qualified Data.Configurator as C import qualified Data.Map.Strict as M import qualified Data.Text as T @@ -86,12 +85,12 @@ data AppConfig = AppConfig , configJWKS :: Maybe JWKSet , configJwtAudience :: Maybe StringOrURI , configJwtRoleClaimKey :: JSPath - , configJwtSecret :: Maybe B.ByteString + , configJwtSecret :: Maybe BS.ByteString , configJwtSecretIsBase64 :: Bool , configLogLevel :: LogLevel , configOpenApiMode :: OpenAPIMode , configOpenApiServerProxyUri :: Maybe Text - , configRawMediaTypes :: [B.ByteString] + , configRawMediaTypes :: [BS.ByteString] , configServerHost :: Text , configServerPort :: Int , configServerUnixSocket :: Maybe FilePath @@ -144,7 +143,7 @@ toText conf = ,("log-level", q . show . configLogLevel) ,("openapi-mode", q . show . configOpenApiMode) ,("openapi-server-proxy-uri", q . fromMaybe mempty . configOpenApiServerProxyUri) - ,("raw-media-types", q . toS . B.intercalate "," . configRawMediaTypes) + ,("raw-media-types", q . toS . BS.intercalate "," . configRawMediaTypes) ,("server-host", q . configServerHost) ,("server-port", show . configServerPort) ,("server-unix-socket", q . maybe mempty T.pack . configServerUnixSocket) diff --git a/src/PostgREST/Config/Database.hs b/src/PostgREST/Config/Database.hs index fa6f48a5c..a0f4107f1 100644 --- a/src/PostgREST/Config/Database.hs +++ b/src/PostgREST/Config/Database.hs @@ -9,31 +9,31 @@ 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 +import qualified Hasql.Pool as SQL +import Hasql.Session (Session, statement) +import qualified Hasql.Statement as SQL +import qualified Hasql.Transaction as SQL +import qualified Hasql.Transaction.Sessions as SQL import Text.InterpolatedString.Perl6 (q) import Protolude -queryPgVersion :: H.Session PgVersion -queryPgVersion = H.statement mempty $ H.Statement sql HE.noParams versionRow False +queryPgVersion :: Session PgVersion +queryPgVersion = statement mempty $ SQL.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 -queryDbSettings :: P.Pool -> Bool -> IO (Either P.UsageError [(Text, Text)]) +queryDbSettings :: SQL.Pool -> Bool -> IO (Either SQL.UsageError [(Text, Text)]) queryDbSettings pool prepared = - let transaction = if prepared then HT.transaction else HT.unpreparedTransaction in - P.use pool . transaction HT.ReadCommitted HT.Read $ - HT.statement mempty dbSettingsStatement + let transaction = if prepared then SQL.transaction else SQL.unpreparedTransaction in + SQL.use pool . transaction SQL.ReadCommitted SQL.Read $ + SQL.statement mempty dbSettingsStatement -- | Get db settings from the connection role. Global settings will be overridden by database specific settings. -dbSettingsStatement :: H.Statement () [(Text, Text)] -dbSettingsStatement = H.Statement sql HE.noParams decodeSettings False +dbSettingsStatement :: SQL.Statement () [(Text, Text)] +dbSettingsStatement = SQL.Statement sql HE.noParams decodeSettings False where sql = [q| with diff --git a/src/PostgREST/DbStructure.hs b/src/PostgREST/DbStructure.hs index c97beee35..b2f21f09b 100644 --- a/src/PostgREST/DbStructure.hs +++ b/src/PostgREST/DbStructure.hs @@ -33,8 +33,8 @@ 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.Statement as H -import qualified Hasql.Transaction as HT +import qualified Hasql.Statement as SQL +import qualified Hasql.Transaction as SQL import Contravariant.Extras (contrazip2) import Data.Set as S (fromList) @@ -83,15 +83,15 @@ type ViewColumn = Column -- | A SQL query that can be executed independently type SqlQuery = ByteString -queryDbStructure :: [Schema] -> [Schema] -> Bool -> HT.Transaction DbStructure +queryDbStructure :: [Schema] -> [Schema] -> Bool -> SQL.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 - srcCols <- HT.statement (schemas, extraSearchPath) $ pfkSourceColumns cols prepared - m2oRels <- HT.statement mempty $ allM2ORels tabs cols prepared - keys <- HT.statement mempty $ allPrimaryKeys tabs prepared - procs <- HT.statement schemas $ allProcs prepared + 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 + tabs <- SQL.statement mempty $ allTables prepared + cols <- SQL.statement schemas $ allColumns tabs prepared + srcCols <- SQL.statement (schemas, extraSearchPath) $ pfkSourceColumns cols prepared + m2oRels <- SQL.statement mempty $ allM2ORels tabs cols prepared + keys <- SQL.statement mempty $ allPrimaryKeys tabs prepared + procs <- SQL.statement schemas $ allProcs prepared let rels = addO2MRels . addM2MRels $ addViewM2ORels srcCols m2oRels keys' = addViewPrimaryKeys srcCols keys @@ -224,13 +224,13 @@ decodeProcs = | v == 's' = Stable | otherwise = Volatile -- only 'v' can happen here -allProcs :: Bool -> H.Statement [Schema] ProcsMap -allProcs = H.Statement (toS sql) (arrayParam HE.text) decodeProcs +allProcs :: Bool -> SQL.Statement [Schema] ProcsMap +allProcs = SQL.Statement (toS sql) (arrayParam HE.text) decodeProcs where sql = procsSqlQuery <> " WHERE pn.nspname = ANY($1)" -accessibleProcs :: Bool -> H.Statement Schema ProcsMap -accessibleProcs = H.Statement (toS sql) (param HE.text) decodeProcs +accessibleProcs :: Bool -> SQL.Statement Schema ProcsMap +accessibleProcs = SQL.Statement (toS sql) (param HE.text) decodeProcs where sql = procsSqlQuery <> " WHERE pn.nspname = $1 AND has_function_privilege(p.oid, 'execute')" @@ -299,9 +299,9 @@ procsSqlQuery = [q| LEFT JOIN pg_catalog.pg_description as d ON d.objoid = p.oid |] -schemaDescription :: Bool -> H.Statement Schema (Maybe Text) +schemaDescription :: Bool -> SQL.Statement Schema (Maybe Text) schemaDescription = - H.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text)) + SQL.Statement sql (param HE.text) (join <$> HD.rowMaybe (nullableColumn HD.text)) where sql = [q| select @@ -312,9 +312,9 @@ schemaDescription = where n.nspname = $1 |] -accessibleTables :: Bool -> H.Statement Schema [Table] +accessibleTables :: Bool -> SQL.Statement Schema [Table] accessibleTables = - H.Statement sql (param HE.text) decodeTables + SQL.Statement sql (param HE.text) decodeTables where sql = [q| select @@ -446,9 +446,9 @@ addViewPrimaryKeys srcCols = concatMap (\pk -> filter (\(col, _) -> colTable col == pkTable pk && colName col == pkName pk) srcCols in pk : viewPks) -allTables :: Bool -> H.Statement () [Table] +allTables :: Bool -> SQL.Statement () [Table] allTables = - H.Statement sql HE.noParams decodeTables + SQL.Statement sql HE.noParams decodeTables where sql = [q| SELECT @@ -488,9 +488,9 @@ allTables = AND n.nspname NOT IN ('pg_catalog', 'information_schema') ORDER BY table_schema, table_name |] -allColumns :: [Table] -> Bool -> H.Statement [Schema] [Column] +allColumns :: [Table] -> Bool -> SQL.Statement [Schema] [Column] allColumns tabs = - H.Statement sql (arrayParam HE.text) (decodeColumns tabs) + SQL.Statement sql (arrayParam HE.text) (decodeColumns tabs) where sql = [q| SELECT DISTINCT @@ -621,9 +621,9 @@ columnFromRow tabs (s, t, n, desc, nul, typ, l, d, e) = buildColumn <$> table parseEnum :: Maybe Text -> [Text] parseEnum = maybe [] (split (==',')) -allM2ORels :: [Table] -> [Column] -> Bool -> H.Statement () [Relationship] +allM2ORels :: [Table] -> [Column] -> Bool -> SQL.Statement () [Relationship] allM2ORels tabs cols = - H.Statement sql HE.noParams (decodeRels tabs cols) + SQL.Statement sql HE.noParams (decodeRels tabs cols) where sql = [q| SELECT ns1.nspname AS table_schema, @@ -659,9 +659,9 @@ relFromRow allTabs allCols (rs, rt, cn, rcs, frs, frt, frcs) = cols = mapM (findCol rs rt) rcs colsF = mapM (findCol frs frt) frcs -allPrimaryKeys :: [Table] -> Bool -> H.Statement () [PrimaryKey] +allPrimaryKeys :: [Table] -> Bool -> SQL.Statement () [PrimaryKey] allPrimaryKeys tabs = - H.Statement sql HE.noParams (decodePks tabs) + SQL.Statement sql HE.noParams (decodePks tabs) where sql = [q| -- CTE to replace information_schema.table_constraints to remove owner limit @@ -740,9 +740,9 @@ pkFromRow tabs (s, t, n) = PrimaryKey <$> table <*> pure n where table = find (\tbl -> tableSchema tbl == s && tableName tbl == t) tabs -- returns all the primary and foreign key columns which are referenced in views -pfkSourceColumns :: [Column] -> Bool -> H.Statement ([Schema], [Schema]) [SourceColumn] +pfkSourceColumns :: [Column] -> Bool -> SQL.Statement ([Schema], [Schema]) [SourceColumn] pfkSourceColumns cols = - H.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) (decodeSourceColumns cols) + SQL.Statement sql (contrazip2 (arrayParam HE.text) (arrayParam HE.text)) (decodeSourceColumns cols) -- query explanation at: -- * rationale: https://gist.github.com/wolfgangwalther/5425d64e7b0d20aad71f6f68474d9f19 -- * json transformation: https://gist.github.com/wolfgangwalther/3a8939da680c24ad767e93ad2c183089 diff --git a/src/PostgREST/Error.hs b/src/PostgREST/Error.hs index b11d2954a..23441b5ba 100644 --- a/src/PostgREST/Error.hs +++ b/src/PostgREST/Error.hs @@ -17,9 +17,9 @@ module PostgREST.Error import qualified Data.Aeson as JSON import qualified Data.Text as T -import qualified Hasql.Pool as P -import qualified Hasql.Session as H -import qualified Network.HTTP.Types.Status as HT +import qualified Hasql.Pool as SQL +import qualified Hasql.Session as SQL +import qualified Network.HTTP.Types.Status as HTTP import Data.Aeson ((.=)) import Network.Wai (Response, responseLBS) @@ -41,7 +41,7 @@ import Protolude.Conv (toS, toSL) class (JSON.ToJSON a) => PgrstError a where - status :: a -> HT.Status + status :: a -> HTTP.Status headers :: a -> [Header] errorPayload :: a -> LByteString @@ -67,18 +67,18 @@ data ApiRequestError | UnsupportedVerb -- Unreachable? instance PgrstError ApiRequestError where - status InvalidRange = HT.status416 - status InvalidFilters = HT.status405 - status (InvalidBody _) = HT.status400 - status UnsupportedVerb = HT.status405 - status ActionInappropriate = HT.status405 - status (ParseRequestError _ _) = HT.status400 - status (NoRelBetween _ _) = HT.status400 - status AmbiguousRelBetween{} = HT.status300 - status (AmbiguousRpc _) = HT.status300 - status NoRpc{} = HT.status404 - status (UnacceptableSchema _) = HT.status406 - status (ContentTypeError _) = HT.status415 + status InvalidRange = HTTP.status416 + status InvalidFilters = HTTP.status405 + status (InvalidBody _) = HTTP.status400 + status UnsupportedVerb = HTTP.status405 + status ActionInappropriate = HTTP.status405 + status (ParseRequestError _ _) = HTTP.status400 + status (NoRelBetween _ _) = HTTP.status400 + status AmbiguousRelBetween{} = HTTP.status300 + status (AmbiguousRpc _) = HTTP.status300 + status NoRpc{} = HTTP.status404 + status (UnacceptableSchema _) = HTTP.status406 + status (ContentTypeError _) = HTTP.status415 headers _ = [ContentType.toHeader CTApplicationJSON] @@ -145,32 +145,32 @@ compressedRel Relationship{..} = , "relationship" .= (cons <> fmtEls (colName <$> relColumns) <> fmtEls (colName <$> relForeignColumns)) ] -data PgError = PgError Authenticated P.UsageError +data PgError = PgError Authenticated SQL.UsageError type Authenticated = Bool instance PgrstError PgError where status (PgError authed usageError) = pgErrorStatus authed usageError headers err = - if status err == HT.status401 + if status err == HTTP.status401 then [ContentType.toHeader CTApplicationJSON, ("WWW-Authenticate", "Bearer") :: Header] else [ContentType.toHeader CTApplicationJSON] instance JSON.ToJSON PgError where toJSON (PgError _ usageError) = JSON.toJSON usageError -instance JSON.ToJSON P.UsageError where - toJSON (P.ConnectionError e) = JSON.object [ +instance JSON.ToJSON SQL.UsageError where + toJSON (SQL.ConnectionError e) = JSON.object [ "code" .= ("" :: Text), "message" .= ("Database connection error. Retrying the connection." :: Text), "details" .= (toSL $ fromMaybe "" e :: Text)] - toJSON (P.SessionError e) = JSON.toJSON e -- H.Error + toJSON (SQL.SessionError e) = JSON.toJSON e -- SQL.Error -instance JSON.ToJSON H.QueryError where - toJSON (H.QueryError _ _ e) = JSON.toJSON e +instance JSON.ToJSON SQL.QueryError where + toJSON (SQL.QueryError _ _ e) = JSON.toJSON e -instance JSON.ToJSON H.CommandError where - toJSON (H.ResultError (H.ServerError c m d h)) = case toS c of +instance JSON.ToJSON SQL.CommandError where + toJSON (SQL.ResultError (SQL.ServerError c m d h)) = case toS c of 'P':'T':_ -> JSON.object [ "details" .= (fmap toS d :: Maybe Text), "hint" .= (fmap toS h :: Maybe Text)] @@ -181,86 +181,86 @@ instance JSON.ToJSON H.CommandError where "details" .= (fmap toS d :: Maybe Text), "hint" .= (fmap toS h :: Maybe Text)] - toJSON (H.ResultError (H.UnexpectedResult m)) = JSON.object [ + toJSON (SQL.ResultError (SQL.UnexpectedResult m)) = JSON.object [ "message" .= (m :: Text)] - toJSON (H.ResultError (H.RowError i H.EndOfInput)) = JSON.object [ + toJSON (SQL.ResultError (SQL.RowError i SQL.EndOfInput)) = JSON.object [ "message" .= ("Row error: end of input" :: Text), "details" .= ("Attempt to parse more columns than there are in the result" :: Text), "hint" .= (("Row number " <> show i) :: Text)] - toJSON (H.ResultError (H.RowError i H.UnexpectedNull)) = JSON.object [ + toJSON (SQL.ResultError (SQL.RowError i SQL.UnexpectedNull)) = JSON.object [ "message" .= ("Row error: unexpected null" :: Text), "details" .= ("Attempt to parse a NULL as some value." :: Text), "hint" .= (("Row number " <> show i) :: Text)] - toJSON (H.ResultError (H.RowError i (H.ValueError d))) = JSON.object [ + toJSON (SQL.ResultError (SQL.RowError i (SQL.ValueError d))) = JSON.object [ "message" .= ("Row error: Wrong value parser used" :: Text), "details" .= d, "hint" .= (("Row number " <> show i) :: Text)] - toJSON (H.ResultError (H.UnexpectedAmountOfRows i)) = JSON.object [ + toJSON (SQL.ResultError (SQL.UnexpectedAmountOfRows i)) = JSON.object [ "message" .= ("Unexpected amount of rows" :: Text), "details" .= i] - toJSON (H.ClientError d) = JSON.object [ + toJSON (SQL.ClientError d) = JSON.object [ "message" .= ("Database client error. Retrying the connection." :: Text), "details" .= (fmap toS d :: Maybe Text)] -pgErrorStatus :: Bool -> P.UsageError -> HT.Status -pgErrorStatus _ (P.ConnectionError _) = HT.status503 -pgErrorStatus _ (P.SessionError (H.QueryError _ _ (H.ClientError _))) = HT.status503 -pgErrorStatus authed (P.SessionError (H.QueryError _ _ (H.ResultError rError))) = +pgErrorStatus :: Bool -> SQL.UsageError -> HTTP.Status +pgErrorStatus _ (SQL.ConnectionError _) = HTTP.status503 +pgErrorStatus _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ClientError _))) = HTTP.status503 +pgErrorStatus authed (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError rError))) = case rError of - (H.ServerError c m _ _) -> + (SQL.ServerError c m _ _) -> case toS c of - '0':'8':_ -> HT.status503 -- pg connection err - '0':'9':_ -> HT.status500 -- triggered action exception - '0':'L':_ -> HT.status403 -- invalid grantor - '0':'P':_ -> HT.status403 -- invalid role specification - "23503" -> HT.status409 -- foreign_key_violation - "23505" -> HT.status409 -- unique_violation - "25006" -> HT.status405 -- read_only_sql_transaction - '2':'5':_ -> HT.status500 -- invalid tx state - '2':'8':_ -> HT.status403 -- invalid auth specification - '2':'D':_ -> HT.status500 -- invalid tx termination - '3':'8':_ -> HT.status500 -- external routine exception - '3':'9':_ -> HT.status500 -- external routine invocation - '3':'B':_ -> HT.status500 -- savepoint exception - '4':'0':_ -> HT.status500 -- tx rollback - '5':'3':_ -> HT.status503 -- insufficient resources - '5':'4':_ -> HT.status413 -- too complex - '5':'5':_ -> HT.status500 -- obj not on prereq state - '5':'7':_ -> HT.status500 -- operator intervention - '5':'8':_ -> HT.status500 -- system error - 'F':'0':_ -> HT.status500 -- conf file error - 'H':'V':_ -> HT.status500 -- foreign data wrapper error - "P0001" -> HT.status400 -- default code for "raise" - 'P':'0':_ -> HT.status500 -- PL/pgSQL Error - 'X':'X':_ -> HT.status500 -- internal Error - "42883" -> HT.status404 -- undefined function - "42P01" -> HT.status404 -- undefined table - "42501" -> if authed then HT.status403 else HT.status401 -- insufficient privilege - 'P':'T':n -> fromMaybe HT.status500 (HT.mkStatus <$> readMaybe n <*> pure m) - _ -> HT.status400 + '0':'8':_ -> HTTP.status503 -- pg connection err + '0':'9':_ -> HTTP.status500 -- triggered action exception + '0':'L':_ -> HTTP.status403 -- invalid grantor + '0':'P':_ -> HTTP.status403 -- invalid role specification + "23503" -> HTTP.status409 -- foreign_key_violation + "23505" -> HTTP.status409 -- unique_violation + "25006" -> HTTP.status405 -- read_only_sql_transaction + '2':'5':_ -> HTTP.status500 -- invalid tx state + '2':'8':_ -> HTTP.status403 -- invalid auth specification + '2':'D':_ -> HTTP.status500 -- invalid tx termination + '3':'8':_ -> HTTP.status500 -- external routine exception + '3':'9':_ -> HTTP.status500 -- external routine invocation + '3':'B':_ -> HTTP.status500 -- savepoint exception + '4':'0':_ -> HTTP.status500 -- tx rollback + '5':'3':_ -> HTTP.status503 -- insufficient resources + '5':'4':_ -> HTTP.status413 -- too complex + '5':'5':_ -> HTTP.status500 -- obj not on prereq state + '5':'7':_ -> HTTP.status500 -- operator intervention + '5':'8':_ -> HTTP.status500 -- system error + 'F':'0':_ -> HTTP.status500 -- conf file error + 'H':'V':_ -> HTTP.status500 -- foreign data wrapper error + "P0001" -> HTTP.status400 -- default code for "raise" + 'P':'0':_ -> HTTP.status500 -- PL/pgSQL Error + 'X':'X':_ -> HTTP.status500 -- internal Error + "42883" -> HTTP.status404 -- undefined function + "42P01" -> HTTP.status404 -- undefined table + "42501" -> if authed then HTTP.status403 else HTTP.status401 -- insufficient privilege + 'P':'T':n -> fromMaybe HTTP.status500 (HTTP.mkStatus <$> readMaybe n <*> pure m) + _ -> HTTP.status400 - _ -> HT.status500 + _ -> HTTP.status500 checkIsFatal :: PgError -> Maybe Text -checkIsFatal (PgError _ (P.ConnectionError e)) +checkIsFatal (PgError _ (SQL.ConnectionError e)) | isAuthFailureMessage = Just $ toS failureMessage | otherwise = Nothing where isAuthFailureMessage = "FATAL: password authentication failed" `isPrefixOf` toS failureMessage failureMessage = fromMaybe mempty e -checkIsFatal (PgError _ (P.SessionError (H.QueryError _ _ (H.ResultError serverError)))) +checkIsFatal (PgError _ (SQL.SessionError (SQL.QueryError _ _ (SQL.ResultError serverError)))) = case serverError of -- Check for a syntax error (42601 is the pg code). This would mean the error is on our part somehow, so we treat it as fatal. - H.ServerError "42601" _ _ _ + SQL.ServerError "42601" _ _ _ -> Just "Hint: This is probably a bug in PostgREST, please report it at https://github.com/PostgREST/postgrest/issues" -- Check for a "prepared statement already exists" error (Code 42P05: duplicate_prepared_statement). -- This would mean that a connection pooler in transaction mode is being used -- while prepared statements are enabled in the PostgREST configuration, -- both of which are incompatible with each other. - H.ServerError "42P05" _ _ _ + SQL.ServerError "42P05" _ _ _ -> Just "Hint: If you are using connection poolers in transaction mode, try setting db-prepared-statements to false." -- Check for a "transaction blocks not allowed in statement pooling mode" error (Code 08P01: protocol_violation). -- This would mean that a connection pooler in statement mode is being used which is not supported in PostgREST. - H.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _ + SQL.ServerError "08P01" "transaction blocks not allowed in statement pooling mode" _ _ -> Just "Hint: Connection poolers in statement mode are not supported." _ -> Nothing checkIsFatal _ = Nothing @@ -281,16 +281,16 @@ data Error | PgErr PgError instance PgrstError Error where - status GucHeadersError = HT.status500 - status GucStatusError = HT.status500 - status (BinaryFieldError _) = HT.status406 - status ConnectionLostError = HT.status503 - status PutMatchingPkError = HT.status400 - status PutRangeNotAllowedError = HT.status400 - status JwtTokenMissing = HT.status500 - status (JwtTokenInvalid _) = HT.unauthorized401 - status (SingularityError _) = HT.status406 - status NotFound = HT.status404 + status GucHeadersError = HTTP.status500 + status GucStatusError = HTTP.status500 + status (BinaryFieldError _) = HTTP.status406 + status ConnectionLostError = HTTP.status503 + status PutMatchingPkError = HTTP.status400 + status PutRangeNotAllowedError = HTTP.status400 + status JwtTokenMissing = HTTP.status500 + status (JwtTokenInvalid _) = HTTP.unauthorized401 + status (SingularityError _) = HTTP.status406 + status NotFound = HTTP.status404 status (PgErr err) = status err status (ApiRequestError err) = status err diff --git a/src/PostgREST/Middleware.hs b/src/PostgREST/Middleware.hs index c92efbf9b..8f3f256a9 100644 --- a/src/PostgREST/Middleware.hs +++ b/src/PostgREST/Middleware.hs @@ -19,10 +19,10 @@ import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as M import qualified Data.Text as T import qualified Hasql.Decoders as HD -import qualified Hasql.DynamicStatements.Snippet as H hiding - (sql) -import qualified Hasql.DynamicStatements.Statement as H -import qualified Hasql.Transaction as H +import qualified Hasql.DynamicStatements.Snippet as SQL hiding + (sql) +import qualified Hasql.DynamicStatements.Statement as SQL +import qualified Hasql.Transaction as SQL import qualified Network.HTTP.Types.Header as HTTP import qualified Network.Wai as Wai import qualified Network.Wai.Logger as Wai @@ -57,13 +57,13 @@ import Protolude.Conv (toS) -- | Runs local(transaction scoped) GUCs for every request, plus the pre-request function runPgLocals :: AppConfig -> M.HashMap Text JSON.Value -> - (ApiRequest -> ExceptT Error H.Transaction Wai.Response) -> - ApiRequest -> ByteString -> PgVersion -> ExceptT Error H.Transaction Wai.Response + (ApiRequest -> ExceptT Error SQL.Transaction Wai.Response) -> + ApiRequest -> ByteString -> PgVersion -> ExceptT Error SQL.Transaction Wai.Response runPgLocals conf claims app req jsonDbS actualPgVersion = do - lift $ H.statement mempty $ H.dynamicallyParameterized + lift $ SQL.statement mempty $ SQL.dynamicallyParameterized ("select " <> intercalateSnippet ", " (searchPathSql : roleSql ++ claimsSql ++ [methodSql, pathSql] ++ headersSql ++ cookiesSql ++ appSettingsSql ++ specSql)) HD.noResult (configDbPreparedStatements conf) - lift $ traverse_ H.sql preReqSql + lift $ traverse_ SQL.sql preReqSql app req where methodSql = setConfigLocal mempty ("request.method", iMethod req) @@ -167,12 +167,12 @@ unquoted v = toS $ JSON.encode v optionalRollback :: AppConfig -> ApiRequest - -> ExceptT Error H.Transaction Wai.Response - -> ExceptT Error H.Transaction Wai.Response + -> ExceptT Error SQL.Transaction Wai.Response + -> ExceptT Error SQL.Transaction Wai.Response optionalRollback AppConfig{..} ApiRequest{..} transaction = do resp <- catchError transaction $ return . errorResponseFor when (shouldRollback || (configDbTxRollbackAll && not shouldCommit)) - (lift H.condemn) + (lift SQL.condemn) return $ Wai.mapResponseHeaders preferenceApplied resp where shouldCommit = @@ -190,13 +190,13 @@ optionalRollback AppConfig{..} ApiRequest{..} transaction = do identity -- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL. -setConfigLocal :: ByteString -> (ByteString, ByteString) -> H.Snippet +setConfigLocal :: ByteString -> (ByteString, ByteString) -> SQL.Snippet setConfigLocal prefix (k, v) = "set_config(" <> unknownEncoder (prefix <> k) <> ", " <> unknownEncoder v <> ", true)" -- | Starting from PostgreSQL v14, some characters are not allowed for config names (mostly affecting headers with "-"). -- | A JSON format string is used to avoid this problem. See https://github.com/PostgREST/postgrest/issues/1857 -setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [H.Snippet] +setConfigLocalJson :: ByteString -> [(ByteString, ByteString)] -> [SQL.Snippet] setConfigLocalJson prefix keyVals = [setConfigLocal mempty (prefix, gucJsonVal keyVals)] where gucJsonVal :: [(ByteString, ByteString)] -> ByteString diff --git a/src/PostgREST/OpenAPI.hs b/src/PostgREST/OpenAPI.hs index 9e7d771fe..c942f71fc 100644 --- a/src/PostgREST/OpenAPI.hs +++ b/src/PostgREST/OpenAPI.hs @@ -9,7 +9,7 @@ module PostgREST.OpenAPI (encode) where import qualified Data.Aeson as JSON import qualified Data.ByteString.Lazy as LBS -import qualified Data.HashMap.Strict as HashMap +import qualified Data.HashMap.Strict as M import qualified Data.HashSet.InsOrd as Set import qualified Data.Text as T @@ -40,12 +40,12 @@ import PostgREST.ContentType import Protolude hiding (Proxy, get, toS) import Protolude.Conv (toS) -encode :: AppConfig -> DbStructure -> [Table] -> HashMap.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString +encode :: AppConfig -> DbStructure -> [Table] -> M.HashMap k [ProcDescription] -> Maybe Text -> LBS.ByteString encode conf dbStructure tables procs schemaDescription = JSON.encode $ postgrestSpec (dbRelationships dbStructure) - (concat $ HashMap.elems procs) + (concat $ M.elems procs) (openApiTableInfo dbStructure <$> tables) (proxyUri conf) schemaDescription diff --git a/src/PostgREST/Query/QueryBuilder.hs b/src/PostgREST/Query/QueryBuilder.hs index a42c11907..09ed04e9c 100644 --- a/src/PostgREST/Query/QueryBuilder.hs +++ b/src/PostgREST/Query/QueryBuilder.hs @@ -17,7 +17,7 @@ module PostgREST.Query.QueryBuilder import qualified Data.ByteString.Char8 as BS import qualified Data.Set as S -import qualified Hasql.DynamicStatements.Snippet as H +import qualified Hasql.DynamicStatements.Snippet as SQL import Data.Tree (Tree (..)) @@ -33,11 +33,11 @@ import PostgREST.Request.Types import Protolude -readRequestToQuery :: ReadRequest -> H.Snippet +readRequestToQuery :: ReadRequest -> SQL.Snippet readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicForest joinConditions_ ordts range, _) forest) = "SELECT " <> intercalateSnippet ", " ((pgFmtSelectItem qi <$> colSelects) ++ selects) <> - "FROM " <> H.sql (BS.intercalate ", " (tabl : implJs)) <> " " <> + "FROM " <> SQL.sql (BS.intercalate ", " (tabl : implJs)) <> " " <> intercalateSnippet " " joins <> " " <> (if null logicForest && null joinConditions_ then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest ++ map pgFmtJoinCondition joinConditions_)) <> " " <> @@ -49,16 +49,16 @@ readRequestToQuery (Node (Select colSelects mainQi tblAlias implJoins logicFores qi = maybe mainQi (QualifiedIdentifier mempty) tblAlias (joins, selects) = foldr getJoinsSelects ([],[]) forest -getJoinsSelects :: ReadRequest -> ([H.Snippet], [H.Snippet]) -> ([H.Snippet], [H.Snippet]) +getJoinsSelects :: ReadRequest -> ([SQL.Snippet], [SQL.Snippet]) -> ([SQL.Snippet], [SQL.Snippet]) getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTable=Table{tableName=table}}, alias, _, Just joinType, _)) _) (joins,selects) = let subquery = readRequestToQuery rr in case card of M2O _ -> let aliasOrName = fromMaybe name alias localTableName = pgFmtIdent $ table <> "_" <> aliasOrName - sel = H.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName) + sel = SQL.sql ("row_to_json(" <> localTableName <> ".*) AS " <> pgFmtIdent aliasOrName) joi = (if joinType == JTInner then " INNER" else " LEFT") - <> " JOIN LATERAL( " <> subquery <> " ) AS " <> H.sql localTableName <> " ON TRUE " in + <> " JOIN LATERAL( " <> subquery <> " ) AS " <> SQL.sql localTableName <> " ON TRUE " in (joi:joins,sel:selects) _ -> case joinType of JTInner -> @@ -66,29 +66,29 @@ getJoinsSelects rr@(Node (_, (name, Just Relationship{relCardinality=card,relTab locTblName = table <> "_" <> aliasOrName localTableName = pgFmtIdent locTblName internalTableName = pgFmtIdent $ "_" <> locTblName - sel = H.sql $ localTableName <> "." <> internalTableName <> " AS " <> pgFmtIdent aliasOrName + sel = SQL.sql $ localTableName <> "." <> internalTableName <> " AS " <> pgFmtIdent aliasOrName joi = "INNER JOIN LATERAL(" <> - "SELECT json_agg(" <> H.sql internalTableName <> ") AS " <> H.sql internalTableName <> - "FROM (" <> subquery <> " ) AS " <> H.sql internalTableName <> - ") AS " <> H.sql localTableName <> " ON " <> H.sql localTableName <> "IS NOT NULL" in + "SELECT json_agg(" <> SQL.sql internalTableName <> ") AS " <> SQL.sql internalTableName <> + "FROM (" <> subquery <> " ) AS " <> SQL.sql internalTableName <> + ") AS " <> SQL.sql localTableName <> " ON " <> SQL.sql localTableName <> "IS NOT NULL" in (joi:joins,sel:selects) JTLeft -> let sel = "COALESCE ((" - <> "SELECT json_agg(" <> H.sql (pgFmtIdent table) <> ".*) " - <> "FROM (" <> subquery <> ") " <> H.sql (pgFmtIdent table) <> " " - <> "), '[]') AS " <> H.sql (pgFmtIdent (fromMaybe name alias)) in + <> "SELECT json_agg(" <> SQL.sql (pgFmtIdent table) <> ".*) " + <> "FROM (" <> subquery <> ") " <> SQL.sql (pgFmtIdent table) <> " " + <> "), '[]') AS " <> SQL.sql (pgFmtIdent (fromMaybe name alias)) in (joins,sel:selects) getJoinsSelects _ _ = ([], []) -mutateRequestToQuery :: MutateRequest -> H.Snippet +mutateRequestToQuery :: MutateRequest -> SQL.Snippet mutateRequestToQuery (Insert mainQi iCols body onConflct putConditions returnings) = "WITH " <> normalizedBody body <> " " <> - "INSERT INTO " <> H.sql (fromQi mainQi) <> H.sql (if S.null iCols then " " else "(" <> cols <> ") ") <> - "SELECT " <> H.sql cols <> " " <> - H.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <> + "INSERT INTO " <> SQL.sql (fromQi mainQi) <> SQL.sql (if S.null iCols then " " else "(" <> cols <> ") ") <> + "SELECT " <> SQL.sql cols <> " " <> + SQL.sql ("FROM json_populate_recordset (null::" <> fromQi mainQi <> ", " <> selectBody <> ") _ ") <> -- Only used for PUT (if null putConditions then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree (QualifiedIdentifier mempty "_") <$> putConditions)) <> - H.sql (BS.unwords [ + SQL.sql (BS.unwords [ maybe "" (\(oncDo, oncCols) -> if null oncCols then mempty @@ -110,13 +110,13 @@ mutateRequestToQuery (Update mainQi uCols body logicForest returnings) = -- if there are no columns we cannot do UPDATE table SET {empty}, it'd be invalid syntax -- selecting an empty resultset from mainQi gives us the column names to prevent errors when using &select= -- the select has to be based on "returnings" to make computed overloaded functions not throw - then H.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false") + then SQL.sql ("SELECT " <> emptyBodyReturnedColumns <> " FROM " <> fromQi mainQi <> " WHERE false") else "WITH " <> normalizedBody body <> " " <> - "UPDATE " <> H.sql (fromQi mainQi) <> " SET " <> H.sql cols <> " " <> - "FROM (SELECT * FROM json_populate_recordset (null::" <> H.sql (fromQi mainQi) <> " , " <> H.sql selectBody <> " )) _ " <> + "UPDATE " <> SQL.sql (fromQi mainQi) <> " SET " <> SQL.sql cols <> " " <> + "FROM (SELECT * FROM json_populate_recordset (null::" <> SQL.sql (fromQi mainQi) <> " , " <> SQL.sql selectBody <> " )) _ " <> (if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (pgFmtLogicTree mainQi <$> logicForest)) <> " " <> - H.sql (returningF mainQi returnings) + SQL.sql (returningF mainQi returnings) where cols = BS.intercalate ", " (pgFmtIdent <> const " = _." <> pgFmtIdent <$> S.toList uCols) emptyBodyReturnedColumns :: SqlFragment @@ -124,11 +124,11 @@ mutateRequestToQuery (Update mainQi uCols body logicForest returnings) = | null returnings = "NULL" | otherwise = BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName mainQi) <$> returnings) mutateRequestToQuery (Delete mainQi logicForest returnings) = - "DELETE FROM " <> H.sql (fromQi mainQi) <> " " <> + "DELETE FROM " <> SQL.sql (fromQi mainQi) <> " " <> (if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree mainQi) logicForest)) <> " " <> - H.sql (returningF mainQi returnings) + SQL.sql (returningF mainQi returnings) -requestToCallProcQuery :: CallRequest -> H.Snippet +requestToCallProcQuery :: CallRequest -> SQL.Snippet requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall returnings) = prmsCTE <> argsBody where @@ -137,12 +137,12 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r KeyParams [] -> (mempty, mempty) KeyParams prms -> ( "WITH " <> normalizedBody args <> ", " <> - H.sql ( + SQL.sql ( BS.unwords [ "pgrst_args AS (", "SELECT * FROM json_to_recordset(" <> selectBody <> ") AS _(" <> fmtParams prms (const mempty) (\a -> " " <> encodeUtf8 (ppType a)) <> ")", ")"]) - , H.sql $ if multipleCall + , SQL.sql $ if multipleCall then fmtParams prms varadicPrefix (\a -> " := pgrst_args." <> pgFmtIdent (ppName a)) else fmtParams prms varadicPrefix (\a -> " := (SELECT " <> pgFmtIdent (ppName a) <> " FROM pgrst_args LIMIT 1)") ) @@ -154,7 +154,7 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r varadicPrefix :: ProcParam -> SqlFragment varadicPrefix a = if ppVar a then "VARIADIC " else mempty - argsBody :: H.Snippet + argsBody :: SQL.Snippet argsBody | multipleCall = if returnsScalar @@ -166,23 +166,23 @@ requestToCallProcQuery (FunctionCall qi params args returnsScalar multipleCall r then "SELECT " <> callIt <> " AS pgrst_scalar" else "SELECT " <> returnedColumns <> " FROM " <> callIt - callIt :: H.Snippet - callIt = H.sql (fromQi qi) <> "(" <> argFrag <> ")" + callIt :: SQL.Snippet + callIt = SQL.sql (fromQi qi) <> "(" <> argFrag <> ")" - returnedColumns :: H.Snippet + returnedColumns :: SQL.Snippet returnedColumns | null returnings = "*" - | otherwise = H.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings) + | otherwise = SQL.sql $ BS.intercalate ", " (pgFmtColumn (QualifiedIdentifier mempty $ qiName qi) <$> returnings) -- | SQL query meant for COUNTing the root node of the Tree. -- It only takes WHERE into account and doesn't include LIMIT/OFFSET because it would reduce the COUNT. -- SELECT 1 is done instead of SELECT * to prevent doing expensive operations(like functions based on the columns) -- inside the FROM target. -readRequestToCountQuery :: ReadRequest -> H.Snippet +readRequestToCountQuery :: ReadRequest -> SQL.Snippet readRequestToCountQuery (Node (Select{from=qi, where_=logicForest}, _) _) = - "SELECT 1 " <> "FROM " <> H.sql (fromQi qi) <> " " <> + "SELECT 1 " <> "FROM " <> SQL.sql (fromQi qi) <> " " <> if null logicForest then mempty else "WHERE " <> intercalateSnippet " AND " (map (pgFmtLogicTree qi) logicForest) -limitedQuery :: H.Snippet -> Maybe Integer -> H.Snippet -limitedQuery query maxRows = query <> H.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows) +limitedQuery :: SQL.Snippet -> Maybe Integer -> SQL.Snippet +limitedQuery query maxRows = query <> SQL.sql (maybe mempty (\x -> " LIMIT " <> BS.pack (show x)) maxRows) diff --git a/src/PostgREST/Query/SqlFragment.hs b/src/PostgREST/Query/SqlFragment.hs index 8bad14606..15adacfaf 100644 --- a/src/PostgREST/Query/SqlFragment.hs +++ b/src/PostgREST/Query/SqlFragment.hs @@ -37,10 +37,10 @@ module PostgREST.Query.SqlFragment ) where import qualified Data.ByteString.Char8 as BS -import qualified Data.ByteString.Lazy as BL -import qualified Data.HashMap.Strict as HM +import qualified Data.ByteString.Lazy as LBS +import qualified Data.HashMap.Strict as M import qualified Data.Text as T -import qualified Hasql.DynamicStatements.Snippet as H +import qualified Hasql.DynamicStatements.Snippet as SQL import qualified Hasql.Encoders as HE import Data.Foldable (foldr1) @@ -72,8 +72,8 @@ noLocationF = "array[]::text[]" sourceCTEName :: SqlFragment sourceCTEName = "pgrst_source" -operators :: HM.HashMap Text SqlFragment -operators = HM.union (HM.fromList [ +operators :: M.HashMap Text SqlFragment +operators = M.union (M.fromList [ ("eq", "="), ("gte", ">="), ("gt", ">"), @@ -93,8 +93,8 @@ operators = HM.union (HM.fromList [ ("nxl", "&>"), ("adj", "-|-")]) ftsOperators -ftsOperators :: HM.HashMap Text SqlFragment -ftsOperators = HM.fromList [ +ftsOperators :: M.HashMap Text SqlFragment +ftsOperators = M.fromList [ ("fts", "@@ to_tsquery"), ("plfts", "@@ plainto_tsquery"), ("phfts", "@@ phraseto_tsquery"), @@ -106,10 +106,10 @@ ftsOperators = HM.fromList [ -- Otherwise we'd have to use json_populate_record for json objects and json_populate_recordset for json arrays -- We do this in SQL to avoid processing the JSON in application code -- TODO: At this stage there shouldn't be a Maybe since ApiRequest should ensure that an INSERT/UPDATE has a body -normalizedBody :: Maybe BL.ByteString -> H.Snippet +normalizedBody :: Maybe LBS.ByteString -> SQL.Snippet normalizedBody body = "pgrst_payload AS (SELECT " <> jsonPlaceHolder <> " AS json_data), " <> - H.sql (BS.unwords [ + SQL.sql (BS.unwords [ "pgrst_body AS (", "SELECT", "CASE WHEN json_typeof(json_data) = 'array'", @@ -118,14 +118,14 @@ normalizedBody body = "END AS val", "FROM pgrst_payload)"]) where - jsonPlaceHolder = H.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::json" + jsonPlaceHolder = SQL.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::json" -singleParameter :: Maybe BL.ByteString -> ByteString -> H.Snippet +singleParameter :: Maybe LBS.ByteString -> ByteString -> SQL.Snippet singleParameter body typ = if typ == "bytea" -- TODO: Hasql fails when using HE.unknown with bytea(pg tries to utf8 encode). - then H.encoderAndParam (HE.nullable HE.bytea) (toS <$> body) - else H.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::" <> H.sql typ + then SQL.encoderAndParam (HE.nullable HE.bytea) (toS <$> body) + else SQL.encoderAndParam (HE.nullable HE.unknown) (toS <$> body) <> "::" <> SQL.sql typ selectBody :: SqlFragment selectBody = "(SELECT val FROM pgrst_body)" @@ -202,24 +202,24 @@ pgFmtColumn :: QualifiedIdentifier -> Text -> SqlFragment pgFmtColumn table "*" = fromQi table <> ".*" pgFmtColumn table c = fromQi table <> "." <> pgFmtIdent c -pgFmtField :: QualifiedIdentifier -> Field -> H.Snippet -pgFmtField table (c, jp) = H.sql (pgFmtColumn table c) <> pgFmtJsonPath jp +pgFmtField :: QualifiedIdentifier -> Field -> SQL.Snippet +pgFmtField table (c, jp) = SQL.sql (pgFmtColumn table c) <> pgFmtJsonPath jp -pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> H.Snippet -pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> H.sql (pgFmtAs fName jp alias) +pgFmtSelectItem :: QualifiedIdentifier -> SelectItem -> SQL.Snippet +pgFmtSelectItem table (f@(fName, jp), Nothing, alias, _, _) = pgFmtField table f <> SQL.sql (pgFmtAs fName jp alias) -- Ideally we'd quote the cast with "pgFmtIdent cast". However, that would invalidate common casts such as "int", "bigint", etc. -- Try doing: `select 1::"bigint"` - it'll err, using "int8" will work though. There's some parser magic that pg does that's invalidated when quoting. -- Not quoting should be fine, we validate the input on Parsers. -pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _, _) = "CAST (" <> pgFmtField table f <> " AS " <> H.sql (encodeUtf8 cast) <> " )" <> H.sql (pgFmtAs fName jp alias) +pgFmtSelectItem table (f@(fName, jp), Just cast, alias, _, _) = "CAST (" <> pgFmtField table f <> " AS " <> SQL.sql (encodeUtf8 cast) <> " )" <> SQL.sql (pgFmtAs fName jp alias) -pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> H.Snippet +pgFmtOrderTerm :: QualifiedIdentifier -> OrderTerm -> SQL.Snippet pgFmtOrderTerm qi ot = pgFmtField qi (otTerm ot) <> " " <> - H.sql (BS.unwords [ + SQL.sql (BS.unwords [ BS.pack $ maybe mempty show $ otDirection ot, BS.pack $ maybe mempty show $ otNullOrder ot]) -pgFmtFilter :: QualifiedIdentifier -> Filter -> H.Snippet +pgFmtFilter :: QualifiedIdentifier -> Filter -> SQL.Snippet pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper of Op op val -> pgFmtFieldOp op <> " " <> case op of "like" -> unknownLiteral (T.map star val) @@ -239,27 +239,27 @@ pgFmtFilter table (Filter fld (OpExpr hasNot oper)) = notOp <> " " <> case oper where ftsLang = maybe mempty (\l -> unknownLiteral l <> ", ") pgFmtFieldOp op = pgFmtField table fld <> " " <> sqlOperator op - sqlOperator o = H.sql $ HM.lookupDefault "=" o operators + sqlOperator o = SQL.sql $ M.lookupDefault "=" o operators notOp = if hasNot then "NOT" else mempty star c = if c == '*' then '%' else c -- IS cannot be prepared. `PREPARE boolplan AS SELECT * FROM projects where id IS $1` will give a syntax error. -- The above can be fixed by using `PREPARE boolplan AS SELECT * FROM projects where id IS NOT DISTINCT FROM $1;` -- However that would not accept the TRUE/FALSE/NULL keywords. See: https://stackoverflow.com/questions/6133525/proper-way-to-set-preparedstatement-parameter-to-null-under-postgres. - isAllowed :: Text -> H.Snippet - isAllowed v = H.sql $ maybe + isAllowed :: Text -> SQL.Snippet + isAllowed v = SQL.sql $ maybe (pgFmtLit v <> "::unknown") encodeUtf8 (find ((==) . T.toLower $ v) ["null","true","false"]) -pgFmtJoinCondition :: JoinCondition -> H.Snippet +pgFmtJoinCondition :: JoinCondition -> SQL.Snippet pgFmtJoinCondition (JoinCondition (qi1, col1) (qi2, col2)) = - H.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2 + SQL.sql $ pgFmtColumn qi1 col1 <> " = " <> pgFmtColumn qi2 col2 -pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> H.Snippet -pgFmtLogicTree qi (Expr hasNot op forest) = H.sql notOp <> " (" <> intercalateSnippet (" " <> BS.pack (show op) <> " ") (pgFmtLogicTree qi <$> forest) <> ")" +pgFmtLogicTree :: QualifiedIdentifier -> LogicTree -> SQL.Snippet +pgFmtLogicTree qi (Expr hasNot op forest) = SQL.sql notOp <> " (" <> intercalateSnippet (" " <> BS.pack (show op) <> " ") (pgFmtLogicTree qi <$> forest) <> ")" where notOp = if hasNot then "NOT" else mempty pgFmtLogicTree qi (Stmnt flt) = pgFmtFilter qi flt -pgFmtJsonPath :: JsonPath -> H.Snippet +pgFmtJsonPath :: JsonPath -> SQL.Snippet pgFmtJsonPath = \case [] -> mempty (JArrow x:xs) -> "->" <> pgFmtJsonOperand x <> pgFmtJsonPath xs @@ -280,7 +280,7 @@ pgFmtAs fName jp Nothing = case jOp <$> lastMay jp of Nothing -> mempty pgFmtAs _ _ (Just alias) = " AS " <> pgFmtIdent alias -countF :: H.Snippet -> Bool -> (H.Snippet, SqlFragment) +countF :: SQL.Snippet -> Bool -> (SQL.Snippet, SqlFragment) countF countQuery shouldCount = if shouldCount then ( @@ -296,7 +296,7 @@ returningF qi returnings = then "RETURNING 1" -- For mutation cases where there's no ?select, we return 1 to know how many rows were modified else "RETURNING " <> BS.intercalate ", " (pgFmtColumn qi <$> returnings) -limitOffsetF :: NonnegRange -> H.Snippet +limitOffsetF :: NonnegRange -> SQL.Snippet limitOffsetF range = if range == allRange then mempty else "LIMIT " <> limit <> " OFFSET " <> offset where @@ -321,12 +321,12 @@ currentSettingF setting = "nullif(current_setting(" <> pgFmtLit setting <> ", true), '')" -- Hasql Snippet utilities -unknownEncoder :: ByteString -> H.Snippet -unknownEncoder = H.encoderAndParam (HE.nonNullable HE.unknown) +unknownEncoder :: ByteString -> SQL.Snippet +unknownEncoder = SQL.encoderAndParam (HE.nonNullable HE.unknown) -unknownLiteral :: Text -> H.Snippet +unknownLiteral :: Text -> SQL.Snippet unknownLiteral = unknownEncoder . encodeUtf8 -intercalateSnippet :: ByteString -> [H.Snippet] -> H.Snippet +intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet intercalateSnippet _ [] = mempty -intercalateSnippet frag snippets = foldr1 (\a b -> a <> H.sql frag <> b) snippets +intercalateSnippet frag snippets = foldr1 (\a b -> a <> SQL.sql frag <> b) snippets diff --git a/src/PostgREST/Query/Statements.hs b/src/PostgREST/Query/Statements.hs index 9848606d6..26ad6307e 100644 --- a/src/PostgREST/Query/Statements.hs +++ b/src/PostgREST/Query/Statements.hs @@ -20,9 +20,9 @@ import qualified Data.Aeson as JSON import qualified Data.Aeson.Lens as L import qualified Data.ByteString.Char8 as BS import qualified Hasql.Decoders as HD -import qualified Hasql.DynamicStatements.Snippet as H -import qualified Hasql.DynamicStatements.Statement as H -import qualified Hasql.Statement as H +import qualified Hasql.DynamicStatements.Snippet as SQL +import qualified Hasql.DynamicStatements.Statement as SQL +import qualified Hasql.Statement as SQL import Control.Lens ((^?)) import Data.Maybe (fromJust) @@ -46,15 +46,15 @@ import Protolude.Conv (toS) -} type ResultsWithCount = (Maybe Int64, Int64, [BS.ByteString], BS.ByteString, Either Error [GucHeader], Either Error (Maybe Status)) -createWriteStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool -> +createWriteStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool -> PreferRepresentation -> [Text] -> PgVersion -> Bool -> - H.Statement () ResultsWithCount + SQL.Statement () ResultsWithCount createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys pgVer = - H.dynamicallyParameterized snippet decodeStandard + SQL.dynamicallyParameterized snippet decodeStandard where snippet = - "WITH " <> H.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <> - H.sql ( + "WITH " <> SQL.sql sourceCTEName <> " AS (" <> mutateQuery <> ") " <> + SQL.sql ( "SELECT " <> "'' AS total_result_set, " <> "pg_catalog.count(_postgrest_t) AS page_total, " <> @@ -82,23 +82,23 @@ createWriteStatement selectQuery mutateQuery wantSingle isInsert asCsv rep pKeys selectF -- prevent using any of the column names in ?select= when no response is returned from the CTE - | rep `elem` [None, HeadersOnly] = H.sql ("SELECT * FROM " <> sourceCTEName) + | rep `elem` [None, HeadersOnly] = SQL.sql ("SELECT * FROM " <> sourceCTEName) | otherwise = selectQuery decodeStandard :: HD.Result ResultsWithCount decodeStandard = fromMaybe (Nothing, 0, [], mempty, Right [], Right Nothing) <$> HD.rowMaybe standardRow -createReadStatement :: H.Snippet -> H.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool -> - H.Statement () ResultsWithCount +createReadStatement :: SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool -> + SQL.Statement () ResultsWithCount createReadStatement selectQuery countQuery isSingle countTotal asCsv binaryField pgVer = - H.dynamicallyParameterized snippet decodeStandard + SQL.dynamicallyParameterized snippet decodeStandard where snippet = "WITH " <> - H.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <> + SQL.sql sourceCTEName <> " AS ( " <> selectQuery <> " ) " <> countCTEF <> " " <> - H.sql ("SELECT " <> + SQL.sql ("SELECT " <> countResultF <> " AS total_result_set, " <> "pg_catalog.count(_postgrest_t) AS page_total, " <> noLocationF <> " AS header, " <> @@ -131,16 +131,16 @@ standardRow = (,,,,,) <$> nullableColumn HD.int8 <*> column HD.int8 type ProcResults = (Maybe Int64, Int64, ByteString, Either Error [GucHeader], Either Error (Maybe Status)) -callProcStatement :: Bool -> Bool -> H.Snippet -> H.Snippet -> H.Snippet -> Bool -> +callProcStatement :: Bool -> Bool -> SQL.Snippet -> SQL.Snippet -> SQL.Snippet -> Bool -> Bool -> Bool -> Bool -> Maybe FieldName -> PgVersion -> Bool -> - H.Statement () ProcResults + SQL.Statement () ProcResults callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQuery countTotal asSingle asCsv multObjects binaryField pgVer = - H.dynamicallyParameterized snippet decodeProc + SQL.dynamicallyParameterized snippet decodeProc where snippet = - "WITH " <> H.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <> + "WITH " <> SQL.sql sourceCTEName <> " AS (" <> callProcQuery <> ") " <> countCTEF <> - H.sql ( + SQL.sql ( "SELECT " <> countResultF <> " AS total_result_set, " <> "pg_catalog.count(_postgrest_t) AS page_total, " <> @@ -170,9 +170,9 @@ callProcStatement returnsScalar returnsSingle callProcQuery selectQuery countQue <*> (fromMaybe defGucHeaders <$> nullableColumn decodeGucHeaders) <*> (fromMaybe defGucStatus <$> nullableColumn decodeGucStatus) -createExplainStatement :: H.Snippet -> Bool -> H.Statement () (Maybe Int64) +createExplainStatement :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64) createExplainStatement countQuery = - H.dynamicallyParameterized snippet decodeExplain + SQL.dynamicallyParameterized snippet decodeExplain where snippet = "EXPLAIN (FORMAT JSON) " <> countQuery -- | diff --git a/src/PostgREST/Request/ApiRequest.hs b/src/PostgREST/Request/ApiRequest.hs index 062728567..3cbc6d45c 100644 --- a/src/PostgREST/Request/ApiRequest.hs +++ b/src/PostgREST/Request/ApiRequest.hs @@ -19,7 +19,7 @@ module PostgREST.Request.ApiRequest import qualified Data.Aeson as JSON import qualified Data.ByteString as BS -import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy as LBS import qualified Data.CaseInsensitive as CI import qualified Data.Csv as CSV import qualified Data.HashMap.Strict as M @@ -72,11 +72,11 @@ import Protolude hiding (head, toS) import Protolude.Conv (toS) -type RequestBody = BL.ByteString +type RequestBody = LBS.ByteString data Payload = ProcessedJSON -- ^ Cached attributes of a JSON payload - { payRaw :: BL.ByteString + { payRaw :: LBS.ByteString -- ^ This is the raw ByteString that comes from the request body. We -- cache this instead of an Aeson Value because it was detected that for -- large payloads the encoding had high memory usage, see @@ -85,8 +85,8 @@ data Payload -- ^ Keys of the object or if it's an array these keys are guaranteed to -- be the same across all its objects } - | RawJSON { payRaw :: BL.ByteString } - | RawPay { payRaw :: BL.ByteString } + | RawJSON { payRaw :: LBS.ByteString } + | RawPay { payRaw :: LBS.ByteString } data InvokeMethod = InvHead | InvGet | InvPost deriving Eq -- | Types of things a user wants to do to tables/views/procs @@ -273,7 +273,7 @@ userApiRequest conf@AppConfig{..} dbStructure req reqBody if isJust columns then Right $ RawJSON reqBody else note "All object keys must match" . payloadAttributes reqBody - =<< if BL.null reqBody && isTargetingProc + =<< if LBS.null reqBody && isTargetingProc then Right emptyObject else JSON.eitherDecode reqBody CTTextCSV -> do @@ -406,7 +406,7 @@ mutuallyAgreeable sProduces cAccepts = then listToMaybe sProduces else exact -type CsvData = V.Vector (M.HashMap Text BL.ByteString) +type CsvData = V.Vector (M.HashMap Text LBS.ByteString) {-| Converts CSV like diff --git a/src/PostgREST/Request/Types.hs b/src/PostgREST/Request/Types.hs index 9c1a792dd..6acbb4cbd 100644 --- a/src/PostgREST/Request/Types.hs +++ b/src/PostgREST/Request/Types.hs @@ -34,7 +34,7 @@ module PostgREST.Request.Types , fstFieldNames ) where -import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy as LBS import qualified Data.Set as S import Data.Tree (Tree (..)) @@ -110,7 +110,7 @@ data MutateQuery = Insert { in_ :: QualifiedIdentifier , insCols :: S.Set FieldName - , insBody :: Maybe BL.ByteString + , insBody :: Maybe LBS.ByteString , onConflict :: Maybe (PreferResolution, [FieldName]) , where_ :: [LogicTree] , returning :: [FieldName] @@ -118,7 +118,7 @@ data MutateQuery | Update { in_ :: QualifiedIdentifier , updCols :: S.Set FieldName - , updBody :: Maybe BL.ByteString + , updBody :: Maybe LBS.ByteString , where_ :: [LogicTree] , returning :: [FieldName] } @@ -131,7 +131,7 @@ data MutateQuery data CallQuery = FunctionCall { funCQi :: QualifiedIdentifier , funCParams :: CallParams - , funCArgs :: Maybe BL.ByteString + , funCArgs :: Maybe LBS.ByteString , funCScalar :: Bool , funCMultipleCall :: Bool , funCReturning :: [FieldName] diff --git a/src/PostgREST/Workers.hs b/src/PostgREST/Workers.hs index 3aa19c06d..be2cc8c10 100644 --- a/src/PostgREST/Workers.hs +++ b/src/PostgREST/Workers.hs @@ -9,13 +9,13 @@ module PostgREST.Workers import qualified Data.Aeson as JSON import qualified Data.ByteString as BS -import qualified Hasql.Connection as C -import qualified Hasql.Notifications as N -import qualified Hasql.Pool as P -import qualified Hasql.Transaction.Sessions as HT +import qualified Hasql.Notifications as SQL +import qualified Hasql.Pool as SQL +import qualified Hasql.Transaction.Sessions as SQL -import Control.Retry (RetryStatus, capDelay, exponentialBackoff, - retrying, rsPreviousDelay) +import Control.Retry (RetryStatus, capDelay, exponentialBackoff, + retrying, rsPreviousDelay) +import Hasql.Connection (acquire) import PostgREST.AppState (AppState) import PostgREST.Config (AppConfig (..), readAppConfig) @@ -108,7 +108,7 @@ connectionWorker appState = do connectionStatus :: AppState -> IO ConnectionStatus connectionStatus appState = retrying retrySettings shouldRetry $ - const $ P.release pool >> getConnectionStatus + const $ SQL.release pool >> getConnectionStatus where pool = AppState.getPool appState retrySettings = capDelay delayMicroseconds $ exponentialBackoff backoffMicroseconds @@ -117,7 +117,7 @@ connectionStatus appState = getConnectionStatus :: IO ConnectionStatus getConnectionStatus = do - pgVersion <- P.use pool queryPgVersion + pgVersion <- SQL.use pool queryPgVersion case pgVersion of Left e -> do let err = PgError False e @@ -152,8 +152,8 @@ loadSchemaCache :: AppState -> IO SCacheStatus loadSchemaCache appState = do AppConfig{..} <- AppState.getConfig appState result <- - let transaction = if configDbPreparedStatements then HT.transaction else HT.unpreparedTransaction in - P.use (AppState.getPool appState) . transaction HT.ReadCommitted HT.Read $ + let transaction = if configDbPreparedStatements then SQL.transaction else SQL.unpreparedTransaction in + SQL.use (AppState.getPool appState) . transaction SQL.ReadCommitted SQL.Read $ queryDbStructure (toList configDbSchemas) configDbExtraSearchPath configDbPreparedStatements case result of Left e -> do @@ -194,12 +194,12 @@ listener appState = do -- forkFinally allows to detect if the thread dies void . flip forkFinally (handleFinally dbChannel) $ do - dbOrError <- C.acquire $ toS configDbUri + dbOrError <- acquire $ toS configDbUri case dbOrError of Right db -> do AppState.logWithZTime appState $ "Listening for notifications on the " <> dbChannel <> " channel" - N.listen db $ N.toPgIdentifier dbChannel - N.waitForNotifications handleNotification db + SQL.listen db $ SQL.toPgIdentifier dbChannel + SQL.waitForNotifications handleNotification db _ -> die $ "Could not listen for notifications on the " <> dbChannel <> " channel" where