{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}

-- | View and patch types for the concurrency management/observability API.
module Arbiter.Core.Concurrency.Stats
  ( ConcurrencyPolicyView (..)
  , ConcurrencyKeyView (..)
  , ConcurrencyPolicyUpdate (..)
  ) where

import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.:?), (.=))
import Data.Aeson qualified as Aeson
import Data.Int (Int32, Int64)
import Data.Text (Text)
import GHC.Generics (Generic)

import Arbiter.Core.Json (explicitOptionalField, patchOptions)

-- | A pool with its default and override limits plus live key and in-flight stats.
-- The effective cap is @override@ when set, else @default@.
data ConcurrencyPolicyView = ConcurrencyPolicyView
  { ConcurrencyPolicyView -> Text
prefix :: Text
  , ConcurrencyPolicyView -> Int32
defaultLimit :: Int32
  , ConcurrencyPolicyView -> Maybe Int32
overrideLimit :: Maybe Int32
  , ConcurrencyPolicyView -> Int64
keyCount :: Int64
  , ConcurrencyPolicyView -> Int64
totalInFlight :: Int64
  , ConcurrencyPolicyView -> Maybe Int32
maxInFlight :: Maybe Int32
  }
  deriving stock (ConcurrencyPolicyView -> ConcurrencyPolicyView -> Bool
(ConcurrencyPolicyView -> ConcurrencyPolicyView -> Bool)
-> (ConcurrencyPolicyView -> ConcurrencyPolicyView -> Bool)
-> Eq ConcurrencyPolicyView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConcurrencyPolicyView -> ConcurrencyPolicyView -> Bool
== :: ConcurrencyPolicyView -> ConcurrencyPolicyView -> Bool
$c/= :: ConcurrencyPolicyView -> ConcurrencyPolicyView -> Bool
/= :: ConcurrencyPolicyView -> ConcurrencyPolicyView -> Bool
Eq, (forall x. ConcurrencyPolicyView -> Rep ConcurrencyPolicyView x)
-> (forall x. Rep ConcurrencyPolicyView x -> ConcurrencyPolicyView)
-> Generic ConcurrencyPolicyView
forall x. Rep ConcurrencyPolicyView x -> ConcurrencyPolicyView
forall x. ConcurrencyPolicyView -> Rep ConcurrencyPolicyView x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConcurrencyPolicyView -> Rep ConcurrencyPolicyView x
from :: forall x. ConcurrencyPolicyView -> Rep ConcurrencyPolicyView x
$cto :: forall x. Rep ConcurrencyPolicyView x -> ConcurrencyPolicyView
to :: forall x. Rep ConcurrencyPolicyView x -> ConcurrencyPolicyView
Generic, Int -> ConcurrencyPolicyView -> ShowS
[ConcurrencyPolicyView] -> ShowS
ConcurrencyPolicyView -> String
(Int -> ConcurrencyPolicyView -> ShowS)
-> (ConcurrencyPolicyView -> String)
-> ([ConcurrencyPolicyView] -> ShowS)
-> Show ConcurrencyPolicyView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConcurrencyPolicyView -> ShowS
showsPrec :: Int -> ConcurrencyPolicyView -> ShowS
$cshow :: ConcurrencyPolicyView -> String
show :: ConcurrencyPolicyView -> String
$cshowList :: [ConcurrencyPolicyView] -> ShowS
showList :: [ConcurrencyPolicyView] -> ShowS
Show)
  deriving anyclass (Maybe ConcurrencyPolicyView
Value -> Parser [ConcurrencyPolicyView]
Value -> Parser ConcurrencyPolicyView
(Value -> Parser ConcurrencyPolicyView)
-> (Value -> Parser [ConcurrencyPolicyView])
-> Maybe ConcurrencyPolicyView
-> FromJSON ConcurrencyPolicyView
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ConcurrencyPolicyView
parseJSON :: Value -> Parser ConcurrencyPolicyView
$cparseJSONList :: Value -> Parser [ConcurrencyPolicyView]
parseJSONList :: Value -> Parser [ConcurrencyPolicyView]
$comittedField :: Maybe ConcurrencyPolicyView
omittedField :: Maybe ConcurrencyPolicyView
FromJSON, [ConcurrencyPolicyView] -> Value
[ConcurrencyPolicyView] -> Encoding
ConcurrencyPolicyView -> Bool
ConcurrencyPolicyView -> Value
ConcurrencyPolicyView -> Encoding
(ConcurrencyPolicyView -> Value)
-> (ConcurrencyPolicyView -> Encoding)
-> ([ConcurrencyPolicyView] -> Value)
-> ([ConcurrencyPolicyView] -> Encoding)
-> (ConcurrencyPolicyView -> Bool)
-> ToJSON ConcurrencyPolicyView
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ConcurrencyPolicyView -> Value
toJSON :: ConcurrencyPolicyView -> Value
$ctoEncoding :: ConcurrencyPolicyView -> Encoding
toEncoding :: ConcurrencyPolicyView -> Encoding
$ctoJSONList :: [ConcurrencyPolicyView] -> Value
toJSONList :: [ConcurrencyPolicyView] -> Value
$ctoEncodingList :: [ConcurrencyPolicyView] -> Encoding
toEncodingList :: [ConcurrencyPolicyView] -> Encoding
$comitField :: ConcurrencyPolicyView -> Bool
omitField :: ConcurrencyPolicyView -> Bool
ToJSON)

-- | A single key's in-flight count, its effective cap, and fill fraction.
data ConcurrencyKeyView = ConcurrencyKeyView
  { ConcurrencyKeyView -> Text
concurrencyKey :: Text
  , ConcurrencyKeyView -> Text
concurrencyPrefix :: Text
  , ConcurrencyKeyView -> Int32
inFlight :: Int32
  , ConcurrencyKeyView -> Int32
effectiveLimit :: Int32
  , ConcurrencyKeyView -> Maybe Double
fillFraction :: Maybe Double
  }
  deriving stock (ConcurrencyKeyView -> ConcurrencyKeyView -> Bool
(ConcurrencyKeyView -> ConcurrencyKeyView -> Bool)
-> (ConcurrencyKeyView -> ConcurrencyKeyView -> Bool)
-> Eq ConcurrencyKeyView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConcurrencyKeyView -> ConcurrencyKeyView -> Bool
== :: ConcurrencyKeyView -> ConcurrencyKeyView -> Bool
$c/= :: ConcurrencyKeyView -> ConcurrencyKeyView -> Bool
/= :: ConcurrencyKeyView -> ConcurrencyKeyView -> Bool
Eq, (forall x. ConcurrencyKeyView -> Rep ConcurrencyKeyView x)
-> (forall x. Rep ConcurrencyKeyView x -> ConcurrencyKeyView)
-> Generic ConcurrencyKeyView
forall x. Rep ConcurrencyKeyView x -> ConcurrencyKeyView
forall x. ConcurrencyKeyView -> Rep ConcurrencyKeyView x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConcurrencyKeyView -> Rep ConcurrencyKeyView x
from :: forall x. ConcurrencyKeyView -> Rep ConcurrencyKeyView x
$cto :: forall x. Rep ConcurrencyKeyView x -> ConcurrencyKeyView
to :: forall x. Rep ConcurrencyKeyView x -> ConcurrencyKeyView
Generic, Int -> ConcurrencyKeyView -> ShowS
[ConcurrencyKeyView] -> ShowS
ConcurrencyKeyView -> String
(Int -> ConcurrencyKeyView -> ShowS)
-> (ConcurrencyKeyView -> String)
-> ([ConcurrencyKeyView] -> ShowS)
-> Show ConcurrencyKeyView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConcurrencyKeyView -> ShowS
showsPrec :: Int -> ConcurrencyKeyView -> ShowS
$cshow :: ConcurrencyKeyView -> String
show :: ConcurrencyKeyView -> String
$cshowList :: [ConcurrencyKeyView] -> ShowS
showList :: [ConcurrencyKeyView] -> ShowS
Show)

instance ToJSON ConcurrencyKeyView where
  toJSON :: ConcurrencyKeyView -> Value
toJSON ConcurrencyKeyView
view =
    [Pair] -> Value
object
      [ Key
"key" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConcurrencyKeyView -> Text
concurrencyKey ConcurrencyKeyView
view
      , Key
"prefix" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConcurrencyKeyView -> Text
concurrencyPrefix ConcurrencyKeyView
view
      , Key
"inFlight" Key -> Int32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConcurrencyKeyView -> Int32
inFlight ConcurrencyKeyView
view
      , Key
"effectiveLimit" Key -> Int32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConcurrencyKeyView -> Int32
effectiveLimit ConcurrencyKeyView
view
      , Key
"fillFraction" Key -> Maybe Double -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ConcurrencyKeyView -> Maybe Double
fillFraction ConcurrencyKeyView
view
      ]

instance FromJSON ConcurrencyKeyView where
  parseJSON :: Value -> Parser ConcurrencyKeyView
parseJSON = String
-> (Object -> Parser ConcurrencyKeyView)
-> Value
-> Parser ConcurrencyKeyView
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ConcurrencyKeyView" ((Object -> Parser ConcurrencyKeyView)
 -> Value -> Parser ConcurrencyKeyView)
-> (Object -> Parser ConcurrencyKeyView)
-> Value
-> Parser ConcurrencyKeyView
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Text
-> Text -> Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView
ConcurrencyKeyView
      (Text
 -> Text -> Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView)
-> Parser Text
-> Parser
     (Text -> Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key"
      Parser
  (Text -> Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView)
-> Parser Text
-> Parser (Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prefix"
      Parser (Int32 -> Int32 -> Maybe Double -> ConcurrencyKeyView)
-> Parser Int32
-> Parser (Int32 -> Maybe Double -> ConcurrencyKeyView)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Int32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inFlight"
      Parser (Int32 -> Maybe Double -> ConcurrencyKeyView)
-> Parser Int32 -> Parser (Maybe Double -> ConcurrencyKeyView)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Int32
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"effectiveLimit"
      Parser (Maybe Double -> ConcurrencyKeyView)
-> Parser (Maybe Double) -> Parser ConcurrencyKeyView
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fillFraction"

-- | A patch over a pool's override limit. 'Nothing' leaves it unchanged, @Just
-- Nothing@ clears the override (reverts to the default), @Just (Just v)@ sets it.
data ConcurrencyPolicyUpdate = ConcurrencyPolicyUpdate
  { ConcurrencyPolicyUpdate -> Maybe (Maybe Int32)
overrideLimit :: Maybe (Maybe Int32)
  }
  deriving stock (ConcurrencyPolicyUpdate -> ConcurrencyPolicyUpdate -> Bool
(ConcurrencyPolicyUpdate -> ConcurrencyPolicyUpdate -> Bool)
-> (ConcurrencyPolicyUpdate -> ConcurrencyPolicyUpdate -> Bool)
-> Eq ConcurrencyPolicyUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConcurrencyPolicyUpdate -> ConcurrencyPolicyUpdate -> Bool
== :: ConcurrencyPolicyUpdate -> ConcurrencyPolicyUpdate -> Bool
$c/= :: ConcurrencyPolicyUpdate -> ConcurrencyPolicyUpdate -> Bool
/= :: ConcurrencyPolicyUpdate -> ConcurrencyPolicyUpdate -> Bool
Eq, (forall x.
 ConcurrencyPolicyUpdate -> Rep ConcurrencyPolicyUpdate x)
-> (forall x.
    Rep ConcurrencyPolicyUpdate x -> ConcurrencyPolicyUpdate)
-> Generic ConcurrencyPolicyUpdate
forall x. Rep ConcurrencyPolicyUpdate x -> ConcurrencyPolicyUpdate
forall x. ConcurrencyPolicyUpdate -> Rep ConcurrencyPolicyUpdate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConcurrencyPolicyUpdate -> Rep ConcurrencyPolicyUpdate x
from :: forall x. ConcurrencyPolicyUpdate -> Rep ConcurrencyPolicyUpdate x
$cto :: forall x. Rep ConcurrencyPolicyUpdate x -> ConcurrencyPolicyUpdate
to :: forall x. Rep ConcurrencyPolicyUpdate x -> ConcurrencyPolicyUpdate
Generic, Int -> ConcurrencyPolicyUpdate -> ShowS
[ConcurrencyPolicyUpdate] -> ShowS
ConcurrencyPolicyUpdate -> String
(Int -> ConcurrencyPolicyUpdate -> ShowS)
-> (ConcurrencyPolicyUpdate -> String)
-> ([ConcurrencyPolicyUpdate] -> ShowS)
-> Show ConcurrencyPolicyUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConcurrencyPolicyUpdate -> ShowS
showsPrec :: Int -> ConcurrencyPolicyUpdate -> ShowS
$cshow :: ConcurrencyPolicyUpdate -> String
show :: ConcurrencyPolicyUpdate -> String
$cshowList :: [ConcurrencyPolicyUpdate] -> ShowS
showList :: [ConcurrencyPolicyUpdate] -> ShowS
Show)

instance ToJSON ConcurrencyPolicyUpdate where
  toJSON :: ConcurrencyPolicyUpdate -> Value
toJSON = Options -> ConcurrencyPolicyUpdate -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
Aeson.genericToJSON Options
patchOptions
  toEncoding :: ConcurrencyPolicyUpdate -> Encoding
toEncoding = Options -> ConcurrencyPolicyUpdate -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
Aeson.genericToEncoding Options
patchOptions

-- | Hand-written. A missing key leaves the field unchanged. An explicit @null@
-- clears the override.
instance FromJSON ConcurrencyPolicyUpdate where
  parseJSON :: Value -> Parser ConcurrencyPolicyUpdate
parseJSON = String
-> (Object -> Parser ConcurrencyPolicyUpdate)
-> Value
-> Parser ConcurrencyPolicyUpdate
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ConcurrencyPolicyUpdate" ((Object -> Parser ConcurrencyPolicyUpdate)
 -> Value -> Parser ConcurrencyPolicyUpdate)
-> (Object -> Parser ConcurrencyPolicyUpdate)
-> Value
-> Parser ConcurrencyPolicyUpdate
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Maybe (Maybe Int32) -> ConcurrencyPolicyUpdate
ConcurrencyPolicyUpdate (Maybe (Maybe Int32) -> ConcurrencyPolicyUpdate)
-> Parser (Maybe (Maybe Int32)) -> Parser ConcurrencyPolicyUpdate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Text -> Parser (Maybe (Maybe Int32))
forall a. FromJSON a => Object -> Text -> Parser (Maybe (Maybe a))
explicitOptionalField Object
obj Text
"overrideLimit"