module Main where

import           Test.Sandwich

import           Control.Monad.IO.Class            (liftIO)
import           Data.Bits                         (shiftL, (.|.))
import           Data.Default                      (def)
import           Data.Int                          (Int64)
import           Data.Word                         (Word32)
import qualified Data.HashMap.Lazy                 as H
import qualified Data.Text                         as T
import qualified Data.Vector                       as V
import qualified Validation                        as Val

import           Data.PackStream.Ps                (Ps(..), PackStream(..))
import           Data.PackStream                   (pack, unpack)
import           Data.PackStream.Integer           (toPSInteger)
import qualified Data.PackStream.Result            as R
import           Database.Bolty hiding             (Error)
import           Database.Bolty.Decode            (DecodeError(..), decodeRow, decodeRows)
import           Database.Bolty.Record            (lookupField)
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.Value.Type        (Node(..), Relationship(..), UnboundRelationship(..)
                                                  , Path(..), Date(..), Time(..), LocalTime(..)
                                                  , DateTime(..), DateTimeZoneId(..), LocalDateTime(..)
                                                  , Duration(..), Point2D(..), Point3D(..))
import           Database.Bolty.Message.Request    (Request(..), Hello(..), Route(..), RouteExtra(..)
                                                  , Logon(..), TelemetryApi(..))
import           Database.Bolty.Message.Response   (Response(..), RoutingTable(..), parseRoutingTable, extractBookmark)
import           Database.Bolty.Routing            (parseAddress)
import           Database.Bolty.Session            (newBookmarkManager, getBookmarks, updateBookmark)
import           Database.Bolty.Decode            (psToBolt, boltToPs)
import           Database.Bolty.Value.Helpers      (sigLocalDateTime, supportsLogonLogoff, supportsTelemetry)


-- = Helpers

setUserAgent :: UserAgent -> Config -> Config
setUserAgent ua Config{..} = Config { user_agent = ua, .. }

-- = Config validation tests

configTests :: TopSpec
configTests = describe "Config validation" $ do
  it "validates default config" $ do
    case validateConfig (def :: Config) of
      Val.Failure errs -> expectationFailure $ "Default config should validate: " <> show errs
      Val.Success _    -> pure ()

  it "rejects empty host" $ do
    let cfg = (def :: Config) { host = "" }
    case validateConfig cfg of
      Val.Failure _ -> pure ()
      Val.Success _ -> expectationFailure "Empty host should be rejected"

  it "rejects empty user agent name" $ do
    let cfg = setUserAgent (UserAgent "" "1.0") (def :: Config)
    case validateConfig cfg of
      Val.Failure _ -> pure ()
      Val.Success _ -> expectationFailure "Empty user agent name should be rejected"

  it "rejects empty user agent version" $ do
    let cfg = setUserAgent (UserAgent "bolty" "") (def :: Config)
    case validateConfig cfg of
      Val.Failure _ -> pure ()
      Val.Success _ -> expectationFailure "Empty user agent version should be rejected"

  it "rejects empty version list" $ do
    let cfg = (def :: Config) { versions = [] }
    case validateConfig cfg of
      Val.Failure _ -> pure ()
      Val.Success _ -> expectationFailure "Empty version list should be rejected"


-- = Version validation tests

versionTests :: TopSpec
versionTests = describe "Version validation" $ do
  it "rejects major version < 4" $ do
    let cfg = (def :: Config) { versions = [Version 0 3] }
    case validateConfig cfg of
      Val.Failure _ -> pure ()
      Val.Success _ -> expectationFailure "Major version < 4 should be rejected"

  it "rejects version 4.1 (below 4.4 floor)" $ do
    let cfg = (def :: Config) { versions = [Version 1 4] }
    case validateConfig cfg of
      Val.Failure _ -> pure ()
      Val.Success _ -> expectationFailure "Version 4.1 should be rejected (below 4.4 floor)"

  it "accepts version 5.0" $ do
    let cfg = (def :: Config) { versions = [Version 0 5] }
    case validateConfig cfg of
      Val.Failure errs -> expectationFailure $ "Version 5.0 should validate: " <> show errs
      Val.Success _    -> pure ()


-- = Bolt value extractor tests

extractorTests :: TopSpec
extractorTests = describe "Bolt value extractors" $ do
  it "asText extracts text" $ do
    asText (BoltString "hello") `shouldBe` Just "hello"

  it "asText returns Nothing for non-text" $ do
    asText (BoltInteger 42) `shouldBe` Nothing

  it "asInt extracts integer" $ do
    asInt (BoltInteger 42) `shouldBe` Just 42

  it "asInt returns Nothing for non-integer" $ do
    asInt (BoltString "hello") `shouldBe` Nothing

  it "asBool extracts boolean" $ do
    asBool (BoltBoolean True) `shouldBe` Just True
    asBool (BoltBoolean False) `shouldBe` Just False

  it "asBool returns Nothing for non-boolean" $ do
    asBool BoltNull `shouldBe` Nothing

  it "asFloat extracts float" $ do
    asFloat (BoltFloat 3.14) `shouldBe` Just 3.14

  it "asNull extracts null" $ do
    asNull BoltNull `shouldBe` Just ()

  it "asNull returns Nothing for non-null" $ do
    asNull (BoltInteger 0) `shouldBe` Nothing

  it "asList extracts list" $ do
    let v = V.fromList [BoltInteger 1, BoltInteger 2]
    asList (BoltList v) `shouldBe` Just v

  it "asDict extracts dictionary" $ do
    let m = H.fromList [("key", BoltString "value")]
    asDict (BoltDictionary m) `shouldBe` Just m


-- = Record accessor tests

recordTests :: TopSpec
recordTests = describe "Record accessors" $ do
  let columns = V.fromList ["name", "age", "city"]
  let record  = V.fromList [BoltString "Alice", BoltInteger 30, BoltString "Paris"]

  it "lookupField finds existing field" $ do
    lookupField columns "name" record `shouldBe` Just (BoltString "Alice")
    lookupField columns "age" record `shouldBe` Just (BoltInteger 30)
    lookupField columns "city" record `shouldBe` Just (BoltString "Paris")

  it "lookupField returns Nothing for missing field" $ do
    lookupField columns "email" record `shouldBe` Nothing

  it "lookupField returns Nothing for empty record" $ do
    lookupField columns "name" V.empty `shouldBe` Nothing


-- = PackStream round-trip tests

packstreamRoundTripTests :: TopSpec
packstreamRoundTripTests = describe "PackStream round-trips" $ do
  it "round-trips PsNull" $ do
    unpack (pack PsNull) `shouldBe` Right PsNull

  it "round-trips PsBoolean True" $ do
    unpack (pack (PsBoolean True)) `shouldBe` Right (PsBoolean True)

  it "round-trips PsBoolean False" $ do
    unpack (pack (PsBoolean False)) `shouldBe` Right (PsBoolean False)

  it "round-trips PsInteger small" $ do
    unpack (pack (PsInteger 42)) `shouldBe` Right (PsInteger 42)

  it "round-trips PsInteger negative" $ do
    unpack (pack (PsInteger (-100))) `shouldBe` Right (PsInteger (-100))

  it "round-trips PsInteger zero" $ do
    unpack (pack (PsInteger 0)) `shouldBe` Right (PsInteger 0)

  it "round-trips PsFloat" $ do
    unpack (pack (PsFloat 3.14)) `shouldBe` Right (PsFloat 3.14)

  it "round-trips PsString" $ do
    unpack (pack (PsString "hello world")) `shouldBe` Right (PsString "hello world")

  it "round-trips PsString empty" $ do
    unpack (pack (PsString "")) `shouldBe` Right (PsString "")

  it "round-trips PsString unicode" $ do
    unpack (pack (PsString "\x1F600 emoji")) `shouldBe` Right (PsString "\x1F600 emoji")

  it "round-trips PsList empty" $ do
    unpack (pack (PsList V.empty)) `shouldBe` Right (PsList V.empty)

  it "round-trips PsList with values" $ do
    let v = PsList $ V.fromList [PsInteger 1, PsString "two", PsBoolean True]
    unpack (pack v) `shouldBe` Right v

  it "round-trips PsDictionary empty" $ do
    unpack (pack (PsDictionary H.empty)) `shouldBe` Right (PsDictionary H.empty)

  it "round-trips PsDictionary with entries" $ do
    let d = PsDictionary $ H.fromList [("key", PsString "value"), ("num", PsInteger 42)]
    unpack (pack d) `shouldBe` Right d

  it "round-trips nested structures" $ do
    let nested = PsList $ V.fromList
          [ PsDictionary $ H.fromList [("a", PsInteger 1)]
          , PsList $ V.fromList [PsNull, PsBoolean False]
          ]
    unpack (pack nested) `shouldBe` Right nested

  -- Integer range tests
  it "round-trips PsInteger tiny positive (127)" $ do
    unpack (pack (PsInteger 127)) `shouldBe` Right (PsInteger 127)

  it "round-trips PsInteger tiny negative (-16)" $ do
    unpack (pack (PsInteger (-16))) `shouldBe` Right (PsInteger (-16))

  it "round-trips PsInteger INT_8 range (128)" $ do
    unpack (pack (PsInteger 128)) `shouldBe` Right (PsInteger 128)

  it "round-trips PsInteger INT_8 range (-128)" $ do
    unpack (pack (PsInteger (-128))) `shouldBe` Right (PsInteger (-128))

  it "round-trips PsInteger INT_16 range (1000)" $ do
    unpack (pack (PsInteger 1000)) `shouldBe` Right (PsInteger 1000)

  it "round-trips PsInteger INT_32 range (100000)" $ do
    unpack (pack (PsInteger 100000)) `shouldBe` Right (PsInteger 100000)

  it "round-trips PsInteger INT_64 range (maxBound)" $ do
    let big = PsInteger 9223372036854775807
    unpack (pack big) `shouldBe` Right big

  it "round-trips PsInteger INT_64 range (minBound)" $ do
    let small = PsInteger (-9223372036854775808)
    unpack (pack small) `shouldBe` Right small

  -- Bytes tests
  it "round-trips PsBytes empty" $ do
    unpack (pack (PsBytes "")) `shouldBe` Right (PsBytes "")

  it "round-trips PsBytes with data" $ do
    let bs = PsBytes "\x00\x01\x02\xFF"
    unpack (pack bs) `shouldBe` Right bs

  -- Structure tests
  it "round-trips PsStructure empty fields" $ do
    let s = PsStructure 0x01 V.empty
    unpack (pack s) `shouldBe` Right s

  it "round-trips PsStructure with one field (like HELLO)" $ do
    let s = PsStructure 0x01 $ V.singleton $ PsDictionary $ H.fromList
              [("user_agent", PsString "bolty/2.0"), ("scheme", PsString "none")]
    unpack (pack s) `shouldBe` Right s

  it "round-trips PsStructure with multiple fields" $ do
    let s = PsStructure 0x4E $ V.fromList  -- Node structure tag
              [ PsInteger 1                    -- id
              , PsList (V.fromList [PsString "Person"])  -- labels
              , PsDictionary (H.fromList [("name", PsString "Alice")])  -- properties
              , PsString "4:abc:1"             -- element_id
              ]
    unpack (pack s) `shouldBe` Right s

  -- Larger collection tests
  it "round-trips PsList with 16 elements (LIST_8)" $ do
    let v = PsList $ V.fromList [PsInteger (fromIntegral i) | i <- [0..15 :: Int]]
    unpack (pack v) `shouldBe` Right v

  it "round-trips Text via PackStream class" $ do
    let txt = "hello" :: T.Text
    let result = either R.Error R.Success $ unpack (pack txt)
    (fromPs =<< result) `shouldBe` R.Success txt

  it "round-trips Bool via PackStream class" $ do
    let result = either R.Error R.Success $ unpack (pack True)
    (fromPs =<< result) `shouldBe` R.Success True


-- = Message serialization tests

messageTests :: TopSpec
messageTests = describe "Message serialization" $ do
  it "HELLO with None scheme produces correct structure" $ do
    let hello = Hello (UserAgent "bolty" "2.0") None NoRouting False
    let ps = toPs (RHello hello)
    case ps of
      PsStructure 0x01 fields -> do
        V.length fields `shouldBe` 1
        case V.head fields of
          PsDictionary m -> do
            case H.lookup "user_agent" m of
              Just (PsString ua) -> ua `shouldBe` "bolty/2.0"
              _                  -> expectationFailure "expected user_agent string"
            case H.lookup "scheme" m of
              Just (PsString s) -> s `shouldBe` "none"
              _                 -> expectationFailure "expected scheme string"
            H.member "routing" m `shouldBe` False
          _ -> expectationFailure "expected dictionary as HELLO field"
      _ -> expectationFailure "expected structure with tag 0x01"

  it "HELLO with Basic scheme includes principal and credentials" $ do
    let hello = Hello (UserAgent "bolty" "2.0") (Basic "neo4j" "password") NoRouting False
    let ps = toPs (RHello hello)
    case ps of
      PsStructure 0x01 fields -> case V.head fields of
        PsDictionary m -> do
          H.lookup "scheme" m `shouldBe` Just (PsString "basic")
          H.lookup "principal" m `shouldBe` Just (PsString "neo4j")
          H.lookup "credentials" m `shouldBe` Just (PsString "password")
        _ -> expectationFailure "expected dictionary"
      _ -> expectationFailure "expected structure"

  it "HELLO with Routing includes routing dict" $ do
    let hello = Hello (UserAgent "bolty" "2.0") None Routing False
    let ps = toPs (RHello hello)
    case ps of
      PsStructure 0x01 fields -> case V.head fields of
        PsDictionary m -> case H.lookup "routing" m of
          Just (PsDictionary r) -> H.null r `shouldBe` True
          _                     -> expectationFailure "expected routing dictionary"
        _ -> expectationFailure "expected dictionary"
      _ -> expectationFailure "expected structure"

  it "GOODBYE produces empty structure with tag 0x02" $ do
    let ps = toPs RGoodbye
    case ps of
      PsStructure 0x02 fields -> V.null fields `shouldBe` True
      _ -> expectationFailure "expected structure with tag 0x02"

  it "RESET produces empty structure with tag 0x0F" $ do
    let ps = toPs RReset
    case ps of
      PsStructure 0x0F fields -> V.null fields `shouldBe` True
      _ -> expectationFailure "expected structure with tag 0x0F"

  it "HELLO round-trips through PackStream" $ do
    let hello = Hello (UserAgent "bolty" "2.0") (Basic "neo4j" "pass") NoRouting False
    let request = RHello hello
    let ps = toPs request
    let encoded = pack ps
    case unpack encoded of
      Left e   -> expectationFailure $ "decode failed: " <> T.unpack e
      Right ps' -> do
        -- Verify the decoded Ps matches
        ps' `shouldBe` ps

  it "SUCCESS response round-trips through PackStream" $ do
    let meta = H.fromList [("server", PsString "Neo4j/5.0.0"), ("connection_id", PsString "bolt-1")]
    let response = RSuccess meta
    let ps = toPs response
    let encoded = pack ps
    case unpack encoded of
      Left e    -> expectationFailure $ "decode failed: " <> T.unpack e
      Right ps' -> ps' `shouldBe` ps


-- = Structure round-trip tests

structureRoundTripTests :: TopSpec
structureRoundTripTests = describe "Structure round-trips" $ do

  it "round-trips Node" $ do
    let node = Node 42 (V.fromList ["Person", "Employee"])
                 (H.fromList [("name", PsString "Alice"), ("age", PsInteger 30)])
                 "4:abc:42"
    (fromPs (toPs node) :: R.Result Node) `shouldBe` R.Success node

  it "round-trips Relationship" $ do
    let rel = Relationship 1 10 20 "KNOWS"
                (H.fromList [("since", PsInteger 2020)])
                "4:abc:1" "4:abc:10" "4:abc:20"
    (fromPs (toPs rel) :: R.Result Relationship) `shouldBe` R.Success rel

  it "round-trips UnboundRelationship" $ do
    let urel = UnboundRelationship 5 "LIKES" H.empty "4:abc:5"
    (fromPs (toPs urel) :: R.Result UnboundRelationship) `shouldBe` R.Success urel

  it "round-trips Path" $ do
    let n1 = Node 1 (V.singleton "A") H.empty "4:abc:1"
    let n2 = Node 2 (V.singleton "B") H.empty "4:abc:2"
    let r1 = UnboundRelationship 10 "TO" H.empty "4:abc:10"
    let path = Path (V.fromList [n1, n2]) (V.singleton r1) (V.fromList [1, 1])
    (fromPs (toPs path) :: R.Result Path) `shouldBe` R.Success path

  it "round-trips Date" $ do
    let d = Date 19738
    (fromPs (toPs d) :: R.Result Date) `shouldBe` R.Success d

  it "round-trips Time" $ do
    let t = Time 43200000000000 3600
    (fromPs (toPs t) :: R.Result Time) `shouldBe` R.Success t

  it "round-trips LocalTime" $ do
    let lt = LocalTime 43200000000000
    (fromPs (toPs lt) :: R.Result LocalTime) `shouldBe` R.Success lt

  it "round-trips DateTime" $ do
    let dt = DateTime 1705312800 0 3600
    (fromPs (toPs dt) :: R.Result DateTime) `shouldBe` R.Success dt

  it "round-trips DateTimeZoneId" $ do
    let dtz = DateTimeZoneId 1705312800 0 "Europe/Paris"
    (fromPs (toPs dtz) :: R.Result DateTimeZoneId) `shouldBe` R.Success dtz

  it "round-trips LocalDateTime" $ do
    let ldt = LocalDateTime 1705312800 500000000
    (fromPs (toPs ldt) :: R.Result LocalDateTime) `shouldBe` R.Success ldt

  it "round-trips Duration" $ do
    let dur = Duration 14 10 3600 0
    (fromPs (toPs dur) :: R.Result Duration) `shouldBe` R.Success dur

  it "round-trips Point2D" $ do
    let p = Point2D 7203 1.5 2.5
    (fromPs (toPs p) :: R.Result Point2D) `shouldBe` R.Success p

  it "round-trips Point3D" $ do
    let p = Point3D 9157 1.0 2.0 3.0
    (fromPs (toPs p) :: R.Result Point3D) `shouldBe` R.Success p

  it "Node structure dispatches correctly through Bolt" $ do
    let node = Node 42 (V.fromList ["Person"])
                 (H.fromList [("name", PsString "Alice")])
                 "4:abc:42"
    let ps = toPs node
    case (fromPs ps :: R.Result Bolt) of
      R.Success (BoltNode n) -> n `shouldBe` node
      other -> expectationFailure $ "Expected BoltNode, got: " <> show other

  it "Date structure dispatches correctly through Bolt" $ do
    let d = Date 19738
    let ps = toPs d
    case (fromPs ps :: R.Result Bolt) of
      R.Success (BoltDate d') -> d' `shouldBe` d
      other -> expectationFailure $ "Expected BoltDate, got: " <> show other

  it "Point2D structure dispatches correctly through Bolt" $ do
    let p = Point2D 7203 1.5 2.5
    let ps = toPs p
    case (fromPs ps :: R.Result Bolt) of
      R.Success (BoltPoint2D p') -> p' `shouldBe` p
      other -> expectationFailure $ "Expected BoltPoint2D, got: " <> show other


-- = Pool config tests

poolConfigTests :: TopSpec
poolConfigTests = describe "Pool config" $ do
  it "defaultPoolConfig has maxPingRetries == 1" $ do
    maxPingRetries defaultPoolConfig `shouldBe` 1

  it "defaultPoolConfig has maxConnections == 10" $ do
    maxConnections defaultPoolConfig `shouldBe` 10

  it "defaultPoolConfig has idleTimeout == 60" $ do
    idleTimeout defaultPoolConfig `shouldBe` 60


-- = Retry config and isTransient tests

retryTests :: TopSpec
retryTests = describe "Retry logic" $ do
  it "isTransient returns True for transient error" $ do
    isTransient (ResponseErrorFailure "Neo.TransientError.Transaction.DeadlockDetected" "deadlock") `shouldBe` True

  it "isTransient returns True for other transient error codes" $ do
    isTransient (ResponseErrorFailure "Neo.TransientError.General.MemoryPoolOutOfMemoryError" "oom") `shouldBe` True

  it "isTransient returns False for client error" $ do
    isTransient (ResponseErrorFailure "Neo.ClientError.Statement.SyntaxError" "bad syntax") `shouldBe` False

  it "isTransient returns False for database error" $ do
    isTransient (ResponseErrorFailure "Neo.DatabaseError.General.UnknownError" "unknown") `shouldBe` False

  it "isTransient returns False for ResetFailed" $ do
    isTransient ResetFailed `shouldBe` False

  it "isTransient returns False for AuthentificationFailed" $ do
    isTransient AuthentificationFailed `shouldBe` False

  it "defaultRetryConfig has expected values" $ do
    maxRetries defaultRetryConfig `shouldBe` 5
    initialDelay defaultRetryConfig `shouldBe` 200_000
    maxDelay defaultRetryConfig `shouldBe` 5_000_000


-- = Route serialization tests

routeTests :: TopSpec
routeTests = describe "Route serialization" $ do

  it "Route serializes to 3-field structure with tag 0x66" $ do
    let route = Route H.empty V.empty (RouteExtra Nothing Nothing)
    let ps = toPs (RRoute route)
    case ps of
      PsStructure 0x66 fields -> V.length fields `shouldBe` 3
      _ -> expectationFailure $ "expected structure with tag 0x66, got: " <> show ps

  it "Route with address and bookmarks round-trips through PackStream" $ do
    let route = Route (H.singleton "address" (PsString "localhost:7687"))
                      (V.fromList ["bk1", "bk2"])
                      (RouteExtra (Just "neo4j") Nothing)
    let ps = toPs (RRoute route)
    let encoded = pack ps
    case unpack encoded of
      Left e   -> expectationFailure $ "decode failed: " <> T.unpack e
      Right ps' -> ps' `shouldBe` ps

  it "Route round-trips through Request fromPs/toPs" $ do
    let route = Route H.empty V.empty (RouteExtra Nothing Nothing)
    let request = RRoute route
    let ps = toPs request
    case (fromPs ps :: R.Result Request) of
      R.Success (RRoute Route{routing, bookmarks, extra = _}) -> do
        H.null routing `shouldBe` True
        V.null bookmarks `shouldBe` True
      R.Success _other -> expectationFailure $ "expected RRoute, got other Request"
      R.Error e -> expectationFailure $ "fromPs failed: " <> T.unpack e


-- = Routing table parsing tests

routingTableTests :: TopSpec
routingTableTests = describe "parseRoutingTable" $ do

  it "parses valid response with multiple roles" $ do
    let meta = H.singleton "rt" $ PsDictionary $ H.fromList
          [ ("ttl", PsInteger (toPSInteger (300 :: Int64)))
          , ("db", PsString "neo4j")
          , ("servers", PsList $ V.fromList
              [ PsDictionary $ H.fromList
                  [ ("role", PsString "ROUTE")
                  , ("addresses", PsList $ V.fromList [PsString "r1:7687", PsString "r2:7687"])
                  ]
              , PsDictionary $ H.fromList
                  [ ("role", PsString "READ")
                  , ("addresses", PsList $ V.fromList [PsString "rd1:7687"])
                  ]
              , PsDictionary $ H.fromList
                  [ ("role", PsString "WRITE")
                  , ("addresses", PsList $ V.fromList [PsString "wr1:7687"])
                  ]
              ])
          ]
    case parseRoutingTable meta of
      Right RoutingTable{ttl, db, routers, readers, writers} -> do
        ttl `shouldBe` 300
        db `shouldBe` "neo4j"
        V.length routers `shouldBe` 2
        V.length readers `shouldBe` 1
        V.length writers `shouldBe` 1
        V.head routers `shouldBe` "r1:7687"
        V.head readers `shouldBe` "rd1:7687"
        V.head writers `shouldBe` "wr1:7687"
      Left e -> expectationFailure $ "parse failed: " <> T.unpack e

  it "fails on missing rt key" $ do
    let meta = H.singleton "other" (PsString "value")
    case parseRoutingTable meta of
      Left _  -> pure ()
      Right _ -> expectationFailure "expected failure for missing rt key"

  it "fails on missing servers key" $ do
    let meta = H.singleton "rt" $ PsDictionary $ H.fromList
          [ ("ttl", PsInteger (toPSInteger (300 :: Int64)))
          , ("db", PsString "neo4j")
          ]
    case parseRoutingTable meta of
      Left _  -> pure ()
      Right _ -> expectationFailure "expected failure for missing servers key"

  it "handles CE single-server-all-roles response" $ do
    let addr = PsString "localhost:7687"
    let meta = H.singleton "rt" $ PsDictionary $ H.fromList
          [ ("ttl", PsInteger (toPSInteger (300 :: Int64)))
          , ("db", PsString "neo4j")
          , ("servers", PsList $ V.fromList
              [ PsDictionary $ H.fromList
                  [ ("role", PsString "ROUTE"), ("addresses", PsList $ V.singleton addr) ]
              , PsDictionary $ H.fromList
                  [ ("role", PsString "READ"), ("addresses", PsList $ V.singleton addr) ]
              , PsDictionary $ H.fromList
                  [ ("role", PsString "WRITE"), ("addresses", PsList $ V.singleton addr) ]
              ])
          ]
    case parseRoutingTable meta of
      Right RoutingTable{routers, readers, writers} -> do
        V.length routers `shouldBe` 1
        V.length readers `shouldBe` 1
        V.length writers `shouldBe` 1
        V.head routers `shouldBe` "localhost:7687"
        V.head readers `shouldBe` "localhost:7687"
        V.head writers `shouldBe` "localhost:7687"
      Left e -> expectationFailure $ "parse failed: " <> T.unpack e

  it "isTransient returns True for RoutingTableError" $ do
    isTransient (RoutingTableError "test") `shouldBe` True


-- = parseAddress tests

parseAddressTests :: TopSpec
parseAddressTests = describe "parseAddress" $ do

  it "parses host:port" $ do
    parseAddress "localhost:7687" `shouldBe` ("localhost", 7687)

  it "parses host with non-default port" $ do
    parseAddress "db.example.com:9999" `shouldBe` ("db.example.com", 9999)

  it "falls back to 7687 for missing port" $ do
    parseAddress "localhost" `shouldBe` ("localhost", 7687)

  it "falls back to 7687 for non-numeric port" $ do
    parseAddress "localhost:abc" `shouldBe` ("localhost", 7687)

  it "parses port 0" $ do
    parseAddress "host:0" `shouldBe` ("host", 0)


-- = RoutingPoolConfig tests

routingPoolConfigTests :: TopSpec
routingPoolConfigTests = describe "RoutingPool config" $ do

  it "defaultRoutingPoolConfig has refreshBuffer == 10" $ do
    refreshBuffer defaultRoutingPoolConfig `shouldBe` 10

  it "defaultRoutingPoolConfig has routingDb == Nothing" $ do
    routingDb defaultRoutingPoolConfig `shouldBe` Nothing

  it "defaultRoutingPoolConfig uses defaultPoolConfig" $ do
    maxConnections (poolConfig defaultRoutingPoolConfig) `shouldBe` 10


-- = Routing error detection tests

routingErrorTests :: TopSpec
routingErrorTests = describe "Routing error detection" $ do

  it "isRoutingError returns True for NotALeader" $ do
    isRoutingError (ResponseErrorFailure "Neo.ClientError.Cluster.NotALeader" "not a leader") `shouldBe` True

  it "isRoutingError returns True for ForbiddenOnReadOnlyDatabase" $ do
    isRoutingError (ResponseErrorFailure "Neo.ClientError.General.ForbiddenOnReadOnlyDatabase" "read only") `shouldBe` True

  it "isRoutingError returns False for transient error" $ do
    isRoutingError (ResponseErrorFailure "Neo.TransientError.Transaction.DeadlockDetected" "deadlock") `shouldBe` False

  it "isRoutingError returns False for syntax error" $ do
    isRoutingError (ResponseErrorFailure "Neo.ClientError.Statement.SyntaxError" "bad syntax") `shouldBe` False

  it "isRoutingError returns False for non-response errors" $ do
    isRoutingError ResetFailed `shouldBe` False
    isRoutingError (RoutingTableError "test") `shouldBe` False


-- = Bookmark management tests

bookmarkTests :: TopSpec
bookmarkTests = describe "Bookmark management" $ do

  it "new BookmarkManager starts empty" $ do
    bm <- liftIO $ newBookmarkManager []
    bms <- liftIO $ getBookmarks bm
    bms `shouldBe` []

  it "new BookmarkManager with initial bookmarks" $ do
    bm <- liftIO $ newBookmarkManager ["bm1", "bm2"]
    bms <- liftIO $ getBookmarks bm
    bms `shouldBe` ["bm1", "bm2"]

  it "updateBookmark replaces bookmarks with single new one" $ do
    bm <- liftIO $ newBookmarkManager ["old1", "old2"]
    liftIO $ updateBookmark bm "new1"
    bms <- liftIO $ getBookmarks bm
    bms `shouldBe` ["new1"]

  it "updateBookmark on empty manager adds bookmark" $ do
    bm <- liftIO $ newBookmarkManager []
    liftIO $ updateBookmark bm "bm1"
    bms <- liftIO $ getBookmarks bm
    bms `shouldBe` ["bm1"]

  it "successive updateBookmark calls keep only the latest" $ do
    bm <- liftIO $ newBookmarkManager []
    liftIO $ updateBookmark bm "bm1"
    liftIO $ updateBookmark bm "bm2"
    bms <- liftIO $ getBookmarks bm
    bms `shouldBe` ["bm2"]

  it "extractBookmark extracts bookmark from metadata" $ do
    let meta = H.fromList [("bookmark", PsString "FB:kcwQ123")]
    extractBookmark meta `shouldBe` Just "FB:kcwQ123"

  it "extractBookmark returns Nothing when no bookmark" $ do
    let meta = H.fromList [("server", PsString "Neo4j/5.0")]
    extractBookmark meta `shouldBe` Nothing

  it "extractBookmark returns Nothing for non-string bookmark" $ do
    let meta = H.fromList [("bookmark", PsInteger 42)]
    extractBookmark meta `shouldBe` Nothing


-- = Session config tests

sessionConfigTests :: TopSpec
sessionConfigTests = describe "Session config" $ do

  it "defaultSessionConfig has default database" $ do
    database defaultSessionConfig `shouldBe` Nothing

  it "defaultSessionConfig has WriteAccess mode" $ do
    accessMode defaultSessionConfig `shouldBe` WriteAccess

  it "defaultSessionConfig has no initial bookmarks" $ do
    sessionBookmarks defaultSessionConfig `shouldBe` []


-- = Validation strategy tests

validationStrategyTests :: TopSpec
validationStrategyTests = describe "Validation strategy" $ do

  it "defaultPoolConfig uses PingIfIdle 30" $ do
    validationStrategy defaultPoolConfig `shouldBe` PingIfIdle 30

  it "AlwaysPing /= NeverPing" $ do
    (AlwaysPing == NeverPing) `shouldBe` False

  it "PingIfIdle 30 == PingIfIdle 30" $ do
    (PingIfIdle 30 == PingIfIdle 30) `shouldBe` True

  it "PingIfIdle 10 /= PingIfIdle 60" $ do
    (PingIfIdle 10 == PingIfIdle 60) `shouldBe` False

  it "show AlwaysPing" $ do
    show AlwaysPing `shouldBe` "AlwaysPing"

  it "show NeverPing" $ do
    show NeverPing `shouldBe` "NeverPing"

  it "show PingIfIdle 30" $ do
    show (PingIfIdle 30) `shouldBe` "PingIfIdle 30"


-- = Version 5.x validation tests

version5xTests :: TopSpec
version5xTests = describe "Version 5.x validation" $ do

  it "accepts version 5.1" $ do
    let cfg = (def :: Config) { versions = [Version 1 5] }
    case validateConfig cfg of
      Val.Failure errs -> expectationFailure $ "Version 5.1 should validate: " <> show errs
      Val.Success _    -> pure ()

  it "accepts version 5.2" $ do
    let cfg = (def :: Config) { versions = [Version 2 5] }
    case validateConfig cfg of
      Val.Failure errs -> expectationFailure $ "Version 5.2 should validate: " <> show errs
      Val.Success _    -> pure ()

  it "accepts version 5.3" $ do
    let cfg = (def :: Config) { versions = [Version 3 5] }
    case validateConfig cfg of
      Val.Failure errs -> expectationFailure $ "Version 5.3 should validate: " <> show errs
      Val.Success _    -> pure ()

  it "accepts version 5.4" $ do
    let cfg = (def :: Config) { versions = [Version 4 5] }
    case validateConfig cfg of
      Val.Failure errs -> expectationFailure $ "Version 5.4 should validate: " <> show errs
      Val.Success _    -> pure ()

  it "rejects version 5.5" $ do
    let cfg = (def :: Config) { versions = [Version 5 5] }
    case validateConfig cfg of
      Val.Failure _ -> pure ()
      Val.Success _ -> expectationFailure "Version 5.5 should be rejected"

  it "default config offers 5.4 and 4.4" $ do
    let cfg = def :: Config
    case validateConfig cfg of
      Val.Failure errs -> expectationFailure $ "Default config should validate: " <> show errs
      Val.Success _    -> do
        let vs = versions cfg
        -- Should contain 5.4 as highest and 4.4 as fallback
        any (\(Version m mj) -> mj == 5 && m == 4) vs `shouldBe` True
        any (\(Version m mj) -> mj == 4 && m == 4) vs `shouldBe` True


-- = LOGON/LOGOFF/TELEMETRY message tests

logonLogoffTests :: TopSpec
logonLogoffTests = describe "LOGON/LOGOFF/TELEMETRY message serialization" $ do

  it "LOGON serializes to structure with tag 0x6A and auth dictionary" $ do
    let logonReq = RLogon (Logon (Basic "neo4j" "password"))
    let ps = toPs logonReq
    case ps of
      PsStructure 0x6A fields -> do
        V.length fields `shouldBe` 1
        case V.head fields of
          PsDictionary m -> do
            H.lookup "scheme" m `shouldBe` Just (PsString "basic")
            H.lookup "principal" m `shouldBe` Just (PsString "neo4j")
            H.lookup "credentials" m `shouldBe` Just (PsString "password")
          _ -> expectationFailure "expected dictionary as LOGON field"
      _ -> expectationFailure $ "expected structure with tag 0x6A, got: " <> show ps

  it "LOGON round-trips through PackStream" $ do
    let logonReq = RLogon (Logon (Basic "neo4j" "pass"))
    let ps = toPs logonReq
    let encoded = pack ps
    case unpack encoded of
      Left e   -> expectationFailure $ "decode failed: " <> T.unpack e
      Right ps' -> ps' `shouldBe` ps

  it "LOGOFF serializes to empty structure with tag 0x6B" $ do
    let ps = toPs RLogoff
    case ps of
      PsStructure 0x6B fields -> V.null fields `shouldBe` True
      _ -> expectationFailure $ "expected structure with tag 0x6B, got: " <> show ps

  it "TELEMETRY serializes to structure with tag 0x54 and integer field" $ do
    let ps = toPs (RTelemetry ManagedTransactions)
    case ps of
      PsStructure 0x54 fields -> do
        V.length fields `shouldBe` 1
        case V.head fields of
          PsInteger _ -> pure ()
          _ -> expectationFailure "expected integer field for TELEMETRY"
      _ -> expectationFailure $ "expected structure with tag 0x54, got: " <> show ps

  it "TELEMETRY round-trips through PackStream" $ do
    let telReq = RTelemetry ExplicitTransactions
    let ps = toPs telReq
    let encoded = pack ps
    case unpack encoded of
      Left e   -> expectationFailure $ "decode failed: " <> T.unpack e
      Right ps' -> ps' `shouldBe` ps

  it "TelemetryApi values encode to correct integers" $ do
    let check api expected = case toPs (RTelemetry api) of
          PsStructure 0x54 fields -> case V.head fields of
            PsInteger n -> case fromPs (PsInteger n) :: R.Result Int64 of
              R.Success v -> v `shouldBe` expected
              R.Error e   -> expectationFailure $ "fromPs failed: " <> T.unpack e
            _ -> expectationFailure "expected integer"
          _ -> expectationFailure "expected structure"
    check ManagedTransactions 0
    check ExplicitTransactions 1
    check ImplicitTransactions 2
    check ExecuteQuery 3


-- = Version helper tests

versionHelperTests :: TopSpec
versionHelperTests = describe "Version helpers" $ do
  let mkVersion :: Word32 -> Word32 -> Word32
      mkVersion major minor = major .|. (minor `shiftL` 8)

  it "supportsLogonLogoff returns True for 5.1" $ do
    supportsLogonLogoff (mkVersion 5 1) `shouldBe` True

  it "supportsLogonLogoff returns True for 5.4" $ do
    supportsLogonLogoff (mkVersion 5 4) `shouldBe` True

  it "supportsLogonLogoff returns False for 5.0" $ do
    supportsLogonLogoff (mkVersion 5 0) `shouldBe` False

  it "supportsLogonLogoff returns False for 4.4" $ do
    supportsLogonLogoff (mkVersion 4 4) `shouldBe` False

  it "supportsTelemetry returns True for 5.4" $ do
    supportsTelemetry (mkVersion 5 4) `shouldBe` True

  it "supportsTelemetry returns False for 5.3" $ do
    supportsTelemetry (mkVersion 5 3) `shouldBe` False

  it "supportsTelemetry returns False for 5.0" $ do
    supportsTelemetry (mkVersion 5 0) `shouldBe` False

  it "supportsTelemetry returns False for 4.4" $ do
    supportsTelemetry (mkVersion 4 4) `shouldBe` False


-- = Query logging config tests

loggingConfigTests :: TopSpec
loggingConfigTests = describe "Query logging config" $ do
  it "default config has queryLogger = Nothing" $ do
    case queryLogger (def :: Config) of
      Nothing -> pure ()
      Just _  -> expectationFailure "Expected queryLogger to be Nothing"

  it "config with logger validates" $ do
    let cfg = (def :: Config) { queryLogger = Just (\_ _ -> pure ()) }
    case validateConfig cfg of
      Val.Failure errs -> expectationFailure $ "Config with logger should validate: " <> show errs
      Val.Success _    -> pure ()

  it "QueryLog can be constructed" $ do
    let ql = QueryLog
          { qlCypher      = "RETURN 1"
          , qlParameters  = H.empty
          , qlRowCount    = 1
          , qlServerFirst = 5
          , qlServerLast  = 10
          , qlClientTime  = 15.0
          }
    qlCypher ql `shouldBe` "RETURN 1"
    qlRowCount ql `shouldBe` 1
    qlServerFirst ql `shouldBe` 5
    qlServerLast ql `shouldBe` 10
    qlClientTime ql `shouldBe` 15.0


-- = Notification parsing tests

notificationTests :: TopSpec
notificationTests = describe "Notification parsing" $ do

  it "parses Nothing to empty vector" $ do
    V.length (parseNotifications Nothing) `shouldBe` 0

  it "parses empty list to empty vector" $ do
    V.length (parseNotifications (Just (PsList V.empty))) `shouldBe` 0

  it "parses non-list to empty vector" $ do
    V.length (parseNotifications (Just (PsString "bad"))) `shouldBe` 0

  it "parses a valid notification" $ do
    let notif = PsDictionary $ H.fromList
          [ ("code", PsString "Neo.ClientNotification.Statement.CartesianProduct")
          , ("title", PsString "Cartesian product warning")
          , ("description", PsString "This query builds a cartesian product")
          , ("severity", PsString "WARNING")
          , ("category", PsString "PERFORMANCE")
          , ("position", PsDictionary $ H.fromList
              [ ("offset", PsInteger 0)
              , ("line", PsInteger 1)
              , ("column", PsInteger 1)
              ])
          ]
    let result = parseNotifications (Just (PsList (V.singleton notif)))
    V.length result `shouldBe` 1
    let n = V.head result
    nCode n `shouldBe` "Neo.ClientNotification.Statement.CartesianProduct"
    nTitle n `shouldBe` "Cartesian product warning"
    nDescription n `shouldBe` "This query builds a cartesian product"
    nSeverity n `shouldBe` SevWarning
    nCategory n `shouldBe` "PERFORMANCE"
    nPosition n `shouldBe` Just (Position 0 1 1)

  it "parses INFORMATION severity" $ do
    let notif = PsDictionary $ H.fromList
          [ ("code", PsString "Neo.ClientNotification.Statement.FeatureDeprecationWarning")
          , ("title", PsString "Deprecated")
          , ("description", PsString "Use newer syntax")
          , ("severity", PsString "INFORMATION")
          , ("category", PsString "DEPRECATION")
          ]
    let result = parseNotifications (Just (PsList (V.singleton notif)))
    V.length result `shouldBe` 1
    nSeverity (V.head result) `shouldBe` SevInformation
    nPosition (V.head result) `shouldBe` Nothing

  it "handles missing optional fields" $ do
    let notif = PsDictionary $ H.fromList
          [ ("code", PsString "Neo.Test.Code")
          , ("title", PsString "Test")
          , ("description", PsString "Test desc")
          ]
    let result = parseNotifications (Just (PsList (V.singleton notif)))
    V.length result `shouldBe` 1
    nCategory (V.head result) `shouldBe` ""
    nPosition (V.head result) `shouldBe` Nothing

  it "skips malformed entries in list" $ do
    let good = PsDictionary $ H.fromList
          [ ("code", PsString "Neo.Test.Code")
          , ("title", PsString "Test")
          , ("description", PsString "Test desc")
          ]
    let bad = PsString "not a notification"
    let result = parseNotifications (Just (PsList (V.fromList [good, bad, good])))
    V.length result `shouldBe` 2

  it "default config has notificationHandler = Nothing" $ do
    case notificationHandler (def :: Config) of
      Nothing -> pure ()
      Just _  -> expectationFailure "Expected notificationHandler to be Nothing"


-- = Query stats parsing tests

statsTests :: TopSpec
statsTests = describe "Query stats parsing" $ do

  it "parses Nothing to Nothing" $ do
    parseStats Nothing `shouldBe` Nothing

  it "parses non-dictionary to Nothing" $ do
    parseStats (Just (PsString "bad")) `shouldBe` Nothing

  it "parses full stats dictionary" $ do
    let statsPs = PsDictionary $ H.fromList
          [ ("nodes-created", PsInteger 2)
          , ("nodes-deleted", PsInteger 1)
          , ("relationships-created", PsInteger 3)
          , ("relationships-deleted", PsInteger 0)
          , ("properties-set", PsInteger 5)
          , ("labels-added", PsInteger 2)
          , ("labels-removed", PsInteger 0)
          , ("indexes-added", PsInteger 0)
          , ("indexes-removed", PsInteger 0)
          , ("constraints-added", PsInteger 0)
          , ("constraints-removed", PsInteger 0)
          , ("contains-updates", PsBoolean True)
          , ("contains-system-updates", PsBoolean False)
          , ("system-updates", PsInteger 0)
          ]
    case parseStats (Just statsPs) of
      Nothing -> expectationFailure "Expected Just QueryStats"
      Just qs -> do
        nodesCreated qs `shouldBe` 2
        nodesDeleted qs `shouldBe` 1
        relationshipsCreated qs `shouldBe` 3
        propertiesSet qs `shouldBe` 5
        labelsAdded qs `shouldBe` 2
        containsUpdates qs `shouldBe` True
        containsSystemUpdates qs `shouldBe` False

  it "missing keys default to 0/False" $ do
    let statsPs = PsDictionary $ H.fromList
          [ ("nodes-created", PsInteger 1)
          , ("contains-updates", PsBoolean True)
          ]
    case parseStats (Just statsPs) of
      Nothing -> expectationFailure "Expected Just QueryStats"
      Just qs -> do
        nodesCreated qs `shouldBe` 1
        nodesDeleted qs `shouldBe` 0
        relationshipsCreated qs `shouldBe` 0
        labelsAdded qs `shouldBe` 0
        containsUpdates qs `shouldBe` True
        containsSystemUpdates qs `shouldBe` False
        systemUpdates qs `shouldBe` 0

  it "parses empty dictionary" $ do
    case parseStats (Just (PsDictionary H.empty)) of
      Nothing -> expectationFailure "Expected Just QueryStats"
      Just qs -> do
        nodesCreated qs `shouldBe` 0
        containsUpdates qs `shouldBe` False


-- = Plan/Profile parsing tests

planTests :: TopSpec
planTests = describe "Plan parsing" $ do

  it "parsePlan Nothing returns Nothing" $ do
    parsePlan Nothing `shouldBe` Nothing

  it "parsePlan non-dictionary returns Nothing" $ do
    parsePlan (Just (PsString "bad")) `shouldBe` Nothing

  it "parsePlan parses a simple plan node" $ do
    let planPs = PsDictionary $ H.fromList
          [ ("operatorType", PsString "ProduceResults@neo4j")
          , ("args", PsDictionary $ H.fromList
              [ ("planner-impl", PsString "IDP")
              , ("runtime", PsString "SLOTTED")
              ])
          , ("identifiers", PsList $ V.fromList [PsString "n"])
          , ("estimatedRows", PsFloat 10.0)
          , ("children", PsList V.empty)
          ]
    case parsePlan (Just planPs) of
      Nothing -> expectationFailure "Expected Just PlanNode"
      Just pn -> do
        pnOperatorType pn `shouldBe` "ProduceResults@neo4j"
        H.size (pnArguments pn) `shouldBe` 2
        pnIdentifiers pn `shouldBe` V.fromList ["n"]
        pnEstimatedRows pn `shouldBe` 10.0
        V.length (pnChildren pn) `shouldBe` 0

  it "parsePlan parses nested children" $ do
    let child = PsDictionary $ H.fromList
          [ ("operatorType", PsString "AllNodesScan@neo4j")
          , ("identifiers", PsList $ V.fromList [PsString "n"])
          , ("estimatedRows", PsFloat 100.0)
          , ("children", PsList V.empty)
          ]
    let root = PsDictionary $ H.fromList
          [ ("operatorType", PsString "ProduceResults@neo4j")
          , ("identifiers", PsList $ V.fromList [PsString "n"])
          , ("estimatedRows", PsFloat 100.0)
          , ("children", PsList $ V.fromList [child])
          ]
    case parsePlan (Just root) of
      Nothing -> expectationFailure "Expected Just PlanNode"
      Just pn -> do
        V.length (pnChildren pn) `shouldBe` 1
        pnOperatorType (V.head (pnChildren pn)) `shouldBe` "AllNodesScan@neo4j"

  it "parsePlan requires operatorType" $ do
    let planPs = PsDictionary $ H.fromList
          [ ("identifiers", PsList V.empty)
          , ("estimatedRows", PsFloat 1.0)
          ]
    parsePlan (Just planPs) `shouldBe` Nothing

  it "parsePlan defaults missing optional fields" $ do
    let planPs = PsDictionary $ H.fromList
          [ ("operatorType", PsString "NodeByLabelScan")
          ]
    case parsePlan (Just planPs) of
      Nothing -> expectationFailure "Expected Just PlanNode"
      Just pn -> do
        pnArguments pn `shouldBe` H.empty
        pnIdentifiers pn `shouldBe` V.empty
        pnEstimatedRows pn `shouldBe` 0.0
        V.length (pnChildren pn) `shouldBe` 0

  it "parsePlan skips malformed children" $ do
    let good = PsDictionary $ H.fromList
          [ ("operatorType", PsString "Scan") ]
    let bad = PsString "not a plan node"
    let root = PsDictionary $ H.fromList
          [ ("operatorType", PsString "Root")
          , ("children", PsList $ V.fromList [good, bad, good])
          ]
    case parsePlan (Just root) of
      Nothing -> expectationFailure "Expected Just PlanNode"
      Just pn -> V.length (pnChildren pn) `shouldBe` 2


profileTests :: TopSpec
profileTests = describe "Profile parsing" $ do

  it "parseProfile Nothing returns Nothing" $ do
    parseProfile Nothing `shouldBe` Nothing

  it "parseProfile non-dictionary returns Nothing" $ do
    parseProfile (Just (PsString "bad")) `shouldBe` Nothing

  it "parseProfile parses a full profile node" $ do
    let profPs = PsDictionary $ H.fromList
          [ ("operatorType", PsString "ProduceResults@neo4j")
          , ("args", PsDictionary $ H.fromList
              [ ("runtime", PsString "SLOTTED") ])
          , ("identifiers", PsList $ V.fromList [PsString "n"])
          , ("estimatedRows", PsFloat 10.0)
          , ("dbHits", PsInteger 42)
          , ("rows", PsInteger 10)
          , ("pageCacheHits", PsInteger 5)
          , ("pageCacheMisses", PsInteger 2)
          , ("time", PsInteger 1234)
          , ("children", PsList V.empty)
          ]
    case parseProfile (Just profPs) of
      Nothing -> expectationFailure "Expected Just ProfileNode"
      Just pr -> do
        prOperatorType pr `shouldBe` "ProduceResults@neo4j"
        prDbHits pr `shouldBe` 42
        prRows pr `shouldBe` 10
        prPageCacheHits pr `shouldBe` 5
        prPageCacheMisses pr `shouldBe` 2
        prTime pr `shouldBe` 1234
        prEstimatedRows pr `shouldBe` 10.0
        V.length (prChildren pr) `shouldBe` 0

  it "parseProfile parses nested children" $ do
    let child = PsDictionary $ H.fromList
          [ ("operatorType", PsString "AllNodesScan@neo4j")
          , ("identifiers", PsList $ V.fromList [PsString "n"])
          , ("estimatedRows", PsFloat 100.0)
          , ("dbHits", PsInteger 101)
          , ("rows", PsInteger 100)
          , ("children", PsList V.empty)
          ]
    let root = PsDictionary $ H.fromList
          [ ("operatorType", PsString "ProduceResults@neo4j")
          , ("identifiers", PsList $ V.fromList [PsString "n"])
          , ("estimatedRows", PsFloat 100.0)
          , ("dbHits", PsInteger 0)
          , ("rows", PsInteger 100)
          , ("children", PsList $ V.fromList [child])
          ]
    case parseProfile (Just root) of
      Nothing -> expectationFailure "Expected Just ProfileNode"
      Just pr -> do
        V.length (prChildren pr) `shouldBe` 1
        prDbHits (V.head (prChildren pr)) `shouldBe` 101

  it "parseProfile requires operatorType" $ do
    let profPs = PsDictionary $ H.fromList
          [ ("dbHits", PsInteger 5)
          , ("rows", PsInteger 1)
          ]
    parseProfile (Just profPs) `shouldBe` Nothing

  it "parseProfile defaults missing numeric fields to 0" $ do
    let profPs = PsDictionary $ H.fromList
          [ ("operatorType", PsString "NodeByLabelScan")
          ]
    case parseProfile (Just profPs) of
      Nothing -> expectationFailure "Expected Just ProfileNode"
      Just pr -> do
        prDbHits pr `shouldBe` 0
        prRows pr `shouldBe` 0
        prPageCacheHits pr `shouldBe` 0
        prPageCacheMisses pr `shouldBe` 0
        prTime pr `shouldBe` 0
        prEstimatedRows pr `shouldBe` 0.0

  it "parseProfile handles estimatedRows as integer" $ do
    let profPs = PsDictionary $ H.fromList
          [ ("operatorType", PsString "Scan")
          , ("estimatedRows", PsInteger 42)
          ]
    case parseProfile (Just profPs) of
      Nothing -> expectationFailure "Expected Just ProfileNode"
      Just pr -> prEstimatedRows pr `shouldBe` 42.0


-- = Server hint tests

serverHintTests :: TopSpec
serverHintTests = describe "Server hint config" $ do

  it "defaultPoolConfig idleTimeout is 60" $ do
    idleTimeout defaultPoolConfig `shouldBe` 60


-- = Decode tests

decodeTests :: TopSpec
decodeTests = describe "Record decoding" $ do
  let columns = V.fromList ["name", "age", "active"]
  let record  = V.fromList [BoltString "Alice", BoltInteger 30, BoltBoolean True]

  it "bool decodes BoltBoolean True" $ do
    runDecode Database.Bolty.bool (BoltBoolean True) `shouldBe` Right True

  it "bool rejects BoltString" $ do
    case runDecode Database.Bolty.bool (BoltString "x") of
      Left (TypeMismatch _ _) -> pure ()
      other -> expectationFailure $ "Expected TypeMismatch, got: " <> show other

  it "int decodes BoltInteger" $ do
    case runDecode Database.Bolty.int (BoltInteger 42) of
      Right n -> n `shouldBe` 42
      Left e  -> expectationFailure $ "Expected success, got: " <> show e

  it "int64 decodes BoltInteger to Int64" $ do
    runDecode int64 (BoltInteger 42) `shouldBe` Right (42 :: Int64)

  it "text decodes BoltString" $ do
    runDecode Database.Bolty.text (BoltString "hello") `shouldBe` Right "hello"

  it "float decodes BoltFloat" $ do
    runDecode Database.Bolty.float (BoltFloat 3.14) `shouldBe` Right 3.14

  it "nullable text decodes BoltNull to Nothing" $ do
    runDecode (nullable Database.Bolty.text) BoltNull `shouldBe` Right Nothing

  it "nullable text decodes BoltString to Just" $ do
    runDecode (nullable Database.Bolty.text) (BoltString "x") `shouldBe` Right (Just "x")

  it "list int decodes BoltList" $ do
    let v = BoltList $ V.fromList [BoltInteger 1, BoltInteger 2, BoltInteger 3]
    case runDecode (Database.Bolty.list Database.Bolty.int) v of
      Right xs -> V.length xs `shouldBe` 3
      Left e   -> expectationFailure $ "Expected success, got: " <> show e

  it "column 0 text decodes first field" $ do
    decodeRow (column 0 Database.Bolty.text) columns record `shouldBe` Right "Alice"

  it "column 5 on 3-element record gives IndexOutOfBounds" $ do
    decodeRow (column 5 Database.Bolty.text) columns record `shouldBe` Left (IndexOutOfBounds 5 3)

  it "field 'name' text finds column by name" $ do
    decodeRow (field "name" Database.Bolty.text) columns record `shouldBe` Right "Alice"

  it "field 'missing' gives MissingField" $ do
    decodeRow (field "missing" Database.Bolty.text) columns record `shouldBe` Left (MissingField "missing")

  it "decodeRows maps decoder over multiple records" $ do
    let recs = V.fromList [record, record]
    case decodeRows (field "name" Database.Bolty.text) columns recs of
      Right vs -> vs `shouldBe` V.fromList ["Alice", "Alice"]
      Left e   -> expectationFailure $ "Expected success, got: " <> show e

  it "RowDecoder Applicative composes" $ do
    let decoder = (,) <$> field "name" Database.Bolty.text <*> field "age" int64
    decodeRow decoder columns record `shouldBe` Right ("Alice", 30)


-- = sigLocalDateTime regression test

sigLocalDateTimeTest :: TopSpec
sigLocalDateTimeTest = describe "sigLocalDateTime tag" $ do
  it "sigLocalDateTime is 0x64 (not 0x66)" $ do
    sigLocalDateTime `shouldBe` 0x64


-- = psToBolt / boltToPs tests

psToBoltTests :: TopSpec
psToBoltTests = describe "psToBolt" $ do

  it "converts Node PsStructure to BoltNode" $ do
    let n = Node 1 (V.singleton "Person") (H.singleton "name" (PsString "Alice")) "4:abc:1"
    case psToBolt (toPs n) of
      BoltNode n' -> n' `shouldBe` n
      other       -> expectationFailure $ "Expected BoltNode, got: " <> show other

  it "converts Relationship PsStructure to BoltRelationship" $ do
    let r = Relationship 1 10 20 "KNOWS" H.empty "4:abc:1" "4:abc:10" "4:abc:20"
    case psToBolt (toPs r) of
      BoltRelationship r' -> r' `shouldBe` r
      other               -> expectationFailure $ "Expected BoltRelationship, got: " <> show other

  it "converts UnboundRelationship PsStructure to BoltUnboundRelationship" $ do
    let ur = UnboundRelationship 5 "LIKES" H.empty "4:abc:5"
    case psToBolt (toPs ur) of
      BoltUnboundRelationship ur' -> ur' `shouldBe` ur
      other                       -> expectationFailure $ "Expected BoltUnboundRelationship, got: " <> show other

  it "converts Path PsStructure to BoltPath" $ do
    let n1 = Node 1 (V.singleton "A") H.empty "4:abc:1"
    let n2 = Node 2 (V.singleton "B") H.empty "4:abc:2"
    let r1 = UnboundRelationship 10 "TO" H.empty "4:abc:10"
    let p = Path (V.fromList [n1, n2]) (V.singleton r1) (V.fromList [1, 1])
    case psToBolt (toPs p) of
      BoltPath p' -> p' `shouldBe` p
      other       -> expectationFailure $ "Expected BoltPath, got: " <> show other

  it "converts Date PsStructure to BoltDate" $ do
    let d = Date 19738
    case psToBolt (toPs d) of
      BoltDate d' -> d' `shouldBe` d
      other       -> expectationFailure $ "Expected BoltDate, got: " <> show other

  it "converts Time PsStructure to BoltTime" $ do
    let t = Time 43200000000000 3600
    case psToBolt (toPs t) of
      BoltTime t' -> t' `shouldBe` t
      other       -> expectationFailure $ "Expected BoltTime, got: " <> show other

  it "converts LocalTime PsStructure to BoltLocalTime" $ do
    let lt = LocalTime 43200000000000
    case psToBolt (toPs lt) of
      BoltLocalTime lt' -> lt' `shouldBe` lt
      other             -> expectationFailure $ "Expected BoltLocalTime, got: " <> show other

  it "converts DateTime PsStructure to BoltDateTime" $ do
    let dt = DateTime 1705312800 0 3600
    case psToBolt (toPs dt) of
      BoltDateTime dt' -> dt' `shouldBe` dt
      other            -> expectationFailure $ "Expected BoltDateTime, got: " <> show other

  it "converts DateTimeZoneId PsStructure to BoltDateTimeZoneId" $ do
    let dtz = DateTimeZoneId 1705312800 0 "Europe/Paris"
    case psToBolt (toPs dtz) of
      BoltDateTimeZoneId dtz' -> dtz' `shouldBe` dtz
      other                   -> expectationFailure $ "Expected BoltDateTimeZoneId, got: " <> show other

  it "converts LocalDateTime PsStructure to BoltLocalDateTime" $ do
    let ldt = LocalDateTime 1705312800 500000000
    case psToBolt (toPs ldt) of
      BoltLocalDateTime ldt' -> ldt' `shouldBe` ldt
      other                  -> expectationFailure $ "Expected BoltLocalDateTime, got: " <> show other

  it "converts Duration PsStructure to BoltDuration" $ do
    let dur = Duration 14 10 3600 0
    case psToBolt (toPs dur) of
      BoltDuration dur' -> dur' `shouldBe` dur
      other             -> expectationFailure $ "Expected BoltDuration, got: " <> show other

  it "converts Point2D PsStructure to BoltPoint2D" $ do
    let p = Point2D 7203 1.5 2.5
    case psToBolt (toPs p) of
      BoltPoint2D p' -> p' `shouldBe` p
      other          -> expectationFailure $ "Expected BoltPoint2D, got: " <> show other

  it "converts Point3D PsStructure to BoltPoint3D" $ do
    let p = Point3D 9157 1.0 2.0 3.0
    case psToBolt (toPs p) of
      BoltPoint3D p' -> p' `shouldBe` p
      other          -> expectationFailure $ "Expected BoltPoint3D, got: " <> show other

  it "unknown structure tag returns BoltNull" $ do
    psToBolt (PsStructure 0xFF V.empty) `shouldBe` BoltNull


boltToPsRoundTripTests :: TopSpec
boltToPsRoundTripTests = describe "boltToPs round-trips" $ do

  it "round-trips BoltNode" $ do
    let n = Node 1 (V.singleton "Person") (H.singleton "name" (PsString "Alice")) "4:abc:1"
    let bolt = BoltNode n
    psToBolt (boltToPs bolt) `shouldBe` bolt

  it "round-trips BoltRelationship" $ do
    let r = Relationship 1 10 20 "KNOWS" H.empty "4:abc:1" "4:abc:10" "4:abc:20"
    let bolt = BoltRelationship r
    psToBolt (boltToPs bolt) `shouldBe` bolt

  it "round-trips BoltDate" $ do
    let bolt = BoltDate (Date 19738)
    psToBolt (boltToPs bolt) `shouldBe` bolt

  it "round-trips BoltDateTime" $ do
    let bolt = BoltDateTime (DateTime 1705312800 0 3600)
    psToBolt (boltToPs bolt) `shouldBe` bolt

  it "round-trips BoltLocalDateTime" $ do
    let bolt = BoltLocalDateTime (LocalDateTime 1705312800 500000000)
    psToBolt (boltToPs bolt) `shouldBe` bolt

  it "round-trips BoltDuration" $ do
    let bolt = BoltDuration (Duration 14 10 3600 0)
    psToBolt (boltToPs bolt) `shouldBe` bolt

  it "round-trips BoltPoint2D" $ do
    let bolt = BoltPoint2D (Point2D 7203 1.5 2.5)
    psToBolt (boltToPs bolt) `shouldBe` bolt

  it "round-trips BoltPoint3D" $ do
    let bolt = BoltPoint3D (Point3D 9157 1.0 2.0 3.0)
    psToBolt (boltToPs bolt) `shouldBe` bolt


-- = patch_bolt tests

patchBoltTests :: TopSpec
patchBoltTests = describe "patch_bolt in HELLO" $ do

  it "HELLO with patchBolt=True includes patch_bolt key" $ do
    let hello = Hello (UserAgent "bolty" "2.0") (Basic "neo4j" "pass") NoRouting True
    let ps = toPs (RHello hello)
    case ps of
      PsStructure 0x01 fields -> case V.head fields of
        PsDictionary m -> case H.lookup "patch_bolt" m of
          Just (PsList v) -> V.toList v `shouldBe` [PsString "utc"]
          _               -> expectationFailure "expected patch_bolt list"
        _ -> expectationFailure "expected dictionary"
      _ -> expectationFailure "expected structure"

  it "HELLO with patchBolt=False omits patch_bolt key" $ do
    let hello = Hello (UserAgent "bolty" "2.0") (Basic "neo4j" "pass") NoRouting False
    let ps = toPs (RHello hello)
    case ps of
      PsStructure 0x01 fields -> case V.head fields of
        PsDictionary m -> H.member "patch_bolt" m `shouldBe` False
        _ -> expectationFailure "expected dictionary"
      _ -> expectationFailure "expected structure"


-- = ResultSet tests

resultSetTests :: TopSpec
resultSetTests = describe "ResultSet" $ do
  let cols = V.fromList ["name", "age"]
  let mkRecord n a = V.fromList [BoltString n, BoltInteger a]
  let rs = ResultSet cols $ V.fromList
        [ mkRecord "Alice" 30
        , mkRecord "Bob" 25
        , mkRecord "Carol" 35
        ]

  describe "decodeResultSet" $ do
    it "decodes 2-column, 3-row result" $ do
      let decoder = (,) <$> field "name" Database.Bolty.text <*> field "age" int64
      decodeResultSet decoder rs `shouldBe`
        Right (V.fromList [("Alice", 30), ("Bob", 25), ("Carol", 35)])

    it "returns empty vector for empty result set" $ do
      let emptyRs = ResultSet cols V.empty
      decodeResultSet (field "name" Database.Bolty.text) emptyRs `shouldBe` Right V.empty

    it "returns MissingField for absent column" $ do
      decodeResultSet (field "email" Database.Bolty.text) rs `shouldBe` Left (MissingField "email")

    it "returns TypeMismatch for wrong type" $ do
      case decodeResultSet (field "name" int64) rs of
        Left (TypeMismatch _ _) -> pure ()
        other -> expectationFailure $ "Expected TypeMismatch, got: " <> show other

  describe "groupByField" $ do
    let groupCols = V.fromList ["parent", "child"]
    let mkGroupRec p c = V.fromList [p, c]

    it "groups 4 rows into 2 groups of 2" $ do
      let groupRs = ResultSet groupCols $ V.fromList
            [ mkGroupRec (BoltString "A") (BoltString "c1")
            , mkGroupRec (BoltString "A") (BoltString "c2")
            , mkGroupRec (BoltString "B") (BoltString "c3")
            , mkGroupRec (BoltString "B") (BoltString "c4")
            ]
      case groupByField (field "parent" (nullable Database.Bolty.text)) groupRs of
        Right groups -> do
          V.length groups `shouldBe` 2
          fst (groups V.! 0) `shouldBe` "A"
          V.length (RS.records (snd (groups V.! 0))) `shouldBe` 2
          fst (groups V.! 1) `shouldBe` "B"
          V.length (RS.records (snd (groups V.! 1))) `shouldBe` 2
        Left e -> expectationFailure $ "Expected success, got: " <> show e

    it "skips NULL keys (does not break consecutive run)" $ do
      let groupRs = ResultSet groupCols $ V.fromList
            [ mkGroupRec (BoltString "A") (BoltString "c1")
            , mkGroupRec BoltNull (BoltString "c2")
            , mkGroupRec (BoltString "A") (BoltString "c3")
            ]
      case groupByField (field "parent" (nullable Database.Bolty.text)) groupRs of
        Right groups -> do
          -- NULL rows are simply dropped; "A" remains current group
          V.length groups `shouldBe` 1
          fst (groups V.! 0) `shouldBe` "A"
          V.length (RS.records (snd (groups V.! 0))) `shouldBe` 2
        Left e -> expectationFailure $ "Expected success, got: " <> show e

    it "NULL between different keys does not merge them" $ do
      let groupRs = ResultSet groupCols $ V.fromList
            [ mkGroupRec (BoltString "A") (BoltString "c1")
            , mkGroupRec BoltNull (BoltString "c2")
            , mkGroupRec (BoltString "B") (BoltString "c3")
            ]
      case groupByField (field "parent" (nullable Database.Bolty.text)) groupRs of
        Right groups -> do
          V.length groups `shouldBe` 2
          fst (groups V.! 0) `shouldBe` "A"
          fst (groups V.! 1) `shouldBe` "B"
        Left e -> expectationFailure $ "Expected success, got: " <> show e

    it "consecutive grouping: [A, A, B, A] produces 3 groups" $ do
      let groupRs = ResultSet groupCols $ V.fromList
            [ mkGroupRec (BoltString "A") (BoltString "c1")
            , mkGroupRec (BoltString "A") (BoltString "c2")
            , mkGroupRec (BoltString "B") (BoltString "c3")
            , mkGroupRec (BoltString "A") (BoltString "c4")
            ]
      case groupByField (field "parent" (nullable Database.Bolty.text)) groupRs of
        Right groups -> do
          V.length groups `shouldBe` 3
          fst (groups V.! 0) `shouldBe` "A"
          fst (groups V.! 1) `shouldBe` "B"
          fst (groups V.! 2) `shouldBe` "A"
        Left e -> expectationFailure $ "Expected success, got: " <> show e

    it "returns empty vector for empty result set" $ do
      let emptyRs = ResultSet groupCols V.empty
      groupByField (field "parent" (nullable Database.Bolty.text)) emptyRs `shouldBe` Right V.empty

    it "returns empty vector when all keys are NULL" $ do
      let groupRs = ResultSet groupCols $ V.fromList
            [ mkGroupRec BoltNull (BoltString "c1")
            , mkGroupRec BoltNull (BoltString "c2")
            ]
      groupByField (field "parent" (nullable Database.Bolty.text)) groupRs `shouldBe` Right V.empty

    it "single record produces one group" $ do
      let groupRs = ResultSet groupCols $ V.fromList
            [ mkGroupRec (BoltString "A") (BoltString "c1") ]
      case groupByField (field "parent" (nullable Database.Bolty.text)) groupRs of
        Right groups -> do
          V.length groups `shouldBe` 1
          fst (groups V.! 0) `shouldBe` "A"
        Left e -> expectationFailure $ "Expected success, got: " <> show e

    it "propagates decode error" $ do
      case groupByField (field "missing" (nullable Database.Bolty.text)) rs of
        Left (MissingField "missing") -> pure ()
        other -> expectationFailure $ "Expected MissingField, got: " <> show other

    it "preserves field names in sub-ResultSets" $ do
      let groupRs = ResultSet groupCols $ V.fromList
            [ mkGroupRec (BoltString "A") (BoltString "c1")
            , mkGroupRec (BoltString "A") (BoltString "c2")
            ]
      case groupByField (field "parent" (nullable Database.Bolty.text)) groupRs of
        Right groups -> do
          V.length groups `shouldBe` 1
          RS.fields (snd (groups V.! 0)) `shouldBe` groupCols
        Left e -> expectationFailure $ "Expected success, got: " <> show e

    it "full pipeline: group then decode within groups" $ do
      let groupRs = ResultSet groupCols $ V.fromList
            [ mkGroupRec (BoltString "A") (BoltString "c1")
            , mkGroupRec (BoltString "A") (BoltString "c2")
            , mkGroupRec (BoltString "B") (BoltString "c3")
            ]
      case groupByField (field "parent" (nullable Database.Bolty.text)) groupRs of
        Right groups -> do
          V.length groups `shouldBe` 2
          let childDecoder = field "child" Database.Bolty.text
          case decodeResultSet childDecoder (snd (groups V.! 0)) of
            Right children -> children `shouldBe` V.fromList ["c1", "c2"]
            Left e -> expectationFailure $ "Decode failed: " <> show e
          case decodeResultSet childDecoder (snd (groups V.! 1)) of
            Right children -> children `shouldBe` V.fromList ["c3"]
            Left e -> expectationFailure $ "Decode failed: " <> show e
        Left e -> expectationFailure $ "Expected success, got: " <> show e


-- = Main

main :: IO ()
main = runSandwichWithCommandLineArgs defaultOptions $ do
  configTests
  versionTests
  version5xTests
  extractorTests
  recordTests
  packstreamRoundTripTests
  messageTests
  logonLogoffTests
  structureRoundTripTests
  poolConfigTests
  retryTests
  routeTests
  routingTableTests
  parseAddressTests
  routingPoolConfigTests
  routingErrorTests
  bookmarkTests
  sessionConfigTests
  validationStrategyTests
  versionHelperTests
  loggingConfigTests
  notificationTests
  statsTests
  planTests
  profileTests
  serverHintTests
  decodeTests
  sigLocalDateTimeTest
  psToBoltTests
  boltToPsRoundTripTests
  patchBoltTests
  resultSetTests