Type.hs

-- | Internal module. Not part of the public API.
--
-- Core types for Neo4j BOLT connections: configuration, errors, and connection handles.
module Database.Bolty.Connection.Type
  ( Config(..)
  , ValidatedConfig(..)
  , ServerState(..)
  , Connection(..)
  , Error(..)
  , Scheme(..)
  , Principal
  , Credentials
  , Routing(..)
  , UserAgent(..)
  , isTransient
  , isRoutingError
  ) where

import           Data.Kind                       (Type)
import           Control.Exception               (Exception, SomeException)
import           Data.Default                    (Default(..))
import           Data.IORef                      (IORef)
import           Data.Text                       (Text)
import           Data.Word                       (Word16, Word32, Word64)
import           GHC.Generics                    (Generic)
import qualified Network.Connection              as NC
import qualified Data.HashMap.Lazy               as H
import qualified Data.Text                       as T

import           Database.Bolty.Connection.Version (Version(..))
import           Database.Bolty.Logging          (QueryLog(..))
import           Database.Bolty.Message.Response  (QueryMeta)
import           Database.Bolty.Notification     (Notification)


-- | Connection configuration. Use 'Data.Default.def' for sensible defaults and
-- override the fields you need. Must be validated with 'validateConfig' before use.
type Config :: Type
data Config = Config
  { host         :: T.Text
  -- ^ Server hostname or IP address. Default: @\"127.0.0.1\"@.
  , port         :: Word16
  -- ^ Server port. Default: @7687@.
  , scheme       :: Scheme
  -- ^ Authentication scheme. Default: 'None'.
  , use_tls      :: Bool
  -- ^ Whether to use TLS. Default: @True@.
  , versions     :: [Version]
  -- ^ BOLT protocol versions to negotiate, in preference order.
  , timeout      :: Int
  -- ^ Connection timeout in milliseconds. Default: @10000@.
  , routing      :: Routing
  -- ^ Routing configuration. Default: 'NoRouting'.
  , user_agent   :: UserAgent
  -- ^ User-agent string sent in HELLO.
  , queryLogger          :: Maybe (QueryLog -> QueryMeta -> IO ())
  -- ^ Optional callback fired after each query completes.
  , notificationHandler  :: Maybe (Notification -> IO ())
  -- ^ Optional callback fired for each server notification (warnings, hints, deprecations).
  }

instance Default Config where
  def = Config
    { host        = "127.0.0.1"
    , port        = 7687
    , scheme      = None
    , use_tls     = True
    , versions    = [ Version{major = 5, minor = 4}
                    , Version{major = 5, minor = 3}
                    , Version{major = 5, minor = 2}
                    , Version{major = 5, minor = 1}
                    , Version{major = 5, minor = 0}
                    , Version{major = 4, minor = 4}
                    ]
    , timeout     = 10_000
    , routing     = NoRouting
    , user_agent  = UserAgent{name = "bolty", version = "2.0"}
    , queryLogger         = Nothing
    , notificationHandler = Nothing
    }

-- | A validated configuration ready for 'Database.Bolty.connect'. Created via 'validateConfig'.
type ValidatedConfig :: Type
data ValidatedConfig = ValidatedConfig
  { host                 :: T.Text
  , port                 :: Word16
  , scheme               :: Scheme
  , use_tls              :: Bool
  , versions             :: [Word32]
  -- ^ Encoded BOLT version words.
  , timeout              :: Int
  , routing              :: Routing
  , user_agent           :: UserAgent
  , queryLogger          :: Maybe (QueryLog -> QueryMeta -> IO ())
  , notificationHandler  :: Maybe (Notification -> IO ())
  }


-- | https://neo4j.com/docs/bolt/current/bolt/server-state/#server-states
type ServerState :: Type
data ServerState
  = Disconnected
  | Connected
  | Defunct
  | Authentication
  | Ready
  | Streaming
  | TXready
  | TXstreaming
  | Failed
  | Interrupted
  deriving stock (Show, Eq)


-- | An open connection to a Neo4j server. Obtain via 'Database.Bolty.connect'.
type Connection :: Type
data Connection = Connection
  { rawConnection        :: !NC.Connection
  , timeout_milliseconds :: !Int
  , version              :: Word32
  -- ^ Negotiated BOLT protocol version.
  , server_state         :: IORef ServerState
  , server_agent         :: Text
  -- ^ Server agent string from HELLO response.
  , connection_id        :: Text
  -- ^ Server-assigned connection ID.
  , lastActivity         :: IORef Word64
  -- ^ Monotonic nanosecond timestamp of last successful operation.
  -- Used by 'PingIfIdle' validation strategy to skip health checks
  -- on recently-used connections.
  , telemetry_enabled    :: Bool
  -- ^ Whether the server supports telemetry (from HELLO SUCCESS hints).
  , serverIdleTimeout    :: Maybe Int
  -- ^ Server-advertised idle timeout in seconds (from @connection.recv_timeout_seconds@ hint).
  -- 'Nothing' if the server didn't send this hint (Bolt < 5.x or hint not present).
  , queryLogger          :: Maybe (QueryLog -> QueryMeta -> IO ())
  -- ^ Optional callback fired after each query completes.
  , notificationHandler  :: Maybe (Notification -> IO ())
  -- ^ Optional callback fired for each server notification.
  }


instance Exception Error

-- | Errors that can occur during BOLT communication.
type Error :: Type
data Error
  = TimeOut T.Text
  -- ^ A network operation timed out.
  | AuthentificationFailed
  -- ^ The server rejected the authentication credentials.
  | UnsupportedServerVersion Word32
  -- ^ No mutually supported BOLT version could be negotiated.
  | ResetFailed
  -- ^ A RESET message failed (connection is likely defunct).
  | CannotReadResponse T.Text
  -- ^ Failed to parse a response from the server.
  | NonboltyError SomeException
  -- ^ A non-BOLT exception (e.g. network IO error).
  | ResponseErrorRecords
  -- ^ Received records when a non-record response was expected.
  | WrongMessageFormat T.Text
  -- ^ The server sent an unexpected message type.
  | ResponseErrorIgnored
  -- ^ The server sent an IGNORED response.
  | ResponseErrorFailure T.Text T.Text
  -- ^ A FAILURE response with Neo4j error code and message.
  | InvalidState ServerState T.Text
  -- ^ Attempted an operation in an invalid server state.
  | RoutingTableError T.Text
  -- ^ Failed to fetch or parse a routing table.
  deriving stock (Show)


-- | Username for authentication.
type Principal :: Type
type Principal = T.Text
-- | Password or token for authentication.
type Credentials :: Type
type Credentials = T.Text

-- | Authentication scheme for the HELLO handshake.
type Scheme :: Type
data Scheme
  = None
  -- ^ No authentication.
  | Basic !Principal !Credentials
  -- ^ Basic username\/password authentication.
  | Kerberos
  -- ^ Kerberos authentication (ticket obtained externally).
  | Bearer !Credentials
  -- ^ Bearer token authentication (e.g. SSO).
  deriving stock (Eq, Generic)


-- | Routing mode for cluster-aware connections.
type Routing :: Type
data Routing
  = NoRouting
  -- ^ Direct connection (no routing).
  | Routing
  -- ^ Use server-side routing with default settings.
  | RoutingSpec !T.Text !(H.HashMap T.Text T.Text)
  -- ^ Use server-side routing with explicit address and parameters.
  -- Arguments: advertised address (e.g. @\"core1:7687\"@), additional routing context parameters.
  deriving stock (Eq)


-- | User-agent identifier sent to the server in the HELLO message.
type UserAgent :: Type
data UserAgent = UserAgent
  { name    :: !T.Text
  -- ^ Application name.
  , version :: !T.Text
  -- ^ Application version.
  }
  deriving stock (Eq)


-- | Check if an error is a transient Neo4j failure that can be retried.
isTransient :: Error -> Bool
isTransient (ResponseErrorFailure code _) = "Neo.TransientError." `T.isPrefixOf` code
isTransient (RoutingTableError _) = True
isTransient _ = False

-- | Check if an error indicates stale routing information.
-- These errors mean the driver sent a request to the wrong server
-- (e.g. a write to a read replica). The routing table should be
-- invalidated and the operation retried on a fresh leader.
isRoutingError :: Error -> Bool
isRoutingError (ResponseErrorFailure code _) =
     "Neo.ClientError.Cluster.NotALeader" `T.isPrefixOf` code
  || "Neo.ClientError.General.ForbiddenOnReadOnlyDatabase" `T.isPrefixOf` code
isRoutingError _ = False