{-# LANGUAGE MagicHash #-}

-- | Types related to resizing a connection pool
--
-- Resize connection pools, on-demand, based on underlying server replicas
--
-- See @'resizeSourcePools' in Hasura.RQL.Types.Backend
module Hasura.RQL.Types.ResizePool
  ( ServerReplicas,
    ResizePoolStrategy (..),
    getServerReplicasInt,
    safeServerReplicas,
    SourceResizePoolSummary (..),
    noPoolsResizedSummary,

    -- * exporting for tests
    unsafeServerReplicas,
    oneServerReplica,
  )
where

import GHC.Exts (Int (I#), Word (W#), int2Word#)
import Hasura.Prelude

-- | Number of server instances. A wrapper over @'Word' type, a non-negative integer
-- with the same size as @'Int'. Useful for resize a connection pool.
newtype ServerReplicas = ServerReplicas {ServerReplicas -> Word
serverReplicaNumber :: Word}
  deriving (Int -> ServerReplicas -> ShowS
[ServerReplicas] -> ShowS
ServerReplicas -> String
(Int -> ServerReplicas -> ShowS)
-> (ServerReplicas -> String)
-> ([ServerReplicas] -> ShowS)
-> Show ServerReplicas
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerReplicas -> ShowS
showsPrec :: Int -> ServerReplicas -> ShowS
$cshow :: ServerReplicas -> String
show :: ServerReplicas -> String
$cshowList :: [ServerReplicas] -> ShowS
showList :: [ServerReplicas] -> ShowS
Show, ServerReplicas -> ServerReplicas -> Bool
(ServerReplicas -> ServerReplicas -> Bool)
-> (ServerReplicas -> ServerReplicas -> Bool) -> Eq ServerReplicas
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerReplicas -> ServerReplicas -> Bool
== :: ServerReplicas -> ServerReplicas -> Bool
$c/= :: ServerReplicas -> ServerReplicas -> Bool
/= :: ServerReplicas -> ServerReplicas -> Bool
Eq)

unsafeServerReplicas :: Word -> ServerReplicas
unsafeServerReplicas :: Word -> ServerReplicas
unsafeServerReplicas = Word -> ServerReplicas
ServerReplicas

oneServerReplica :: ServerReplicas
oneServerReplica :: ServerReplicas
oneServerReplica = Word -> ServerReplicas
ServerReplicas Word
1

-- | Safely build @'ServerReplicas' from non-negative and non-zero @'Int' value.
safeServerReplicas :: Int -> Either Text ServerReplicas
safeServerReplicas :: Int -> Either Text ServerReplicas
safeServerReplicas i :: Int
i@(I# Int#
i#)
  | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Text -> Either Text ServerReplicas
forall a b. a -> Either a b
Left (Text -> Either Text ServerReplicas)
-> Text -> Either Text ServerReplicas
forall a b. (a -> b) -> a -> b
$ Text
"Expecting a non-zero and non-negative integer for ServerReplicas but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
i
  | Bool
otherwise = ServerReplicas -> Either Text ServerReplicas
forall a b. b -> Either a b
Right (ServerReplicas -> Either Text ServerReplicas)
-> ServerReplicas -> Either Text ServerReplicas
forall a b. (a -> b) -> a -> b
$ Word -> ServerReplicas
ServerReplicas (Word -> ServerReplicas) -> Word -> ServerReplicas
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# (Int# -> Word#
int2Word# Int#
i#)

-- | Get server replic count in @'Int'
getServerReplicasInt :: ServerReplicas -> Int
getServerReplicasInt :: ServerReplicas -> Int
getServerReplicasInt (ServerReplicas Word
replicaNumber) = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
replicaNumber

-- | A strategy for resizing a pool
data ResizePoolStrategy
  = -- | Never resize the pool
    NeverResizePool
  | -- | Resize the pool by using provided total maximum connections
    ResizePool Int

-- | Summary of a source's pools resize. Predominantly used to log.
data SourceResizePoolSummary = SourceResizePoolSummary
  { SourceResizePoolSummary -> Bool
_srpsPrimaryResized :: Bool,
    SourceResizePoolSummary -> Bool
_srpsReadReplicasResized :: Bool,
    SourceResizePoolSummary -> [Text]
_srpsConnectionSet :: [Text]
  }
  deriving (SourceResizePoolSummary -> SourceResizePoolSummary -> Bool
(SourceResizePoolSummary -> SourceResizePoolSummary -> Bool)
-> (SourceResizePoolSummary -> SourceResizePoolSummary -> Bool)
-> Eq SourceResizePoolSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceResizePoolSummary -> SourceResizePoolSummary -> Bool
== :: SourceResizePoolSummary -> SourceResizePoolSummary -> Bool
$c/= :: SourceResizePoolSummary -> SourceResizePoolSummary -> Bool
/= :: SourceResizePoolSummary -> SourceResizePoolSummary -> Bool
Eq, Int -> SourceResizePoolSummary -> ShowS
[SourceResizePoolSummary] -> ShowS
SourceResizePoolSummary -> String
(Int -> SourceResizePoolSummary -> ShowS)
-> (SourceResizePoolSummary -> String)
-> ([SourceResizePoolSummary] -> ShowS)
-> Show SourceResizePoolSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceResizePoolSummary -> ShowS
showsPrec :: Int -> SourceResizePoolSummary -> ShowS
$cshow :: SourceResizePoolSummary -> String
show :: SourceResizePoolSummary -> String
$cshowList :: [SourceResizePoolSummary] -> ShowS
showList :: [SourceResizePoolSummary] -> ShowS
Show)

noPoolsResizedSummary :: SourceResizePoolSummary
noPoolsResizedSummary :: SourceResizePoolSummary
noPoolsResizedSummary =
  Bool -> Bool -> [Text] -> SourceResizePoolSummary
SourceResizePoolSummary Bool
False Bool
False []