-- | Interface for processing observations of the status of the pool.
--
-- Provides a flexible mechanism for monitoring the healthiness of the pool via logs and metrics without any opinionated choices on the actual monitoring technologies.
-- Specific interpreters are encouraged to be created as extension libraries.
module Hasql.Pool.Observation where

import Hasql.Pool.Prelude

-- | An observation of a change of the state of a pool.
data Observation
  = -- | Status of one of the pool's connections has changed.
    ConnectionObservation
      -- | Generated connection ID.
      -- For grouping the observations by one connection.
      UUID
      -- | Status that the connection has entered.
      ConnectionStatus
  deriving (Int -> Observation -> ShowS
[Observation] -> ShowS
Observation -> String
(Int -> Observation -> ShowS)
-> (Observation -> String)
-> ([Observation] -> ShowS)
-> Show Observation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Observation -> ShowS
showsPrec :: Int -> Observation -> ShowS
$cshow :: Observation -> String
show :: Observation -> String
$cshowList :: [Observation] -> ShowS
showList :: [Observation] -> ShowS
Show, Observation -> Observation -> Bool
(Observation -> Observation -> Bool)
-> (Observation -> Observation -> Bool) -> Eq Observation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Observation -> Observation -> Bool
== :: Observation -> Observation -> Bool
$c/= :: Observation -> Observation -> Bool
/= :: Observation -> Observation -> Bool
Eq)

-- | Status of a connection.
data ConnectionStatus
  = -- | Connection is being established.
    --
    -- This is the initial status of every connection.
    ConnectingConnectionStatus
  | -- | Connection is established and not occupied.
    ReadyForUseConnectionStatus
  | -- | Is being used by some session.
    --
    -- After it's done the status will transition to 'ReadyForUseConnectionStatus' or 'TerminatedConnectionStatus'.
    InUseConnectionStatus
  | -- | Connection terminated.
    TerminatedConnectionStatus ConnectionTerminationReason
  deriving (Int -> ConnectionStatus -> ShowS
[ConnectionStatus] -> ShowS
ConnectionStatus -> String
(Int -> ConnectionStatus -> ShowS)
-> (ConnectionStatus -> String)
-> ([ConnectionStatus] -> ShowS)
-> Show ConnectionStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionStatus -> ShowS
showsPrec :: Int -> ConnectionStatus -> ShowS
$cshow :: ConnectionStatus -> String
show :: ConnectionStatus -> String
$cshowList :: [ConnectionStatus] -> ShowS
showList :: [ConnectionStatus] -> ShowS
Show, ConnectionStatus -> ConnectionStatus -> Bool
(ConnectionStatus -> ConnectionStatus -> Bool)
-> (ConnectionStatus -> ConnectionStatus -> Bool)
-> Eq ConnectionStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionStatus -> ConnectionStatus -> Bool
== :: ConnectionStatus -> ConnectionStatus -> Bool
$c/= :: ConnectionStatus -> ConnectionStatus -> Bool
/= :: ConnectionStatus -> ConnectionStatus -> Bool
Eq)

-- | Explanation of why a connection was terminated.
data ConnectionTerminationReason
  = -- | The age timeout of the connection has passed.
    AgingConnectionTerminationReason
  | -- | The timeout of how long a connection may remain idle in the pool has passed.
    IdlenessConnectionTerminationReason
  | -- | Connectivity issues with the server.
    NetworkErrorConnectionTerminationReason (Maybe Text)
  | -- | User has invoked the 'Hasql.Pool.release' procedure.
    ReleaseConnectionTerminationReason
  deriving (Int -> ConnectionTerminationReason -> ShowS
[ConnectionTerminationReason] -> ShowS
ConnectionTerminationReason -> String
(Int -> ConnectionTerminationReason -> ShowS)
-> (ConnectionTerminationReason -> String)
-> ([ConnectionTerminationReason] -> ShowS)
-> Show ConnectionTerminationReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionTerminationReason -> ShowS
showsPrec :: Int -> ConnectionTerminationReason -> ShowS
$cshow :: ConnectionTerminationReason -> String
show :: ConnectionTerminationReason -> String
$cshowList :: [ConnectionTerminationReason] -> ShowS
showList :: [ConnectionTerminationReason] -> ShowS
Show, ConnectionTerminationReason -> ConnectionTerminationReason -> Bool
(ConnectionTerminationReason
 -> ConnectionTerminationReason -> Bool)
-> (ConnectionTerminationReason
    -> ConnectionTerminationReason -> Bool)
-> Eq ConnectionTerminationReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConnectionTerminationReason -> ConnectionTerminationReason -> Bool
== :: ConnectionTerminationReason -> ConnectionTerminationReason -> Bool
$c/= :: ConnectionTerminationReason -> ConnectionTerminationReason -> Bool
/= :: ConnectionTerminationReason -> ConnectionTerminationReason -> Bool
Eq)