{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- Context is a collection of attributes that can be referenced in flag
-- evaluations and analytics events.
--
-- To create a Context of a single kind, such as a user, you may use
-- 'makeContext'.
--
-- To create an LDContext with multiple kinds, use 'makeMultiContext'.
--
-- Additional properties can be set on a single-kind context using the set
-- methods found in this module.
--
-- Each method will always return a Context. However, that Context may be
-- invalid. You can check the validity of the resulting context, and the
-- associated errors by calling 'isValid' and 'getError'.
module LaunchDarkly.Server.Context
    ( Context
    , makeContext
    , makeMultiContext
    , withName
    , withAnonymous
    , withAttribute
    , withPrivateAttributes
    , isValid
    , getError
    , getIndividualContext
    , getValueForReference
    , getValue
    )
where

import Data.Aeson (Value (..))
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import LaunchDarkly.AesonCompat (lookupKey)
import LaunchDarkly.Server.Context.Internal (Context (..), MultiContext (..), SingleContext (..), makeContext, makeMultiContext, withAnonymous, withAttribute, withName, withPrivateAttributes)
import LaunchDarkly.Server.Reference (Reference)
import qualified LaunchDarkly.Server.Reference as R

-- | Determines if the provided context is valid.
isValid :: Context -> Bool
isValid :: Context -> Bool
isValid (Invalid Text
_) = Bool
False
isValid Context
_ = Bool
True

-- | Returns the error associated with the context if it is invalid.
getError :: Context -> Text
getError :: Context -> Text
getError (Invalid Text
e) = Text
e
getError Context
_ = Text
""

-- |
-- Returns the single-kind Context corresponding to one of the kinds in this
-- context.
--
-- If this method is called on a single-kind Context and the requested kind
-- matches the context's kind, then that context is returned.
--
-- If the method is called on a multi-context, the provided kind must match the
-- context kind of one of the individual contexts.
--
-- If there is no context corresponding to `kind`, the method returns Nothing.
getIndividualContext :: Text -> Context -> Maybe Context
getIndividualContext :: Text -> Context -> Maybe Context
getIndividualContext Text
kind (Multi (MultiContext {KeyMap SingleContext
contexts :: KeyMap SingleContext
$sel:contexts:MultiContext :: MultiContext -> KeyMap SingleContext
contexts})) = SingleContext -> Context
Single (SingleContext -> Context) -> Maybe SingleContext -> Maybe Context
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> KeyMap SingleContext -> Maybe SingleContext
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
kind KeyMap SingleContext
contexts
getIndividualContext Text
kind c :: Context
c@(Single (SingleContext {kind :: SingleContext -> Text
kind = Text
k}))
    | Text
kind Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
k = Context -> Maybe Context
forall a. a -> Maybe a
Just Context
c
    | Bool
otherwise = Maybe Context
forall a. Maybe a
Nothing
getIndividualContext Text
_ Context
_ = Maybe Context
forall a. Maybe a
Nothing

-- |
-- Looks up the value of any attribute of the Context by name. This includes
-- only attributes that are addressable in evaluations-- not metadata such as
-- private attributes.
--
-- For a single-kind context, the attribute name can be any custom attribute.
-- It can also be one of the built-in ones like "kind", "key", or "name".
--
-- For a multi-kind context, the only supported attribute name is "kind". Use
-- 'getIndividualContext' to inspect a Context for a particular kind and then
-- get its attributes.
--
-- This method does not support complex expressions for getting individual
-- values out of JSON objects or arrays, such as "/address/street". Use
-- 'getValueForReference' for that purpose.
--
-- If the value is found, the return value is the attribute value; otherwise,
-- it is Null.
getValue :: Text -> Context -> Value
getValue :: Text -> Context -> Value
getValue Text
ref = Reference -> Context -> Value
getValueForReference (Text -> Reference
R.makeLiteral Text
ref)

-- |
-- Looks up the value of any attribute of the Context, or a value contained
-- within an attribute, based on a 'Reference' instance. This includes only
-- attributes that are addressable in evaluations-- not metadata such as
-- private attributes.
--
-- This implements the same behavior that the SDK uses to resolve attribute
-- references during a flag evaluation. In a single-kind context, the
-- 'Reference' can represent a simple attribute name-- either a built-in one
-- like "name" or "key", or a custom attribute -- or, it can be a
-- slash-delimited path using a JSON-Pointer-like syntax. See 'Reference' for
-- more details.
--
-- For a multi-kind context, the only supported attribute name is "kind". Use
-- 'getIndividualContext' to inspect a Context for a particular kind and then
-- get its attributes.
--
-- If the value is found, the return value is the attribute value; otherwise,
-- it is Null.
getValueForReference :: Reference -> Context -> Value
getValueForReference :: Reference -> Context -> Value
getValueForReference (Reference -> Bool
R.isValid -> Bool
False) Context
_ = Value
Null
getValueForReference Reference
reference Context
context = case Reference -> [Text]
R.getComponents Reference
reference of
    [] -> Value
Null
    (Text
component : [Text]
components) ->
        let value :: Value
value = Text -> Context -> Value
getTopLevelValue Text
component Context
context
         in (Value -> Text -> Value) -> Value -> [Text] -> Value
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Value -> Text -> Value
getValueFromJsonObject Value
value [Text]
components

-- This helper method retrieves a Value from a JSON object type.
--
-- If the key does not exist, or the type isn't an object, this method will
-- return Null.
getValueFromJsonObject :: Value -> Text -> Value
getValueFromJsonObject :: Value -> Text -> Value
getValueFromJsonObject (Object Object
nm) Text
component = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
component Object
nm)
getValueFromJsonObject Value
_ Text
_ = Value
Null

-- Attribute retrieval can mostly be defined recursively. However, this isn't
-- true for the top level attribute since the entire context isn't stored in a
-- single object property.
--
-- To prime the recursion, we define this simple helper function to retrieve
-- attributes addressable at the top level.
getTopLevelValue :: Text -> Context -> Value
getTopLevelValue :: Text -> Context -> Value
getTopLevelValue Text
_ (Invalid Text
_) = Value
Null
getTopLevelValue Text
"kind" (Multi MultiContext
_) = Value
"multi"
getTopLevelValue Text
_ (Multi MultiContext
_) = Value
Null
getTopLevelValue Text
"key" (Single SingleContext {Text
key :: Text
$sel:key:SingleContext :: SingleContext -> Text
key}) = Text -> Value
String Text
key
getTopLevelValue Text
"kind" (Single SingleContext {Text
kind :: SingleContext -> Text
kind :: Text
kind}) = Text -> Value
String Text
kind
getTopLevelValue Text
"name" (Single SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Maybe Text
Nothing}) = Value
Null
getTopLevelValue Text
"name" (Single SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Just Text
n}) = Text -> Value
String Text
n
getTopLevelValue Text
"anonymous" (Single SingleContext {Bool
anonymous :: Bool
$sel:anonymous:SingleContext :: SingleContext -> Bool
anonymous}) = Bool -> Value
Bool Bool
anonymous
getTopLevelValue Text
_ (Single SingleContext {$sel:attributes:SingleContext :: SingleContext -> Maybe Object
attributes = Maybe Object
Nothing}) = Value
Null
getTopLevelValue Text
key (Single SingleContext {$sel:attributes:SingleContext :: SingleContext -> Maybe Object
attributes = Just Object
attrs}) = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Object -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
key Object
attrs