diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,54 @@ +# 1.9 + +- Revised the settings construction exposing a tree of modules +- Added a global prepared statements setting + +## Why the changes? + +To introduce the new global prepared statements setting and to make the settings API ready for extension without backward compatibility breakage. + +## Instructions on upgrading the 1.8 code + +### When explicit connection string is used + +Replace + +```haskell +Hasql.Connection.acquire connectionString +``` + +with + +```haskell +Hasql.Connection.acquire + [ Hasql.Connection.Setting.connection (Hasql.Connection.Setting.Connection.string connectionString) + ] +``` + +### When parameteric connection string is used + +Replace + +```haskell +Hasql.Connection.acquire (Hasql.Connection.settings host port user password dbname) +``` + +with + +```haskell +Hasql.Connection.acquire + [ Hasql.Connection.Setting.connection + ( Hasql.Connection.Setting.Connection.params + [ Hasql.Connection.Setting.Connection.Param.host host, + Hasql.Connection.Setting.Connection.Param.port port, + Hasql.Connection.Setting.Connection.Param.user user, + Hasql.Connection.Setting.Connection.Param.password password, + Hasql.Connection.Setting.Connection.Param.dbname dbname + ] + ) + ] +``` + # 1.8.1 - In case of exceptions thrown by user from inside of Session, the connection status gets checked to be out of transaction and unless it is the connection gets reset. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -86,7 +86,7 @@ result <- Session.run (sumAndDivModSession 3 8 3) connection print result where - connectionSettings = Connection.settings "localhost" 5432 "postgres" "" "postgres" + connectionSettings = Connection.connectionString "localhost" 5432 "postgres" "" "postgres" -- * Sessions diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs --- a/benchmarks/Main.hs +++ b/benchmarks/Main.hs @@ -16,7 +16,7 @@ useConnection connection where acquireConnection = - A.acquire "" + A.acquire [] useConnection connection = defaultMain [ sessionBench "largeResultInVector" sessionWithSingleLargeResultInVector, diff --git a/hasql.cabal b/hasql.cabal --- a/hasql.cabal +++ b/hasql.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hasql -version: 1.8.1.4 +version: 1.9 category: Hasql, Database, PostgreSQL synopsis: Fast PostgreSQL driver with a flexible mapping API description: @@ -63,6 +63,7 @@ LiberalTypeSynonyms MultiParamTypeClasses MultiWayIf + NamedFieldPuns NoImplicitPrelude NoMonomorphismRestriction OverloadedStrings @@ -99,6 +100,9 @@ hs-source-dirs: library exposed-modules: Hasql.Connection + Hasql.Connection.Setting + Hasql.Connection.Setting.Connection + Hasql.Connection.Setting.Connection.Param Hasql.Decoders Hasql.Encoders Hasql.Pipeline @@ -107,6 +111,9 @@ other-modules: Hasql.Commands + Hasql.Connection.Config + Hasql.Connection.Config.ConnectionString + Hasql.Connection.Config.ConnectionString.Params Hasql.Connection.Core Hasql.Decoders.All Hasql.Decoders.Array @@ -129,7 +136,6 @@ Hasql.Prelude Hasql.PreparedStatementRegistry Hasql.Session.Core - Hasql.Settings build-depends: aeson >=2 && <3, @@ -137,6 +143,7 @@ base >=4.14 && <5, bytestring >=0.10 && <0.13, bytestring-strict-builder >=0.4.5.1 && <0.5, + containers >=0.6 && <0.8, contravariant >=1.3 && <2, dlist >=0.8 && <0.9 || >=1 && <2, hashable >=1.2 && <2, diff --git a/hspec/Hasql/PipelineSpec.hs b/hspec/Hasql/PipelineSpec.hs --- a/hspec/Hasql/PipelineSpec.hs +++ b/hspec/Hasql/PipelineSpec.hs @@ -57,12 +57,13 @@ it "Leaves the connection usable" do result <- Dsl.runSessionOnLocalDb do - tryError - $ Dsl.runPipelineInSession - $ (,,) - <$> GenerateSeries.pipeline True GenerateSeries.Params {start = 0, end = 2} - <*> BrokenSyntax.pipeline True BrokenSyntax.Params {start = 0, end = 2} - <*> GenerateSeries.pipeline True GenerateSeries.Params {start = 0, end = 2} + _ <- + tryError + $ Dsl.runPipelineInSession + $ (,,) + <$> GenerateSeries.pipeline True GenerateSeries.Params {start = 0, end = 2} + <*> BrokenSyntax.pipeline True BrokenSyntax.Params {start = 0, end = 2} + <*> GenerateSeries.pipeline True GenerateSeries.Params {start = 0, end = 2} GenerateSeries.session True GenerateSeries.Params {start = 0, end = 0} shouldBe result (Right [0]) @@ -81,11 +82,12 @@ it "Leaves the connection usable" do result <- Dsl.runSessionOnLocalDb do - tryError - $ Dsl.runPipelineInSession - $ (,,) - <$> GenerateSeries.pipeline True GenerateSeries.Params {start = 0, end = 2} - <*> WrongDecoder.pipeline True WrongDecoder.Params {start = 0, end = 2} - <*> GenerateSeries.pipeline True GenerateSeries.Params {start = 0, end = 2} + _ <- + tryError + $ Dsl.runPipelineInSession + $ (,,) + <$> GenerateSeries.pipeline True GenerateSeries.Params {start = 0, end = 2} + <*> WrongDecoder.pipeline True WrongDecoder.Params {start = 0, end = 2} + <*> GenerateSeries.pipeline True GenerateSeries.Params {start = 0, end = 2} GenerateSeries.session True GenerateSeries.Params {start = 0, end = 0} shouldBe result (Right [0]) diff --git a/library/Hasql/Connection.hs b/library/Hasql/Connection.hs --- a/library/Hasql/Connection.hs +++ b/library/Hasql/Connection.hs @@ -5,11 +5,8 @@ ConnectionError, acquire, release, - Settings, - settings, withLibPQConnection, ) where import Hasql.Connection.Core -import Hasql.Settings diff --git a/library/Hasql/Connection/Config.hs b/library/Hasql/Connection/Config.hs new file mode 100644 --- /dev/null +++ b/library/Hasql/Connection/Config.hs @@ -0,0 +1,29 @@ +module Hasql.Connection.Config where + +import Hasql.Prelude + +data Config = Config + { connectionString :: ByteString, + usePreparedStatements :: Bool + } + +class Updates a where + update :: a -> Config -> Config + +nil :: Config +nil = + Config + { connectionString = "", + usePreparedStatements = True + } + +fromUpdates :: (Updates a) => [a] -> Config +fromUpdates = foldl' (flip update) nil + +setConnectionString :: ByteString -> Config -> Config +setConnectionString connectionString config = + config {connectionString} + +setUsePreparedStatements :: Bool -> Config -> Config +setUsePreparedStatements usePreparedStatements config = + config {usePreparedStatements} diff --git a/library/Hasql/Connection/Config/ConnectionString.hs b/library/Hasql/Connection/Config/ConnectionString.hs new file mode 100644 --- /dev/null +++ b/library/Hasql/Connection/Config/ConnectionString.hs @@ -0,0 +1,21 @@ +module Hasql.Connection.Config.ConnectionString where + +import Data.ByteString qualified as B +import Data.Map.Strict qualified as Map +import Data.Text.Encoding qualified +import Hasql.Connection.Config.ConnectionString.Params qualified as Params +import Hasql.Prelude + +type ConnectionString = ByteString + +class Constructs a where + construct :: a -> ConnectionString + +fromText :: Text -> ConnectionString +fromText = Data.Text.Encoding.encodeUtf8 + +fromParams :: Params.Params -> ConnectionString +fromParams = + B.intercalate " " . fmap renderParam . Map.toList + where + renderParam (k, v) = mconcat [k, "=", v] diff --git a/library/Hasql/Connection/Config/ConnectionString/Params.hs b/library/Hasql/Connection/Config/ConnectionString/Params.hs new file mode 100644 --- /dev/null +++ b/library/Hasql/Connection/Config/ConnectionString/Params.hs @@ -0,0 +1,18 @@ +module Hasql.Connection.Config.ConnectionString.Params where + +import Data.Map.Strict qualified as Map +import Hasql.Prelude + +type Params = Map.Map ByteString ByteString + +class Updates a where + update :: a -> Params -> Params + +nil :: Params +nil = Map.empty + +fromUpdates :: (Updates a) => [a] -> Params +fromUpdates = foldl' (flip update) nil + +setKeyValue :: ByteString -> ByteString -> Params -> Params +setKeyValue key value = Map.insert key value diff --git a/library/Hasql/Connection/Core.hs b/library/Hasql/Connection/Core.hs --- a/library/Hasql/Connection/Core.hs +++ b/library/Hasql/Connection/Core.hs @@ -2,16 +2,25 @@ -- This module provides a low-level effectful API dealing with the connections to the database. module Hasql.Connection.Core where +import Hasql.Connection.Config qualified as Config +import Hasql.Connection.Setting qualified as Setting import Hasql.IO qualified as IO import Hasql.LibPq14 qualified as LibPQ import Hasql.Prelude import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry -import Hasql.Settings qualified as Settings -- | -- A single connection to the database. data Connection - = Connection !(MVar LibPQ.Connection) !Bool !PreparedStatementRegistry.PreparedStatementRegistry + = Connection + -- | Whether prepared statements are allowed. + !Bool + -- | Lower level libpq connection. + !(MVar LibPQ.Connection) + -- | Integer datetimes. + !Bool + -- | Prepared statement registry. + !PreparedStatementRegistry.PreparedStatementRegistry -- | -- Possible details of the connection acquistion error. @@ -19,23 +28,27 @@ Maybe ByteString -- | --- Acquire a connection using the provided settings encoded according to the PostgreSQL format. -acquire :: Settings.Settings -> IO (Either ConnectionError Connection) +-- Establish a connection according to the provided settings. +acquire :: + [Setting.Setting] -> + IO (Either ConnectionError Connection) acquire settings = {-# SCC "acquire" #-} runExceptT $ do - pqConnection <- lift (IO.acquireConnection settings) + pqConnection <- lift (IO.acquireConnection (Config.connectionString config)) lift (IO.checkConnectionStatus pqConnection) >>= traverse throwError lift (IO.initConnection pqConnection) integerDatetimes <- lift (IO.getIntegerDatetimes pqConnection) registry <- lift (IO.acquirePreparedStatementRegistry) pqConnectionRef <- lift (newMVar pqConnection) - pure (Connection pqConnectionRef integerDatetimes registry) + pure (Connection (Config.usePreparedStatements config) pqConnectionRef integerDatetimes registry) + where + config = Config.fromUpdates settings -- | -- Release the connection. release :: Connection -> IO () -release (Connection pqConnectionRef _ _) = +release (Connection _ pqConnectionRef _ _) = mask_ $ do nullConnection <- LibPQ.newNullConnection pqConnection <- swapMVar pqConnectionRef nullConnection @@ -46,5 +59,5 @@ -- -- The access to the connection is exclusive. withLibPQConnection :: Connection -> (LibPQ.Connection -> IO a) -> IO a -withLibPQConnection (Connection pqConnectionRef _ _) = +withLibPQConnection (Connection _ pqConnectionRef _ _) = withMVar pqConnectionRef diff --git a/library/Hasql/Connection/Setting.hs b/library/Hasql/Connection/Setting.hs new file mode 100644 --- /dev/null +++ b/library/Hasql/Connection/Setting.hs @@ -0,0 +1,35 @@ +module Hasql.Connection.Setting + ( Setting, + connection, + usePreparedStatements, + ) +where + +import Hasql.Connection.Config qualified as Config +import Hasql.Connection.Config.ConnectionString qualified as Config.ConnectionString +import Hasql.Connection.Setting.Connection qualified as Connection +import Hasql.Prelude + +-- | Setting of a client handle. +newtype Setting = Setting (Config.Config -> Config.Config) + +instance Config.Updates Setting where + update (Setting update) = update + +-- | Connection details like address of the remote service and authentication info. +connection :: Connection.Connection -> Setting +connection = + Setting . Config.setConnectionString . Config.ConnectionString.construct + +-- | Whether prepared statements are allowed. +-- +-- When 'False', even the statements marked as preparable will be executed without preparation. +-- +-- This is useful when dealing with proxying applications like @pgbouncer@, which may be incompatible with prepared statements. +-- Consult their docs or just set it to 'False' to stay on the safe side. +-- It should be noted that starting from version @1.21.0@ @pgbouncer@ now does provide support for prepared statements. +-- +-- 'True' by default. +usePreparedStatements :: Bool -> Setting +usePreparedStatements = + Setting . Config.setUsePreparedStatements diff --git a/library/Hasql/Connection/Setting/Connection.hs b/library/Hasql/Connection/Setting/Connection.hs new file mode 100644 --- /dev/null +++ b/library/Hasql/Connection/Setting/Connection.hs @@ -0,0 +1,27 @@ +module Hasql.Connection.Setting.Connection + ( Connection, + string, + params, + ) +where + +import Hasql.Connection.Config.ConnectionString qualified as Config.ConnectionString +import Hasql.Connection.Config.ConnectionString.Params qualified as Config.ConnectionString.Params +import Hasql.Connection.Setting.Connection.Param qualified as Param +import Hasql.Prelude + +-- | Instructions on how to connect to the database. +newtype Connection = Connection ByteString + +instance Config.ConnectionString.Constructs Connection where + construct = coerce + +-- | Preconstructed connection string according to . +string :: Text -> Connection +string = + Connection . Config.ConnectionString.fromText + +-- | Structured parameters. +params :: [Param.Param] -> Connection +params = + Connection . Config.ConnectionString.fromParams . Config.ConnectionString.Params.fromUpdates diff --git a/library/Hasql/Connection/Setting/Connection/Param.hs b/library/Hasql/Connection/Setting/Connection/Param.hs new file mode 100644 --- /dev/null +++ b/library/Hasql/Connection/Setting/Connection/Param.hs @@ -0,0 +1,52 @@ +module Hasql.Connection.Setting.Connection.Param + ( Param, + host, + port, + user, + password, + dbname, + other, + ) +where + +import Data.ByteString.Builder qualified as BB +import Data.ByteString.Lazy qualified as BL +import Data.Text.Encoding qualified as Text +import Hasql.Connection.Config.ConnectionString.Params qualified as Config +import Hasql.Prelude + +-- | Parameter of the connection instructions. +newtype Param = Param (Config.Params -> Config.Params) + +instance Config.Updates Param where + update = coerce + +-- | Host domain name or IP-address. +host :: Text -> Param +host = + Param . Config.setKeyValue "host" . Text.encodeUtf8 + +-- | Port number. +port :: Word16 -> Param +port = + Param . Config.setKeyValue "port" . BL.toStrict . BB.toLazyByteString . BB.word16Dec + +-- | User name. +user :: Text -> Param +user = + Param . Config.setKeyValue "user" . Text.encodeUtf8 + +-- | Password. +password :: Text -> Param +password = + Param . Config.setKeyValue "password" . Text.encodeUtf8 + +-- | Database name. +dbname :: Text -> Param +dbname = + Param . Config.setKeyValue "dbname" . Text.encodeUtf8 + +-- | Any other parameter under the provided name according to . +other :: Text -> Text -> Param +other name = + Param . Config.setKeyValue (Text.encodeUtf8 name) . Text.encodeUtf8 diff --git a/library/Hasql/Encoders/All.hs b/library/Hasql/Encoders/All.hs --- a/library/Hasql/Encoders/All.hs +++ b/library/Hasql/Encoders/All.hs @@ -406,11 +406,11 @@ -- | Single field of a row-type. field :: NullableOrNot Value a -> Composite a field = \case - NonNullable (Value (Value.Value elementOID arrayOID encode print)) -> + NonNullable (Value (Value.Value elementOID _ encode print)) -> Composite (\val idt -> A.field (PTI.oidWord32 elementOID) (encode idt val)) (\val -> [print val]) - Nullable (Value (Value.Value elementOID arrayOID encode print)) -> + Nullable (Value (Value.Value elementOID _ encode print)) -> Composite ( \val idt -> case val of Nothing -> A.nullField (PTI.oidWord32 elementOID) diff --git a/library/Hasql/Encoders/Params.hs b/library/Hasql/Encoders/Params.hs --- a/library/Hasql/Encoders/Params.hs +++ b/library/Hasql/Encoders/Params.hs @@ -24,7 +24,7 @@ & zipWith (\format encoding -> (,format) <$> encoding) formatList compileUnpreparedStatementData :: Params a -> Bool -> a -> [Maybe (A.Oid, ByteString, A.Format)] -compileUnpreparedStatementData (Params _ columnsMetadata serializer printer) integerDatetimes input = +compileUnpreparedStatementData (Params _ columnsMetadata serializer _) integerDatetimes input = zipWith ( \(oid, format) encoding -> (,,) <$> pure oid <*> encoding <*> pure format diff --git a/library/Hasql/Errors.hs b/library/Hasql/Errors.hs --- a/library/Hasql/Errors.hs +++ b/library/Hasql/Errors.hs @@ -75,7 +75,7 @@ ClientError (Just message) -> "Client error: " <> show message ClientError Nothing -> "Client error without details" ResultError resultError -> case resultError of - ServerError code message details hint position -> + ServerError code message details hint _ -> "Server error " <> BC.unpack code <> ": " diff --git a/library/Hasql/Pipeline/Core.hs b/library/Hasql/Pipeline/Core.hs --- a/library/Hasql/Pipeline/Core.hs +++ b/library/Hasql/Pipeline/Core.hs @@ -11,8 +11,8 @@ import Hasql.PreparedStatementRegistry qualified as PreparedStatementRegistry import Hasql.Statement qualified as Statement -run :: forall a. Pipeline a -> Pq.Connection -> PreparedStatementRegistry.PreparedStatementRegistry -> Bool -> IO (Either SessionError a) -run (Pipeline sendQueriesInIO) connection registry integerDatetimes = do +run :: forall a. Pipeline a -> Bool -> Pq.Connection -> PreparedStatementRegistry.PreparedStatementRegistry -> Bool -> IO (Either SessionError a) +run (Pipeline sendQueriesInIO) usePreparedStatements connection registry integerDatetimes = do runExceptT do enterPipelineMode recvQueries <- sendQueries @@ -31,7 +31,7 @@ sendQueries :: ExceptT SessionError IO (ExceptT SessionError IO a) sendQueries = - fmap ExceptT $ ExceptT $ sendQueriesInIO connection registry integerDatetimes + fmap ExceptT $ ExceptT $ sendQueriesInIO usePreparedStatements connection registry integerDatetimes pipelineSync :: ExceptT SessionError IO () pipelineSync = @@ -116,7 +116,8 @@ -- @ newtype Pipeline a = Pipeline - ( Pq.Connection -> + ( Bool -> + Pq.Connection -> PreparedStatementRegistry.PreparedStatementRegistry -> Bool -> IO (Either SessionError (IO (Either SessionError a))) @@ -125,15 +126,15 @@ instance Applicative Pipeline where pure a = - Pipeline (\_ _ _ -> pure (Right (pure (Right a)))) + Pipeline (\_ _ _ _ -> pure (Right (pure (Right a)))) Pipeline lSend <*> Pipeline rSend = - Pipeline \conn reg integerDatetimes -> - lSend conn reg integerDatetimes >>= \case + Pipeline \usePreparedStatements conn reg integerDatetimes -> + lSend usePreparedStatements conn reg integerDatetimes >>= \case Left sendErr -> pure (Left sendErr) Right lRecv -> - rSend conn reg integerDatetimes <&> \case + rSend usePreparedStatements conn reg integerDatetimes <&> \case Left sendErr -> Left sendErr Right rRecv -> @@ -145,8 +146,8 @@ statement params (Statement.Statement sql (Encoders.Params encoder) (Decoders.Result decoder) preparable) = Pipeline run where - run connection registry integerDatetimes = - if preparable + run usePreparedStatements connection registry integerDatetimes = + if usePreparedStatements && preparable then runPrepared else runUnprepared where diff --git a/library/Hasql/PreparedStatementRegistry.hs b/library/Hasql/PreparedStatementRegistry.hs --- a/library/Hasql/PreparedStatementRegistry.hs +++ b/library/Hasql/PreparedStatementRegistry.hs @@ -60,5 +60,5 @@ instance Hashable LocalKey where {-# INLINE hashWithSalt #-} - hashWithSalt salt (LocalKey template types) = + hashWithSalt salt (LocalKey template _) = hashWithSalt salt template diff --git a/library/Hasql/Session/Core.hs b/library/Hasql/Session/Core.hs --- a/library/Hasql/Session/Core.hs +++ b/library/Hasql/Session/Core.hs @@ -30,7 +30,7 @@ runExceptT $ runReaderT impl connection handler = case connection of - Connection.Connection pqConnVar _ registry -> + Connection.Connection _ pqConnVar _ registry -> withMVar pqConnVar \pqConn -> Pq.transactionStatus pqConn >>= \case Pq.TransIdle -> pure () @@ -46,7 +46,7 @@ sql sql = Session $ ReaderT - $ \(Connection.Connection pqConnectionRef integerDatetimes registry) -> + $ \(Connection.Connection _ pqConnectionRef integerDatetimes _) -> ExceptT $ fmap (first (QueryError sql [])) $ withMVar pqConnectionRef @@ -64,12 +64,12 @@ statement input (Statement.Statement template (Encoders.Params paramsEncoder) (Decoders.Result decoder) preparable) = Session $ ReaderT - $ \(Connection.Connection pqConnectionRef integerDatetimes registry) -> + $ \(Connection.Connection usePreparedStatements pqConnectionRef integerDatetimes registry) -> ExceptT $ fmap (first (QueryError template (Encoders.Params.renderReadable paramsEncoder input))) $ withMVar pqConnectionRef $ \pqConnection -> do - r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template paramsEncoder preparable input + r1 <- IO.sendParametricStatement pqConnection integerDatetimes registry template paramsEncoder (usePreparedStatements && preparable) input r2 <- IO.getResults pqConnection integerDatetimes decoder return $ r1 *> r2 @@ -77,6 +77,6 @@ -- Execute a pipeline. pipeline :: Pipeline.Pipeline result -> Session result pipeline pipeline = - Session $ ReaderT \(Connection.Connection pqConnectionRef integerDatetimes registry) -> + Session $ ReaderT \(Connection.Connection usePreparedStatements pqConnectionRef integerDatetimes registry) -> ExceptT $ withMVar pqConnectionRef \pqConnection -> - Pipeline.run pipeline pqConnection registry integerDatetimes + Pipeline.run pipeline usePreparedStatements pqConnection registry integerDatetimes diff --git a/library/Hasql/Settings.hs b/library/Hasql/Settings.hs deleted file mode 100644 --- a/library/Hasql/Settings.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Hasql.Settings where - -import Data.ByteString qualified as B -import Data.ByteString.Builder qualified as BB -import Data.ByteString.Lazy qualified as BL -import Hasql.Prelude - --- | --- All settings encoded in a single byte-string according to --- . -type Settings = - ByteString - --- | --- Encode a host, a port, a user, a password and a database into the PostgreSQL settings byte-string. -{-# INLINE settings #-} -settings :: ByteString -> Word16 -> ByteString -> ByteString -> ByteString -> Settings -settings host port user password database = - BL.toStrict - $ BB.toLazyByteString - $ mconcat - $ intersperse (BB.char7 ' ') - $ catMaybes - $ [ mappend (BB.string7 "host=") - . BB.byteString - <$> mfilter (not . B.null) (pure host), - mappend (BB.string7 "port=") - . BB.word16Dec - <$> mfilter (/= 0) (pure port), - mappend (BB.string7 "user=") - . BB.byteString - <$> mfilter (not . B.null) (pure user), - mappend (BB.string7 "password=") - . BB.byteString - <$> mfilter (not . B.null) (pure password), - mappend (BB.string7 "dbname=") - . BB.byteString - <$> mfilter (not . B.null) (pure database) - ] diff --git a/library/Hasql/Statement.hs b/library/Hasql/Statement.hs --- a/library/Hasql/Statement.hs +++ b/library/Hasql/Statement.hs @@ -54,14 +54,10 @@ (Encoders.Params params) -- | Decoder of result. (Decoders.Result result) - -- | Flag, determining whether it should be prepared. + -- | Flag, determining whether it can be prepared. -- -- Set it to 'True' if your application has a limited amount of queries and doesn't generate the SQL dynamically. -- This will boost the performance by allowing Postgres to avoid reconstructing the execution plan each time the query gets executed. - -- - -- Note that if you're using proxying applications like @pgbouncer@, such tools may be incompatible with prepared statements. - -- So do consult their docs or just set it to 'False' to stay on the safe side. - -- It should be noted that starting from version @1.21.0@ @pgbouncer@ now does provide support for prepared statements. Bool instance Functor (Statement params) where diff --git a/profiling/Main.hs b/profiling/Main.hs --- a/profiling/Main.hs +++ b/profiling/Main.hs @@ -2,6 +2,9 @@ import Data.Vector qualified as F import Hasql.Connection qualified as A +import Hasql.Connection.Setting qualified as E +import Hasql.Connection.Setting.Connection qualified as F +import Hasql.Connection.Setting.Connection.Param qualified as G import Hasql.Decoders qualified as D import Hasql.Session qualified as B import Hasql.Statement qualified as C @@ -12,21 +15,22 @@ do Right connection <- acquireConnection traceEventIO "START Session" - Right result <- B.run sessionWithManySmallResults connection + Right _ <- B.run sessionWithManySmallResults connection traceEventIO "STOP Session" return () where acquireConnection = - A.acquire settings - where - settings = - A.settings host port user password database - where - host = "localhost" - port = 5432 - user = "postgres" - password = "postgres" - database = "postgres" + A.acquire + [ E.connection + ( F.params + [ G.host "localhost", + G.port 5432, + G.user "postgres", + G.password "postgres", + G.dbname "postgres" + ] + ) + ] -- * Sessions diff --git a/tasty/Main.hs b/tasty/Main.hs --- a/tasty/Main.hs +++ b/tasty/Main.hs @@ -279,7 +279,7 @@ Session.sql "asldfjsldk" io = Connection.with $ \c -> do - Session.run errorSession c + _ <- Session.run errorSession c Session.run sumSession c in io >>= \x -> assertBool (show x) (either (const False) isRight x), testCase "\"another command is already in progress\" bugfix" diff --git a/tasty/Main/Connection.hs b/tasty/Main/Connection.hs --- a/tasty/Main/Connection.hs +++ b/tasty/Main/Connection.hs @@ -1,6 +1,7 @@ module Main.Connection where import Hasql.Connection qualified as HC +import Hasql.TestingKit.Constants qualified as Constants import Main.Prelude with :: (HC.Connection -> IO a) -> IO (Either HC.ConnectionError a) @@ -8,16 +9,7 @@ runExceptT $ acquire >>= \connection -> use connection <* release connection where acquire = - ExceptT $ HC.acquire settings - where - settings = - HC.settings host port user password database - where - host = "localhost" - port = 5432 - user = "postgres" - password = "postgres" - database = "postgres" + ExceptT $ HC.acquire Constants.localConnectionSettings use connection = lift $ handler connection release connection = diff --git a/testing-kit/Hasql/TestingKit/Constants.hs b/testing-kit/Hasql/TestingKit/Constants.hs --- a/testing-kit/Hasql/TestingKit/Constants.hs +++ b/testing-kit/Hasql/TestingKit/Constants.hs @@ -1,13 +1,18 @@ module Hasql.TestingKit.Constants where -import Hasql.Connection qualified as Connection +import Hasql.Connection.Setting qualified as Setting +import Hasql.Connection.Setting.Connection qualified as Setting.Connection +import Hasql.Connection.Setting.Connection.Param qualified as Setting.Connection.Component -localConnectionSettings :: Connection.Settings +localConnectionSettings :: [Setting.Setting] localConnectionSettings = - Connection.settings host port user password database - where - host = "localhost" - port = 5432 - user = "postgres" - password = "postgres" - database = "postgres" + [ Setting.connection + ( Setting.Connection.params + [ Setting.Connection.Component.host "localhost", + Setting.Connection.Component.port 5432, + Setting.Connection.Component.user "postgres", + Setting.Connection.Component.password "postgres", + Setting.Connection.Component.dbname "postgres" + ] + ) + ] diff --git a/threads-test/Main.hs b/threads-test/Main.hs --- a/threads-test/Main.hs +++ b/threads-test/Main.hs @@ -1,6 +1,9 @@ module Main where import Hasql.Connection qualified +import Hasql.Connection.Setting qualified +import Hasql.Connection.Setting.Connection qualified +import Hasql.Connection.Setting.Connection.Param qualified import Hasql.Session qualified import Main.Statements qualified as Statements import Prelude @@ -18,7 +21,16 @@ $ Hasql.Connection.acquire connectionSettings where connectionSettings = - Hasql.Connection.settings "localhost" 5432 "postgres" "postgres" "postgres" + [ Hasql.Connection.Setting.connection + ( Hasql.Connection.Setting.Connection.params + [ Hasql.Connection.Setting.Connection.Param.host "localhost", + Hasql.Connection.Setting.Connection.Param.port 5432, + Hasql.Connection.Setting.Connection.Param.user "postgres", + Hasql.Connection.Setting.Connection.Param.password "postgres", + Hasql.Connection.Setting.Connection.Param.dbname "postgres" + ] + ) + ] use (connection1, connection2) = do beginVar <- newEmptyMVar