{-# LANGUAGE OverloadedLists #-}

module LaunchDarkly.Server.Details where

import Data.Aeson.Types (ToJSON, Value (..), toJSON)
import Data.Text (Text)
import GHC.Exts (fromList)
import GHC.Generics (Generic)
import GHC.Natural (Natural)

-- |
-- Combines the result of a flag evaluation with an explanation of how it was
-- calculated.
data EvaluationDetail value = EvaluationDetail
    { forall value. EvaluationDetail value -> value
value :: !value
    -- ^ The result of the flag evaluation. This will be either one of the
    -- flag's variations or the default value passed by the application.
    , forall value. EvaluationDetail value -> Maybe Integer
variationIndex :: !(Maybe Integer)
    -- ^ The index of the returned value within the flag's list of variations,
    -- e.g. 0 for the first variation - or Nothing if the default value was
    -- returned.
    , forall value. EvaluationDetail value -> EvaluationReason
reason :: !EvaluationReason
    -- ^ Describes the main factor that influenced the flag evaluation value.
    }
    deriving ((forall x.
 EvaluationDetail value -> Rep (EvaluationDetail value) x)
-> (forall x.
    Rep (EvaluationDetail value) x -> EvaluationDetail value)
-> Generic (EvaluationDetail value)
forall x. Rep (EvaluationDetail value) x -> EvaluationDetail value
forall x. EvaluationDetail value -> Rep (EvaluationDetail value) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall value x.
Rep (EvaluationDetail value) x -> EvaluationDetail value
forall value x.
EvaluationDetail value -> Rep (EvaluationDetail value) x
$cfrom :: forall value x.
EvaluationDetail value -> Rep (EvaluationDetail value) x
from :: forall x. EvaluationDetail value -> Rep (EvaluationDetail value) x
$cto :: forall value x.
Rep (EvaluationDetail value) x -> EvaluationDetail value
to :: forall x. Rep (EvaluationDetail value) x -> EvaluationDetail value
Generic, EvaluationDetail value -> EvaluationDetail value -> Bool
(EvaluationDetail value -> EvaluationDetail value -> Bool)
-> (EvaluationDetail value -> EvaluationDetail value -> Bool)
-> Eq (EvaluationDetail value)
forall value.
Eq value =>
EvaluationDetail value -> EvaluationDetail value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall value.
Eq value =>
EvaluationDetail value -> EvaluationDetail value -> Bool
== :: EvaluationDetail value -> EvaluationDetail value -> Bool
$c/= :: forall value.
Eq value =>
EvaluationDetail value -> EvaluationDetail value -> Bool
/= :: EvaluationDetail value -> EvaluationDetail value -> Bool
Eq, Int -> EvaluationDetail value -> ShowS
[EvaluationDetail value] -> ShowS
EvaluationDetail value -> String
(Int -> EvaluationDetail value -> ShowS)
-> (EvaluationDetail value -> String)
-> ([EvaluationDetail value] -> ShowS)
-> Show (EvaluationDetail value)
forall value. Show value => Int -> EvaluationDetail value -> ShowS
forall value. Show value => [EvaluationDetail value] -> ShowS
forall value. Show value => EvaluationDetail value -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall value. Show value => Int -> EvaluationDetail value -> ShowS
showsPrec :: Int -> EvaluationDetail value -> ShowS
$cshow :: forall value. Show value => EvaluationDetail value -> String
show :: EvaluationDetail value -> String
$cshowList :: forall value. Show value => [EvaluationDetail value] -> ShowS
showList :: [EvaluationDetail value] -> ShowS
Show)

instance ToJSON a => ToJSON (EvaluationDetail a) where
    toJSON :: EvaluationDetail a -> Value
toJSON = EvaluationDetail a -> Value
forall a. ToJSON a => a -> Value
toJSON

-- | Defines the possible values of the Kind property of EvaluationReason.
data EvaluationReason
    = -- | Indicates that the flag was off and therefore returned its configured
      -- off value.
      EvaluationReasonOff
    | -- | indicates that the context key was specifically targeted for this flag.
      EvaluationReasonTargetMatch
    | EvaluationReasonRuleMatch
        { EvaluationReason -> Natural
ruleIndex :: !Natural
        -- ^ The index of the rule that was matched (0 being the first).
        , EvaluationReason -> Text
ruleId :: !Text
        -- ^ The unique identifier of the rule that was matched.
        , EvaluationReason -> Bool
inExperiment :: !Bool
        -- ^ Whether the evaluation was part of an experiment. Is true if
        -- the evaluation resulted in an experiment rollout *and* served
        -- one of the variations in the experiment. Otherwise false.
        }
    | -- \^ Indicates that the context matched one of the flag's rules.
      EvaluationReasonPrerequisiteFailed
        { EvaluationReason -> Text
prerequisiteKey :: !Text
        -- ^ The flag key of the prerequisite that failed.
        }
    | -- \^ Indicates that the flag was considered off because it had at least
      -- one prerequisite flag that either was off or did not return the desired
      -- variation.
      EvaluationReasonFallthrough
        { inExperiment :: !Bool
        -- ^ Whether the evaluation was part of an experiment. Is
        -- true if the evaluation resulted in an experiment rollout *and*
        -- served one of the variations in the experiment. Otherwise false.
        }
    | -- \^ Indicates that the flag was on but the context did not match any targets
      -- or rules.
      EvaluationReasonError
        { EvaluationReason -> EvalErrorKind
errorKind :: !EvalErrorKind
        -- ^ Describes the type of error.
        }
    -- \^ Indicates that the flag could not be evaluated, e.g. because it does
    -- not exist or due to an unexpected error. In this case the result value
    -- will be the default value that the caller passed to the client.
    deriving ((forall x. EvaluationReason -> Rep EvaluationReason x)
-> (forall x. Rep EvaluationReason x -> EvaluationReason)
-> Generic EvaluationReason
forall x. Rep EvaluationReason x -> EvaluationReason
forall x. EvaluationReason -> Rep EvaluationReason x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EvaluationReason -> Rep EvaluationReason x
from :: forall x. EvaluationReason -> Rep EvaluationReason x
$cto :: forall x. Rep EvaluationReason x -> EvaluationReason
to :: forall x. Rep EvaluationReason x -> EvaluationReason
Generic, EvaluationReason -> EvaluationReason -> Bool
(EvaluationReason -> EvaluationReason -> Bool)
-> (EvaluationReason -> EvaluationReason -> Bool)
-> Eq EvaluationReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EvaluationReason -> EvaluationReason -> Bool
== :: EvaluationReason -> EvaluationReason -> Bool
$c/= :: EvaluationReason -> EvaluationReason -> Bool
/= :: EvaluationReason -> EvaluationReason -> Bool
Eq, Int -> EvaluationReason -> ShowS
[EvaluationReason] -> ShowS
EvaluationReason -> String
(Int -> EvaluationReason -> ShowS)
-> (EvaluationReason -> String)
-> ([EvaluationReason] -> ShowS)
-> Show EvaluationReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvaluationReason -> ShowS
showsPrec :: Int -> EvaluationReason -> ShowS
$cshow :: EvaluationReason -> String
show :: EvaluationReason -> String
$cshowList :: [EvaluationReason] -> ShowS
showList :: [EvaluationReason] -> ShowS
Show)

instance ToJSON EvaluationReason where
    toJSON :: EvaluationReason -> Value
toJSON EvaluationReason
x = case EvaluationReason
x of
        EvaluationReason
EvaluationReasonOff ->
            Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Item Object] -> Object
forall l. IsList l => [Item l] -> l
fromList [(Key
"kind", Value
"OFF")]
        EvaluationReason
EvaluationReasonTargetMatch ->
            Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Item Object] -> Object
forall l. IsList l => [Item l] -> l
fromList [(Key
"kind", Value
"TARGET_MATCH")]
        (EvaluationReasonRuleMatch Natural
ruleIndex Text
ruleId Bool
True) ->
            Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Item Object] -> Object
forall l. IsList l => [Item l] -> l
fromList [(Key
"kind", Value
"RULE_MATCH"), (Key
"ruleIndex", Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
ruleIndex), (Key
"ruleId", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
ruleId), (Key
"inExperiment", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
True)]
        (EvaluationReasonRuleMatch Natural
ruleIndex Text
ruleId Bool
False) ->
            Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Item Object] -> Object
forall l. IsList l => [Item l] -> l
fromList [(Key
"kind", Value
"RULE_MATCH"), (Key
"ruleIndex", Natural -> Value
forall a. ToJSON a => a -> Value
toJSON Natural
ruleIndex), (Key
"ruleId", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
ruleId)]
        (EvaluationReasonPrerequisiteFailed Text
prerequisiteKey) ->
            Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Item Object] -> Object
forall l. IsList l => [Item l] -> l
fromList [(Key
"kind", Value
"PREREQUISITE_FAILED"), (Key
"prerequisiteKey", Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
prerequisiteKey)]
        EvaluationReasonFallthrough Bool
True ->
            Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Item Object] -> Object
forall l. IsList l => [Item l] -> l
fromList [(Key
"kind", Value
"FALLTHROUGH"), (Key
"inExperiment", Bool -> Value
forall a. ToJSON a => a -> Value
toJSON Bool
True)]
        EvaluationReasonFallthrough Bool
False ->
            Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Item Object] -> Object
forall l. IsList l => [Item l] -> l
fromList [(Key
"kind", Value
"FALLTHROUGH")]
        (EvaluationReasonError EvalErrorKind
errorKind) ->
            Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ [Item Object] -> Object
forall l. IsList l => [Item l] -> l
fromList [(Key
"kind", Value
"ERROR"), (Key
"errorKind", EvalErrorKind -> Value
forall a. ToJSON a => a -> Value
toJSON EvalErrorKind
errorKind)]

isInExperiment :: EvaluationReason -> Bool
isInExperiment :: EvaluationReason -> Bool
isInExperiment EvaluationReason
reason = case EvaluationReason
reason of
    EvaluationReasonRuleMatch Natural
_ Text
_ Bool
inExperiment -> Bool
inExperiment
    EvaluationReasonFallthrough Bool
inExperiment -> Bool
inExperiment
    EvaluationReason
_ -> Bool
False

-- | Defines the possible values of the errorKind property of EvaluationReason.
data EvalErrorKind
    = -- | Indicates that there was an internal inconsistency in the flag data,
      -- e.g. a rule specified a nonexistent variation.
      EvalErrorKindMalformedFlag
    | -- | Indicates that the caller provided a flag key that did not match any
      -- known flag.
      EvalErrorFlagNotFound
    | -- | Indicates that the result value was not of the requested type, e.g.
      -- you called boolVariationDetail but the value was an integer.
      EvalErrorWrongType
    | -- | Indicates that the caller tried to evaluate a flag before the client
      -- had successfully initialized.
      EvalErrorClientNotReady
    | -- | Indicates that the caller tried to evaluate a flag with an invalid
      -- context
      EvalErrorInvalidContext
    | -- | Indicates that some error was returned by the external feature store.
      EvalErrorExternalStore !Text
    deriving ((forall x. EvalErrorKind -> Rep EvalErrorKind x)
-> (forall x. Rep EvalErrorKind x -> EvalErrorKind)
-> Generic EvalErrorKind
forall x. Rep EvalErrorKind x -> EvalErrorKind
forall x. EvalErrorKind -> Rep EvalErrorKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EvalErrorKind -> Rep EvalErrorKind x
from :: forall x. EvalErrorKind -> Rep EvalErrorKind x
$cto :: forall x. Rep EvalErrorKind x -> EvalErrorKind
to :: forall x. Rep EvalErrorKind x -> EvalErrorKind
Generic, EvalErrorKind -> EvalErrorKind -> Bool
(EvalErrorKind -> EvalErrorKind -> Bool)
-> (EvalErrorKind -> EvalErrorKind -> Bool) -> Eq EvalErrorKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EvalErrorKind -> EvalErrorKind -> Bool
== :: EvalErrorKind -> EvalErrorKind -> Bool
$c/= :: EvalErrorKind -> EvalErrorKind -> Bool
/= :: EvalErrorKind -> EvalErrorKind -> Bool
Eq, Int -> EvalErrorKind -> ShowS
[EvalErrorKind] -> ShowS
EvalErrorKind -> String
(Int -> EvalErrorKind -> ShowS)
-> (EvalErrorKind -> String)
-> ([EvalErrorKind] -> ShowS)
-> Show EvalErrorKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EvalErrorKind -> ShowS
showsPrec :: Int -> EvalErrorKind -> ShowS
$cshow :: EvalErrorKind -> String
show :: EvalErrorKind -> String
$cshowList :: [EvalErrorKind] -> ShowS
showList :: [EvalErrorKind] -> ShowS
Show)

instance ToJSON EvalErrorKind where
    toJSON :: EvalErrorKind -> Value
toJSON EvalErrorKind
x = Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ case EvalErrorKind
x of
        EvalErrorKind
EvalErrorKindMalformedFlag -> Text
"MALFORMED_FLAG"
        EvalErrorKind
EvalErrorFlagNotFound -> Text
"FLAG_NOT_FOUND"
        EvalErrorKind
EvalErrorWrongType -> Text
"WRONG_TYPE"
        EvalErrorKind
EvalErrorClientNotReady -> Text
"CLIENT_NOT_READY"
        EvalErrorExternalStore Text
_ -> Text
"EXTERNAL_STORE_ERROR"
        EvalErrorKind
EvalErrorInvalidContext -> Text
"ERROR_INVALID_CONTEXT"