{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

{- |
Module      : Unleash.Internal.JsonTypes
Copyright   : Copyright © FINN.no AS, Inc. All rights reserved.
License     : MIT
Stability   : experimental

Unleash domain transfer objects.
-}
module Unleash.Internal.JsonTypes (
    Features (..),
    Feature (..),
    Strategy (..),
    Constraint (..),
    Variant (..),
    Payload (..),
    Override (..),
    Context (..),
    emptyContext,
    Segment (..),
    VariantResponse (..),
    emptyVariantResponse,
    MetricsPayload (..),
    FullMetricsPayload (..),
    FullMetricsBucket (..),
    YesAndNoes (..),
    FullRegisterPayload (..),
    RegisterPayload (..),
) where

import Data.Aeson (FromJSON, Options (..), ToJSON (toJSON), defaultOptions, genericParseJSON, genericToJSON)
import Data.Aeson.Types (parseJSON)
import Data.Map.Strict (Map)
import Data.Text (Text)
import Data.Time (UTCTime)
import GHC.Generics (Generic)

-- | Feature toggle set.
data Features = Features
    { Features -> Int
version :: Int,
      Features -> [Feature]
features :: [Feature],
      Features -> Maybe [Segment]
segments :: Maybe [Segment]
    }
    deriving stock (Features -> Features -> Bool
(Features -> Features -> Bool)
-> (Features -> Features -> Bool) -> Eq Features
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Features -> Features -> Bool
== :: Features -> Features -> Bool
$c/= :: Features -> Features -> Bool
/= :: Features -> Features -> Bool
Eq, Int -> Features -> ShowS
[Features] -> ShowS
Features -> String
(Int -> Features -> ShowS)
-> (Features -> String) -> ([Features] -> ShowS) -> Show Features
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Features -> ShowS
showsPrec :: Int -> Features -> ShowS
$cshow :: Features -> String
show :: Features -> String
$cshowList :: [Features] -> ShowS
showList :: [Features] -> ShowS
Show, (forall x. Features -> Rep Features x)
-> (forall x. Rep Features x -> Features) -> Generic Features
forall x. Rep Features x -> Features
forall x. Features -> Rep Features x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Features -> Rep Features x
from :: forall x. Features -> Rep Features x
$cto :: forall x. Rep Features x -> Features
to :: forall x. Rep Features x -> Features
Generic)
    deriving anyclass (Value -> Parser [Features]
Value -> Parser Features
(Value -> Parser Features)
-> (Value -> Parser [Features]) -> FromJSON Features
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Features
parseJSON :: Value -> Parser Features
$cparseJSONList :: Value -> Parser [Features]
parseJSONList :: Value -> Parser [Features]
FromJSON, [Features] -> Value
[Features] -> Encoding
Features -> Value
Features -> Encoding
(Features -> Value)
-> (Features -> Encoding)
-> ([Features] -> Value)
-> ([Features] -> Encoding)
-> ToJSON Features
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Features -> Value
toJSON :: Features -> Value
$ctoEncoding :: Features -> Encoding
toEncoding :: Features -> Encoding
$ctoJSONList :: [Features] -> Value
toJSONList :: [Features] -> Value
$ctoEncodingList :: [Features] -> Encoding
toEncodingList :: [Features] -> Encoding
ToJSON)

-- | Feature toggle.
data Feature = Feature
    { Feature -> Text
name :: Text,
      Feature -> Maybe Text
description :: Maybe Text,
      Feature -> Bool
enabled :: Bool,
      Feature -> [Strategy]
strategies :: [Strategy],
      Feature -> Maybe [Variant]
variants :: Maybe [Variant]
    }
    deriving stock (Feature -> Feature -> Bool
(Feature -> Feature -> Bool)
-> (Feature -> Feature -> Bool) -> Eq Feature
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Feature -> Feature -> Bool
== :: Feature -> Feature -> Bool
$c/= :: Feature -> Feature -> Bool
/= :: Feature -> Feature -> Bool
Eq, Int -> Feature -> ShowS
[Feature] -> ShowS
Feature -> String
(Int -> Feature -> ShowS)
-> (Feature -> String) -> ([Feature] -> ShowS) -> Show Feature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Feature -> ShowS
showsPrec :: Int -> Feature -> ShowS
$cshow :: Feature -> String
show :: Feature -> String
$cshowList :: [Feature] -> ShowS
showList :: [Feature] -> ShowS
Show, (forall x. Feature -> Rep Feature x)
-> (forall x. Rep Feature x -> Feature) -> Generic Feature
forall x. Rep Feature x -> Feature
forall x. Feature -> Rep Feature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Feature -> Rep Feature x
from :: forall x. Feature -> Rep Feature x
$cto :: forall x. Rep Feature x -> Feature
to :: forall x. Rep Feature x -> Feature
Generic)
    deriving anyclass (Value -> Parser [Feature]
Value -> Parser Feature
(Value -> Parser Feature)
-> (Value -> Parser [Feature]) -> FromJSON Feature
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Feature
parseJSON :: Value -> Parser Feature
$cparseJSONList :: Value -> Parser [Feature]
parseJSONList :: Value -> Parser [Feature]
FromJSON, [Feature] -> Value
[Feature] -> Encoding
Feature -> Value
Feature -> Encoding
(Feature -> Value)
-> (Feature -> Encoding)
-> ([Feature] -> Value)
-> ([Feature] -> Encoding)
-> ToJSON Feature
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Feature -> Value
toJSON :: Feature -> Value
$ctoEncoding :: Feature -> Encoding
toEncoding :: Feature -> Encoding
$ctoJSONList :: [Feature] -> Value
toJSONList :: [Feature] -> Value
$ctoEncodingList :: [Feature] -> Encoding
toEncodingList :: [Feature] -> Encoding
ToJSON)

-- | Strategy. Encompasses all (supported) types of strategies.
data Strategy = Strategy
    { Strategy -> Text
name :: Text,
      Strategy -> Maybe (Map Text Text)
parameters :: Maybe (Map Text Text),
      Strategy -> Maybe [Constraint]
constraints :: Maybe [Constraint],
      Strategy -> Maybe [Int]
segments :: Maybe [Int]
    }
    deriving stock (Strategy -> Strategy -> Bool
(Strategy -> Strategy -> Bool)
-> (Strategy -> Strategy -> Bool) -> Eq Strategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Strategy -> Strategy -> Bool
== :: Strategy -> Strategy -> Bool
$c/= :: Strategy -> Strategy -> Bool
/= :: Strategy -> Strategy -> Bool
Eq, Int -> Strategy -> ShowS
[Strategy] -> ShowS
Strategy -> String
(Int -> Strategy -> ShowS)
-> (Strategy -> String) -> ([Strategy] -> ShowS) -> Show Strategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Strategy -> ShowS
showsPrec :: Int -> Strategy -> ShowS
$cshow :: Strategy -> String
show :: Strategy -> String
$cshowList :: [Strategy] -> ShowS
showList :: [Strategy] -> ShowS
Show, (forall x. Strategy -> Rep Strategy x)
-> (forall x. Rep Strategy x -> Strategy) -> Generic Strategy
forall x. Rep Strategy x -> Strategy
forall x. Strategy -> Rep Strategy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Strategy -> Rep Strategy x
from :: forall x. Strategy -> Rep Strategy x
$cto :: forall x. Rep Strategy x -> Strategy
to :: forall x. Rep Strategy x -> Strategy
Generic)
    deriving anyclass (Value -> Parser [Strategy]
Value -> Parser Strategy
(Value -> Parser Strategy)
-> (Value -> Parser [Strategy]) -> FromJSON Strategy
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Strategy
parseJSON :: Value -> Parser Strategy
$cparseJSONList :: Value -> Parser [Strategy]
parseJSONList :: Value -> Parser [Strategy]
FromJSON, [Strategy] -> Value
[Strategy] -> Encoding
Strategy -> Value
Strategy -> Encoding
(Strategy -> Value)
-> (Strategy -> Encoding)
-> ([Strategy] -> Value)
-> ([Strategy] -> Encoding)
-> ToJSON Strategy
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Strategy -> Value
toJSON :: Strategy -> Value
$ctoEncoding :: Strategy -> Encoding
toEncoding :: Strategy -> Encoding
$ctoJSONList :: [Strategy] -> Value
toJSONList :: [Strategy] -> Value
$ctoEncodingList :: [Strategy] -> Encoding
toEncodingList :: [Strategy] -> Encoding
ToJSON)

-- | Strategy constraint.
data Constraint = Constraint
    { Constraint -> Text
contextName :: Text,
      Constraint -> Text
operator :: Text,
      Constraint -> Maybe [Text]
values :: Maybe [Text],
      Constraint -> Maybe Bool
caseInsensitive :: Maybe Bool,
      Constraint -> Maybe Bool
inverted :: Maybe Bool,
      Constraint -> Maybe Text
value :: Maybe Text
    }
    deriving stock (Constraint -> Constraint -> Bool
(Constraint -> Constraint -> Bool)
-> (Constraint -> Constraint -> Bool) -> Eq Constraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Constraint -> Constraint -> Bool
== :: Constraint -> Constraint -> Bool
$c/= :: Constraint -> Constraint -> Bool
/= :: Constraint -> Constraint -> Bool
Eq, Int -> Constraint -> ShowS
[Constraint] -> ShowS
Constraint -> String
(Int -> Constraint -> ShowS)
-> (Constraint -> String)
-> ([Constraint] -> ShowS)
-> Show Constraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Constraint -> ShowS
showsPrec :: Int -> Constraint -> ShowS
$cshow :: Constraint -> String
show :: Constraint -> String
$cshowList :: [Constraint] -> ShowS
showList :: [Constraint] -> ShowS
Show, (forall x. Constraint -> Rep Constraint x)
-> (forall x. Rep Constraint x -> Constraint) -> Generic Constraint
forall x. Rep Constraint x -> Constraint
forall x. Constraint -> Rep Constraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Constraint -> Rep Constraint x
from :: forall x. Constraint -> Rep Constraint x
$cto :: forall x. Rep Constraint x -> Constraint
to :: forall x. Rep Constraint x -> Constraint
Generic)
    deriving anyclass (Value -> Parser [Constraint]
Value -> Parser Constraint
(Value -> Parser Constraint)
-> (Value -> Parser [Constraint]) -> FromJSON Constraint
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Constraint
parseJSON :: Value -> Parser Constraint
$cparseJSONList :: Value -> Parser [Constraint]
parseJSONList :: Value -> Parser [Constraint]
FromJSON, [Constraint] -> Value
[Constraint] -> Encoding
Constraint -> Value
Constraint -> Encoding
(Constraint -> Value)
-> (Constraint -> Encoding)
-> ([Constraint] -> Value)
-> ([Constraint] -> Encoding)
-> ToJSON Constraint
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Constraint -> Value
toJSON :: Constraint -> Value
$ctoEncoding :: Constraint -> Encoding
toEncoding :: Constraint -> Encoding
$ctoJSONList :: [Constraint] -> Value
toJSONList :: [Constraint] -> Value
$ctoEncodingList :: [Constraint] -> Encoding
toEncodingList :: [Constraint] -> Encoding
ToJSON)

-- | Variant.
data Variant = Variant
    { Variant -> Text
name :: Text,
      Variant -> Maybe Payload
payload :: Maybe Payload,
      Variant -> Int
weight :: Int,
      Variant -> Maybe Text
stickiness :: Maybe Text,
      Variant -> Maybe [Override]
overrides :: Maybe [Override]
    }
    deriving stock (Variant -> Variant -> Bool
(Variant -> Variant -> Bool)
-> (Variant -> Variant -> Bool) -> Eq Variant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Variant -> Variant -> Bool
== :: Variant -> Variant -> Bool
$c/= :: Variant -> Variant -> Bool
/= :: Variant -> Variant -> Bool
Eq, Int -> Variant -> ShowS
[Variant] -> ShowS
Variant -> String
(Int -> Variant -> ShowS)
-> (Variant -> String) -> ([Variant] -> ShowS) -> Show Variant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Variant -> ShowS
showsPrec :: Int -> Variant -> ShowS
$cshow :: Variant -> String
show :: Variant -> String
$cshowList :: [Variant] -> ShowS
showList :: [Variant] -> ShowS
Show, (forall x. Variant -> Rep Variant x)
-> (forall x. Rep Variant x -> Variant) -> Generic Variant
forall x. Rep Variant x -> Variant
forall x. Variant -> Rep Variant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Variant -> Rep Variant x
from :: forall x. Variant -> Rep Variant x
$cto :: forall x. Rep Variant x -> Variant
to :: forall x. Rep Variant x -> Variant
Generic)
    deriving anyclass (Value -> Parser [Variant]
Value -> Parser Variant
(Value -> Parser Variant)
-> (Value -> Parser [Variant]) -> FromJSON Variant
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Variant
parseJSON :: Value -> Parser Variant
$cparseJSONList :: Value -> Parser [Variant]
parseJSONList :: Value -> Parser [Variant]
FromJSON, [Variant] -> Value
[Variant] -> Encoding
Variant -> Value
Variant -> Encoding
(Variant -> Value)
-> (Variant -> Encoding)
-> ([Variant] -> Value)
-> ([Variant] -> Encoding)
-> ToJSON Variant
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Variant -> Value
toJSON :: Variant -> Value
$ctoEncoding :: Variant -> Encoding
toEncoding :: Variant -> Encoding
$ctoJSONList :: [Variant] -> Value
toJSONList :: [Variant] -> Value
$ctoEncodingList :: [Variant] -> Encoding
toEncodingList :: [Variant] -> Encoding
ToJSON)

typeWorkAroundOptions :: Options
typeWorkAroundOptions :: Options
typeWorkAroundOptions =
    Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
typeWorkaround}
    where
        typeWorkaround :: String -> String
        typeWorkaround :: ShowS
typeWorkaround String
s = case String
s of
            String
"type" -> String
"type_"
            String
"type_" -> String
"type"
            String
_ -> String
s

-- | Variant payload.
data Payload = Payload
    { -- | Payload type.
      Payload -> Text
type_ :: Text,
      -- | Payload.
      Payload -> Text
value :: Text
    }
    deriving stock (Payload -> Payload -> Bool
(Payload -> Payload -> Bool)
-> (Payload -> Payload -> Bool) -> Eq Payload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Payload -> Payload -> Bool
== :: Payload -> Payload -> Bool
$c/= :: Payload -> Payload -> Bool
/= :: Payload -> Payload -> Bool
Eq, Int -> Payload -> ShowS
[Payload] -> ShowS
Payload -> String
(Int -> Payload -> ShowS)
-> (Payload -> String) -> ([Payload] -> ShowS) -> Show Payload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Payload -> ShowS
showsPrec :: Int -> Payload -> ShowS
$cshow :: Payload -> String
show :: Payload -> String
$cshowList :: [Payload] -> ShowS
showList :: [Payload] -> ShowS
Show, (forall x. Payload -> Rep Payload x)
-> (forall x. Rep Payload x -> Payload) -> Generic Payload
forall x. Rep Payload x -> Payload
forall x. Payload -> Rep Payload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Payload -> Rep Payload x
from :: forall x. Payload -> Rep Payload x
$cto :: forall x. Rep Payload x -> Payload
to :: forall x. Rep Payload x -> Payload
Generic)

instance FromJSON Payload where
    parseJSON :: Value -> Parser Payload
parseJSON = Options -> Value -> Parser Payload
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
typeWorkAroundOptions

instance ToJSON Payload where
    toJSON :: Payload -> Value
toJSON = Options -> Payload -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
typeWorkAroundOptions

-- | Contextual override.
data Override = Override
    { Override -> Text
contextName :: Text,
      Override -> [Text]
values :: [Text]
    }
    deriving stock (Override -> Override -> Bool
(Override -> Override -> Bool)
-> (Override -> Override -> Bool) -> Eq Override
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Override -> Override -> Bool
== :: Override -> Override -> Bool
$c/= :: Override -> Override -> Bool
/= :: Override -> Override -> Bool
Eq, Int -> Override -> ShowS
[Override] -> ShowS
Override -> String
(Int -> Override -> ShowS)
-> (Override -> String) -> ([Override] -> ShowS) -> Show Override
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Override -> ShowS
showsPrec :: Int -> Override -> ShowS
$cshow :: Override -> String
show :: Override -> String
$cshowList :: [Override] -> ShowS
showList :: [Override] -> ShowS
Show, (forall x. Override -> Rep Override x)
-> (forall x. Rep Override x -> Override) -> Generic Override
forall x. Rep Override x -> Override
forall x. Override -> Rep Override x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Override -> Rep Override x
from :: forall x. Override -> Rep Override x
$cto :: forall x. Rep Override x -> Override
to :: forall x. Rep Override x -> Override
Generic)
    deriving anyclass (Value -> Parser [Override]
Value -> Parser Override
(Value -> Parser Override)
-> (Value -> Parser [Override]) -> FromJSON Override
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Override
parseJSON :: Value -> Parser Override
$cparseJSONList :: Value -> Parser [Override]
parseJSONList :: Value -> Parser [Override]
FromJSON, [Override] -> Value
[Override] -> Encoding
Override -> Value
Override -> Encoding
(Override -> Value)
-> (Override -> Encoding)
-> ([Override] -> Value)
-> ([Override] -> Encoding)
-> ToJSON Override
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Override -> Value
toJSON :: Override -> Value
$ctoEncoding :: Override -> Encoding
toEncoding :: Override -> Encoding
$ctoJSONList :: [Override] -> Value
toJSONList :: [Override] -> Value
$ctoEncodingList :: [Override] -> Encoding
toEncodingList :: [Override] -> Encoding
ToJSON)

-- | Client context.
data Context = Context
    { -- | User ID.
      Context -> Maybe Text
userId :: Maybe Text,
      -- | Session ID.
      Context -> Maybe Text
sessionId :: Maybe Text,
      -- | Remote address.
      Context -> Maybe Text
remoteAddress :: Maybe Text,
      -- | Current UTC time.
      Context -> Maybe Text
currentTime :: Maybe Text,
      -- | Application environment (e.g. @Production@).
      Context -> Maybe Text
environment :: Maybe Text,
      -- | Application name.
      Context -> Maybe Text
appName :: Maybe Text,
      -- | Other custom properties.
      Context -> Maybe (Map Text (Maybe Text))
properties :: Maybe (Map Text (Maybe Text))
    }
    deriving stock (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
/= :: Context -> Context -> Bool
Eq, Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Context -> ShowS
showsPrec :: Int -> Context -> ShowS
$cshow :: Context -> String
show :: Context -> String
$cshowList :: [Context] -> ShowS
showList :: [Context] -> ShowS
Show, (forall x. Context -> Rep Context x)
-> (forall x. Rep Context x -> Context) -> Generic Context
forall x. Rep Context x -> Context
forall x. Context -> Rep Context x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Context -> Rep Context x
from :: forall x. Context -> Rep Context x
$cto :: forall x. Rep Context x -> Context
to :: forall x. Rep Context x -> Context
Generic)
    deriving anyclass (Value -> Parser [Context]
Value -> Parser Context
(Value -> Parser Context)
-> (Value -> Parser [Context]) -> FromJSON Context
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Context
parseJSON :: Value -> Parser Context
$cparseJSONList :: Value -> Parser [Context]
parseJSONList :: Value -> Parser [Context]
FromJSON, [Context] -> Value
[Context] -> Encoding
Context -> Value
Context -> Encoding
(Context -> Value)
-> (Context -> Encoding)
-> ([Context] -> Value)
-> ([Context] -> Encoding)
-> ToJSON Context
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Context -> Value
toJSON :: Context -> Value
$ctoEncoding :: Context -> Encoding
toEncoding :: Context -> Encoding
$ctoJSONList :: [Context] -> Value
toJSONList :: [Context] -> Value
$ctoEncodingList :: [Context] -> Encoding
toEncodingList :: [Context] -> Encoding
ToJSON)

-- | An initial client context.
emptyContext :: Context
emptyContext :: Context
emptyContext = Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe (Map Text (Maybe Text))
-> Context
Context Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe (Map Text (Maybe Text))
forall a. Maybe a
Nothing

-- | Segment.
data Segment = Segment
    { Segment -> Int
id :: Int,
      Segment -> [Constraint]
constraints :: [Constraint]
    }
    deriving stock (Segment -> Segment -> Bool
(Segment -> Segment -> Bool)
-> (Segment -> Segment -> Bool) -> Eq Segment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Segment -> Segment -> Bool
== :: Segment -> Segment -> Bool
$c/= :: Segment -> Segment -> Bool
/= :: Segment -> Segment -> Bool
Eq, Int -> Segment -> ShowS
[Segment] -> ShowS
Segment -> String
(Int -> Segment -> ShowS)
-> (Segment -> String) -> ([Segment] -> ShowS) -> Show Segment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Segment -> ShowS
showsPrec :: Int -> Segment -> ShowS
$cshow :: Segment -> String
show :: Segment -> String
$cshowList :: [Segment] -> ShowS
showList :: [Segment] -> ShowS
Show, (forall x. Segment -> Rep Segment x)
-> (forall x. Rep Segment x -> Segment) -> Generic Segment
forall x. Rep Segment x -> Segment
forall x. Segment -> Rep Segment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Segment -> Rep Segment x
from :: forall x. Segment -> Rep Segment x
$cto :: forall x. Rep Segment x -> Segment
to :: forall x. Rep Segment x -> Segment
Generic)
    deriving anyclass (Value -> Parser [Segment]
Value -> Parser Segment
(Value -> Parser Segment)
-> (Value -> Parser [Segment]) -> FromJSON Segment
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser Segment
parseJSON :: Value -> Parser Segment
$cparseJSONList :: Value -> Parser [Segment]
parseJSONList :: Value -> Parser [Segment]
FromJSON, [Segment] -> Value
[Segment] -> Encoding
Segment -> Value
Segment -> Encoding
(Segment -> Value)
-> (Segment -> Encoding)
-> ([Segment] -> Value)
-> ([Segment] -> Encoding)
-> ToJSON Segment
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Segment -> Value
toJSON :: Segment -> Value
$ctoEncoding :: Segment -> Encoding
toEncoding :: Segment -> Encoding
$ctoJSONList :: [Segment] -> Value
toJSONList :: [Segment] -> Value
$ctoEncodingList :: [Segment] -> Encoding
toEncodingList :: [Segment] -> Encoding
ToJSON)

-- | Variant response.
data VariantResponse = VariantResponse
    { -- | Variant name.
      VariantResponse -> Text
name :: Text,
      -- | Variant payload.
      VariantResponse -> Maybe Payload
payload :: Maybe Payload,
      -- | Variant state.
      VariantResponse -> Bool
enabled :: Bool
    }
    deriving stock (VariantResponse -> VariantResponse -> Bool
(VariantResponse -> VariantResponse -> Bool)
-> (VariantResponse -> VariantResponse -> Bool)
-> Eq VariantResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VariantResponse -> VariantResponse -> Bool
== :: VariantResponse -> VariantResponse -> Bool
$c/= :: VariantResponse -> VariantResponse -> Bool
/= :: VariantResponse -> VariantResponse -> Bool
Eq, Int -> VariantResponse -> ShowS
[VariantResponse] -> ShowS
VariantResponse -> String
(Int -> VariantResponse -> ShowS)
-> (VariantResponse -> String)
-> ([VariantResponse] -> ShowS)
-> Show VariantResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VariantResponse -> ShowS
showsPrec :: Int -> VariantResponse -> ShowS
$cshow :: VariantResponse -> String
show :: VariantResponse -> String
$cshowList :: [VariantResponse] -> ShowS
showList :: [VariantResponse] -> ShowS
Show, (forall x. VariantResponse -> Rep VariantResponse x)
-> (forall x. Rep VariantResponse x -> VariantResponse)
-> Generic VariantResponse
forall x. Rep VariantResponse x -> VariantResponse
forall x. VariantResponse -> Rep VariantResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VariantResponse -> Rep VariantResponse x
from :: forall x. VariantResponse -> Rep VariantResponse x
$cto :: forall x. Rep VariantResponse x -> VariantResponse
to :: forall x. Rep VariantResponse x -> VariantResponse
Generic)
    deriving anyclass (Value -> Parser [VariantResponse]
Value -> Parser VariantResponse
(Value -> Parser VariantResponse)
-> (Value -> Parser [VariantResponse]) -> FromJSON VariantResponse
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser VariantResponse
parseJSON :: Value -> Parser VariantResponse
$cparseJSONList :: Value -> Parser [VariantResponse]
parseJSONList :: Value -> Parser [VariantResponse]
FromJSON, [VariantResponse] -> Value
[VariantResponse] -> Encoding
VariantResponse -> Value
VariantResponse -> Encoding
(VariantResponse -> Value)
-> (VariantResponse -> Encoding)
-> ([VariantResponse] -> Value)
-> ([VariantResponse] -> Encoding)
-> ToJSON VariantResponse
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: VariantResponse -> Value
toJSON :: VariantResponse -> Value
$ctoEncoding :: VariantResponse -> Encoding
toEncoding :: VariantResponse -> Encoding
$ctoJSONList :: [VariantResponse] -> Value
toJSONList :: [VariantResponse] -> Value
$ctoEncodingList :: [VariantResponse] -> Encoding
toEncodingList :: [VariantResponse] -> Encoding
ToJSON)

-- | The default (disabled) variant response.
emptyVariantResponse :: VariantResponse
emptyVariantResponse :: VariantResponse
emptyVariantResponse =
    VariantResponse
        { $sel:name:VariantResponse :: Text
name = Text
"disabled",
          $sel:payload:VariantResponse :: Maybe Payload
payload = Maybe Payload
forall a. Maybe a
Nothing,
          $sel:enabled:VariantResponse :: Bool
enabled = Bool
False
        }

-- | Metrics payload.
data MetricsPayload = MetricsPayload
    { -- | Application name.
      MetricsPayload -> Text
appName :: Text,
      -- | Instance identifier (typically hostname).
      MetricsPayload -> Text
instanceId :: Text,
      -- | Start timestamp for this interval.
      MetricsPayload -> UTCTime
start :: UTCTime,
      -- | End timestamp for this interval.
      MetricsPayload -> UTCTime
stop :: UTCTime,
      -- | Feature toggle usage metrics.
      MetricsPayload -> [(Text, Bool)]
toggles :: [(Text, Bool)]
    }
    deriving stock (MetricsPayload -> MetricsPayload -> Bool
(MetricsPayload -> MetricsPayload -> Bool)
-> (MetricsPayload -> MetricsPayload -> Bool) -> Eq MetricsPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetricsPayload -> MetricsPayload -> Bool
== :: MetricsPayload -> MetricsPayload -> Bool
$c/= :: MetricsPayload -> MetricsPayload -> Bool
/= :: MetricsPayload -> MetricsPayload -> Bool
Eq, Int -> MetricsPayload -> ShowS
[MetricsPayload] -> ShowS
MetricsPayload -> String
(Int -> MetricsPayload -> ShowS)
-> (MetricsPayload -> String)
-> ([MetricsPayload] -> ShowS)
-> Show MetricsPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetricsPayload -> ShowS
showsPrec :: Int -> MetricsPayload -> ShowS
$cshow :: MetricsPayload -> String
show :: MetricsPayload -> String
$cshowList :: [MetricsPayload] -> ShowS
showList :: [MetricsPayload] -> ShowS
Show, (forall x. MetricsPayload -> Rep MetricsPayload x)
-> (forall x. Rep MetricsPayload x -> MetricsPayload)
-> Generic MetricsPayload
forall x. Rep MetricsPayload x -> MetricsPayload
forall x. MetricsPayload -> Rep MetricsPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MetricsPayload -> Rep MetricsPayload x
from :: forall x. MetricsPayload -> Rep MetricsPayload x
$cto :: forall x. Rep MetricsPayload x -> MetricsPayload
to :: forall x. Rep MetricsPayload x -> MetricsPayload
Generic)

-- | Full metrics payload.
data FullMetricsPayload = FullMetricsPayload
    { FullMetricsPayload -> Text
appName :: Text,
      FullMetricsPayload -> Text
instanceId :: Text,
      FullMetricsPayload -> FullMetricsBucket
bucket :: FullMetricsBucket
    }
    deriving stock (FullMetricsPayload -> FullMetricsPayload -> Bool
(FullMetricsPayload -> FullMetricsPayload -> Bool)
-> (FullMetricsPayload -> FullMetricsPayload -> Bool)
-> Eq FullMetricsPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FullMetricsPayload -> FullMetricsPayload -> Bool
== :: FullMetricsPayload -> FullMetricsPayload -> Bool
$c/= :: FullMetricsPayload -> FullMetricsPayload -> Bool
/= :: FullMetricsPayload -> FullMetricsPayload -> Bool
Eq, Int -> FullMetricsPayload -> ShowS
[FullMetricsPayload] -> ShowS
FullMetricsPayload -> String
(Int -> FullMetricsPayload -> ShowS)
-> (FullMetricsPayload -> String)
-> ([FullMetricsPayload] -> ShowS)
-> Show FullMetricsPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FullMetricsPayload -> ShowS
showsPrec :: Int -> FullMetricsPayload -> ShowS
$cshow :: FullMetricsPayload -> String
show :: FullMetricsPayload -> String
$cshowList :: [FullMetricsPayload] -> ShowS
showList :: [FullMetricsPayload] -> ShowS
Show, (forall x. FullMetricsPayload -> Rep FullMetricsPayload x)
-> (forall x. Rep FullMetricsPayload x -> FullMetricsPayload)
-> Generic FullMetricsPayload
forall x. Rep FullMetricsPayload x -> FullMetricsPayload
forall x. FullMetricsPayload -> Rep FullMetricsPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FullMetricsPayload -> Rep FullMetricsPayload x
from :: forall x. FullMetricsPayload -> Rep FullMetricsPayload x
$cto :: forall x. Rep FullMetricsPayload x -> FullMetricsPayload
to :: forall x. Rep FullMetricsPayload x -> FullMetricsPayload
Generic)
    deriving anyclass ([FullMetricsPayload] -> Value
[FullMetricsPayload] -> Encoding
FullMetricsPayload -> Value
FullMetricsPayload -> Encoding
(FullMetricsPayload -> Value)
-> (FullMetricsPayload -> Encoding)
-> ([FullMetricsPayload] -> Value)
-> ([FullMetricsPayload] -> Encoding)
-> ToJSON FullMetricsPayload
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FullMetricsPayload -> Value
toJSON :: FullMetricsPayload -> Value
$ctoEncoding :: FullMetricsPayload -> Encoding
toEncoding :: FullMetricsPayload -> Encoding
$ctoJSONList :: [FullMetricsPayload] -> Value
toJSONList :: [FullMetricsPayload] -> Value
$ctoEncodingList :: [FullMetricsPayload] -> Encoding
toEncodingList :: [FullMetricsPayload] -> Encoding
ToJSON)

-- | Full metrics bucket.
data FullMetricsBucket = FullMetricsBucket
    { -- | Start timestamp for this interval.
      FullMetricsBucket -> UTCTime
start :: UTCTime,
      -- | End timestamp for this interval.
      FullMetricsBucket -> UTCTime
stop :: UTCTime,
      -- | Feature toggle usage metrics.
      FullMetricsBucket -> Map Text YesAndNoes
toggles :: Map Text YesAndNoes
    }
    deriving stock (FullMetricsBucket -> FullMetricsBucket -> Bool
(FullMetricsBucket -> FullMetricsBucket -> Bool)
-> (FullMetricsBucket -> FullMetricsBucket -> Bool)
-> Eq FullMetricsBucket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FullMetricsBucket -> FullMetricsBucket -> Bool
== :: FullMetricsBucket -> FullMetricsBucket -> Bool
$c/= :: FullMetricsBucket -> FullMetricsBucket -> Bool
/= :: FullMetricsBucket -> FullMetricsBucket -> Bool
Eq, Int -> FullMetricsBucket -> ShowS
[FullMetricsBucket] -> ShowS
FullMetricsBucket -> String
(Int -> FullMetricsBucket -> ShowS)
-> (FullMetricsBucket -> String)
-> ([FullMetricsBucket] -> ShowS)
-> Show FullMetricsBucket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FullMetricsBucket -> ShowS
showsPrec :: Int -> FullMetricsBucket -> ShowS
$cshow :: FullMetricsBucket -> String
show :: FullMetricsBucket -> String
$cshowList :: [FullMetricsBucket] -> ShowS
showList :: [FullMetricsBucket] -> ShowS
Show, (forall x. FullMetricsBucket -> Rep FullMetricsBucket x)
-> (forall x. Rep FullMetricsBucket x -> FullMetricsBucket)
-> Generic FullMetricsBucket
forall x. Rep FullMetricsBucket x -> FullMetricsBucket
forall x. FullMetricsBucket -> Rep FullMetricsBucket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FullMetricsBucket -> Rep FullMetricsBucket x
from :: forall x. FullMetricsBucket -> Rep FullMetricsBucket x
$cto :: forall x. Rep FullMetricsBucket x -> FullMetricsBucket
to :: forall x. Rep FullMetricsBucket x -> FullMetricsBucket
Generic)
    deriving anyclass ([FullMetricsBucket] -> Value
[FullMetricsBucket] -> Encoding
FullMetricsBucket -> Value
FullMetricsBucket -> Encoding
(FullMetricsBucket -> Value)
-> (FullMetricsBucket -> Encoding)
-> ([FullMetricsBucket] -> Value)
-> ([FullMetricsBucket] -> Encoding)
-> ToJSON FullMetricsBucket
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FullMetricsBucket -> Value
toJSON :: FullMetricsBucket -> Value
$ctoEncoding :: FullMetricsBucket -> Encoding
toEncoding :: FullMetricsBucket -> Encoding
$ctoJSONList :: [FullMetricsBucket] -> Value
toJSONList :: [FullMetricsBucket] -> Value
$ctoEncodingList :: [FullMetricsBucket] -> Encoding
toEncodingList :: [FullMetricsBucket] -> Encoding
ToJSON)

-- | Helper data structure for metrics.
data YesAndNoes = YesAndNoes
    { -- | The number of times the feature toggle was fetched as enabled in an interval.
      YesAndNoes -> Int
yes :: Int,
      -- | The number of times the feature toggle was fetched as disabled in an interval.
      YesAndNoes -> Int
no :: Int
    }
    deriving stock (YesAndNoes -> YesAndNoes -> Bool
(YesAndNoes -> YesAndNoes -> Bool)
-> (YesAndNoes -> YesAndNoes -> Bool) -> Eq YesAndNoes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: YesAndNoes -> YesAndNoes -> Bool
== :: YesAndNoes -> YesAndNoes -> Bool
$c/= :: YesAndNoes -> YesAndNoes -> Bool
/= :: YesAndNoes -> YesAndNoes -> Bool
Eq, Int -> YesAndNoes -> ShowS
[YesAndNoes] -> ShowS
YesAndNoes -> String
(Int -> YesAndNoes -> ShowS)
-> (YesAndNoes -> String)
-> ([YesAndNoes] -> ShowS)
-> Show YesAndNoes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> YesAndNoes -> ShowS
showsPrec :: Int -> YesAndNoes -> ShowS
$cshow :: YesAndNoes -> String
show :: YesAndNoes -> String
$cshowList :: [YesAndNoes] -> ShowS
showList :: [YesAndNoes] -> ShowS
Show, (forall x. YesAndNoes -> Rep YesAndNoes x)
-> (forall x. Rep YesAndNoes x -> YesAndNoes) -> Generic YesAndNoes
forall x. Rep YesAndNoes x -> YesAndNoes
forall x. YesAndNoes -> Rep YesAndNoes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. YesAndNoes -> Rep YesAndNoes x
from :: forall x. YesAndNoes -> Rep YesAndNoes x
$cto :: forall x. Rep YesAndNoes x -> YesAndNoes
to :: forall x. Rep YesAndNoes x -> YesAndNoes
Generic)
    deriving anyclass ([YesAndNoes] -> Value
[YesAndNoes] -> Encoding
YesAndNoes -> Value
YesAndNoes -> Encoding
(YesAndNoes -> Value)
-> (YesAndNoes -> Encoding)
-> ([YesAndNoes] -> Value)
-> ([YesAndNoes] -> Encoding)
-> ToJSON YesAndNoes
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: YesAndNoes -> Value
toJSON :: YesAndNoes -> Value
$ctoEncoding :: YesAndNoes -> Encoding
toEncoding :: YesAndNoes -> Encoding
$ctoJSONList :: [YesAndNoes] -> Value
toJSONList :: [YesAndNoes] -> Value
$ctoEncodingList :: [YesAndNoes] -> Encoding
toEncodingList :: [YesAndNoes] -> Encoding
ToJSON)

-- | Full client registration payload.
data FullRegisterPayload = FullRegisterPayload
    { -- | Application name.
      FullRegisterPayload -> Text
appName :: Text,
      -- | Instance identifier (typically hostname).
      FullRegisterPayload -> Text
instanceId :: Text,
      -- | Unleash client SDK version.
      FullRegisterPayload -> Text
sdkVersion :: Text,
      -- | Supported strategies.
      FullRegisterPayload -> [Text]
strategies :: [Text],
      -- | When the application was started.
      FullRegisterPayload -> UTCTime
started :: UTCTime,
      -- | Expected metrics sending interval.
      FullRegisterPayload -> Int
interval :: Int
    }
    deriving stock (FullRegisterPayload -> FullRegisterPayload -> Bool
(FullRegisterPayload -> FullRegisterPayload -> Bool)
-> (FullRegisterPayload -> FullRegisterPayload -> Bool)
-> Eq FullRegisterPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FullRegisterPayload -> FullRegisterPayload -> Bool
== :: FullRegisterPayload -> FullRegisterPayload -> Bool
$c/= :: FullRegisterPayload -> FullRegisterPayload -> Bool
/= :: FullRegisterPayload -> FullRegisterPayload -> Bool
Eq, Int -> FullRegisterPayload -> ShowS
[FullRegisterPayload] -> ShowS
FullRegisterPayload -> String
(Int -> FullRegisterPayload -> ShowS)
-> (FullRegisterPayload -> String)
-> ([FullRegisterPayload] -> ShowS)
-> Show FullRegisterPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FullRegisterPayload -> ShowS
showsPrec :: Int -> FullRegisterPayload -> ShowS
$cshow :: FullRegisterPayload -> String
show :: FullRegisterPayload -> String
$cshowList :: [FullRegisterPayload] -> ShowS
showList :: [FullRegisterPayload] -> ShowS
Show, (forall x. FullRegisterPayload -> Rep FullRegisterPayload x)
-> (forall x. Rep FullRegisterPayload x -> FullRegisterPayload)
-> Generic FullRegisterPayload
forall x. Rep FullRegisterPayload x -> FullRegisterPayload
forall x. FullRegisterPayload -> Rep FullRegisterPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FullRegisterPayload -> Rep FullRegisterPayload x
from :: forall x. FullRegisterPayload -> Rep FullRegisterPayload x
$cto :: forall x. Rep FullRegisterPayload x -> FullRegisterPayload
to :: forall x. Rep FullRegisterPayload x -> FullRegisterPayload
Generic)
    deriving anyclass ([FullRegisterPayload] -> Value
[FullRegisterPayload] -> Encoding
FullRegisterPayload -> Value
FullRegisterPayload -> Encoding
(FullRegisterPayload -> Value)
-> (FullRegisterPayload -> Encoding)
-> ([FullRegisterPayload] -> Value)
-> ([FullRegisterPayload] -> Encoding)
-> ToJSON FullRegisterPayload
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FullRegisterPayload -> Value
toJSON :: FullRegisterPayload -> Value
$ctoEncoding :: FullRegisterPayload -> Encoding
toEncoding :: FullRegisterPayload -> Encoding
$ctoJSONList :: [FullRegisterPayload] -> Value
toJSONList :: [FullRegisterPayload] -> Value
$ctoEncodingList :: [FullRegisterPayload] -> Encoding
toEncodingList :: [FullRegisterPayload] -> Encoding
ToJSON)

-- | Client registration payload.
data RegisterPayload = RegisterPayload
    { -- | Application name.
      RegisterPayload -> Text
appName :: Text,
      -- | Instance identifier (typically hostname).
      RegisterPayload -> Text
instanceId :: Text,
      -- | Client application startup timestamp.
      RegisterPayload -> UTCTime
started :: UTCTime,
      -- | Intended metrics sending interval.
      RegisterPayload -> Int
intervalSeconds :: Int
    }
    deriving stock (RegisterPayload -> RegisterPayload -> Bool
(RegisterPayload -> RegisterPayload -> Bool)
-> (RegisterPayload -> RegisterPayload -> Bool)
-> Eq RegisterPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegisterPayload -> RegisterPayload -> Bool
== :: RegisterPayload -> RegisterPayload -> Bool
$c/= :: RegisterPayload -> RegisterPayload -> Bool
/= :: RegisterPayload -> RegisterPayload -> Bool
Eq, Int -> RegisterPayload -> ShowS
[RegisterPayload] -> ShowS
RegisterPayload -> String
(Int -> RegisterPayload -> ShowS)
-> (RegisterPayload -> String)
-> ([RegisterPayload] -> ShowS)
-> Show RegisterPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegisterPayload -> ShowS
showsPrec :: Int -> RegisterPayload -> ShowS
$cshow :: RegisterPayload -> String
show :: RegisterPayload -> String
$cshowList :: [RegisterPayload] -> ShowS
showList :: [RegisterPayload] -> ShowS
Show, (forall x. RegisterPayload -> Rep RegisterPayload x)
-> (forall x. Rep RegisterPayload x -> RegisterPayload)
-> Generic RegisterPayload
forall x. Rep RegisterPayload x -> RegisterPayload
forall x. RegisterPayload -> Rep RegisterPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RegisterPayload -> Rep RegisterPayload x
from :: forall x. RegisterPayload -> Rep RegisterPayload x
$cto :: forall x. Rep RegisterPayload x -> RegisterPayload
to :: forall x. Rep RegisterPayload x -> RegisterPayload
Generic)
    deriving anyclass ([RegisterPayload] -> Value
[RegisterPayload] -> Encoding
RegisterPayload -> Value
RegisterPayload -> Encoding
(RegisterPayload -> Value)
-> (RegisterPayload -> Encoding)
-> ([RegisterPayload] -> Value)
-> ([RegisterPayload] -> Encoding)
-> ToJSON RegisterPayload
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RegisterPayload -> Value
toJSON :: RegisterPayload -> Value
$ctoEncoding :: RegisterPayload -> Encoding
toEncoding :: RegisterPayload -> Encoding
$ctoJSONList :: [RegisterPayload] -> Value
toJSONList :: [RegisterPayload] -> Value
$ctoEncodingList :: [RegisterPayload] -> Encoding
toEncodingList :: [RegisterPayload] -> Encoding
ToJSON)