-- | 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
  { Config -> Text
host         :: T.Text
  -- ^ Server hostname or IP address. Default: @\"127.0.0.1\"@.
  , Config -> Word16
port         :: Word16
  -- ^ Server port. Default: @7687@.
  , Config -> Scheme
scheme       :: Scheme
  -- ^ Authentication scheme. Default: 'None'.
  , Config -> Bool
use_tls      :: Bool
  -- ^ Whether to use TLS. Default: @True@.
  , Config -> [Version]
versions     :: [Version]
  -- ^ BOLT protocol versions to negotiate, in preference order.
  , Config -> Int
timeout      :: Int
  -- ^ Connection timeout in milliseconds. Default: @10000@.
  , Config -> Routing
routing      :: Routing
  -- ^ Routing configuration. Default: 'NoRouting'.
  , Config -> UserAgent
user_agent   :: UserAgent
  -- ^ User-agent string sent in HELLO.
  , Config -> Maybe (QueryLog -> QueryMeta -> IO ())
queryLogger          :: Maybe (QueryLog -> QueryMeta -> IO ())
  -- ^ Optional callback fired after each query completes.
  , Config -> Maybe (Notification -> IO ())
notificationHandler  :: Maybe (Notification -> IO ())
  -- ^ Optional callback fired for each server notification (warnings, hints, deprecations).
  }

instance Default Config where
  def :: Config
def = Config
    { host :: Text
host        = Text
"127.0.0.1"
    , port :: Word16
port        = Word16
7687
    , scheme :: Scheme
scheme      = Scheme
None
    , use_tls :: Bool
use_tls     = Bool
True
    , versions :: [Version]
versions    = [ Version{major :: Word8
major = Word8
5, minor :: Word8
minor = Word8
4}
                    , Version{major :: Word8
major = Word8
5, minor :: Word8
minor = Word8
3}
                    , Version{major :: Word8
major = Word8
5, minor :: Word8
minor = Word8
2}
                    , Version{major :: Word8
major = Word8
5, minor :: Word8
minor = Word8
1}
                    , Version{major :: Word8
major = Word8
5, minor :: Word8
minor = Word8
0}
                    , Version{major :: Word8
major = Word8
4, minor :: Word8
minor = Word8
4}
                    ]
    , timeout :: Int
timeout     = Int
10_000
    , routing :: Routing
routing     = Routing
NoRouting
    , user_agent :: UserAgent
user_agent  = UserAgent{name :: Text
name = Text
"bolty", version :: Text
version = Text
"2.0"}
    , queryLogger :: Maybe (QueryLog -> QueryMeta -> IO ())
queryLogger         = Maybe (QueryLog -> QueryMeta -> IO ())
forall a. Maybe a
Nothing
    , notificationHandler :: Maybe (Notification -> IO ())
notificationHandler = Maybe (Notification -> IO ())
forall a. Maybe a
Nothing
    }

-- | A validated configuration ready for 'Database.Bolty.connect'. Created via 'validateConfig'.
type ValidatedConfig :: Type
data ValidatedConfig = ValidatedConfig
  { ValidatedConfig -> Text
host                 :: T.Text
  , ValidatedConfig -> Word16
port                 :: Word16
  , ValidatedConfig -> Scheme
scheme               :: Scheme
  , ValidatedConfig -> Bool
use_tls              :: Bool
  , ValidatedConfig -> [Word32]
versions             :: [Word32]
  -- ^ Encoded BOLT version words.
  , ValidatedConfig -> Int
timeout              :: Int
  , ValidatedConfig -> Routing
routing              :: Routing
  , ValidatedConfig -> UserAgent
user_agent           :: UserAgent
  , ValidatedConfig -> Maybe (QueryLog -> QueryMeta -> IO ())
queryLogger          :: Maybe (QueryLog -> QueryMeta -> IO ())
  , ValidatedConfig -> Maybe (Notification -> 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 (Int -> ServerState -> ShowS
[ServerState] -> ShowS
ServerState -> String
(Int -> ServerState -> ShowS)
-> (ServerState -> String)
-> ([ServerState] -> ShowS)
-> Show ServerState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerState -> ShowS
showsPrec :: Int -> ServerState -> ShowS
$cshow :: ServerState -> String
show :: ServerState -> String
$cshowList :: [ServerState] -> ShowS
showList :: [ServerState] -> ShowS
Show, ServerState -> ServerState -> Bool
(ServerState -> ServerState -> Bool)
-> (ServerState -> ServerState -> Bool) -> Eq ServerState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerState -> ServerState -> Bool
== :: ServerState -> ServerState -> Bool
$c/= :: ServerState -> ServerState -> Bool
/= :: ServerState -> ServerState -> Bool
Eq)


-- | An open connection to a Neo4j server. Obtain via 'Database.Bolty.connect'.
type Connection :: Type
data Connection = Connection
  { Connection -> Connection
rawConnection        :: !NC.Connection
  , Connection -> Int
timeout_milliseconds :: !Int
  , Connection -> Word32
version              :: Word32
  -- ^ Negotiated BOLT protocol version.
  , Connection -> IORef ServerState
server_state         :: IORef ServerState
  , Connection -> Text
server_agent         :: Text
  -- ^ Server agent string from HELLO response.
  , Connection -> Text
connection_id        :: Text
  -- ^ Server-assigned connection ID.
  , Connection -> IORef Word64
lastActivity         :: IORef Word64
  -- ^ Monotonic nanosecond timestamp of last successful operation.
  -- Used by 'PingIfIdle' validation strategy to skip health checks
  -- on recently-used connections.
  , Connection -> Bool
telemetry_enabled    :: Bool
  -- ^ Whether the server supports telemetry (from HELLO SUCCESS hints).
  , Connection -> Maybe Int
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).
  , Connection -> Maybe (QueryLog -> QueryMeta -> IO ())
queryLogger          :: Maybe (QueryLog -> QueryMeta -> IO ())
  -- ^ Optional callback fired after each query completes.
  , Connection -> Maybe (Notification -> IO ())
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 (Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
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 (Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
/= :: Scheme -> Scheme -> Bool
Eq, (forall x. Scheme -> Rep Scheme x)
-> (forall x. Rep Scheme x -> Scheme) -> Generic Scheme
forall x. Rep Scheme x -> Scheme
forall x. Scheme -> Rep Scheme x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Scheme -> Rep Scheme x
from :: forall x. Scheme -> Rep Scheme x
$cto :: forall x. Rep Scheme x -> Scheme
to :: forall x. Rep Scheme x -> Scheme
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 (Routing -> Routing -> Bool
(Routing -> Routing -> Bool)
-> (Routing -> Routing -> Bool) -> Eq Routing
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Routing -> Routing -> Bool
== :: Routing -> Routing -> Bool
$c/= :: Routing -> Routing -> Bool
/= :: Routing -> Routing -> Bool
Eq)


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


-- | Check if an error is a transient Neo4j failure that can be retried.
isTransient :: Error -> Bool
isTransient :: Error -> Bool
isTransient (ResponseErrorFailure Text
code Text
_) = Text
"Neo.TransientError." Text -> Text -> Bool
`T.isPrefixOf` Text
code
isTransient (RoutingTableError Text
_) = Bool
True
isTransient Error
_ = Bool
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 :: Error -> Bool
isRoutingError (ResponseErrorFailure Text
code Text
_) =
     Text
"Neo.ClientError.Cluster.NotALeader" Text -> Text -> Bool
`T.isPrefixOf` Text
code
  Bool -> Bool -> Bool
|| Text
"Neo.ClientError.General.ForbiddenOnReadOnlyDatabase" Text -> Text -> Bool
`T.isPrefixOf` Text
code
isRoutingError Error
_ = Bool
False