module LaunchDarkly.Server.Features where

import Control.Lens                  (element, (^?))
import Control.Monad                 (mzero)
import Data.Aeson                    (FromJSON(..), ToJSON(..), Value(..), withObject, (.:), (.:?), object, (.=), (.!=))
import Data.Maybe                    (fromMaybe)
import Data.Text                     (Text)
import Data.HashSet                  (HashSet)
import Data.Generics.Product         (getField)
import GHC.Natural                   (Natural)
import GHC.Generics                  (Generic)

import LaunchDarkly.Server.Operators (Op)
import LaunchDarkly.Server.Details (EvaluationReason (..))
import qualified LaunchDarkly.Server.Details as D

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

data Rule = Rule
    { Rule -> Text
id                 :: !Text
    , Rule -> [Clause]
clauses            :: ![Clause]
    , Rule -> VariationOrRollout
variationOrRollout :: !VariationOrRollout
    , Rule -> Bool
trackEvents        :: !Bool
    } deriving (forall x. Rep Rule x -> Rule
forall x. Rule -> Rep Rule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rule x -> Rule
$cfrom :: forall x. Rule -> Rep Rule x
Generic, Int -> Rule -> ShowS
[Rule] -> ShowS
Rule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rule] -> ShowS
$cshowList :: [Rule] -> ShowS
show :: Rule -> String
$cshow :: Rule -> String
showsPrec :: Int -> Rule -> ShowS
$cshowsPrec :: Int -> Rule -> ShowS
Show, Rule -> Rule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rule -> Rule -> Bool
$c/= :: Rule -> Rule -> Bool
== :: Rule -> Rule -> Bool
$c== :: Rule -> Rule -> Bool
Eq)

instance FromJSON Rule where
    parseJSON :: Value -> Parser Rule
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Rule" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Text
id          <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"id"
        [Clause]
clauses     <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"clauses"
        Maybe Integer
variation   <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"variation"
        Maybe Rollout
rollout     <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rollout"
        Bool
trackEvents <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"trackEvents"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Rule
            { $sel:id:Rule :: Text
id                 = Text
id
            , $sel:clauses:Rule :: [Clause]
clauses            = [Clause]
clauses
            , $sel:variationOrRollout:Rule :: VariationOrRollout
variationOrRollout = VariationOrRollout
                { $sel:variation:VariationOrRollout :: Maybe Integer
variation = Maybe Integer
variation
                , $sel:rollout:VariationOrRollout :: Maybe Rollout
rollout   = Maybe Rollout
rollout
                }
            , $sel:trackEvents:Rule :: Bool
trackEvents        = Bool
trackEvents
            }

instance ToJSON Rule where
    toJSON :: Rule -> Value
toJSON Rule
rule = [Pair] -> Value
object
        [ Key
"id"          forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"id" Rule
rule
        , Key
"clauses"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clauses" Rule
rule
        , Key
"trackEvents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" Rule
rule
        , Key
"variation"   forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variation" (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationOrRollout" Rule
rule)
        , Key
"rollout"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rollout" (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variationOrRollout" Rule
rule)
        ]

data WeightedVariation = WeightedVariation
    { WeightedVariation -> Integer
variation :: !Integer
    , WeightedVariation -> Float
weight    :: !Float
    , WeightedVariation -> Bool
untracked :: !Bool
    } deriving (forall x. Rep WeightedVariation x -> WeightedVariation
forall x. WeightedVariation -> Rep WeightedVariation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WeightedVariation x -> WeightedVariation
$cfrom :: forall x. WeightedVariation -> Rep WeightedVariation x
Generic, [WeightedVariation] -> Encoding
[WeightedVariation] -> Value
WeightedVariation -> Encoding
WeightedVariation -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WeightedVariation] -> Encoding
$ctoEncodingList :: [WeightedVariation] -> Encoding
toJSONList :: [WeightedVariation] -> Value
$ctoJSONList :: [WeightedVariation] -> Value
toEncoding :: WeightedVariation -> Encoding
$ctoEncoding :: WeightedVariation -> Encoding
toJSON :: WeightedVariation -> Value
$ctoJSON :: WeightedVariation -> Value
ToJSON, Int -> WeightedVariation -> ShowS
[WeightedVariation] -> ShowS
WeightedVariation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WeightedVariation] -> ShowS
$cshowList :: [WeightedVariation] -> ShowS
show :: WeightedVariation -> String
$cshow :: WeightedVariation -> String
showsPrec :: Int -> WeightedVariation -> ShowS
$cshowsPrec :: Int -> WeightedVariation -> ShowS
Show, WeightedVariation -> WeightedVariation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WeightedVariation -> WeightedVariation -> Bool
$c/= :: WeightedVariation -> WeightedVariation -> Bool
== :: WeightedVariation -> WeightedVariation -> Bool
$c== :: WeightedVariation -> WeightedVariation -> Bool
Eq)

instance FromJSON WeightedVariation where
    parseJSON :: Value -> Parser WeightedVariation
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"WeightedVariation" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        Integer
variation <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"variation"
        Float
weight    <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"weight"
        Bool
untracked <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"untracked" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
        forall (f :: * -> *) a. Applicative f => a -> f a
pure WeightedVariation { Bool
Float
Integer
untracked :: Bool
weight :: Float
variation :: Integer
$sel:untracked:WeightedVariation :: Bool
$sel:weight:WeightedVariation :: Float
$sel:variation:WeightedVariation :: Integer
.. }

data RolloutKind = RolloutKindExperiment | RolloutKindRollout
    deriving (RolloutKind -> RolloutKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RolloutKind -> RolloutKind -> Bool
$c/= :: RolloutKind -> RolloutKind -> Bool
== :: RolloutKind -> RolloutKind -> Bool
$c== :: RolloutKind -> RolloutKind -> Bool
Eq, Int -> RolloutKind -> ShowS
[RolloutKind] -> ShowS
RolloutKind -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RolloutKind] -> ShowS
$cshowList :: [RolloutKind] -> ShowS
show :: RolloutKind -> String
$cshow :: RolloutKind -> String
showsPrec :: Int -> RolloutKind -> ShowS
$cshowsPrec :: Int -> RolloutKind -> ShowS
Show)

instance ToJSON RolloutKind where
    toJSON :: RolloutKind -> Value
toJSON RolloutKind
x = Text -> Value
String forall a b. (a -> b) -> a -> b
$ case RolloutKind
x of
        RolloutKind
RolloutKindExperiment -> Text
"experiment"
        RolloutKind
RolloutKindRollout    -> Text
"rollout"

instance FromJSON RolloutKind where
    parseJSON :: Value -> Parser RolloutKind
parseJSON Value
x = case Value
x of
        (String Text
"experiment") -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RolloutKind
RolloutKindExperiment
        (String Text
"rollout")    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure RolloutKind
RolloutKindRollout
        Value
_                     -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

data Rollout = Rollout
    { Rollout -> [WeightedVariation]
variations :: ![WeightedVariation]
    , Rollout -> Maybe Text
bucketBy   :: !(Maybe Text)
    , Rollout -> RolloutKind
kind       :: !RolloutKind
    , Rollout -> Maybe Int
seed       :: !(Maybe Int)
    } deriving (forall x. Rep Rollout x -> Rollout
forall x. Rollout -> Rep Rollout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rollout x -> Rollout
$cfrom :: forall x. Rollout -> Rep Rollout x
Generic, [Rollout] -> Encoding
[Rollout] -> Value
Rollout -> Encoding
Rollout -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Rollout] -> Encoding
$ctoEncodingList :: [Rollout] -> Encoding
toJSONList :: [Rollout] -> Value
$ctoJSONList :: [Rollout] -> Value
toEncoding :: Rollout -> Encoding
$ctoEncoding :: Rollout -> Encoding
toJSON :: Rollout -> Value
$ctoJSON :: Rollout -> Value
ToJSON, Int -> Rollout -> ShowS
[Rollout] -> ShowS
Rollout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rollout] -> ShowS
$cshowList :: [Rollout] -> ShowS
show :: Rollout -> String
$cshow :: Rollout -> String
showsPrec :: Int -> Rollout -> ShowS
$cshowsPrec :: Int -> Rollout -> ShowS
Show, Rollout -> Rollout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rollout -> Rollout -> Bool
$c/= :: Rollout -> Rollout -> Bool
== :: Rollout -> Rollout -> Bool
$c== :: Rollout -> Rollout -> Bool
Eq)

instance FromJSON Rollout where
    parseJSON :: Value -> Parser Rollout
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"rollout" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
        [WeightedVariation]
variations <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"variations"
        Maybe Text
bucketBy   <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bucketBy"
        RolloutKind
kind       <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"kind" forall a. Parser (Maybe a) -> a -> Parser a
.!= RolloutKind
RolloutKindRollout
        Maybe Int
seed       <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"seed"
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Rollout { [WeightedVariation]
Maybe Int
Maybe Text
RolloutKind
seed :: Maybe Int
kind :: RolloutKind
bucketBy :: Maybe Text
variations :: [WeightedVariation]
$sel:seed:Rollout :: Maybe Int
$sel:kind:Rollout :: RolloutKind
$sel:bucketBy:Rollout :: Maybe Text
$sel:variations:Rollout :: [WeightedVariation]
.. }

data VariationOrRollout = VariationOrRollout
    { VariationOrRollout -> Maybe Integer
variation :: !(Maybe Integer)
    , VariationOrRollout -> Maybe Rollout
rollout   :: !(Maybe Rollout)
    } deriving (forall x. Rep VariationOrRollout x -> VariationOrRollout
forall x. VariationOrRollout -> Rep VariationOrRollout x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VariationOrRollout x -> VariationOrRollout
$cfrom :: forall x. VariationOrRollout -> Rep VariationOrRollout x
Generic, Value -> Parser [VariationOrRollout]
Value -> Parser VariationOrRollout
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VariationOrRollout]
$cparseJSONList :: Value -> Parser [VariationOrRollout]
parseJSON :: Value -> Parser VariationOrRollout
$cparseJSON :: Value -> Parser VariationOrRollout
FromJSON, [VariationOrRollout] -> Encoding
[VariationOrRollout] -> Value
VariationOrRollout -> Encoding
VariationOrRollout -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VariationOrRollout] -> Encoding
$ctoEncodingList :: [VariationOrRollout] -> Encoding
toJSONList :: [VariationOrRollout] -> Value
$ctoJSONList :: [VariationOrRollout] -> Value
toEncoding :: VariationOrRollout -> Encoding
$ctoEncoding :: VariationOrRollout -> Encoding
toJSON :: VariationOrRollout -> Value
$ctoJSON :: VariationOrRollout -> Value
ToJSON, Int -> VariationOrRollout -> ShowS
[VariationOrRollout] -> ShowS
VariationOrRollout -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VariationOrRollout] -> ShowS
$cshowList :: [VariationOrRollout] -> ShowS
show :: VariationOrRollout -> String
$cshow :: VariationOrRollout -> String
showsPrec :: Int -> VariationOrRollout -> ShowS
$cshowsPrec :: Int -> VariationOrRollout -> ShowS
Show, VariationOrRollout -> VariationOrRollout -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VariationOrRollout -> VariationOrRollout -> Bool
$c/= :: VariationOrRollout -> VariationOrRollout -> Bool
== :: VariationOrRollout -> VariationOrRollout -> Bool
$c== :: VariationOrRollout -> VariationOrRollout -> Bool
Eq)

data ClientSideAvailability = ClientSideAvailability
    { ClientSideAvailability -> Bool
usingEnvironmentId     :: !Bool
    , ClientSideAvailability -> Bool
usingMobileKey         :: !Bool
    , ClientSideAvailability -> Bool
explicit               :: !Bool
    } deriving (forall x. Rep ClientSideAvailability x -> ClientSideAvailability
forall x. ClientSideAvailability -> Rep ClientSideAvailability x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClientSideAvailability x -> ClientSideAvailability
$cfrom :: forall x. ClientSideAvailability -> Rep ClientSideAvailability x
Generic, Int -> ClientSideAvailability -> ShowS
[ClientSideAvailability] -> ShowS
ClientSideAvailability -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientSideAvailability] -> ShowS
$cshowList :: [ClientSideAvailability] -> ShowS
show :: ClientSideAvailability -> String
$cshow :: ClientSideAvailability -> String
showsPrec :: Int -> ClientSideAvailability -> ShowS
$cshowsPrec :: Int -> ClientSideAvailability -> ShowS
Show, ClientSideAvailability -> ClientSideAvailability -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientSideAvailability -> ClientSideAvailability -> Bool
$c/= :: ClientSideAvailability -> ClientSideAvailability -> Bool
== :: ClientSideAvailability -> ClientSideAvailability -> Bool
$c== :: ClientSideAvailability -> ClientSideAvailability -> Bool
Eq)

instance FromJSON ClientSideAvailability where
    parseJSON :: Value -> Parser ClientSideAvailability
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ClientSideAvailability" forall a b. (a -> b) -> a -> b
$ \Object
obj -> Bool -> Bool -> Bool -> ClientSideAvailability
ClientSideAvailability
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"usingEnvironmentId"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"usingMobileKey"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

instance ToJSON ClientSideAvailability where
    toJSON :: ClientSideAvailability -> Value
toJSON (ClientSideAvailability Bool
env Bool
mob Bool
_) =
        [Pair] -> Value
object [ Key
"usingEnvironmentId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
env, Key
"usingMobileKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
mob ]

data Flag = Flag
    { Flag -> Text
key                    :: !Text
    , Flag -> Natural
version                :: !Natural
    , Flag -> Bool
on                     :: !Bool
    , Flag -> Bool
trackEvents            :: !Bool
    , Flag -> Bool
trackEventsFallthrough :: !Bool
    , Flag -> Bool
deleted                :: !Bool
    , Flag -> [Prerequisite]
prerequisites          :: ![Prerequisite]
    , Flag -> Text
salt                   :: !Text
    , Flag -> [Target]
targets                :: ![Target]
    , Flag -> [Rule]
rules                  :: ![Rule]
    , Flag -> VariationOrRollout
fallthrough            :: !VariationOrRollout
    , Flag -> Maybe Integer
offVariation           :: !(Maybe Integer)
    , Flag -> [Value]
variations             :: ![Value]
    , Flag -> Maybe Natural
debugEventsUntilDate   :: !(Maybe Natural)
    , Flag -> ClientSideAvailability
clientSideAvailability :: !ClientSideAvailability
    } deriving (forall x. Rep Flag x -> Flag
forall x. Flag -> Rep Flag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Flag x -> Flag
$cfrom :: forall x. Flag -> Rep Flag x
Generic, Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show, Flag -> Flag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq)

instance ToJSON Flag where
    toJSON :: Flag -> Value
toJSON Flag
flag = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$
        [ Key
"key" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" Flag
flag
        , Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"version" Flag
flag
        , Key
"on" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"on" Flag
flag
        , Key
"trackEvents" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents" Flag
flag
        , Key
"trackEventsFallthrough" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEventsFallthrough" Flag
flag
        , Key
"deleted" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"deleted" Flag
flag
        , Key
"prerequisites" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"prerequisites" Flag
flag
        , Key
"salt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"salt" Flag
flag
        , Key
"targets" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"targets" Flag
flag
        , Key
"rules" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" Flag
flag
        , Key
"fallthrough" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"fallthrough" Flag
flag
        , Key
"offVariation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"offVariation" Flag
flag
        , Key
"variations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"variations" Flag
flag
        , Key
"debugEventsUntilDate" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"debugEventsUntilDate" Flag
flag
        , Key
"clientSide" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"usingEnvironmentId" forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clientSideAvailability" Flag
flag)
        ] forall a. Semigroup a => a -> a -> a
<> case forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"explicit" forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clientSideAvailability" Flag
flag of
               Bool
True -> [ Key
"clientSideAvailability" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"clientSideAvailability" Flag
flag ]
               Bool
False -> [ ]

instance FromJSON Flag where
    parseJSON :: Value -> Parser Flag
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Flag" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        Text
key <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key"
        Natural
version <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
        Bool
on <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"on"
        Bool
trackEvents <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"trackEvents"
        Bool
trackEventsFallthrough <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"trackEventsFallthrough"
        Bool
deleted <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deleted"
        [Prerequisite]
prerequisites <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prerequisites"
        Text
salt <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"salt"
        [Target]
targets <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"targets"
        [Rule]
rules <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rules"
        VariationOrRollout
fallthrough <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fallthrough"
        Maybe Integer
offVariation <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"offVariation"
        [Value]
variations <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"variations"
        Maybe Natural
debugEventsUntilDate <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"debugEventsUntilDate"
        Bool
clientSide <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"clientSide" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
        ClientSideAvailability
clientSideAvailability <- Object
obj forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"clientSideAvailability" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool -> Bool -> Bool -> ClientSideAvailability
ClientSideAvailability Bool
clientSide Bool
True Bool
False
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Flag { Bool
Natural
[Value]
[Prerequisite]
[Rule]
[Target]
Maybe Integer
Maybe Natural
Text
ClientSideAvailability
VariationOrRollout
clientSideAvailability :: ClientSideAvailability
debugEventsUntilDate :: Maybe Natural
variations :: [Value]
offVariation :: Maybe Integer
fallthrough :: VariationOrRollout
rules :: [Rule]
targets :: [Target]
salt :: Text
prerequisites :: [Prerequisite]
deleted :: Bool
trackEventsFallthrough :: Bool
trackEvents :: Bool
on :: Bool
version :: Natural
key :: Text
$sel:clientSideAvailability:Flag :: ClientSideAvailability
$sel:debugEventsUntilDate:Flag :: Maybe Natural
$sel:variations:Flag :: [Value]
$sel:offVariation:Flag :: Maybe Integer
$sel:fallthrough:Flag :: VariationOrRollout
$sel:rules:Flag :: [Rule]
$sel:targets:Flag :: [Target]
$sel:salt:Flag :: Text
$sel:prerequisites:Flag :: [Prerequisite]
$sel:deleted:Flag :: Bool
$sel:trackEventsFallthrough:Flag :: Bool
$sel:trackEvents:Flag :: Bool
$sel:on:Flag :: Bool
$sel:version:Flag :: Natural
$sel:key:Flag :: Text
.. }

isClientSideOnlyFlag :: Flag -> Bool
isClientSideOnlyFlag :: Flag -> Bool
isClientSideOnlyFlag Flag
flag = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"usingEnvironmentId" forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField  @"clientSideAvailability" Flag
flag

-- If the reason for the flag is in an experiment,
-- or if it's a fallthrough reason and the flag has trackEventsFallthrough
-- or if it's a rule match and the rule that matched has track events turned on
-- otherwise false
isInExperiment :: Flag -> EvaluationReason -> Bool
isInExperiment :: Flag -> EvaluationReason -> Bool
isInExperiment Flag
_ EvaluationReason
reason
  | EvaluationReason -> Bool
D.isInExperiment EvaluationReason
reason = Bool
True
isInExperiment Flag
flag EvaluationReasonFallthrough {Bool
$sel:inExperiment:EvaluationReasonOff :: EvaluationReason -> Bool
inExperiment :: Bool
..} = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEventsFallthrough" Flag
flag
isInExperiment Flag
flag (EvaluationReasonRuleMatch Natural
ruleIndex Text
_ Bool
_) =
    let index :: Int
index = forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
ruleIndex
        rules :: [Rule]
rules = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"rules" Flag
flag
        rule :: Maybe Rule
rule = [Rule]
rules forall s a. s -> Getting (First a) s a -> Maybe a
^? forall (t :: * -> *) a.
Traversable t =>
Int -> IndexedTraversal' Int (t a) a
element Int
index
    in forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"trackEvents") Maybe Rule
rule
isInExperiment Flag
_ EvaluationReason
_ = Bool
False

data Prerequisite = Prerequisite
    { Prerequisite -> Text
key       :: !Text
    , Prerequisite -> Integer
variation :: !Integer
    } deriving (forall x. Rep Prerequisite x -> Prerequisite
forall x. Prerequisite -> Rep Prerequisite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Prerequisite x -> Prerequisite
$cfrom :: forall x. Prerequisite -> Rep Prerequisite x
Generic, Value -> Parser [Prerequisite]
Value -> Parser Prerequisite
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Prerequisite]
$cparseJSONList :: Value -> Parser [Prerequisite]
parseJSON :: Value -> Parser Prerequisite
$cparseJSON :: Value -> Parser Prerequisite
FromJSON, [Prerequisite] -> Encoding
[Prerequisite] -> Value
Prerequisite -> Encoding
Prerequisite -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Prerequisite] -> Encoding
$ctoEncodingList :: [Prerequisite] -> Encoding
toJSONList :: [Prerequisite] -> Value
$ctoJSONList :: [Prerequisite] -> Value
toEncoding :: Prerequisite -> Encoding
$ctoEncoding :: Prerequisite -> Encoding
toJSON :: Prerequisite -> Value
$ctoJSON :: Prerequisite -> Value
ToJSON, Int -> Prerequisite -> ShowS
[Prerequisite] -> ShowS
Prerequisite -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prerequisite] -> ShowS
$cshowList :: [Prerequisite] -> ShowS
show :: Prerequisite -> String
$cshow :: Prerequisite -> String
showsPrec :: Int -> Prerequisite -> ShowS
$cshowsPrec :: Int -> Prerequisite -> ShowS
Show, Prerequisite -> Prerequisite -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prerequisite -> Prerequisite -> Bool
$c/= :: Prerequisite -> Prerequisite -> Bool
== :: Prerequisite -> Prerequisite -> Bool
$c== :: Prerequisite -> Prerequisite -> Bool
Eq)

data SegmentRule = SegmentRule
    { SegmentRule -> Text
id       :: !Text
    , SegmentRule -> [Clause]
clauses  :: ![Clause]
    , SegmentRule -> Maybe Float
weight   :: !(Maybe Float)
    , SegmentRule -> Maybe Text
bucketBy :: !(Maybe Text)
    } deriving (forall x. Rep SegmentRule x -> SegmentRule
forall x. SegmentRule -> Rep SegmentRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SegmentRule x -> SegmentRule
$cfrom :: forall x. SegmentRule -> Rep SegmentRule x
Generic, Value -> Parser [SegmentRule]
Value -> Parser SegmentRule
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SegmentRule]
$cparseJSONList :: Value -> Parser [SegmentRule]
parseJSON :: Value -> Parser SegmentRule
$cparseJSON :: Value -> Parser SegmentRule
FromJSON, [SegmentRule] -> Encoding
[SegmentRule] -> Value
SegmentRule -> Encoding
SegmentRule -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SegmentRule] -> Encoding
$ctoEncodingList :: [SegmentRule] -> Encoding
toJSONList :: [SegmentRule] -> Value
$ctoJSONList :: [SegmentRule] -> Value
toEncoding :: SegmentRule -> Encoding
$ctoEncoding :: SegmentRule -> Encoding
toJSON :: SegmentRule -> Value
$ctoJSON :: SegmentRule -> Value
ToJSON, Int -> SegmentRule -> ShowS
[SegmentRule] -> ShowS
SegmentRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SegmentRule] -> ShowS
$cshowList :: [SegmentRule] -> ShowS
show :: SegmentRule -> String
$cshow :: SegmentRule -> String
showsPrec :: Int -> SegmentRule -> ShowS
$cshowsPrec :: Int -> SegmentRule -> ShowS
Show, SegmentRule -> SegmentRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SegmentRule -> SegmentRule -> Bool
$c/= :: SegmentRule -> SegmentRule -> Bool
== :: SegmentRule -> SegmentRule -> Bool
$c== :: SegmentRule -> SegmentRule -> Bool
Eq)

data Segment = Segment
    { Segment -> Text
key      :: !Text
    , Segment -> HashSet Text
included :: !(HashSet Text)
    , Segment -> HashSet Text
excluded :: !(HashSet Text)
    , Segment -> Text
salt     :: !Text
    , Segment -> [SegmentRule]
rules    :: ![SegmentRule]
    , Segment -> Natural
version  :: !Natural
    , Segment -> Bool
deleted  :: !Bool
    } deriving (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
$cto :: forall x. Rep Segment x -> Segment
$cfrom :: forall x. Segment -> Rep Segment x
Generic, Value -> Parser [Segment]
Value -> Parser Segment
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Segment]
$cparseJSONList :: Value -> Parser [Segment]
parseJSON :: Value -> Parser Segment
$cparseJSON :: Value -> Parser Segment
FromJSON, [Segment] -> Encoding
[Segment] -> Value
Segment -> Encoding
Segment -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Segment] -> Encoding
$ctoEncodingList :: [Segment] -> Encoding
toJSONList :: [Segment] -> Value
$ctoJSONList :: [Segment] -> Value
toEncoding :: Segment -> Encoding
$ctoEncoding :: Segment -> Encoding
toJSON :: Segment -> Value
$ctoJSON :: Segment -> Value
ToJSON, Int -> Segment -> ShowS
[Segment] -> ShowS
Segment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Segment] -> ShowS
$cshowList :: [Segment] -> ShowS
show :: Segment -> String
$cshow :: Segment -> String
showsPrec :: Int -> Segment -> ShowS
$cshowsPrec :: Int -> Segment -> ShowS
Show, Segment -> Segment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Segment -> Segment -> Bool
$c/= :: Segment -> Segment -> Bool
== :: Segment -> Segment -> Bool
$c== :: Segment -> Segment -> Bool
Eq)

data Clause = Clause
    { Clause -> Text
attribute :: !Text
    , Clause -> Bool
negate    :: !Bool
    , Clause -> Op
op        :: !Op
    , Clause -> [Value]
values    :: ![Value]
    } deriving (forall x. Rep Clause x -> Clause
forall x. Clause -> Rep Clause x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Clause x -> Clause
$cfrom :: forall x. Clause -> Rep Clause x
Generic, Value -> Parser [Clause]
Value -> Parser Clause
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Clause]
$cparseJSONList :: Value -> Parser [Clause]
parseJSON :: Value -> Parser Clause
$cparseJSON :: Value -> Parser Clause
FromJSON, [Clause] -> Encoding
[Clause] -> Value
Clause -> Encoding
Clause -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Clause] -> Encoding
$ctoEncodingList :: [Clause] -> Encoding
toJSONList :: [Clause] -> Value
$ctoJSONList :: [Clause] -> Value
toEncoding :: Clause -> Encoding
$ctoEncoding :: Clause -> Encoding
toJSON :: Clause -> Value
$ctoJSON :: Clause -> Value
ToJSON, Int -> Clause -> ShowS
[Clause] -> ShowS
Clause -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Clause] -> ShowS
$cshowList :: [Clause] -> ShowS
show :: Clause -> String
$cshow :: Clause -> String
showsPrec :: Int -> Clause -> ShowS
$cshowsPrec :: Int -> Clause -> ShowS
Show, Clause -> Clause -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Clause -> Clause -> Bool
$c/= :: Clause -> Clause -> Bool
== :: Clause -> Clause -> Bool
$c== :: Clause -> Clause -> Bool
Eq)