module Hasura.RQL.Types.ApiLimit
  ( ApiLimit (..),
    DepthLimit,
    Limit (..),
    MaxDepth (..),
    MaxNodes (..),
    MaxTime (..),
    NodeLimit,
    RateLimit,
    RateLimitConfig (..),
    TimeLimit,
    UniqueParamConfig (..),
    emptyApiLimit,
  )
where

import Control.Lens
import Data.Aeson
import Data.Aeson.Casing qualified as Casing
import Data.Text qualified as T
import Data.Text.Extended (ToTxt (..))
import Hasura.Prelude
import Hasura.Server.Utils (isSessionVariable)
import Hasura.Session (RoleName)

data ApiLimit = ApiLimit
  { ApiLimit -> Maybe RateLimit
_alRateLimit :: Maybe RateLimit,
    ApiLimit -> Maybe DepthLimit
_alDepthLimit :: Maybe DepthLimit,
    ApiLimit -> Maybe NodeLimit
_alNodeLimit :: Maybe NodeLimit,
    ApiLimit -> Maybe TimeLimit
_alTimeLimit :: Maybe TimeLimit,
    ApiLimit -> Bool
_alDisabled :: Bool
  }
  deriving (Int -> ApiLimit -> ShowS
[ApiLimit] -> ShowS
ApiLimit -> String
(Int -> ApiLimit -> ShowS)
-> (ApiLimit -> String) -> ([ApiLimit] -> ShowS) -> Show ApiLimit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiLimit] -> ShowS
$cshowList :: [ApiLimit] -> ShowS
show :: ApiLimit -> String
$cshow :: ApiLimit -> String
showsPrec :: Int -> ApiLimit -> ShowS
$cshowsPrec :: Int -> ApiLimit -> ShowS
Show, ApiLimit -> ApiLimit -> Bool
(ApiLimit -> ApiLimit -> Bool)
-> (ApiLimit -> ApiLimit -> Bool) -> Eq ApiLimit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiLimit -> ApiLimit -> Bool
$c/= :: ApiLimit -> ApiLimit -> Bool
== :: ApiLimit -> ApiLimit -> Bool
$c== :: ApiLimit -> ApiLimit -> Bool
Eq, (forall x. ApiLimit -> Rep ApiLimit x)
-> (forall x. Rep ApiLimit x -> ApiLimit) -> Generic ApiLimit
forall x. Rep ApiLimit x -> ApiLimit
forall x. ApiLimit -> Rep ApiLimit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApiLimit x -> ApiLimit
$cfrom :: forall x. ApiLimit -> Rep ApiLimit x
Generic)

instance FromJSON ApiLimit where
  parseJSON :: Value -> Parser ApiLimit
parseJSON = String -> (Object -> Parser ApiLimit) -> Value -> Parser ApiLimit
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ApiLimit" ((Object -> Parser ApiLimit) -> Value -> Parser ApiLimit)
-> (Object -> Parser ApiLimit) -> Value -> Parser ApiLimit
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe RateLimit
-> Maybe DepthLimit
-> Maybe NodeLimit
-> Maybe TimeLimit
-> Bool
-> ApiLimit
ApiLimit
      (Maybe RateLimit
 -> Maybe DepthLimit
 -> Maybe NodeLimit
 -> Maybe TimeLimit
 -> Bool
 -> ApiLimit)
-> Parser (Maybe RateLimit)
-> Parser
     (Maybe DepthLimit
      -> Maybe NodeLimit -> Maybe TimeLimit -> Bool -> ApiLimit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe RateLimit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rate_limit"
      Parser
  (Maybe DepthLimit
   -> Maybe NodeLimit -> Maybe TimeLimit -> Bool -> ApiLimit)
-> Parser (Maybe DepthLimit)
-> Parser (Maybe NodeLimit -> Maybe TimeLimit -> Bool -> ApiLimit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe DepthLimit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"depth_limit"
      Parser (Maybe NodeLimit -> Maybe TimeLimit -> Bool -> ApiLimit)
-> Parser (Maybe NodeLimit)
-> Parser (Maybe TimeLimit -> Bool -> ApiLimit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe NodeLimit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"node_limit"
      Parser (Maybe TimeLimit -> Bool -> ApiLimit)
-> Parser (Maybe TimeLimit) -> Parser (Bool -> ApiLimit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe TimeLimit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"time_limit"
      Parser (Bool -> ApiLimit) -> Parser Bool -> Parser ApiLimit
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"disabled" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

instance ToJSON ApiLimit where
  toJSON :: ApiLimit -> Value
toJSON =
    Options -> ApiLimit -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (ShowS -> Options
Casing.aesonPrefix ShowS
Casing.snakeCase) {omitNothingFields :: Bool
omitNothingFields = Bool
True}

emptyApiLimit :: ApiLimit
emptyApiLimit :: ApiLimit
emptyApiLimit = Maybe RateLimit
-> Maybe DepthLimit
-> Maybe NodeLimit
-> Maybe TimeLimit
-> Bool
-> ApiLimit
ApiLimit Maybe RateLimit
forall a. Maybe a
Nothing Maybe DepthLimit
forall a. Maybe a
Nothing Maybe NodeLimit
forall a. Maybe a
Nothing Maybe TimeLimit
forall a. Maybe a
Nothing Bool
False

data Limit a = Limit
  { Limit a -> a
_lGlobal :: a,
    Limit a -> InsOrdHashMap RoleName a
_lPerRole :: InsOrdHashMap RoleName a
  }
  deriving (Int -> Limit a -> ShowS
[Limit a] -> ShowS
Limit a -> String
(Int -> Limit a -> ShowS)
-> (Limit a -> String) -> ([Limit a] -> ShowS) -> Show (Limit a)
forall a. Show a => Int -> Limit a -> ShowS
forall a. Show a => [Limit a] -> ShowS
forall a. Show a => Limit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit a] -> ShowS
$cshowList :: forall a. Show a => [Limit a] -> ShowS
show :: Limit a -> String
$cshow :: forall a. Show a => Limit a -> String
showsPrec :: Int -> Limit a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Limit a -> ShowS
Show, Limit a -> Limit a -> Bool
(Limit a -> Limit a -> Bool)
-> (Limit a -> Limit a -> Bool) -> Eq (Limit a)
forall a. Eq a => Limit a -> Limit a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limit a -> Limit a -> Bool
$c/= :: forall a. Eq a => Limit a -> Limit a -> Bool
== :: Limit a -> Limit a -> Bool
$c== :: forall a. Eq a => Limit a -> Limit a -> Bool
Eq, (forall x. Limit a -> Rep (Limit a) x)
-> (forall x. Rep (Limit a) x -> Limit a) -> Generic (Limit a)
forall x. Rep (Limit a) x -> Limit a
forall x. Limit a -> Rep (Limit a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Limit a) x -> Limit a
forall a x. Limit a -> Rep (Limit a) x
$cto :: forall a x. Rep (Limit a) x -> Limit a
$cfrom :: forall a x. Limit a -> Rep (Limit a) x
Generic)

instance FromJSON a => FromJSON (Limit a) where
  parseJSON :: Value -> Parser (Limit a)
parseJSON = String -> (Object -> Parser (Limit a)) -> Value -> Parser (Limit a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Limit" ((Object -> Parser (Limit a)) -> Value -> Parser (Limit a))
-> (Object -> Parser (Limit a)) -> Value -> Parser (Limit a)
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    a -> InsOrdHashMap RoleName a -> Limit a
forall a. a -> InsOrdHashMap RoleName a -> Limit a
Limit (a -> InsOrdHashMap RoleName a -> Limit a)
-> Parser a -> Parser (InsOrdHashMap RoleName a -> Limit a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"global" Parser (InsOrdHashMap RoleName a -> Limit a)
-> Parser (InsOrdHashMap RoleName a) -> Parser (Limit a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (InsOrdHashMap RoleName a))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"per_role" Parser (Maybe (InsOrdHashMap RoleName a))
-> InsOrdHashMap RoleName a -> Parser (InsOrdHashMap RoleName a)
forall a. Parser (Maybe a) -> a -> Parser a
.!= InsOrdHashMap RoleName a
forall a. Monoid a => a
mempty

instance ToJSON a => ToJSON (Limit a) where
  toJSON :: Limit a -> Value
toJSON =
    Options -> Limit a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (ShowS -> Options
Casing.aesonPrefix ShowS
Casing.snakeCase)

type RateLimit = Limit RateLimitConfig

type DepthLimit = Limit MaxDepth

type NodeLimit = Limit MaxNodes

type TimeLimit = Limit MaxTime

data RateLimitConfig = RateLimitConfig
  { RateLimitConfig -> Int
_rlcMaxReqsPerMin :: Int,
    RateLimitConfig -> Maybe UniqueParamConfig
_rlcUniqueParams :: Maybe UniqueParamConfig
  }
  deriving (Int -> RateLimitConfig -> ShowS
[RateLimitConfig] -> ShowS
RateLimitConfig -> String
(Int -> RateLimitConfig -> ShowS)
-> (RateLimitConfig -> String)
-> ([RateLimitConfig] -> ShowS)
-> Show RateLimitConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RateLimitConfig] -> ShowS
$cshowList :: [RateLimitConfig] -> ShowS
show :: RateLimitConfig -> String
$cshow :: RateLimitConfig -> String
showsPrec :: Int -> RateLimitConfig -> ShowS
$cshowsPrec :: Int -> RateLimitConfig -> ShowS
Show, RateLimitConfig -> RateLimitConfig -> Bool
(RateLimitConfig -> RateLimitConfig -> Bool)
-> (RateLimitConfig -> RateLimitConfig -> Bool)
-> Eq RateLimitConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RateLimitConfig -> RateLimitConfig -> Bool
$c/= :: RateLimitConfig -> RateLimitConfig -> Bool
== :: RateLimitConfig -> RateLimitConfig -> Bool
$c== :: RateLimitConfig -> RateLimitConfig -> Bool
Eq, (forall x. RateLimitConfig -> Rep RateLimitConfig x)
-> (forall x. Rep RateLimitConfig x -> RateLimitConfig)
-> Generic RateLimitConfig
forall x. Rep RateLimitConfig x -> RateLimitConfig
forall x. RateLimitConfig -> Rep RateLimitConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RateLimitConfig x -> RateLimitConfig
$cfrom :: forall x. RateLimitConfig -> Rep RateLimitConfig x
Generic)

instance FromJSON RateLimitConfig where
  parseJSON :: Value -> Parser RateLimitConfig
parseJSON =
    Options -> Value -> Parser RateLimitConfig
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (ShowS -> Options
Casing.aesonPrefix ShowS
Casing.snakeCase)

instance ToJSON RateLimitConfig where
  toJSON :: RateLimitConfig -> Value
toJSON =
    Options -> RateLimitConfig -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON (ShowS -> Options
Casing.aesonPrefix ShowS
Casing.snakeCase)

-- | The unique key using which an authenticated client can be identified
data UniqueParamConfig
  = -- | it can be a list of session variable (like session var in 'UserInfo')
    UPCSessionVar [Text]
  | -- | or it can be an IP address
    UPCIpAddress
  deriving (Int -> UniqueParamConfig -> ShowS
[UniqueParamConfig] -> ShowS
UniqueParamConfig -> String
(Int -> UniqueParamConfig -> ShowS)
-> (UniqueParamConfig -> String)
-> ([UniqueParamConfig] -> ShowS)
-> Show UniqueParamConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UniqueParamConfig] -> ShowS
$cshowList :: [UniqueParamConfig] -> ShowS
show :: UniqueParamConfig -> String
$cshow :: UniqueParamConfig -> String
showsPrec :: Int -> UniqueParamConfig -> ShowS
$cshowsPrec :: Int -> UniqueParamConfig -> ShowS
Show, UniqueParamConfig -> UniqueParamConfig -> Bool
(UniqueParamConfig -> UniqueParamConfig -> Bool)
-> (UniqueParamConfig -> UniqueParamConfig -> Bool)
-> Eq UniqueParamConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UniqueParamConfig -> UniqueParamConfig -> Bool
$c/= :: UniqueParamConfig -> UniqueParamConfig -> Bool
== :: UniqueParamConfig -> UniqueParamConfig -> Bool
$c== :: UniqueParamConfig -> UniqueParamConfig -> Bool
Eq, (forall x. UniqueParamConfig -> Rep UniqueParamConfig x)
-> (forall x. Rep UniqueParamConfig x -> UniqueParamConfig)
-> Generic UniqueParamConfig
forall x. Rep UniqueParamConfig x -> UniqueParamConfig
forall x. UniqueParamConfig -> Rep UniqueParamConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UniqueParamConfig x -> UniqueParamConfig
$cfrom :: forall x. UniqueParamConfig -> Rep UniqueParamConfig x
Generic)

instance ToJSON UniqueParamConfig where
  toJSON :: UniqueParamConfig -> Value
toJSON = \case
    UPCSessionVar [Text]
xs -> [Text] -> Value
forall a. ToJSON a => a -> Value
toJSON [Text]
xs
    UniqueParamConfig
UPCIpAddress -> Value
"IP"

instance FromJSON UniqueParamConfig where
  parseJSON :: Value -> Parser UniqueParamConfig
parseJSON = \case
    String Text
v -> case Text -> Text
T.toLower Text
v of
      Text
"ip" -> UniqueParamConfig -> Parser UniqueParamConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure UniqueParamConfig
UPCIpAddress
      Text
_ -> String -> Parser UniqueParamConfig
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errMsg
    Array Array
xs -> (Value -> Parser Text) -> Array -> Parser (Vector Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser Text
parseSessVar Array
xs Parser (Vector Text)
-> (Vector Text -> UniqueParamConfig) -> Parser UniqueParamConfig
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Text] -> UniqueParamConfig
UPCSessionVar ([Text] -> UniqueParamConfig)
-> (Vector Text -> [Text]) -> Vector Text -> UniqueParamConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    Value
_ -> String -> Parser UniqueParamConfig
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errMsg
    where
      parseSessVar :: Value -> Parser Text
parseSessVar = \case
        String Text
s
          | Text -> Bool
isSessionVariable Text
s Bool -> Bool -> Bool
&& Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"x-hasura-role" -> Text -> Parser Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
s
          | Bool
otherwise -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errMsg
        Value
_ -> String -> Parser Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errMsg
      errMsg :: String
errMsg = String
"Not a valid value. Should be either: 'IP' or a list of Hasura session variables"

newtype MaxDepth = MaxDepth {MaxDepth -> Int
unMaxDepth :: Int}
  deriving stock (Int -> MaxDepth -> ShowS
[MaxDepth] -> ShowS
MaxDepth -> String
(Int -> MaxDepth -> ShowS)
-> (MaxDepth -> String) -> ([MaxDepth] -> ShowS) -> Show MaxDepth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxDepth] -> ShowS
$cshowList :: [MaxDepth] -> ShowS
show :: MaxDepth -> String
$cshow :: MaxDepth -> String
showsPrec :: Int -> MaxDepth -> ShowS
$cshowsPrec :: Int -> MaxDepth -> ShowS
Show, MaxDepth -> MaxDepth -> Bool
(MaxDepth -> MaxDepth -> Bool)
-> (MaxDepth -> MaxDepth -> Bool) -> Eq MaxDepth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxDepth -> MaxDepth -> Bool
$c/= :: MaxDepth -> MaxDepth -> Bool
== :: MaxDepth -> MaxDepth -> Bool
$c== :: MaxDepth -> MaxDepth -> Bool
Eq, Eq MaxDepth
Eq MaxDepth
-> (MaxDepth -> MaxDepth -> Ordering)
-> (MaxDepth -> MaxDepth -> Bool)
-> (MaxDepth -> MaxDepth -> Bool)
-> (MaxDepth -> MaxDepth -> Bool)
-> (MaxDepth -> MaxDepth -> Bool)
-> (MaxDepth -> MaxDepth -> MaxDepth)
-> (MaxDepth -> MaxDepth -> MaxDepth)
-> Ord MaxDepth
MaxDepth -> MaxDepth -> Bool
MaxDepth -> MaxDepth -> Ordering
MaxDepth -> MaxDepth -> MaxDepth
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MaxDepth -> MaxDepth -> MaxDepth
$cmin :: MaxDepth -> MaxDepth -> MaxDepth
max :: MaxDepth -> MaxDepth -> MaxDepth
$cmax :: MaxDepth -> MaxDepth -> MaxDepth
>= :: MaxDepth -> MaxDepth -> Bool
$c>= :: MaxDepth -> MaxDepth -> Bool
> :: MaxDepth -> MaxDepth -> Bool
$c> :: MaxDepth -> MaxDepth -> Bool
<= :: MaxDepth -> MaxDepth -> Bool
$c<= :: MaxDepth -> MaxDepth -> Bool
< :: MaxDepth -> MaxDepth -> Bool
$c< :: MaxDepth -> MaxDepth -> Bool
compare :: MaxDepth -> MaxDepth -> Ordering
$ccompare :: MaxDepth -> MaxDepth -> Ordering
$cp1Ord :: Eq MaxDepth
Ord, (forall x. MaxDepth -> Rep MaxDepth x)
-> (forall x. Rep MaxDepth x -> MaxDepth) -> Generic MaxDepth
forall x. Rep MaxDepth x -> MaxDepth
forall x. MaxDepth -> Rep MaxDepth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MaxDepth x -> MaxDepth
$cfrom :: forall x. MaxDepth -> Rep MaxDepth x
Generic)
  deriving newtype ([MaxDepth] -> Value
[MaxDepth] -> Encoding
MaxDepth -> Value
MaxDepth -> Encoding
(MaxDepth -> Value)
-> (MaxDepth -> Encoding)
-> ([MaxDepth] -> Value)
-> ([MaxDepth] -> Encoding)
-> ToJSON MaxDepth
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MaxDepth] -> Encoding
$ctoEncodingList :: [MaxDepth] -> Encoding
toJSONList :: [MaxDepth] -> Value
$ctoJSONList :: [MaxDepth] -> Value
toEncoding :: MaxDepth -> Encoding
$ctoEncoding :: MaxDepth -> Encoding
toJSON :: MaxDepth -> Value
$ctoJSON :: MaxDepth -> Value
ToJSON, Value -> Parser [MaxDepth]
Value -> Parser MaxDepth
(Value -> Parser MaxDepth)
-> (Value -> Parser [MaxDepth]) -> FromJSON MaxDepth
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MaxDepth]
$cparseJSONList :: Value -> Parser [MaxDepth]
parseJSON :: Value -> Parser MaxDepth
$cparseJSON :: Value -> Parser MaxDepth
FromJSON)

newtype MaxNodes = MaxNodes {MaxNodes -> Int
unMaxNodes :: Int}
  deriving stock (Int -> MaxNodes -> ShowS
[MaxNodes] -> ShowS
MaxNodes -> String
(Int -> MaxNodes -> ShowS)
-> (MaxNodes -> String) -> ([MaxNodes] -> ShowS) -> Show MaxNodes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxNodes] -> ShowS
$cshowList :: [MaxNodes] -> ShowS
show :: MaxNodes -> String
$cshow :: MaxNodes -> String
showsPrec :: Int -> MaxNodes -> ShowS
$cshowsPrec :: Int -> MaxNodes -> ShowS
Show, MaxNodes -> MaxNodes -> Bool
(MaxNodes -> MaxNodes -> Bool)
-> (MaxNodes -> MaxNodes -> Bool) -> Eq MaxNodes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxNodes -> MaxNodes -> Bool
$c/= :: MaxNodes -> MaxNodes -> Bool
== :: MaxNodes -> MaxNodes -> Bool
$c== :: MaxNodes -> MaxNodes -> Bool
Eq, Eq MaxNodes
Eq MaxNodes
-> (MaxNodes -> MaxNodes -> Ordering)
-> (MaxNodes -> MaxNodes -> Bool)
-> (MaxNodes -> MaxNodes -> Bool)
-> (MaxNodes -> MaxNodes -> Bool)
-> (MaxNodes -> MaxNodes -> Bool)
-> (MaxNodes -> MaxNodes -> MaxNodes)
-> (MaxNodes -> MaxNodes -> MaxNodes)
-> Ord MaxNodes
MaxNodes -> MaxNodes -> Bool
MaxNodes -> MaxNodes -> Ordering
MaxNodes -> MaxNodes -> MaxNodes
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MaxNodes -> MaxNodes -> MaxNodes
$cmin :: MaxNodes -> MaxNodes -> MaxNodes
max :: MaxNodes -> MaxNodes -> MaxNodes
$cmax :: MaxNodes -> MaxNodes -> MaxNodes
>= :: MaxNodes -> MaxNodes -> Bool
$c>= :: MaxNodes -> MaxNodes -> Bool
> :: MaxNodes -> MaxNodes -> Bool
$c> :: MaxNodes -> MaxNodes -> Bool
<= :: MaxNodes -> MaxNodes -> Bool
$c<= :: MaxNodes -> MaxNodes -> Bool
< :: MaxNodes -> MaxNodes -> Bool
$c< :: MaxNodes -> MaxNodes -> Bool
compare :: MaxNodes -> MaxNodes -> Ordering
$ccompare :: MaxNodes -> MaxNodes -> Ordering
$cp1Ord :: Eq MaxNodes
Ord, (forall x. MaxNodes -> Rep MaxNodes x)
-> (forall x. Rep MaxNodes x -> MaxNodes) -> Generic MaxNodes
forall x. Rep MaxNodes x -> MaxNodes
forall x. MaxNodes -> Rep MaxNodes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MaxNodes x -> MaxNodes
$cfrom :: forall x. MaxNodes -> Rep MaxNodes x
Generic)
  deriving newtype ([MaxNodes] -> Value
[MaxNodes] -> Encoding
MaxNodes -> Value
MaxNodes -> Encoding
(MaxNodes -> Value)
-> (MaxNodes -> Encoding)
-> ([MaxNodes] -> Value)
-> ([MaxNodes] -> Encoding)
-> ToJSON MaxNodes
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MaxNodes] -> Encoding
$ctoEncodingList :: [MaxNodes] -> Encoding
toJSONList :: [MaxNodes] -> Value
$ctoJSONList :: [MaxNodes] -> Value
toEncoding :: MaxNodes -> Encoding
$ctoEncoding :: MaxNodes -> Encoding
toJSON :: MaxNodes -> Value
$ctoJSON :: MaxNodes -> Value
ToJSON, Value -> Parser [MaxNodes]
Value -> Parser MaxNodes
(Value -> Parser MaxNodes)
-> (Value -> Parser [MaxNodes]) -> FromJSON MaxNodes
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MaxNodes]
$cparseJSONList :: Value -> Parser [MaxNodes]
parseJSON :: Value -> Parser MaxNodes
$cparseJSON :: Value -> Parser MaxNodes
FromJSON)

newtype MaxTime = MaxTime {MaxTime -> Seconds
unMaxTime :: Seconds}
  deriving stock (Int -> MaxTime -> ShowS
[MaxTime] -> ShowS
MaxTime -> String
(Int -> MaxTime -> ShowS)
-> (MaxTime -> String) -> ([MaxTime] -> ShowS) -> Show MaxTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxTime] -> ShowS
$cshowList :: [MaxTime] -> ShowS
show :: MaxTime -> String
$cshow :: MaxTime -> String
showsPrec :: Int -> MaxTime -> ShowS
$cshowsPrec :: Int -> MaxTime -> ShowS
Show, MaxTime -> MaxTime -> Bool
(MaxTime -> MaxTime -> Bool)
-> (MaxTime -> MaxTime -> Bool) -> Eq MaxTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MaxTime -> MaxTime -> Bool
$c/= :: MaxTime -> MaxTime -> Bool
== :: MaxTime -> MaxTime -> Bool
$c== :: MaxTime -> MaxTime -> Bool
Eq, Eq MaxTime
Eq MaxTime
-> (MaxTime -> MaxTime -> Ordering)
-> (MaxTime -> MaxTime -> Bool)
-> (MaxTime -> MaxTime -> Bool)
-> (MaxTime -> MaxTime -> Bool)
-> (MaxTime -> MaxTime -> Bool)
-> (MaxTime -> MaxTime -> MaxTime)
-> (MaxTime -> MaxTime -> MaxTime)
-> Ord MaxTime
MaxTime -> MaxTime -> Bool
MaxTime -> MaxTime -> Ordering
MaxTime -> MaxTime -> MaxTime
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MaxTime -> MaxTime -> MaxTime
$cmin :: MaxTime -> MaxTime -> MaxTime
max :: MaxTime -> MaxTime -> MaxTime
$cmax :: MaxTime -> MaxTime -> MaxTime
>= :: MaxTime -> MaxTime -> Bool
$c>= :: MaxTime -> MaxTime -> Bool
> :: MaxTime -> MaxTime -> Bool
$c> :: MaxTime -> MaxTime -> Bool
<= :: MaxTime -> MaxTime -> Bool
$c<= :: MaxTime -> MaxTime -> Bool
< :: MaxTime -> MaxTime -> Bool
$c< :: MaxTime -> MaxTime -> Bool
compare :: MaxTime -> MaxTime -> Ordering
$ccompare :: MaxTime -> MaxTime -> Ordering
$cp1Ord :: Eq MaxTime
Ord, (forall x. MaxTime -> Rep MaxTime x)
-> (forall x. Rep MaxTime x -> MaxTime) -> Generic MaxTime
forall x. Rep MaxTime x -> MaxTime
forall x. MaxTime -> Rep MaxTime x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MaxTime x -> MaxTime
$cfrom :: forall x. MaxTime -> Rep MaxTime x
Generic)
  deriving newtype ([MaxTime] -> Value
[MaxTime] -> Encoding
MaxTime -> Value
MaxTime -> Encoding
(MaxTime -> Value)
-> (MaxTime -> Encoding)
-> ([MaxTime] -> Value)
-> ([MaxTime] -> Encoding)
-> ToJSON MaxTime
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MaxTime] -> Encoding
$ctoEncodingList :: [MaxTime] -> Encoding
toJSONList :: [MaxTime] -> Value
$ctoJSONList :: [MaxTime] -> Value
toEncoding :: MaxTime -> Encoding
$ctoEncoding :: MaxTime -> Encoding
toJSON :: MaxTime -> Value
$ctoJSON :: MaxTime -> Value
ToJSON, Value -> Parser [MaxTime]
Value -> Parser MaxTime
(Value -> Parser MaxTime)
-> (Value -> Parser [MaxTime]) -> FromJSON MaxTime
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MaxTime]
$cparseJSONList :: Value -> Parser [MaxTime]
parseJSON :: Value -> Parser MaxTime
$cparseJSON :: Value -> Parser MaxTime
FromJSON)

-- | Defers to the (illegal) DiffTime Show instance.
--
-- >>> toTxt (MaxTime 2.5)
-- "2.5s"
instance ToTxt MaxTime where
  toTxt :: MaxTime -> Text
toTxt (MaxTime Seconds
t) = DiffTime -> Text
forall a. Show a => a -> Text
tshow (DiffTime -> Text) -> DiffTime -> Text
forall a b. (a -> b) -> a -> b
$ Seconds -> DiffTime
seconds Seconds
t