Skip to content

Commit 48bc0f3

Browse files
NickSeagullNickSeagullBotclaude
authored
refactor(service): unify the three Postgres connection-settings builders (#681) (#690)
* docs(adr): add ADR-0062 shared-connection-settings-builder (#681) Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com> * docs(adr): ADR-0062 → Service.Infra.Postgres.ConnectionConfig (maintainer decision) * refactor(service): unify the three Postgres connection-settings builders (#681) Implements ADR-0062: extract one shared Postgres connection-settings builder (Service.Infra.Postgres.ConnectionConfig) that all three pools route through, so keepalives and the observation handler apply uniformly. No public API change. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com> * refactor(service): address CodeRabbit — explicit imports, port validation, inspectable ConnectionParams tests - Imports (Fix 1): dedupe the double Hasql.Connection.Setting alias; bring used hasql types in explicitly (Setting, Config, Word16) and keep module functions qualified, per the qualified-import contract. - Port validation (Fix 2): add shared validatePort (1..65535) in the single shared path — resolveParams/toConnectionParams now return Result Text, failing fast with `port must be in 1..65535, got N` instead of the silent Word16 wrap. All three pools (EventStore, QueryObjectStore, FileUpload) surface it in their own error type; FileUpload gains an InvalidPort variant. - Inspectable tests (Fix 3): add ResolvedParams (Eq, no Show) capturing every libpq field plus the four ADR-0037 keepalives as data; the spec now asserts host/db/user/password/port AND all four keepalive entries exactly, and both port boundaries / out-of-range inputs. - Module visibility (Fix 4): kept Service.Infra.Postgres.ConnectionConfig in exposed-modules (FALLBACK). The preferred move to other-modules + adding the library `service` dir to the test suite caused mass local recompilation and EndpointSchema type-identity ambiguity (package vs home module); explained on the CodeRabbit thread. It remains internal infra with no stability promise. - ADR (Fix 5): drop Show from the ConnectionParams example derivation to match the implementation (password hygiene). Status stays Proposed. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com> --------- Co-authored-by: NickSeagullBot <bot@nickseagull.dev> Co-authored-by: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
1 parent c7ffced commit 48bc0f3

10 files changed

Lines changed: 934 additions & 144 deletions

File tree

‎core/nhcore.cabal‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -243,6 +243,7 @@ library
243243
Service.EventStore.Postgres
244244
Service.EventStore.Postgres.Internal
245245
Service.EventStore.Postgres.Core
246+
Service.Infra.Postgres.ConnectionConfig
246247
Service.EventStore.Postgres.Notifications
247248
Service.EventStore.Postgres.PostgresEventRecord
248249
Service.EventStore.Postgres.Sessions
@@ -566,6 +567,7 @@ test-suite nhcore-test-service
566567
Service.EventStore.InMemorySpec
567568
Service.EventStore.SimpleSpec
568569
Service.EventStore.Postgres.PoolBudgetSpec
570+
Service.Infra.Postgres.ConnectionConfigSpec
569571
Service.EventStore.Postgres.SubscriptionStoreSpec
570572
Service.EventStore.Postgres.NotificationsSpec
571573
Service.EventStore.PostgresSpec

‎core/service/Service/EventStore/Postgres/Internal.hs‎

Lines changed: 39 additions & 62 deletions
Original file line numberDiff line numberDiff line change
@@ -16,20 +16,15 @@ import Basics
1616
import Default (Default)
1717
import Default qualified
1818
import Hasql.Connection qualified as Hasql
19-
import Hasql.Connection.Setting qualified as ConnectionSetting
2019
import Hasql.Connection.Setting qualified as Hasql
21-
import Hasql.Connection.Setting.Connection qualified as ConnectionSettingConnection
22-
import Hasql.Connection.Setting.Connection.Param qualified as Param
2320
import Hasql.Pool qualified as HasqlPool
24-
import Hasql.Pool.Config qualified as HasqlPoolConfig
25-
import Hasql.Pool.Observation (ConnectionStatus (..), ConnectionTerminationReason (..), Observation (..))
2621
import Json qualified
2722
import Log qualified
28-
import Prelude qualified
2923
import LinkedList (LinkedList)
3024
import Maybe (Maybe (..))
3125
import Maybe qualified
3226
import Result (Result (..))
27+
import Service.Infra.Postgres.ConnectionConfig qualified as ConnectionConfig
3328
import Service.Event
3429
import Service.Event.EntityName qualified as EntityName
3530
import Service.Event.EventMetadata (EventMetadata (..))
@@ -97,53 +92,26 @@ instance EventStoreConfig PostgresEventStore where
9792
createEventStore = new defaultOps
9893

9994

100-
toConnectionPoolSettings :: Int -> LinkedList Hasql.Setting -> HasqlPoolConfig.Config
101-
toConnectionPoolSettings poolSize settings =
102-
[ HasqlPoolConfig.staticConnectionSettings settings
103-
, HasqlPoolConfig.size poolSize
104-
, HasqlPoolConfig.agingTimeout 300
105-
, HasqlPoolConfig.idlenessTimeout 60
106-
, HasqlPoolConfig.observationHandler logPoolObservation
107-
]
108-
|> HasqlPoolConfig.settings
109-
110-
111-
-- | Log connection pool lifecycle events for observability.
112-
-- Only logs termination events to avoid overhead under high load.
113-
-- See ADR-0027 for rationale.
114-
logPoolObservation :: Observation -> Prelude.IO ()
115-
logPoolObservation observation = case observation of
116-
ConnectionObservation _uuid status -> case status of
117-
TerminatedConnectionStatus reason -> case reason of
118-
AgingConnectionTerminationReason ->
119-
((Log.debug "[Pool] Connection terminated (aging timeout)" |> Task.ignoreError :: Task Text Unit) |> Task.runOrPanic)
120-
IdlenessConnectionTerminationReason ->
121-
((Log.debug "[Pool] Connection terminated (idleness timeout)" |> Task.ignoreError :: Task Text Unit) |> Task.runOrPanic)
122-
NetworkErrorConnectionTerminationReason err ->
123-
((Log.critical [fmt|[Pool] Connection terminated (network error: #{show err})|] |> Task.ignoreError :: Task Text Unit) |> Task.runOrPanic)
124-
ReleaseConnectionTerminationReason ->
125-
Prelude.pure ()
126-
InitializationErrorTerminationReason err ->
127-
((Log.critical [fmt|[Pool] Connection terminated (init error: #{show err})|] |> Task.ignoreError :: Task Text Unit) |> Task.runOrPanic)
128-
_ -> Prelude.pure ()
129-
130-
131-
toConnectionSettings :: PostgresEventStore -> LinkedList Hasql.Setting
132-
toConnectionSettings cfg = do
133-
let params =
134-
ConnectionSettingConnection.params
135-
[ Param.host cfg.host,
136-
Param.port (fromIntegral cfg.port),
137-
Param.dbname cfg.databaseName,
138-
Param.user cfg.user,
139-
Param.password cfg.password,
140-
-- TCP keepalive: detect dead connections in cloud environments (ADR-0037, #397)
141-
Param.other "keepalives" "1",
142-
Param.other "keepalives_idle" "30",
143-
Param.other "keepalives_interval" "10",
144-
Param.other "keepalives_count" "5"
145-
]
146-
[params |> ConnectionSetting.connection]
95+
toConnectionSettings :: PostgresEventStore -> Result Text (LinkedList Hasql.Setting)
96+
toConnectionSettings cfg =
97+
ConnectionConfig.toConnectionParams
98+
ConnectionConfig.ConnectionParams
99+
{ host = cfg.host,
100+
databaseName = cfg.databaseName,
101+
user = cfg.user,
102+
password = cfg.password,
103+
port = cfg.port
104+
}
105+
106+
107+
-- | Resolve connection settings inside a Task, surfacing a port-validation
108+
-- error (see 'ConnectionConfig.validatePort') as a Text failure. Used by the
109+
-- LISTEN/NOTIFY paths that acquire one-off connections directly.
110+
connectionSettingsOrThrow :: PostgresEventStore -> Task Text (LinkedList Hasql.Setting)
111+
connectionSettingsOrThrow cfg =
112+
case toConnectionSettings cfg of
113+
Ok settings -> Task.yield settings
114+
Err err -> Task.throw err
147115

148116

149117
data Ops = Ops
@@ -162,19 +130,24 @@ defaultOps = do
162130
False ->
163131
Task.throw [fmt|poolSize must be > 0, got #{size}|]
164132
True ->
165-
toConnectionSettings cfg
166-
|> toConnectionPoolSettings cfg.poolSize
167-
|> HasqlPool.acquire
168-
|> Task.fromIO
169-
|> Task.map (Sessions.Connection)
133+
case toConnectionSettings cfg of
134+
Err portErr ->
135+
Task.throw portErr
136+
Ok settings ->
137+
settings
138+
|> ConnectionConfig.toPoolConfig cfg.poolSize
139+
|> HasqlPool.acquire
140+
|> Task.fromIO
141+
|> Task.map (Sessions.Connection)
170142

171143
let initializeTable connection = do
172144
Sessions.createEventsTableSession
173145
|> Sessions.run connection
174146
|> Task.mapError toText
175147

176148
let initializeSubscriptions _pool subscriptionStore cfg = do
177-
initialListenConnection <- Hasql.acquire (toConnectionSettings cfg) |> Task.fromIOEither |> Task.mapError toText
149+
listenSettings <- connectionSettingsOrThrow cfg
150+
initialListenConnection <- Hasql.acquire listenSettings |> Task.fromIOEither |> Task.mapError toText
178151
Task.finally
179152
(Hasql.release initialListenConnection |> Task.fromIO)
180153
do
@@ -185,8 +158,9 @@ defaultOps = do
185158
|> Sessions.runConnection initialListenConnection
186159
|> Task.mapError toText
187160
let connectionFactory = do
188-
listenConnection <- Hasql.acquire (toConnectionSettings cfg) |> Task.fromIOEither |> Task.mapError toText
189-
queryResult <- Hasql.acquire (toConnectionSettings cfg) |> Task.fromIOEither |> Task.mapError toText |> Task.asResult
161+
factorySettings <- connectionSettingsOrThrow cfg
162+
listenConnection <- Hasql.acquire factorySettings |> Task.fromIOEither |> Task.mapError toText
163+
queryResult <- Hasql.acquire factorySettings |> Task.fromIOEither |> Task.mapError toText |> Task.asResult
190164
case queryResult of
191165
Ok queryConnection -> Task.yield (listenConnection, queryConnection)
192166
Err err -> do
@@ -798,8 +772,11 @@ subscribeToStreamEventsImpl ::
798772
subscribeToStreamEventsImpl ops cfg store entityName streamId callback =
799773
ops |> withConnectionAndError cfg \conn -> do
800774
-- Subscribe to the stream-specific notification channel
775+
streamSettings <-
776+
connectionSettingsOrThrow cfg
777+
|> Task.mapError (\err -> SubscriptionError (SubscriptionId "stream") err)
801778
connection <-
802-
Hasql.acquire (toConnectionSettings cfg)
779+
Hasql.acquire streamSettings
803780
|> Task.fromIOEither
804781
|> Task.mapError (\err -> SubscriptionError (SubscriptionId "stream") (err |> toText))
805782
Notifications.subscribeToStream connection streamId

‎core/service/Service/FileUpload/FileStateStore/Postgres.hs‎

Lines changed: 16 additions & 46 deletions
Original file line numberDiff line numberDiff line change
@@ -53,21 +53,16 @@ import Bytes qualified
5353
import Core
5454
import Data.Functor.Contravariant ((>$<))
5555
import Data.Semigroup ((<>))
56-
import Hasql.Connection.Setting qualified as ConnectionSetting
57-
import Hasql.Connection.Setting.Connection qualified as ConnectionSettingConnection
58-
import Hasql.Connection.Setting.Connection.Param qualified as Param
5956
import Hasql.Decoders qualified as Decoders
6057
import Hasql.Encoders qualified as Encoders
6158
import Hasql.Pool (Pool)
6259
import Hasql.Pool qualified as HasqlPool
63-
import Hasql.Pool.Config qualified as HasqlPoolConfig
64-
import Hasql.Pool.Observation (ConnectionStatus (..), ConnectionTerminationReason (..), Observation (..))
6560
import Hasql.Session qualified as Session
66-
import Log qualified
6761
import Prelude qualified
6862
import Hasql.Statement (Statement (..))
6963

7064
import Result qualified
65+
import Service.Infra.Postgres.ConnectionConfig qualified as ConnectionConfig
7166
import Service.EventStore.Postgres (PostgresEventStore (..))
7267
import Service.FileUpload.Core (
7368
BlobKey (..),
@@ -92,6 +87,7 @@ data PostgresFileStoreError
9287
= PoolError HasqlPool.UsageError
9388
| DeserializationError Text
9489
| InvalidPoolSize Text
90+
| InvalidPort Text
9591
deriving (Eq, Show)
9692

9793

@@ -171,46 +167,20 @@ createPool cfg = do
171167
case size > 0 of
172168
False ->
173169
Task.throw (InvalidPoolSize [fmt|poolSize must be > 0, got #{size}|])
174-
True -> do
175-
let params =
176-
ConnectionSettingConnection.params
177-
[ Param.host cfg.host
178-
, Param.port (fromIntegral cfg.port)
179-
, Param.dbname cfg.databaseName
180-
, Param.user cfg.user
181-
, Param.password cfg.password
182-
]
183-
let settings = [params |> ConnectionSetting.connection]
184-
let poolConfig =
185-
[ HasqlPoolConfig.staticConnectionSettings settings
186-
, HasqlPoolConfig.size cfg.poolSize
187-
, HasqlPoolConfig.agingTimeout 300
188-
, HasqlPoolConfig.idlenessTimeout 60
189-
, HasqlPoolConfig.observationHandler logPoolObservation
190-
]
191-
|> HasqlPoolConfig.settings
192-
HasqlPool.acquire poolConfig
193-
|> Task.fromIO
194-
195-
196-
-- | Log connection pool lifecycle events for observability.
197-
-- Only logs termination events to avoid overhead under high load.
198-
-- See ADR-0027 for rationale.
199-
logPoolObservation :: Observation -> Prelude.IO ()
200-
logPoolObservation observation = case observation of
201-
ConnectionObservation _uuid status -> case status of
202-
TerminatedConnectionStatus reason -> case reason of
203-
AgingConnectionTerminationReason ->
204-
((Log.debug "[Pool] Connection terminated (aging timeout)" |> Task.ignoreError :: Task Text Unit) |> Task.runOrPanic)
205-
IdlenessConnectionTerminationReason ->
206-
((Log.debug "[Pool] Connection terminated (idleness timeout)" |> Task.ignoreError :: Task Text Unit) |> Task.runOrPanic)
207-
NetworkErrorConnectionTerminationReason err ->
208-
((Log.critical [fmt|[Pool] Connection terminated (network error: #{show err})|] |> Task.ignoreError :: Task Text Unit) |> Task.runOrPanic)
209-
ReleaseConnectionTerminationReason ->
210-
Prelude.pure ()
211-
InitializationErrorTerminationReason err ->
212-
((Log.critical [fmt|[Pool] Connection terminated (init error: #{show err})|] |> Task.ignoreError :: Task Text Unit) |> Task.runOrPanic)
213-
_ -> Prelude.pure ()
170+
True ->
171+
case ConnectionConfig.toConnectionParams
172+
ConnectionConfig.ConnectionParams
173+
{ host = cfg.host
174+
, databaseName = cfg.databaseName
175+
, user = cfg.user
176+
, password = cfg.password
177+
, port = cfg.port
178+
} of
179+
Err portErr -> Task.throw (InvalidPort portErr)
180+
Ok settings -> do
181+
let poolConfig = ConnectionConfig.toPoolConfig cfg.poolSize settings
182+
HasqlPool.acquire poolConfig
183+
|> Task.fromIO
214184

215185

216186
-- | Create the file_upload_state table if it doesn't exist.

0 commit comments

Comments
 (0)