bolty 0.1.1.0 → 0.2.0.0

raw patch · 15 files changed

+1156/−71 lines, 15 filesdep ~aesondep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, bytestring

API changes (from Hackage documentation)

Files

• bolty.cabal +5/−3
• changelog.md +18/−0
• integration/Main.hs +196/−0
• src/Database/Bolty.hs +88/−20
• src/Database/Bolty/AccessMode.hs +41/−0
• src/Database/Bolty/Admin.hs +312/−0
• src/Database/Bolty/Connection.hs +21/−1
• src/Database/Bolty/Message/Request.hs +22/−22
• src/Database/Bolty/Message/Response.hs +1/−0
• src/Database/Bolty/Plan.hs +33/−0
• src/Database/Bolty/Routing.hs +2/−13
• src/Database/Bolty/Session.hs +3/−6
• src/Database/Bolty/Stats.hs +24/−0
• src/Database/Bolty/Value/Type.hs +22/−2
• test/Main.hs +368/−4

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           bolty-version:        0.1.1.0+version:        0.2.0.0 synopsis:       Haskell driver for Neo4j (BOLT protocol 4.4-5.4) description:    Native Haskell driver for Neo4j graph database using the BOLT protocol.                 Supports BOLT versions 4.4 through 5.4 with connection pooling,@@ -37,6 +37,7 @@ library   exposed-modules:       Database.Bolty+      Database.Bolty.AccessMode       Database.Bolty.Decode       Database.Bolty.Pool       Database.Bolty.Record@@ -45,6 +46,7 @@       Database.Bolty.Session       Database.Bolty.Logging       Database.Bolty.Notification+      Database.Bolty.Admin       Database.Bolty.Plan       Database.Bolty.Stats       Database.Bolty.Connection@@ -196,10 +198,10 @@   ghc-options: -Weverything -Wno-all-missed-specialisations -Wno-implicit-prelude -Wno-missed-specialisations -Wno-missing-import-lists -Wno-missing-safe-haskell-mode -Wno-name-shadowing -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe -threaded -rtsopts -with-rtsopts=-N -Wno-missing-export-lists -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-unused-imports -Wno-unused-packages   build-depends:       QuickCheck-    , aeson >=2.1 && <2.3+    , aeson     , base >=4.18 && <5     , bolty-    , bytestring >=0.11 && <0.13+    , bytestring     , crypton-connection >=0.3 && <0.5     , data-default >=0.7 && <0.9     , extra >=1.7 && <1.9

@@ -6,6 +6,24 @@ and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## 0.2.0.0++- New `Database.Bolty.AccessMode` module: `AccessMode = ReadAccess | WriteAccess` with a single `PackStream` instance. Re-exported from `Database.Bolty`.+- New `Database.Bolty.Admin` module with gated transaction primitives for admin tools, CLIs, and migrations: `withReadOnlyTransaction` and `withConfirmedWriteTransaction` (plus pool variants), `ReadOutcome` / `WriteOutcome` types, `totalAffected`, `describeReadOutcome` / `describeWriteOutcome`.+- New transaction primitives in `Database.Bolty`: `withReadTransaction` and `withReadTransaction'` (un-gated read tx with cluster routing-to-follower and server-side enforcement), public `withTxMode :: AccessMode -> ...`, `withRetryTransactionMode :: AccessMode -> ...`.+- New public Aeson interop: `parsePs`, `psToAeson`, `propsToAeson`, `propsFromAeson`.+- New exports `renderPlan` (from `Database.Bolty.Plan`) and `formatStatsLine` (from `Database.Bolty.Stats`).+- New `Show QueryMeta` instance.+- **Breaking**: `Begin.mode`, `RunExtra.mode`, `RunAutoCommitTransaction.mode` are now `AccessMode` instead of `Char`. Use `ReadAccess` / `WriteAccess` instead of `'r'` / `'w'`.+- **Breaking**: `withTxMode` and `withRetryTransactionMode` take `AccessMode` instead of `Char`.+- **Breaking**: `Database.Bolty.Tx` module renamed to `Database.Bolty.Admin`. `totalAffected` moved from `Database.Bolty.Stats` to `Database.Bolty.Admin` (re-export from `Database.Bolty` is unchanged).+- **Breaking**: `AccessMode(..)` no longer re-exported from `Database.Bolty.Routing`. Import from `Database.Bolty.AccessMode` or `Database.Bolty`.+- **Breaking**: Internal helper `fromPsMode` removed.+- Fix: `Begin.fromPs`, `RunExtra.fromPs`, and the autocommit RUN decoder now accept wire dicts where the optional `mode` key is absent (defaulting to `WriteAccess` per the Bolt spec). Previously bolty rejected spec-compliant peers that omitted the default.+- Fix: `withReadOnlyTransaction` opens BEGIN with `mode='r'` (was `mode='w'`) for cluster read routing and server-side write rejection on Neo4j 5+.+- Fix: pool-variant transaction helpers capture pool-acquire failures in the returned `Either` instead of propagating them as exceptions.+- 15 new direct `AccessMode` unit tests covering encode/decode round-trips, rejection of invalid `Ps` shapes, `Bounded` / `Enum` exhaustion, and parent-message decoders for the spec-default and rejection paths on `Begin`, `RunExtra`, and the autocommit `RUN`. bolty-test: 320 → 335 passing.+ ## 0.1.0.2  - Fix pool crash on machines with more than 10 CPU cores (set numStripes to 1)

@@ -252,7 +252,34 @@         Nothing -> expectationFailure "Expected 'alice'"       liftIO $ wp $ \p -> queryIO p "MATCH (n:TestTxParam) DELETE n" >> pure () +    it "withReadTransaction runs a read query" $ do+      -- The un-gated read tx primitive: just opens BEGIN with mode='r',+      -- runs the action, commits. No post-hoc stats inspection.+      result <- liftIO $ wp $ \p ->+        withReadTransaction p $ \conn ->+          queryIO conn "RETURN 42 AS n"+      case asInt (V.head $ V.head result) of+        Just n  -> n `shouldBe` 42+        Nothing -> expectationFailure "Expected 42" +    it "withReadTransaction rejects writes upfront (AccessMode)" $ do+      -- mode='r' makes the server reject any write attempt before it+      -- runs. The exception type varies by Neo4j version; we just check+      -- that an exception was thrown and no row landed.+      r :: Either SomeException () <- liftIO $ try $+        wp $ \p ->+          withReadTransaction p $ \conn ->+            queryIO conn "CREATE (:TestReadTxReject {tag: 'nope'})" >> pure ()+      case r of+        Left _  -> pure ()+        Right _ -> expectationFailure "Expected an AccessMode error from server"+      count <- liftIO $ wp $ \p ->+        queryIO p "MATCH (n:TestReadTxReject) RETURN count(n) AS c"+      case asInt (V.head $ V.head count) of+        Just n  -> n `shouldBe` 0+        Nothing -> expectationFailure "Expected 0"++   describe (label ++ " - Graph type queries") $ do      it "returns a Node" $ do@@ -1373,6 +1400,173 @@   -- ================================================================+-- Admin / sandbox transaction integration tests (Database.Bolty.Admin)+--+-- The whole point of these wrappers is the tx-rollback behaviour, which+-- only the bolt server can verify -- a unit test that mocks the+-- connection can't observe whether the writes actually became durable.+-- These cases set up a graph fixture, run the gated tx, then poll the+-- database to assert state.+-- ================================================================++adminTestSuite :: TopSpec+adminTestSuite = do+  let wp :: (Connection -> IO a) -> IO a+      wp = mkWithConn neo4j5Config+      -- Unique label so this suite doesn't trip over other tests' fixtures.+      lbl = "BoltyTxTest"+      cleanup = liftIO $ wp $ \p ->+        queryIO p ("MATCH (n:" <> lbl <> ") DETACH DELETE n") >> pure ()+      countNodes = liftIO $ wp $ \p -> do+        r <- queryIO p ("MATCH (n:" <> lbl <> ") RETURN count(n) AS c")+        case asInt (V.head $ V.head r) of+          Just n  -> pure n+          Nothing -> error "expected an int"++  describe "Database.Bolty.Admin (real Neo4j)" $ do++    it "withReadOnlyTransaction returns ReadOK for read-only Cypher" $ do+      cleanup+      outcome <- liftIO $ wp $ \conn ->+        withReadOnlyTransaction conn "RETURN 1 AS x" H.empty+      case outcome of+        Right (ReadOK _ _) -> pure ()+        Right other        -> expectationFailure $+          "expected ReadOK, got " <> T.unpack (describeReadOutcome other)+        Left e             -> expectationFailure $ "tx error: " <> show e++    -- A read tx that attempts a write must never commit. With mode='r',+    -- Neo4j 5 rejects the write upfront with an AccessMode error+    -- ('Left'). Older versions, or procedure-style writes that bypass+    -- access-mode enforcement, would surface as 'ReadAbortedByWrite'.+    -- Both outcomes are correct; only an accidental commit would be a bug.+    it "CREATE inside read tx never commits" $ do+      cleanup+      before <- countNodes+      before `shouldBe` 0+      outcome <- liftIO $ wp $ \conn ->+        withReadOnlyTransaction conn+          ("CREATE (:" <> lbl <> " {tag: 'should-not-persist'}) RETURN 1") H.empty+      assertReadDidNotCommit outcome+      after <- countNodes+      after `shouldBe` 0++    it "DELETE inside read tx leaves the row intact" $ do+      cleanup+      liftIO $ wp $ \p -> queryIO p ("CREATE (:" <> lbl <> " {a: 1})") >> pure ()+      before <- countNodes+      before `shouldBe` 1+      outcome <- liftIO $ wp $ \conn ->+        withReadOnlyTransaction conn+          ("MATCH (n:" <> lbl <> ") DELETE n RETURN count(n)") H.empty+      assertReadDidNotCommit outcome+      after <- countNodes+      after `shouldBe` 1+      cleanup++    it "withConfirmedWriteTransaction commits when the count matches" $ do+      cleanup+      -- CREATE (:X {a:1}) reports affected = node + property + label = 3.+      outcome <- liftIO $ wp $ \conn ->+        withConfirmedWriteTransaction conn+          ("CREATE (:" <> lbl <> " {a: 1})") H.empty 3+      case outcome of+        Right (WriteCommitted _ _) -> pure ()+        Right other                -> expectationFailure $+          "expected WriteCommitted, got " <> T.unpack (describeWriteOutcome other)+        Left e                     -> expectationFailure $ show e+      after <- countNodes+      after `shouldBe` 1+      cleanup++    it "withConfirmedWriteTransaction rolls back on count mismatch" $ do+      cleanup+      outcome <- liftIO $ wp $ \conn ->+        withConfirmedWriteTransaction conn+          ("CREATE (:" <> lbl <> " {a: 99})") H.empty 99+      case outcome of+        Right (WriteAbortedMismatch ex actual _) -> do+          ex `shouldBe` 99+          actual `shouldBe` 3+        Right other                              -> expectationFailure $+          "expected WriteAbortedMismatch, got " <> T.unpack (describeWriteOutcome other)+        Left e                                   -> expectationFailure $ show e+      after <- countNodes+      after `shouldBe` 0++    it "pool variant returns a ReadOK for a simple read" $ do+      cleanup+      cfg <- liftIO $ mkGetConfig neo4j5Config+      pool <- liftIO $ createPool cfg defaultPoolConfig+      outcome <- liftIO $ withReadOnlyTransaction' pool "RETURN 1 AS x" H.empty+      liftIO $ destroyPool pool+      case outcome of+        Right (ReadOK _ _) -> pure ()+        Right other        -> expectationFailure $+          "expected ReadOK, got " <> T.unpack (describeReadOutcome other)+        Left e             -> expectationFailure $ show e++    it "pool variant of confirmed write commits when count matches" $ do+      cleanup+      cfg <- liftIO $ mkGetConfig neo4j5Config+      pool <- liftIO $ createPool cfg defaultPoolConfig+      outcome <- liftIO $ withConfirmedWriteTransaction' pool+        ("CREATE (:" <> lbl <> " {a: 1})") H.empty 3+      liftIO $ destroyPool pool+      case outcome of+        Right (WriteCommitted _ _) -> pure ()+        Right other                -> expectationFailure $+          "expected WriteCommitted, got " <> T.unpack (describeWriteOutcome other)+        Left e                     -> expectationFailure $ show e+      after <- countNodes+      after `shouldBe` 1+      cleanup++    it "pool variant captures pool acquire failures in Left" $ do+      -- Build a pool pointing at a port nothing's listening on. The+      -- subsequent withReadOnlyTransaction' must surface the connect error+      -- as Left, not throw -- this is the contract added by the try-wrap.+      let badConfig = pure def+            { host = "127.0.0.1"+            , port = 65500  -- unprivileged port; nothing listening here+            , scheme = None+            , use_tls = False+            }+      cfg <- liftIO $ mkGetConfig badConfig+      pool <- liftIO $ createPool cfg defaultPoolConfig+      outcome <- liftIO $ withReadOnlyTransaction' pool "RETURN 1" H.empty+      liftIO $ destroyPool pool+      case outcome of+        Left _ -> pure ()  -- expected: pool/connect error captured+        Right res -> expectationFailure $+          "expected Left from broken pool, got " <> T.unpack (describeReadOutcome res)++    it "confirm=0 commits a no-op MATCH that affects nothing" $ do+      cleanup+      -- Boundary case: a query that matches no rows reports affected=0.+      -- confirm=0 must commit cleanly rather than rolling back as a mismatch.+      outcome <- liftIO $ wp $ \conn ->+        withConfirmedWriteTransaction conn+          ("MATCH (n:" <> lbl <> "Nonexistent) DETACH DELETE n") H.empty 0+      case outcome of+        Right (WriteCommitted _ _) -> pure ()+        Right other                -> expectationFailure $+          "expected WriteCommitted, got " <> T.unpack (describeWriteOutcome other)+        Left e                     -> expectationFailure $ show e+++-- | Either path that signals "this read tx didn't commit any writes":+-- the post-hoc stats gate (ReadAbortedByWrite) or the server's upfront+-- mode='r' enforcement (Left _).+assertReadDidNotCommit :: Either SomeException ReadOutcome -> ExampleT context IO ()+assertReadDidNotCommit outcome = case outcome of+  Right (ReadAbortedByWrite _) -> pure ()+  Left _                       -> pure ()+  Right other                  -> expectationFailure $+    "expected ReadAbortedByWrite or Left _, got " <> T.unpack (describeReadOutcome other)+++-- ================================================================ -- Server hints integration tests -- ================================================================ @@ -1704,6 +1898,8 @@   notificationTestSuite   -- Query stats tests (Neo4j 5)   statsTestSuite+  -- Gated transactions (Neo4j 5; covers the rollback semantics)+  adminTestSuite   -- Server hints tests (Neo4j 5)   serverHintTestSuite   -- Decode tests (Neo4j 5)

@@ -43,8 +43,12 @@   , sendTelemetry     -- * Transactions   , withTransaction-  , withRetryTransaction   , withTransaction'+  , withReadTransaction+  , withReadTransaction'+  , withTxMode+  , withRetryTransaction+  , withRetryTransactionMode     -- * Retry configuration   , RetryConfig(..)   , defaultRetryConfig@@ -102,6 +106,7 @@   , ProfileNode(..)   , queryExplain   , queryProfile+  , renderPlan     -- * Query logging   , QueryLog(..)     -- * Notifications@@ -110,6 +115,7 @@   , Position(..)     -- * Query statistics   , QueryStats(..)+  , formatStatsLine     -- * BoltM monad   , BoltM   , runBolt@@ -149,13 +155,30 @@   , groupByField     -- * PackStream re-exports   , Ps(..)+    -- * Aeson interop+  , parsePs+  , psToAeson+  , propsToAeson+  , propsFromAeson+    -- * Admin / sandbox helpers (Database.Bolty.Admin)+  , ReadOutcome(..)+  , WriteOutcome(..)+  , ReadModeViolation(..)+  , WriteCountMismatch(..)+  , describeReadOutcome+  , describeWriteOutcome+  , withReadOnlyTransaction+  , withReadOnlyTransaction'+  , withConfirmedWriteTransaction+  , withConfirmedWriteTransaction'+  , totalAffected   ) where -import           Database.Bolty.Connection          (queryPWithFieldsIO, queryPMetaIO)+import           Database.Bolty.Connection          (queryPWithFieldsIO, queryPMetaIO, withTxMode) import           Database.Bolty.Logging            (QueryLog(..))-import           Database.Bolty.Plan              (PlanNode(..), ProfileNode(..))+import           Database.Bolty.Plan              (PlanNode(..), ProfileNode(..), renderPlan) import           Database.Bolty.Notification      (Notification(..), Severity(..), Position(..))-import           Database.Bolty.Stats             (QueryStats(..))+import           Database.Bolty.Stats             (QueryStats(..), formatStatsLine) import           Database.Bolty.Decode import           Database.Bolty.Connection.Config   (validateConfig) import qualified Database.Bolty.Connection.Pipe     as P@@ -168,7 +191,8 @@ import           Database.Bolty.Pool import           Database.Bolty.Record import           Database.Bolty.ResultSet-import           Database.Bolty.Routing (AccessMode(..), RoutingPool, RoutingPoolConfig(..),+import           Database.Bolty.AccessMode          (AccessMode(..))+import           Database.Bolty.Routing (RoutingPool, RoutingPoolConfig(..),                                         defaultRoutingPoolConfig, createRoutingPool,                                         destroyRoutingPool, withRoutingConnection,                                         acquireRoutingConnection,@@ -179,7 +203,17 @@                                         readTransaction, writeTransaction, getLastBookmarks) import           Database.Bolty.Value.Type          (Bolt(..), asNull, asBool, asInt, asFloat                                                     , asBytes, asText, asList, asDict-                                                    , asNode, asRelationship, asPath)+                                                    , asNode, asRelationship, asPath+                                                    , parsePs, psToAeson+                                                    , propsToAeson, propsFromAeson)+import           Database.Bolty.Admin               (ReadOutcome(..), WriteOutcome(..)+                                                    , ReadModeViolation(..)+                                                    , WriteCountMismatch(..)+                                                    , describeReadOutcome, describeWriteOutcome+                                                    , withReadOnlyTransaction, withReadOnlyTransaction'+                                                    , withConfirmedWriteTransaction+                                                    , withConfirmedWriteTransaction'+                                                    , totalAffected) import           Database.Bolty.Connection.Version  (Version(..))  import           Data.Kind                           (Type)@@ -320,28 +354,53 @@     Nothing   -> error "queryProfile: no profile in response"  --- | Run an action inside an explicit transaction. Automatically commits on success--- and rolls back on failure.+-- | Run an action inside an explicit /write/ transaction. Automatically+-- commits on success and rolls back on failure.+--+-- Equivalent to @'withTxMode' 'WriteAccess'@. Use 'withReadTransaction'+-- for a read-only transaction that can be cluster-routed to a follower+-- and has the server enforce no writes. withTransaction :: HasCallStack => Connection -> (Connection -> IO a) -> IO a-withTransaction conn action = do-  P.beginTx conn defaultBegin-  result <- action conn `onException` P.tryRollback conn-  _ <- P.commitTx conn-  pure result-  where-    defaultBegin = Begin V.empty Nothing H.empty 'w' Nothing Nothing+withTransaction = withTxMode WriteAccess  +-- | Run an action inside an explicit /read/ transaction. Automatically+-- commits on success and rolls back on failure.+--+-- The transaction is opened with 'ReadAccess': in cluster setups the+-- server routes to a follower, and any direct write attempt is rejected+-- upfront with an @AccessMode@ error (a Neo4j 5+ feature). For application+-- code this is the right pair to 'withTransaction'.+--+-- For an admin-tool variant that additionally inspects 'parsedStats'+-- post-hoc and reports a rollback as a typed 'ReadOutcome' instead of+-- a thrown exception, see 'Database.Bolty.Admin.withReadOnlyTransaction'.+--+-- /Not the same as/ 'Database.Bolty.Session.readTransaction', which runs+-- a multi-step action against a session with bookmarks.+withReadTransaction :: HasCallStack => Connection -> (Connection -> IO a) -> IO a+withReadTransaction = withTxMode ReadAccess++ -- | Run a transaction with automatic retry on transient failures. -- Uses exponential backoff between retries. withRetryTransaction :: HasCallStack                      => RetryConfig -> Connection -> (Connection -> IO a) -> IO a-withRetryTransaction RetryConfig{maxRetries, initialDelay, maxDelay} conn action =+withRetryTransaction = withRetryTransactionMode WriteAccess+++-- | Like 'withRetryTransaction' but parameterised on the 'AccessMode',+-- so the same retry machinery serves both 'withTransaction'' and+-- 'withReadTransaction''.+withRetryTransactionMode+  :: HasCallStack+  => AccessMode -> RetryConfig -> Connection -> (Connection -> IO a) -> IO a+withRetryTransactionMode mode RetryConfig{maxRetries, initialDelay, maxDelay} conn action =     go maxRetries initialDelay   where-    go 0 _     = withTransaction conn action+    go 0 _     = withTxMode mode conn action     go n delay = do-      result <- try $ withTransaction conn action+      result <- try $ withTxMode mode conn action       case result of         Right x -> pure x         Left (e :: SomeException) -> case fromException e :: Maybe Error of@@ -351,10 +410,19 @@           _ -> throwIO e  --- | Convenience: acquire a pooled connection, run a retrying transaction, and release.+-- | Convenience: acquire a pooled connection, run a retrying write+-- transaction, and release. withTransaction' :: HasCallStack => BoltPool -> (Connection -> IO a) -> IO a withTransaction' pool@BoltPool{bpRetryConfig} action =   withConnection pool $ \conn ->-    withRetryTransaction bpRetryConfig conn action+    withRetryTransactionMode WriteAccess bpRetryConfig conn action+++-- | Convenience: acquire a pooled connection, run a retrying read+-- transaction, and release.+withReadTransaction' :: HasCallStack => BoltPool -> (Connection -> IO a) -> IO a+withReadTransaction' pool@BoltPool{bpRetryConfig} action =+  withConnection pool $ \conn ->+    withRetryTransactionMode ReadAccess bpRetryConfig conn action  

@@ -0,0 +1,41 @@+-- | Access mode for Bolt transactions and routing.+--+-- The Bolt protocol carries a @mode@ field on BEGIN and RUN messages whose+-- only valid values are @"r"@ (read) and @"w"@ (write). This module hides+-- that wire shape behind a sum type so consumers can't construct invalid+-- modes, and so the read\/write distinction reads as data at use sites+-- (cluster routing, transaction primitives, session management).+--+-- The 'PackStream' instance is the single point where the wire encoding+-- lives: 'ReadAccess' \<-\> @"r"@, 'WriteAccess' \<-\> @"w"@.+module Database.Bolty.AccessMode+  ( AccessMode(..)+  ) where++import           Data.Kind            (Type)+import           Data.PackStream      (PackStream(..), Ps(..), Result(..), withString)+import           GHC.Generics         (Generic)+++-- | Whether a transaction (or session connection) is intended for reading+-- or writing. The value flows to two distinct layers:+--+-- * Cluster routing (Session\/Routing layer): 'ReadAccess' picks a follower,+--   'WriteAccess' picks the leader. No-op on non-clustered connections.+-- * Per-transaction enforcement (BEGIN\/RUN @mode@): 'ReadAccess' instructs+--   the server to reject write attempts upfront (Neo4j 5+); 'WriteAccess'+--   is the default and allows writes.+type AccessMode :: Type+data AccessMode = ReadAccess | WriteAccess+  deriving stock (Show, Eq, Ord, Enum, Bounded, Generic)+++-- | Wire format: a single-character PackStream string, @"r"@ or @"w"@.+-- @fromPs@ rejects any other string to preserve the invariant on decode.+instance PackStream AccessMode where+  toPs ReadAccess  = PsString "r"+  toPs WriteAccess = PsString "w"+  fromPs = withString "AccessMode" $ \t -> case t of+    "r" -> Success ReadAccess+    "w" -> Success WriteAccess+    _   -> Error ("expected mode \"r\" or \"w\", got: " <> t)

@@ -0,0 +1,312 @@+-- | Helpers for admin tools, migration scripts, and sandbox executors --+-- not intended for application code.+--+-- The functions here trade flexibility for safety: they wrap a hand-rolled+-- BEGIN\/COMMIT\/ROLLBACK with a server-stat-based gate so the caller can+-- be sure a query either stays within an expected effect or doesn't commit+-- at all.+--+-- * 'withReadOnlyTransaction' rolls back if the query produced any updates.+-- * 'withConfirmedWriteTransaction' rolls back unless the actual affected+--   count exactly matches the caller-supplied expectation.+--+-- Both come in two variants: the @Connection@ form takes a connection you+-- already hold, and the primed @'@ form pulls one from a 'BoltPool' for+-- the duration of the call.+--+-- Application code generally knows whether its queries read or write and+-- doesn't need either gate. Use 'Database.Bolty.withTransaction' or the+-- session-level 'Database.Bolty.Session.readTransaction' \/ 'writeTransaction'+-- instead.+--+-- This module lives alongside (rather than inside) 'Database.Bolty' to+-- avoid an import cycle: 'Database.Bolty' re-exports the names below.+-- Internals shared with 'Database.Bolty' (the BEGIN/COMMIT/ROLLBACK+-- wrapper) live in 'Database.Bolty.Connection.withTxMode', re-exported+-- from 'Database.Bolty'.+module Database.Bolty.Admin+  ( -- * Outcomes+    ReadOutcome(..)+  , WriteOutcome(..)+  , describeReadOutcome+  , describeWriteOutcome+    -- * Internal exceptions (escape hatches)+  , ReadModeViolation(..)+  , WriteCountMismatch(..)+    -- * Read-only gated transactions+  , withReadOnlyTransaction+  , withReadOnlyTransaction'+    -- * Confirm-gated write transactions+  , withConfirmedWriteTransaction+  , withConfirmedWriteTransaction'+    -- * Affected-count helper used by the gate+  , totalAffected+  ) where++import           Prelude++import           Control.Exception                  (Exception, SomeException, fromException,+                                                     throwIO, try)+import           Data.Int                           (Int64)+import           Data.Kind                          (Type)+import qualified Data.HashMap.Lazy                  as H+import qualified Data.Text                          as T++import           Data.PackStream.Ps                 (Ps)+import           Database.Bolty.AccessMode          (AccessMode(..))+import           Database.Bolty.Connection          (queryPMetaIO, withTxMode)+import           Database.Bolty.Connection.Type     (Connection)+import           Database.Bolty.Message.Response    (QueryMeta(..))+import           Database.Bolty.Pool                (BoltPool, withConnection)+import           Database.Bolty.ResultSet           (ResultSet(..))+import           Database.Bolty.Stats               (QueryStats(..), formatStatsLine)+++-- =====================================================================+-- Outcomes+-- =====================================================================++-- | Outcome of a 'withReadOnlyTransaction' run that didn't fail with a+-- non-validation error. 'ReadAbortedByWrite' fires when the query produced+-- any updates, which forces the transaction to roll back.+--+-- No 'Show' instance: 'QueryMeta' has one only via a stock derive in+-- "Database.Bolty.Message.Response", and you generally don't want a+-- multi-kilobyte stat dump in your logs. Use 'describeReadOutcome' for+-- a one-liner.+type ReadOutcome :: Type+data ReadOutcome+  = ReadOK !ResultSet !QueryMeta+  | ReadAbortedByWrite !QueryStats+++-- | One-line description of a 'ReadOutcome' suitable for assertion+-- messages and logging.+describeReadOutcome :: ReadOutcome -> T.Text+describeReadOutcome (ReadOK _ _)         = "ReadOK"+describeReadOutcome (ReadAbortedByWrite s) =+  "ReadAbortedByWrite (" <> formatStatsLine s <> ")"+++-- | Outcome of a 'withConfirmedWriteTransaction' run. 'WriteAbortedMismatch'+-- fires when the actual affected count doesn't match the caller-supplied+-- confirm number; the transaction is rolled back in that case.+type WriteOutcome :: Type+data WriteOutcome+  = WriteCommitted !ResultSet !QueryMeta+  | WriteAbortedMismatch !Int64 !Int64 !(Maybe QueryStats)+    -- ^ expected, actual, stats (if any)+++-- | One-line description of a 'WriteOutcome' suitable for assertion+-- messages and logging.+describeWriteOutcome :: WriteOutcome -> T.Text+describeWriteOutcome (WriteCommitted _ _) = "WriteCommitted"+describeWriteOutcome (WriteAbortedMismatch ex actual mStats) =+  "WriteAbortedMismatch expected=" <> T.pack (show ex)+  <> " actual=" <> T.pack (show actual)+  <> maybe "" (\s -> " (" <> formatStatsLine s <> ")") mStats+++-- =====================================================================+-- Internal-but-exported rollback exceptions+-- =====================================================================++-- | Thrown inside 'withReadOnlyTransaction' to trigger a rollback. Caught+-- and converted to 'ReadAbortedByWrite' before returning, so callers+-- normally don't see it. Exported only as an escape hatch for code that+-- builds its own wrappers around the primitive.+type ReadModeViolation :: Type+data ReadModeViolation = ReadModeViolation !QueryStats+  deriving stock (Show)+instance Exception ReadModeViolation+++-- | Thrown inside 'withConfirmedWriteTransaction' to trigger a rollback.+-- Same exported-as-escape-hatch caveat as 'ReadModeViolation'.+type WriteCountMismatch :: Type+data WriteCountMismatch = WriteCountMismatch !Int64 !Int64 !(Maybe QueryStats)+  deriving stock (Show)+instance Exception WriteCountMismatch+++-- =====================================================================+-- Read-only query execution (gated)+-- =====================================================================++-- | Run a single query in an explicit read transaction on the given+-- connection. The transaction is opened with @mode='r'@, which has two+-- effects:+--+-- 1. In cluster setups, the server routes the query to a follower.+-- 2. The server enforces read-only access: any direct write attempt+--    (e.g. @CREATE@, @MATCH ... DELETE@) is rejected with+--    @AccessMode@ before it executes, surfacing as 'Left' from this+--    function with a 'ResponseErrorFailure' inside.+--+-- The function additionally inspects 'parsedStats' post-hoc. If a+-- query slips past the server's mode enforcement and reports+-- 'containsUpdates' (some procedures may bypass enforcement), the+-- transaction is rolled back and the function returns+-- 'ReadAbortedByWrite'. This belt-and-braces gate covers older Neo4j+-- versions and procedure-side mutations that don't trigger+-- @AccessMode@.+--+-- Either way, no committed writes survive. Callers that want to verify+-- "the database is unchanged" should rely on 'Right' = ('ReadOK' or+-- 'ReadAbortedByWrite') and 'Left' both being acceptable; only an+-- accidentally committed write would be a bug.+--+-- This is /not/ the same as 'Database.Bolty.Session.readTransaction',+-- which runs a multi-step action against a session in read mode with+-- bookmarks. 'withReadOnlyTransaction' runs a single query, gates on its+-- stats, and returns the outcome; it has no notion of session state.+--+-- Caveats:+--+-- * Procedures with external side effects (e.g. @apoc.export.csv@)+--   cannot be undone -- their files are written before either gate+--   fires. Use 'withReadOnlyTransaction' for pure Cypher only.+-- * 'containsSystemUpdates' (CREATE DATABASE etc.) is not gated; in+--   practice Neo4j refuses to mix system and data ops in one tx, so+--   this is rarely observable.+withReadOnlyTransaction+  :: Connection+  -> T.Text+  -> H.HashMap T.Text Ps+  -> IO (Either SomeException ReadOutcome)+withReadOnlyTransaction conn query params = do+  result <- try $ withTxMode ReadAccess conn $ \tConn -> do+    (rs, meta) <- runQuery tConn query params+    case parsedStats meta of+      Just s | containsUpdates s -> throwIO (ReadModeViolation s)+      _                          -> pure (rs, meta)+  case result of+    Right (rs, meta) -> pure $ Right (ReadOK rs meta)+    Left e -> case fromException e of+      Just (ReadModeViolation s) -> pure $ Right (ReadAbortedByWrite s)+      Nothing                    -> pure $ Left e+++-- | Pool variant of 'withReadOnlyTransaction'. Acquires a connection from+-- the pool for the duration of the call. Pool-level failures (acquire+-- timeout, validation failure) are captured in the returned 'Either'+-- rather than thrown, matching the contract of 'withReadOnlyTransaction'.+withReadOnlyTransaction'+  :: BoltPool+  -> T.Text+  -> H.HashMap T.Text Ps+  -> IO (Either SomeException ReadOutcome)+withReadOnlyTransaction' pool query params = do+  result <- try $ withConnection pool $ \conn ->+    withReadOnlyTransaction conn query params+  pure $ case result of+    Right inner -> inner       -- already Either+    Left  e     -> Left e      -- pool error+++-- =====================================================================+-- Confirm-gated write transactions+-- =====================================================================++-- | Run a query in an explicit write transaction on the given connection,+-- gated by an expected affected-entity count (see 'totalAffected' for+-- what counts as "affected"). The transaction commits only when the+-- actual count equals @expected@; otherwise it rolls back and the+-- function returns 'WriteAbortedMismatch' with the actual count for the+-- caller to react to.+--+-- The intended use is ad-hoc administrative writes where the operator+-- wants a deliberate \"I know exactly what this query will affect\"+-- handshake before any change becomes durable. Run once with a+-- deliberately wrong expected count to discover the actual count, then+-- re-run with the correct value to commit.+withConfirmedWriteTransaction+  :: Connection+  -> T.Text+  -> H.HashMap T.Text Ps+  -> Int64       -- ^ expected total affected count+  -> IO (Either SomeException WriteOutcome)+withConfirmedWriteTransaction conn query params expected = do+  result <- try $ withTxMode WriteAccess conn $ \tConn -> do+    (rs, meta) <- runQuery tConn query params+    let stats  = parsedStats meta+        actual = totalAffected stats+    if actual /= expected+      then throwIO (WriteCountMismatch expected actual stats)+      else pure (rs, meta)+  case result of+    Right (rs, meta) -> pure $ Right (WriteCommitted rs meta)+    Left e -> case fromException e of+      Just (WriteCountMismatch ex ac st) ->+        pure $ Right (WriteAbortedMismatch ex ac st)+      Nothing -> pure $ Left e+++-- | Pool variant of 'withConfirmedWriteTransaction'. Acquires a+-- connection from the pool for the duration of the call. Pool-level+-- failures are captured in the returned 'Either' rather than thrown,+-- matching the contract of 'withConfirmedWriteTransaction'.+withConfirmedWriteTransaction'+  :: BoltPool+  -> T.Text+  -> H.HashMap T.Text Ps+  -> Int64+  -> IO (Either SomeException WriteOutcome)+withConfirmedWriteTransaction' pool query params expected = do+  result <- try $ withConnection pool $ \conn ->+    withConfirmedWriteTransaction conn query params expected+  pure $ case result of+    Right inner -> inner+    Left  e     -> Left e+++-- =====================================================================+-- Affected-count helper+-- =====================================================================++-- | Sum every mutation counter on a 'QueryStats' record. Used by+-- 'withConfirmedWriteTransaction' to compare actual versus expected+-- effect; lives here rather than in "Database.Bolty.Stats" because the+-- summing semantics are admin-tool-shaped (most application code cares+-- about specific counters, or uses the boolean 'containsUpdates' flag).+--+-- The total includes both data and schema mutations within the current+-- database -- nodes, relationships, properties, labels, indexes, and+-- constraints, both created and removed. It does not net out: a query+-- that creates 5 nodes and deletes 5 nodes reports 10, not 0.+--+-- The asymmetry between @CREATE (:X {a:1})@ (3: node + property + label)+-- and @DETACH DELETE n@ (1: node) is intentional: the counters reflect+-- the work the server performed, not just the headline operation.+--+-- Excluded from the sum:+--+-- * The 'containsUpdates' / 'containsSystemUpdates' boolean flags,+--   which are derived from the counters.+-- * 'systemUpdates' -- a separate counter for system-level changes+--   (CREATE DATABASE, CREATE USER, etc.) that affect server-wide state+--   rather than the current database.+totalAffected :: Maybe QueryStats -> Int64+totalAffected Nothing  = 0+totalAffected (Just s) =+    nodesCreated s + nodesDeleted s+  + relationshipsCreated s + relationshipsDeleted s+  + propertiesSet s+  + labelsAdded s + labelsRemoved s+  + indexesAdded s + indexesRemoved s+  + constraintsAdded s + constraintsRemoved s+++-- =====================================================================+-- Internals+-- =====================================================================++-- Run a query and bundle the result into a 'ResultSet'. Mirrors+-- 'Database.Bolty.queryResultMeta' but at the IO level so we don't+-- depend on the 'BoltM' newtype (which would cycle through+-- 'Database.Bolty').+runQuery :: Connection -> T.Text -> H.HashMap T.Text Ps -> IO (ResultSet, QueryMeta)+runQuery conn query params = do+  (fs, rs, meta) <- queryPMetaIO conn query params+  pure (ResultSet fs rs, meta)

@@ -9,16 +9,19 @@   , queryPMetaIO   , requestResponseRunIO   , requestResponsePullIO+  , withTxMode   ) where  import Prelude +import           Database.Bolty.AccessMode        (AccessMode) import qualified Database.Bolty.Connection.Pipe as P import           Database.Bolty.Connection.Type import           Database.Bolty.Logging+import           Database.Bolty.Message.Request   (Begin(Begin)) import           Database.Bolty.Record -import           Control.Exception             (SomeException, throwIO, try)+import           Control.Exception             (SomeException, onException, throwIO, try) import           Data.IORef                    (IORef, newIORef, readIORef, writeIORef) import           Data.Kind                     (Type) import           Data.Text                     (Text)@@ -297,3 +300,20 @@   case notificationHandler of     Nothing      -> pure ()     Just handler -> V.mapM_ handler parsedNotifications+++-- | Run an action inside an explicit transaction opened with the given+-- 'AccessMode'. Automatically commits on success and attempts a rollback+-- on failure.+--+-- The mode controls cluster routing: 'ReadAccess' routes to a follower+-- and engages the server's read-only enforcement; 'WriteAccess' routes+-- to the leader. Higher-level helpers in "Database.Bolty"+-- ('Database.Bolty.withTransaction' / 'Database.Bolty.withReadTransaction')+-- are thin wrappers over this primitive.+withTxMode :: HasCallStack => AccessMode -> Connection -> (Connection -> IO a) -> IO a+withTxMode mode conn action = do+  P.beginTx conn (Begin V.empty Nothing H.empty mode Nothing Nothing)+  result <- action conn `onException` P.tryRollback conn+  _ <- P.commitTx conn+  pure result

@@ -16,9 +16,9 @@   , RunExtra(..), defaultRunExtra   ) where -import           Data.HashMap.Lazy              (HashMap) import           Data.Int                      (Int64) import           Data.Kind                     (Type)+import           Data.Maybe                    (fromMaybe) import           GHC.Generics                  (Generic) import qualified Data.HashMap.Lazy             as H import qualified Data.Text                     as T@@ -26,6 +26,7 @@  import           Data.PackStream import           Data.PackStream.Integer       (toPSInteger, fromPSInteger)+import           Database.Bolty.AccessMode     (AccessMode(..)) import           Database.Bolty.Connection.Instances () import           Database.Bolty.Connection.Type (UserAgent(..), Scheme(..), Routing(..)) @@ -96,7 +97,7 @@                   bookmarks   :: V.Vector T.Text     <- lookupWithError "bookmarks" map "\"bookmarks\" not found in Run Request"                   tx_timeout  :: Maybe Int64         <- lookupMaybe "tx_timeout" map                   tx_metadata :: H.HashMap T.Text Ps <- lookupWithError "tx_metadata" map "\"tx_metadata\" not found in Run Request"-                  mode        :: Char                <- fromPsMode map+                  mode        :: AccessMode          <- lookupMode map                   db          :: Maybe T.Text        <- lookupMaybe "db" map                   imp_user    :: Maybe T.Text        <- lookupMaybe "imp_user" map                   pure $ RRunAutoCommitTransaction RunAutoCommitTransaction{query, parameters, extra, bookmarks, tx_timeout, tx_metadata, mode, db, imp_user}@@ -150,7 +151,7 @@   , bookmarks   = V.empty   , tx_timeout  = Nothing   , tx_metadata = H.empty-  , mode        = 'w'+  , mode        = WriteAccess   , db          = Nothing   , imp_user    = Nothing   }@@ -164,7 +165,7 @@   , bookmarks   = V.empty   , tx_timeout  = Nothing   , tx_metadata = H.empty-  , mode        = 'w'+  , mode        = WriteAccess   , db          = Nothing   , imp_user    = Nothing   }@@ -178,7 +179,7 @@   , bookmarks   :: V.Vector T.Text   , tx_timeout  :: !(Maybe Int64)   , tx_metadata :: !(H.HashMap T.Text Ps)-  , mode        :: !Char+  , mode        :: !AccessMode   , db          :: !(Maybe T.Text)   , imp_user    :: !(Maybe T.Text)   }@@ -198,7 +199,7 @@                               Just i  -> [("imp_user", toPs i)]         in  [ ("bookmarks", toPs bookmarks)             , ("tx_metadata", toPs tx_metadata)-            , ("mode", toPs $ T.singleton mode)+            , ("mode", toPs mode)             , ("db", toPs db)             ] <> tx_timeout_list <> imp_user_list     ]@@ -226,7 +227,7 @@   { bookmarks   :: !(V.Vector T.Text)   , tx_timeout  :: !(Maybe Int64)   , tx_metadata :: !(H.HashMap T.Text Ps)-  , mode        :: !Char+  , mode        :: !AccessMode   , db          :: !(Maybe T.Text)   , imp_user    :: !(Maybe T.Text)   }@@ -236,7 +237,7 @@     [ ("bookmarks", toPs bookmarks)     , ("tx_timeout", toPs tx_timeout)     , ("tx_metadata", toPs tx_metadata)-    , ("mode", toPs $ T.singleton mode)+    , ("mode", toPs mode)     , ("db", toPs db)     , ("imp_user", toPs imp_user)     ]@@ -246,7 +247,7 @@             bookmarks :: V.Vector T.Text <- lookupWithError "bookmarks" map "\"bookmarks\" not found in Begin"             tx_timeout :: Maybe Int64 <- lookupMaybe "tx_timeout" map             tx_metadata :: H.HashMap T.Text Ps <- lookupWithError "tx_metadata" map "\"tx_metadata\" not found in Begin"-            mode :: Char <- fromPsMode map+            mode :: AccessMode <- lookupMode map             db :: (Maybe T.Text) <- lookupMaybe "db" map             imp_user :: Maybe T.Text <- lookupMaybe "imp_user" map             pure $ Begin{bookmarks, tx_timeout, tx_metadata, mode, db, imp_user}@@ -326,7 +327,7 @@   { bookmarks   :: !(V.Vector T.Text)   , tx_timeout  :: !(Maybe Int64)   , tx_metadata :: !(H.HashMap T.Text Ps)-  , mode        :: !Char+  , mode        :: !AccessMode   , db          :: !(Maybe T.Text)   , imp_user    :: !(Maybe T.Text)   }@@ -337,7 +338,7 @@   { bookmarks   = V.empty   , tx_timeout  = Nothing   , tx_metadata = H.empty-  , mode        = 'w'+  , mode        = WriteAccess   , db          = Nothing   , imp_user    = Nothing   }@@ -347,7 +348,7 @@     [ ("bookmarks", toPs bookmarks)     , ("tx_timeout", toPs tx_timeout)     , ("tx_metadata", toPs tx_metadata)-    , ("mode", toPs $ T.singleton mode)+    , ("mode", toPs mode)     , ("db", toPs db)     , ("imp_user", toPs imp_user)     ]@@ -357,21 +358,12 @@             bookmarks :: V.Vector T.Text <- lookupWithError "bookmarks" map "\"bookmarks\" not found in RunExtra"             tx_timeout :: Maybe Int64 <- lookupMaybe "tx_timeout" map             tx_metadata :: H.HashMap T.Text Ps <- lookupWithError "tx_metadata" map "\"tx_metadata\" not found in RunExtra"-            mode :: Char <- fromPsMode map+            mode :: AccessMode <- lookupMode map             db :: Maybe T.Text <- lookupMaybe "db" map             imp_user :: Maybe T.Text <- lookupMaybe "imp_user" map             pure $ RunExtra{bookmarks, tx_timeout, tx_metadata, mode, db, imp_user}  -fromPsMode :: HashMap T.Text Ps -> Result Char-fromPsMode map = do-  mode :: T.Text <- lookupWithError "mode" map "\"mode\" not found in RunExtra"-  if T.length mode == 1 then-    Success $ T.head mode-  else-    Error "\"mode\" in RunExtra should be a single character of either 'r' or 'w'"-- helloToPs :: Hello -> Ps helloToPs Hello{user_agent, scheme, routing, patchBolt} =     PsDictionary $ H.fromList $@@ -524,3 +516,11 @@         Just i  -> fmap RTelemetry $ telemetryApiFromInt i         Nothing -> Error "telemetry api integer out of Int64 range"       _           -> Error "expected integer field for Telemetry"+++-- | Look up the BEGIN\/RUN @mode@ field, defaulting to 'WriteAccess' when+-- absent. Per the Bolt protocol, @mode@ is an optional field with default+-- @"w"@; spec-compliant peers may omit it on write transactions to save+-- bytes. A bare @lookupWithError@ would reject those messages.+lookupMode :: H.HashMap T.Text Ps -> Result AccessMode+lookupMode m = fromMaybe WriteAccess <$> lookupMaybe "mode" m

@@ -227,6 +227,7 @@   , db :: !T.Text   -- ^ the database name where the query was executed (v4.0+).   }+  deriving stock (Show)  -- | Parsed COMMIT SUCCESS metadata. type SuccessCommit :: Type

@@ -4,6 +4,7 @@   , ProfileNode(..)   , parsePlan   , parseProfile+  , renderPlan   ) where  import           Prelude@@ -152,3 +153,35 @@     Just i  -> i     Nothing -> 0   _ -> 0+++-- | Render a 'PlanNode' tree as an indented text block. Each child is+-- indented two spaces deeper than its parent. Identifier vectors (the+-- @vars:@ line) are shown when non-empty so a reader can match+-- variables to operators.+--+-- Operator arguments ('pnArguments') are intentionally dropped for+-- terseness -- the operator name + estimated rows + identifiers are+-- enough to read most plans, and the args dictionary is verbose.+--+-- Pass @0@ for the initial @depth@. Suitable for printing the result+-- of 'queryExplain'.+--+-- Example output:+--+-- > + ProduceResults  (~1.0 rows)+-- >     vars: u, name+-- >   + Projection  (~1.0 rows)+-- >       vars: u, name+-- >     + NodeUniqueIndexSeek  (~1.0 rows)+-- >         vars: u+renderPlan :: Int -> PlanNode -> T.Text+renderPlan depth (PlanNode op _args idents est children) =+  let indent = T.replicate depth "  "+      header = indent <> "+ " <> op+             <> "  (~" <> T.pack (show est) <> " rows)"+      idLine = if V.null idents+                 then ""+                 else indent <> "    vars: " <> T.intercalate ", " (V.toList idents) <> "\n"+      kids   = T.concat $ V.toList $ V.map (renderPlan (depth + 1)) children+  in header <> "\n" <> idLine <> kids

@@ -3,8 +3,6 @@   ( -- * Routing table     getRoutingTable   , RoutingTable(..)-    -- * Access mode-  , AccessMode(..)     -- * Routing pool   , RoutingPool(..)   , RoutingPoolConfig(..)@@ -36,6 +34,7 @@ import           GHC.Clock                      (getMonotonicTimeNSec) import           GHC.Stack                      (HasCallStack) +import           Database.Bolty.AccessMode      (AccessMode(..)) import           Database.Bolty.Connection.Type import qualified Database.Bolty.Connection.Pipe as P import           Database.Bolty.Message.Request (Request(..), Route(..), RouteExtra(..), Begin(..))@@ -43,12 +42,6 @@ import           Database.Bolty.Pool  --- | Access mode for routing: determines whether to use reader or writer servers.-type AccessMode :: Type-data AccessMode = ReadAccess | WriteAccess-  deriving stock (Show, Eq)-- -- | Fetch a routing table from the server. The connection must be in Ready state. getRoutingTable :: HasCallStack => Connection -> Maybe Text -> IO RoutingTable getRoutingTable conn dbName = do@@ -258,10 +251,6 @@                 go (n - 1) (min maxD (delay * 2)) maxD           _ -> throwIO e -    modeChar = case mode of-      ReadAccess  -> 'r'-      WriteAccess -> 'w'-     attempt = do       rt <- getOrRefreshTable rp       let addrs = case mode of@@ -272,7 +261,7 @@       addr <- roundRobin rp addrs       pool <- getOrCreatePool rp addr       withConnection pool $ \conn -> do-        P.beginTx conn $ Begin V.empty Nothing H.empty modeChar Nothing Nothing+        P.beginTx conn $ Begin V.empty Nothing H.empty mode Nothing Nothing         result <- action conn `onException` P.tryRollback conn         _ <- P.commitTx conn         pure result

@@ -30,11 +30,12 @@ import qualified Data.Vector                    as V import           GHC.Stack                      (HasCallStack) +import           Database.Bolty.AccessMode      (AccessMode(..)) import           Database.Bolty.Connection.Type import qualified Database.Bolty.Connection.Pipe as P import           Database.Bolty.Message.Request (Begin(Begin), TelemetryApi(..)) import           Database.Bolty.Pool-import           Database.Bolty.Routing (AccessMode(..), RoutingPool(..), withRoutingConnection,+import           Database.Bolty.Routing (RoutingPool(..), withRoutingConnection,                                         invalidateRoutingTable)  @@ -183,15 +184,11 @@                 go (n - 1) (min maxD (delay * 2)) maxD           _ -> throwIO e -    modeChar = case mode of-      ReadAccess  -> 'r'-      WriteAccess -> 'w'-     attempt =       withSessionConnection sPool mode $ \conn -> do         -- Get current bookmarks and begin the transaction         bms <- getBookmarks sBookmarks-        P.beginTx conn $ Begin (V.fromList bms) Nothing H.empty modeChar (database sConfig) Nothing+        P.beginTx conn $ Begin (V.fromList bms) Nothing H.empty mode (database sConfig) Nothing         -- Run the user's action, rollback on error         result <- action conn `onException` P.tryRollback conn         -- Commit and extract bookmark

@@ -2,6 +2,7 @@ module Database.Bolty.Stats   ( QueryStats(..)   , parseStats+  , formatStatsLine   ) where  import           Prelude@@ -73,3 +74,26 @@ boolField key m = case H.lookup key m of   Just (PsBoolean b) -> b   _                  -> False+++-- | One-line summary of every counter on a 'QueryStats' record. Format:+--+-- > Stats: +nodes=1 -nodes=0 +rels=0 -rels=0 props=1 +labels=1 -labels=0 +idx=0 -idx=0 +constr=0 -constr=0+--+-- Useful for diagnostic logging and CLI rollback messages where you want+-- the whole counter set on one line for terse comparison across runs.+formatStatsLine :: QueryStats -> T.Text+formatStatsLine s = T.concat+  [ "Stats: "+  , "+nodes=", T.pack (show (nodesCreated s))+  , " -nodes=", T.pack (show (nodesDeleted s))+  , " +rels=", T.pack (show (relationshipsCreated s))+  , " -rels=", T.pack (show (relationshipsDeleted s))+  , " props=", T.pack (show (propertiesSet s))+  , " +labels=", T.pack (show (labelsAdded s))+  , " -labels=", T.pack (show (labelsRemoved s))+  , " +idx=", T.pack (show (indexesAdded s))+  , " -idx=", T.pack (show (indexesRemoved s))+  , " +constr=", T.pack (show (constraintsAdded s))+  , " -constr=", T.pack (show (constraintsRemoved s))+  ]

@@ -1,6 +1,8 @@--- | Internal module. Not part of the public API.+-- | Bolt value types: the Haskell representation of Neo4j values returned by queries. ----- Bolt value types: the Haskell representation of Neo4j values returned by queries.+-- The Aeson interop helpers ('parsePs', 'psToAeson', 'propsToAeson',+-- 'propsFromAeson') are part of the stable public API; everything else+-- is the internal value-type machinery surfaced via 'Database.Bolty'. module Database.Bolty.Value.Type   ( Bolt(..)     -- * Bolt value extractors@@ -22,6 +24,13 @@     -- * Spatial types   , Point2D(..)   , Point3D(..)+    -- * Aeson interop+    --+    -- $aesonInterop+  , parsePs+  , psToAeson+  , propsToAeson+  , propsFromAeson   ) where  import           Control.Applicative    ((<|>), empty)@@ -384,6 +393,17 @@   -- = Aeson (ToJSON / FromJSON) instances+--+-- $aesonInterop+--+-- Helpers for moving values between PackStream's 'Ps' and Aeson's 'Aeson.Value'.+-- Useful when binding query parameters from JSON input (e.g. a CLI) or when+-- rendering query results as JSON.+--+-- 'parsePs' handles the @{"bytes": "<base64>"}@ shape so binary values can+-- round-trip through JSON. Both functions use 'scientificToPs', which falls+-- back to 'PsFloat' when an integer literal exceeds the @[-2^63, 2^64-1]@+-- range supported by 'PSInteger' rather than silently truncating.  -- | Convert a PackStream property value to JSON. psToAeson :: Ps -> Aeson.Value

@@ -9,6 +9,7 @@ import           Data.Word                         (Word32, Word64) import qualified Data.HashMap.Lazy                 as H import qualified Data.Text                         as T+import qualified Data.Text.Encoding                as TE import qualified Data.Vector                       as V import qualified Validation                        as Val @@ -22,16 +23,21 @@ import qualified Database.Bolty.ResultSet        as RS import           Database.Bolty.Logging           (QueryLog(..)) import           Database.Bolty.Notification     (Notification(..), Severity(..), Position(..), parseNotifications)-import           Database.Bolty.Plan            (PlanNode(..), ProfileNode(..), parsePlan, parseProfile)-import           Database.Bolty.Stats           (QueryStats(..), parseStats)+import           Database.Bolty.Plan            (PlanNode(..), ProfileNode(..), parsePlan, parseProfile, renderPlan)+import           Database.Bolty.Stats           (QueryStats(..), parseStats, formatStatsLine)+import           Database.Bolty.Admin           (totalAffected) import           Database.Bolty.Value.Type        (Node(..), Relationship(..), UnboundRelationship(..)                                                   , Path(..), Date(..), Time(..), LocalTime(..)                                                   , DateTime(..), DateTimeZoneId(..), LocalDateTime(..)                                                   , Duration(..), Point2D(..), Point3D(..)) import           Database.Bolty.Message.Request    (Request(..), Hello(..), Route(..), RouteExtra(..)+                                                  , Begin(..), RunExtra(..)+                                                  , RunAutoCommitTransaction(..)                                                   , Logon(..), TelemetryApi(..)                                                   , Pull(..), defaultPull)-import           Database.Bolty.Message.Response   (Response(..), RoutingTable(..), parseRoutingTable, extractBookmark)+import           Database.Bolty.Message.Response   (Response(..), RoutingTable(..), parseRoutingTable, extractBookmark, QueryMeta(..))+import qualified Database.Bolty.Message.Response   as Resp+import qualified Data.Aeson.KeyMap                 as KM import           Database.Bolty.Routing            (parseAddress) import           Database.Bolty.Session            (newBookmarkManager, getBookmarks, updateBookmark) import           Database.Bolty.Decode            (psToBolt, boltToPs)@@ -40,7 +46,7 @@ import           Control.Exception                 (IOException, SomeException, fromException, toException) import qualified Data.Aeson                        as Aeson import           Data.Aeson                        (fromJSON, toJSON)-import qualified Data.Aeson.Types                  as Aeson (Result(..))+import qualified Data.Aeson.Types                  as Aeson (Result(..), parseEither) import qualified Data.ByteString                   as BS import qualified Data.Vector.Mutable               as MV import           Test.QuickCheck                   (Arbitrary(..), Gen, Result, oneof, listOf,@@ -341,6 +347,127 @@       other -> expectationFailure $ "Expected BoltPoint2D, got: " <> show other  +-- = AccessMode tests++accessModeTests :: TopSpec+accessModeTests = describe "AccessMode" $ do+  it "ReadAccess encodes to PsString \"r\"" $+    toPs ReadAccess `shouldBe` PsString "r"++  it "WriteAccess encodes to PsString \"w\"" $+    toPs WriteAccess `shouldBe` PsString "w"++  it "round-trips ReadAccess" $+    (fromPs (toPs ReadAccess) :: R.Result AccessMode) `shouldBe` R.Success ReadAccess++  it "round-trips WriteAccess" $+    (fromPs (toPs WriteAccess) :: R.Result AccessMode) `shouldBe` R.Success WriteAccess++  it "rejects an unknown single-char string" $+    case (fromPs (PsString "x") :: R.Result AccessMode) of+      R.Error _   -> pure ()+      R.Success a -> expectationFailure $ "Expected Error, got: " <> show a++  it "rejects the empty string" $+    case (fromPs (PsString "") :: R.Result AccessMode) of+      R.Error _   -> pure ()+      R.Success a -> expectationFailure $ "Expected Error, got: " <> show a++  it "rejects a non-string Ps" $+    case (fromPs (PsInteger 1) :: R.Result AccessMode) of+      R.Error _   -> pure ()+      R.Success a -> expectationFailure $ "Expected Error, got: " <> show a++  it "enumerates exhaustively via Bounded + Enum" $+    [minBound .. maxBound] `shouldBe` [ReadAccess, WriteAccess]++  -- Per Bolt spec, "mode" in BEGIN/RUN extra is optional with default "w".+  -- A spec-compliant peer may omit it on write transactions.+  it "Begin.fromPs accepts absent \"mode\" key and defaults to WriteAccess" $ do+    -- Mirror a spec-compliant peer's BEGIN extra dict: required keys+    -- present, optional keys (mode, tx_timeout, db, imp_user) omitted.+    let dict = PsDictionary $ H.fromList+          [ ("bookmarks", toPs (V.empty :: V.Vector T.Text))+          , ("tx_metadata", PsDictionary H.empty)+          ]+    case (fromPs dict :: R.Result Begin) of+      R.Success b -> b.mode `shouldBe` WriteAccess+      R.Error e   -> expectationFailure $ "Expected Success, got: " <> T.unpack e++  it "Begin.fromPs accepts explicit \"mode\" = \"r\"" $ do+    let dict = PsDictionary $ H.fromList+          [ ("bookmarks", toPs (V.empty :: V.Vector T.Text))+          , ("tx_metadata", PsDictionary H.empty)+          , ("mode", PsString "r")+          ]+    case (fromPs dict :: R.Result Begin) of+      R.Success b -> b.mode `shouldBe` ReadAccess+      R.Error e   -> expectationFailure $ "Expected Success, got: " <> T.unpack e++  it "RunExtra.fromPs accepts absent \"mode\" key and defaults to WriteAccess" $ do+    let dict = PsDictionary $ H.fromList+          [ ("bookmarks", toPs (V.empty :: V.Vector T.Text))+          , ("tx_metadata", PsDictionary H.empty)+          ]+    case (fromPs dict :: R.Result RunExtra) of+      R.Success r -> (r :: RunExtra).mode `shouldBe` WriteAccess+      R.Error e   -> expectationFailure $ "Expected Success, got: " <> T.unpack e++  it "RunExtra.fromPs accepts explicit \"mode\" = \"r\"" $ do+    let dict = PsDictionary $ H.fromList+          [ ("bookmarks", toPs (V.empty :: V.Vector T.Text))+          , ("tx_metadata", PsDictionary H.empty)+          , ("mode", PsString "r")+          ]+    case (fromPs dict :: R.Result RunExtra) of+      R.Success r -> (r :: RunExtra).mode `shouldBe` ReadAccess+      R.Error e   -> expectationFailure $ "Expected Success, got: " <> T.unpack e++  -- Invalid mode values must surface as an Error from the parent decoder,+  -- not silently fall back to WriteAccess (which is the absent-key default).+  it "Begin.fromPs rejects invalid \"mode\" value" $ do+    let dict = PsDictionary $ H.fromList+          [ ("bookmarks", toPs (V.empty :: V.Vector T.Text))+          , ("tx_metadata", PsDictionary H.empty)+          , ("mode", PsString "x")+          ]+    case (fromPs dict :: R.Result Begin) of+      R.Error _    -> pure ()+      R.Success b  -> expectationFailure $ "Expected Error, got mode=" <> show b.mode++  it "RunExtra.fromPs rejects invalid \"mode\" value" $ do+    let dict = PsDictionary $ H.fromList+          [ ("bookmarks", toPs (V.empty :: V.Vector T.Text))+          , ("tx_metadata", PsDictionary H.empty)+          , ("mode", PsString "X")  -- uppercase: a likely human-typo case+          ]+    case (fromPs dict :: R.Result RunExtra) of+      R.Error _    -> pure ()+      R.Success r  -> expectationFailure $ "Expected Error, got mode=" <> show ((r :: RunExtra).mode)++  -- Third lookupMode callsite: the autocommit RUN decoder (fromPsToRunRequest).+  -- Routes through PsStructure 0x10 + the metadata-keys gate that picks the+  -- autocommit branch over the explicit-tx branch.+  it "Autocommit RUN decoder accepts absent \"mode\" and defaults to WriteAccess" $ do+    let runDict = PsDictionary $ H.fromList+          [ ("query", PsString "RETURN 1")+          , ("parameters", PsDictionary H.empty)+          , ("extra", PsDictionary $ H.fromList+              [ ("bookmarks", toPs (V.empty :: V.Vector T.Text))+              , ("tx_metadata", PsDictionary H.empty)+              ])+          , ("bookmarks", toPs (V.empty :: V.Vector T.Text))  -- forces autocommit branch+          , ("tx_metadata", PsDictionary H.empty)+          ]+    case (fromPs (PsStructure 0x10 (V.singleton runDict)) :: R.Result Request) of+      R.Success (RRunAutoCommitTransaction rac) ->+        (rac :: RunAutoCommitTransaction).mode `shouldBe` WriteAccess+      R.Success _ ->+        expectationFailure "Expected RRunAutoCommitTransaction, got a different Request constructor"+      R.Error e ->+        expectationFailure $ "Expected Success, got: " <> T.unpack e++ -- = Pool config tests  poolConfigTests :: TopSpec@@ -959,7 +1086,59 @@         nodesCreated qs `shouldBe` 0         containsUpdates qs `shouldBe` False +  -- = totalAffected +  it "totalAffected Nothing returns 0" $+    totalAffected Nothing `shouldBe` 0++  it "totalAffected of zeros is 0" $+    totalAffected (Just zeroStats) `shouldBe` 0++  it "totalAffected counts CREATE side effects (1 node + 1 prop + 1 label = 3)" $+    totalAffected (Just zeroStats { nodesCreated = 1, propertiesSet = 1, labelsAdded = 1 })+      `shouldBe` 3++  it "totalAffected counts a DETACH DELETE as 1" $+    totalAffected (Just zeroStats { nodesDeleted = 1 }) `shouldBe` 1++  it "totalAffected sums create + delete (no cancellation)" $+    totalAffected (Just zeroStats { nodesCreated = 5, nodesDeleted = 5 }) `shouldBe` 10++  it "totalAffected counts indexes and constraints" $+    totalAffected (Just zeroStats+      { constraintsAdded = 1, indexesAdded = 2, indexesRemoved = 1 })+      `shouldBe` 4++  it "totalAffected ignores containsUpdates and systemUpdates" $+    -- System updates are tracked separately and shouldn't bleed into the+    -- schema-update tally.+    totalAffected (Just zeroStats { containsUpdates = True, systemUpdates = 99 })+      `shouldBe` 0++  -- = formatStatsLine++  it "formatStatsLine renders every counter for an all-zero stat" $+    formatStatsLine zeroStats `shouldBe`+      "Stats: +nodes=0 -nodes=0 +rels=0 -rels=0 props=0 \+      \+labels=0 -labels=0 +idx=0 -idx=0 +constr=0 -constr=0"++  it "formatStatsLine renders a CREATE-style breakdown" $+    formatStatsLine zeroStats { nodesCreated = 1, propertiesSet = 1, labelsAdded = 1 }+      `shouldBe` "Stats: +nodes=1 -nodes=0 +rels=0 -rels=0 props=1 \+                 \+labels=1 -labels=0 +idx=0 -idx=0 +constr=0 -constr=0"++  it "formatStatsLine renders every field with a non-zero value" $+    let allOnes = QueryStats 1 1 1 1 1 1 1 1 1 1 1 False False 0+    in formatStatsLine allOnes `shouldBe`+         "Stats: +nodes=1 -nodes=1 +rels=1 -rels=1 props=1 \+         \+labels=1 -labels=1 +idx=1 -idx=1 +constr=1 -constr=1"+++-- | Helper used by the totalAffected/formatStatsLine cases above.+zeroStats :: QueryStats+zeroStats = QueryStats 0 0 0 0 0 0 0 0 0 0 0 False False 0++ -- = Plan/Profile parsing tests  planTests :: TopSpec@@ -1041,7 +1220,53 @@       Nothing -> expectationFailure "Expected Just PlanNode"       Just pn -> V.length (pnChildren pn) `shouldBe` 2 +  -- = renderPlan +  it "renderPlan emits operator + estimated rows for a leaf" $+    renderPlan 0 (leafPlan "AllNodesScan" 100.0 [])+      `shouldBe` "+ AllNodesScan  (~100.0 rows)\n"++  it "renderPlan emits a vars: line when identifiers are present" $+    renderPlan 0 (leafPlan "NodeByLabelScan" 5.0 ["u"])+      `shouldBe` "+ NodeByLabelScan  (~5.0 rows)\n    vars: u\n"++  it "renderPlan indents two spaces per depth level" $+    renderPlan 2 (leafPlan "Limit" 1.0 [])+      `shouldBe` "    + Limit  (~1.0 rows)\n"++  it "renderPlan walks a parent->child tree" $+    let child  = leafPlan "Scan" 10.0 ["n"]+        parent = (leafPlan "Projection" 10.0 ["n", "x"])+                   { pnChildren = V.singleton child }+    in renderPlan 0 parent `shouldBe`+         "+ Projection  (~10.0 rows)\n\+         \    vars: n, x\n\+         \  + Scan  (~10.0 rows)\n\+         \      vars: n\n"++  it "renderPlan keeps multiple children in source order" $+    let c1 = leafPlan "L" 1.0 []+        c2 = leafPlan "R" 2.0 []+        parent = (leafPlan "Join" 3.0 [])+                   { pnChildren = V.fromList [c1, c2] }+    in renderPlan 0 parent `shouldBe`+         "+ Join  (~3.0 rows)\n\+         \  + L  (~1.0 rows)\n\+         \  + R  (~2.0 rows)\n"+++-- | Helper: build a childless 'PlanNode' from operator + estimated rows+-- + identifiers. Used by the renderPlan tests.+leafPlan :: T.Text -> Double -> [T.Text] -> PlanNode+leafPlan op est idents = PlanNode+  { pnOperatorType  = op+  , pnArguments     = H.empty+  , pnIdentifiers   = V.fromList idents+  , pnEstimatedRows = est+  , pnChildren      = V.empty+  }++ profileTests :: TopSpec profileTests = describe "Profile parsing" $ do @@ -2218,6 +2443,143 @@         fromJSON (toJSON p) == Aeson.Success p       assertQC r +  describe "parsePs / psToAeson (public Aeson interop)" $ do++    it "parsePs handles every JSON scalar type" $ do+      let parse v = Aeson.parseEither parsePs v+      parse Aeson.Null            `shouldBe` Right PsNull+      parse (Aeson.Bool True)     `shouldBe` Right (PsBoolean True)+      parse (Aeson.String "hi")   `shouldBe` Right (PsString "hi")+      parse (Aeson.Number 42)     `shouldBe` Right (PsInteger (toPSInteger (42 :: Int)))+      parse (Aeson.Number 1.5)    `shouldBe` Right (PsFloat 1.5)++    it "parsePs handles arrays and nested objects" $ do+      let parse v = Aeson.parseEither parsePs v+      parse (Aeson.Array (V.fromList [Aeson.Number 1, Aeson.String "two"])) `shouldBe`+        Right (PsList (V.fromList [PsInteger (toPSInteger (1 :: Int)), PsString "two"]))++    it "parsePs decodes the {bytes: <base64>} shape into PsBytes" $ do+      let v = Aeson.Object (KM.fromList [("bytes", Aeson.String "aGVsbG8=")])  -- "hello"+      case Aeson.parseEither parsePs v of+        Right (PsBytes bs) -> bs `shouldBe` "hello"+        Right other        -> expectationFailure $ "expected PsBytes, got " <> show other+        Left err           -> expectationFailure err++    it "parsePs falls back to dictionary when {bytes: ...} value isn't valid base64" $ do+      let v = Aeson.Object (KM.fromList [("bytes", Aeson.String "not base 64!!!")])+      case Aeson.parseEither parsePs v of+        Right (PsDictionary _) -> pure ()+        other                  -> expectationFailure $ "expected PsDictionary fallback, got " <> show other++    it "psToAeson is the inverse of parsePs for plain values" $ do+      let original = PsList (V.fromList+            [ PsNull+            , PsBoolean True+            , PsString "x"+            , PsInteger (toPSInteger (7 :: Int))+            , PsFloat 1.5+            ])+      let json = psToAeson original+      Aeson.parseEither parsePs json `shouldBe` Right original++    it "parsePs handles negative integers" $ do+      Aeson.parseEither parsePs (Aeson.Number (-7))+        `shouldBe` Right (PsInteger (toPSInteger (-7 :: Int)))++    it "parsePs falls back to dictionary when {bytes: ...} has extra keys" $ do+      -- The bytes shape is a single-key match: {"bytes": "<base64>"}.+      -- Adding any other key turns the value back into a regular dictionary.+      let v = Aeson.Object (KM.fromList+                [ ("bytes", Aeson.String "aGVsbG8=")+                , ("extra", Aeson.String "noise")+                ])+      case Aeson.parseEither parsePs v of+        Right (PsDictionary d) -> H.size d `shouldBe` 2+        other -> expectationFailure $ "expected PsDictionary, got " <> show other++    it "parsePs falls back to PsFloat for integers above PSInteger range" $ do+      -- PSInteger covers [-2^63, 2^64-1]. 2^64 = 18446744073709551616.+      -- Larger than that exceeds the range and must round-trip through PsFloat+      -- rather than silently truncate.+      let huge = "18446744073709551617"  -- 2^64 + 1+      case Aeson.eitherDecodeStrict (TE.encodeUtf8 (T.pack huge)) of+        Left err -> expectationFailure $ "JSON parse failed: " <> err+        Right v  -> case Aeson.parseEither parsePs v of+          Right (PsFloat _) -> pure ()+          Right other       -> expectationFailure $+            "expected PsFloat fallback for huge integer, got " <> show other+          Left err          -> expectationFailure err++  describe "Show QueryMeta (smoke)" $ do++    it "Show QueryMeta produces a non-empty string" $+      -- The data constructor has 13 fields; this just pins that the+      -- standalone Show derive landed and doesn't fail at runtime.+      let m = QueryMeta+            { Resp.bookmark = Nothing+            , Resp.t_last = 0+            , Resp.type_ = "r"+            , Resp.stats = Nothing+            , Resp.parsedStats = Nothing+            , Resp.plan = Nothing+            , Resp.profile = Nothing+            , Resp.notifications = Nothing+            , Resp.parsedNotifications = V.empty+            , Resp.parsedPlan = Nothing+            , Resp.parsedProfile = Nothing+            , Resp.db = "neo4j"+            }+      in (length (show m) > 0) `shouldBe` True+++adminHelperTests :: TopSpec+adminHelperTests = describe "Database.Bolty.Admin outcome helpers" $ do++  it "describeReadOutcome prints ReadOK without inspecting fields" $+    -- Build a fully-zeroed ReadOK; the helper should not need to print it.+    let stub = ReadOK emptyResultSet emptyMeta+    in describeReadOutcome stub `shouldBe` "ReadOK"++  it "describeReadOutcome includes the stats line for ReadAbortedByWrite" $+    describeReadOutcome (ReadAbortedByWrite zeroStats) `shouldBe`+      "ReadAbortedByWrite (Stats: +nodes=0 -nodes=0 +rels=0 -rels=0 props=0 \+      \+labels=0 -labels=0 +idx=0 -idx=0 +constr=0 -constr=0)"++  it "describeWriteOutcome prints WriteCommitted without inspecting fields" $+    describeWriteOutcome (WriteCommitted emptyResultSet emptyMeta) `shouldBe` "WriteCommitted"++  it "describeWriteOutcome shows expected/actual when stats are absent" $+    describeWriteOutcome (WriteAbortedMismatch 5 3 Nothing) `shouldBe`+      "WriteAbortedMismatch expected=5 actual=3"++  it "describeWriteOutcome appends the stats line when present" $+    describeWriteOutcome (WriteAbortedMismatch 5 3 (Just zeroStats)) `shouldBe`+      "WriteAbortedMismatch expected=5 actual=3 (Stats: +nodes=0 -nodes=0 +rels=0 -rels=0 props=0 \+      \+labels=0 -labels=0 +idx=0 -idx=0 +constr=0 -constr=0)"+++-- Helpers for the Tx-helper tests above.++emptyResultSet :: RS.ResultSet+emptyResultSet = RS.ResultSet V.empty V.empty++emptyMeta :: QueryMeta+emptyMeta = QueryMeta+  { Resp.bookmark = Nothing+  , Resp.t_last = 0+  , Resp.type_ = "r"+  , Resp.stats = Nothing+  , Resp.parsedStats = Nothing+  , Resp.plan = Nothing+  , Resp.profile = Nothing+  , Resp.notifications = Nothing+  , Resp.parsedNotifications = V.empty+  , Resp.parsedPlan = Nothing+  , Resp.parsedProfile = Nothing+  , Resp.db = "neo4j"+  }++ -- | Assert a QuickCheck result, failing the sandwich test on property failure. assertQC r   | isSuccess r = pure ()@@ -2236,6 +2598,7 @@   messageTests   logonLogoffTests   structureRoundTripTests+  accessModeTests   poolConfigTests   retryTests   routeTests@@ -2265,3 +2628,4 @@   batchedPullTests   maxConnectionLifetimeTests   aesonTests+  adminHelperTests