{-# 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 _) = Bool
False
isValid _ = Bool
True

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

-- |
-- 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 kind :: Text
kind (Multi (MultiContext {KeyMap SingleContext
$sel:contexts:MultiContext :: MultiContext -> KeyMap SingleContext
contexts :: 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 -> HashMap Text v -> Maybe v
lookupKey Text
kind KeyMap SingleContext
contexts
getIndividualContext kind :: Text
kind c :: Context
c@(Single (SingleContext {$sel:kind:SingleContext :: 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 _ _ = 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 ref :: 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) _ = Value
Null
getValueForReference reference :: Reference
reference context :: Context
context = case Reference -> [Text]
R.getComponents Reference
reference of
    [] -> Value
Null
    (component :: Text
component : components :: [Text]
components) ->
        let value :: Value
value = Text -> Context -> Value
getTopLevelValue Text
component Context
context
         in (Value -> Text -> Value) -> Value -> [Text] -> Value
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 nm :: Object
nm) component :: Text
component = Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Text -> Object -> Maybe Value
forall v. Text -> HashMap Text v -> Maybe v
lookupKey Text
component Object
nm)
getValueFromJsonObject _ _ = 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 _ (Invalid _) = Value
Null
getTopLevelValue "kind" (Multi _) = "multi"
getTopLevelValue _ (Multi _) = Value
Null
getTopLevelValue "key" (Single SingleContext {Text
$sel:key:SingleContext :: SingleContext -> Text
key :: Text
key}) = Text -> Value
String Text
key
getTopLevelValue "kind" (Single SingleContext {Text
kind :: Text
$sel:kind:SingleContext :: SingleContext -> Text
kind}) = Text -> Value
String Text
kind
getTopLevelValue "name" (Single SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Maybe Text
Nothing}) = Value
Null
getTopLevelValue "name" (Single SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Just n :: Text
n}) = Text -> Value
String Text
n
getTopLevelValue "anonymous" (Single SingleContext {Bool
$sel:anonymous:SingleContext :: SingleContext -> Bool
anonymous :: Bool
anonymous}) = Bool -> Value
Bool Bool
anonymous
getTopLevelValue _ (Single SingleContext {$sel:attributes:SingleContext :: SingleContext -> Maybe Object
attributes = Maybe Object
Nothing}) = Value
Null
getTopLevelValue key :: Text
key (Single SingleContext {$sel:attributes:SingleContext :: SingleContext -> Maybe Object
attributes = Just attrs :: 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 -> HashMap Text v -> Maybe v
lookupKey Text
key Object
attrs