{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
module LaunchDarkly.Server.Context.Internal
( Context (..)
, SingleContext (..)
, MultiContext (..)
, makeContext
, makeMultiContext
, withName
, withAnonymous
, withAttribute
, withPrivateAttributes
, getKey
, getKeys
, getCanonicalKey
, getKinds
, redactContext
, redactContextRedactAnonymous
)
where
import Data.Aeson (FromJSON, Result (Success), ToJSON, Value (..), fromJSON, parseJSON, toJSON, withObject, (.:), (.:?))
import Data.Aeson.Types (Parser, prependFailure, typeMismatch)
import Data.Function ((&))
import Data.Generics.Product (getField, setField)
import qualified Data.HashSet as HS
import Data.List (sortBy)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Set (Set)
import qualified Data.Set as S
import Data.Text (Text, intercalate, replace, unpack)
import qualified GHC.Exts as Exts (fromList)
import GHC.Generics (Generic)
import LaunchDarkly.AesonCompat (KeyMap, deleteKey, emptyObject, foldrWithKey, fromList, insertKey, keyMapUnion, lookupKey, mapValues, objectKeys, singleton, toList)
import LaunchDarkly.Server.Config (Config)
import LaunchDarkly.Server.Reference (Reference)
import qualified LaunchDarkly.Server.Reference as R
data Context
= Single SingleContext
| Multi MultiContext
| Invalid {Context -> Text
error :: !Text}
deriving ((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, 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, 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)
instance ToJSON Context where
toJSON :: Context -> Value
toJSON (Single SingleContext
c) = SingleContext -> Value
forall a. ToJSON a => a -> Value
toJSON SingleContext
c
toJSON (Multi MultiContext
c) = MultiContext -> Value
forall a. ToJSON a => a -> Value
toJSON MultiContext
c
toJSON (Invalid Text
c) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
c
instance FromJSON Context where
parseJSON :: Value -> Parser Context
parseJSON a :: Value
a@(Object KeyMap Value
o) =
case Text -> KeyMap Value -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
"kind" KeyMap Value
o of
Maybe Value
Nothing -> Value -> Parser Context
parseLegacyUser Value
a
Just (String Text
"multi") -> Value -> Parser Context
parseMultiContext Value
a
Just Value
_ -> Value -> Parser Context
parseSingleContext Value
a
parseJSON Value
invalid = String -> Parser Context -> Parser Context
forall a. String -> Parser a -> Parser a
prependFailure String
"parsing Context failed, " (String -> Value -> Parser Context
forall a. String -> Value -> Parser a
typeMismatch String
"Object" Value
invalid)
data SingleContext = SingleContext
{ SingleContext -> Text
key :: !Text
, SingleContext -> Text
fullKey :: !Text
, SingleContext -> Text
kind :: !Text
, SingleContext -> Maybe Text
name :: !(Maybe Text)
, SingleContext -> Bool
anonymous :: !Bool
, SingleContext -> Maybe (KeyMap Value)
attributes :: !(Maybe (KeyMap Value))
, SingleContext -> Maybe (Set Reference)
privateAttributes :: !(Maybe (Set Reference))
}
deriving ((forall x. SingleContext -> Rep SingleContext x)
-> (forall x. Rep SingleContext x -> SingleContext)
-> Generic SingleContext
forall x. Rep SingleContext x -> SingleContext
forall x. SingleContext -> Rep SingleContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SingleContext -> Rep SingleContext x
from :: forall x. SingleContext -> Rep SingleContext x
$cto :: forall x. Rep SingleContext x -> SingleContext
to :: forall x. Rep SingleContext x -> SingleContext
Generic, Int -> SingleContext -> ShowS
[SingleContext] -> ShowS
SingleContext -> String
(Int -> SingleContext -> ShowS)
-> (SingleContext -> String)
-> ([SingleContext] -> ShowS)
-> Show SingleContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SingleContext -> ShowS
showsPrec :: Int -> SingleContext -> ShowS
$cshow :: SingleContext -> String
show :: SingleContext -> String
$cshowList :: [SingleContext] -> ShowS
showList :: [SingleContext] -> ShowS
Show, SingleContext -> SingleContext -> Bool
(SingleContext -> SingleContext -> Bool)
-> (SingleContext -> SingleContext -> Bool) -> Eq SingleContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SingleContext -> SingleContext -> Bool
== :: SingleContext -> SingleContext -> Bool
$c/= :: SingleContext -> SingleContext -> Bool
/= :: SingleContext -> SingleContext -> Bool
Eq)
instance ToJSON SingleContext where
toJSON :: SingleContext -> Value
toJSON = (Bool -> SingleContext -> Value
toJsonObject Bool
True)
data MultiContext = MultiContext
{ MultiContext -> Text
fullKey :: !Text
, MultiContext -> KeyMap SingleContext
contexts :: !(KeyMap SingleContext)
}
deriving ((forall x. MultiContext -> Rep MultiContext x)
-> (forall x. Rep MultiContext x -> MultiContext)
-> Generic MultiContext
forall x. Rep MultiContext x -> MultiContext
forall x. MultiContext -> Rep MultiContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MultiContext -> Rep MultiContext x
from :: forall x. MultiContext -> Rep MultiContext x
$cto :: forall x. Rep MultiContext x -> MultiContext
to :: forall x. Rep MultiContext x -> MultiContext
Generic, Int -> MultiContext -> ShowS
[MultiContext] -> ShowS
MultiContext -> String
(Int -> MultiContext -> ShowS)
-> (MultiContext -> String)
-> ([MultiContext] -> ShowS)
-> Show MultiContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MultiContext -> ShowS
showsPrec :: Int -> MultiContext -> ShowS
$cshow :: MultiContext -> String
show :: MultiContext -> String
$cshowList :: [MultiContext] -> ShowS
showList :: [MultiContext] -> ShowS
Show, MultiContext -> MultiContext -> Bool
(MultiContext -> MultiContext -> Bool)
-> (MultiContext -> MultiContext -> Bool) -> Eq MultiContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MultiContext -> MultiContext -> Bool
== :: MultiContext -> MultiContext -> Bool
$c/= :: MultiContext -> MultiContext -> Bool
/= :: MultiContext -> MultiContext -> Bool
Eq)
instance ToJSON MultiContext where
toJSON :: MultiContext -> Value
toJSON (MultiContext {KeyMap SingleContext
$sel:contexts:MultiContext :: MultiContext -> KeyMap SingleContext
contexts :: KeyMap SingleContext
contexts}) =
(SingleContext -> Value) -> KeyMap SingleContext -> KeyMap Value
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\SingleContext
c -> Bool -> SingleContext -> Value
toJsonObject Bool
False SingleContext
c) KeyMap SingleContext
contexts
KeyMap Value -> (KeyMap Value -> KeyMap Value) -> KeyMap Value
forall a b. a -> (a -> b) -> b
& Text -> Value -> KeyMap Value -> KeyMap Value
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"kind" Value
"multi"
KeyMap Value -> (KeyMap Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& KeyMap Value -> Value
Object
makeContext :: Text -> Text -> Context
makeContext :: Text -> Text -> Context
makeContext Text
"" Text
_ = Invalid {$sel:error:Single :: Text
error = Text
"context key must not be empty"}
makeContext Text
key Text
kind = Text -> Text -> Context
makeSingleContext Text
key Text
kind
makeSingleContext :: Text -> Text -> Context
makeSingleContext :: Text -> Text -> Context
makeSingleContext Text
_ Text
"" = Invalid {$sel:error:Single :: Text
error = Text
"context kind must not be empty"}
makeSingleContext Text
_ Text
"kind" = Invalid {$sel:error:Single :: Text
error = Text
"context kind cannot be 'kind'"}
makeSingleContext Text
_ Text
"multi" = Invalid {$sel:error:Single :: Text
error = Text
"context kind cannot be 'multi'"}
makeSingleContext Text
key Text
kind
| ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'a' .. Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A' .. Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'.', Char
'-', Char
'_']) (Text -> String
unpack Text
kind)) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
False = Invalid {$sel:error:Single :: Text
error = Text
"context kind contains disallowed characters"}
| Bool
otherwise =
SingleContext -> Context
Single
SingleContext
{ $sel:key:SingleContext :: Text
key = Text
key
, $sel:fullKey:SingleContext :: Text
fullKey = Text -> Text -> Text
canonicalizeKey Text
key Text
kind
, $sel:kind:SingleContext :: Text
kind = Text
kind
, $sel:name:SingleContext :: Maybe Text
name = Maybe Text
forall a. Maybe a
Nothing
, $sel:anonymous:SingleContext :: Bool
anonymous = Bool
False
, $sel:attributes:SingleContext :: Maybe (KeyMap Value)
attributes = Maybe (KeyMap Value)
forall a. Maybe a
Nothing
, $sel:privateAttributes:SingleContext :: Maybe (Set Reference)
privateAttributes = Maybe (Set Reference)
forall a. Maybe a
Nothing
}
makeMultiContext :: [Context] -> Context
makeMultiContext :: [Context] -> Context
makeMultiContext [] = Invalid {$sel:error:Single :: Text
error = Text
"multi-kind contexts require at least one single-kind context"}
makeMultiContext [c :: Context
c@(Single SingleContext
_)] = Context
c
makeMultiContext [Context]
contexts =
let singleContexts :: [SingleContext]
singleContexts = (Context -> Maybe SingleContext) -> [Context] -> [SingleContext]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Context -> Maybe SingleContext
unwrapSingleContext [Context]
contexts
sorted :: [SingleContext]
sorted = (SingleContext -> SingleContext -> Ordering)
-> [SingleContext] -> [SingleContext]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\SingleContext
lhs SingleContext
rhs -> Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SingleContext -> Text
kind SingleContext
lhs) (SingleContext -> Text
kind SingleContext
rhs)) [SingleContext]
singleContexts
kinds :: HashSet Text
kinds = [Text] -> HashSet Text
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([Text] -> HashSet Text) -> [Text] -> HashSet Text
forall a b. (a -> b) -> a -> b
$ (SingleContext -> Text) -> [SingleContext] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SingleContext -> Text
kind [SingleContext]
singleContexts
in case ([Context] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Context]
contexts, [SingleContext] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [SingleContext]
singleContexts, HashSet Text -> Int
forall a. HashSet a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length HashSet Text
kinds) of
(Int
a, Int
b, Int
_) | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
b -> Invalid {$sel:error:Single :: Text
error = Text
"multi-kind contexts can only contain single-kind contexts"}
(Int
a, Int
_, Int
c) | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
c -> Invalid {$sel:error:Single :: Text
error = Text
"multi-kind contexts cannot contain two single-kind contexts with the same kind"}
(Int, Int, Int)
_ ->
MultiContext -> Context
Multi
MultiContext
{ $sel:fullKey:MultiContext :: Text
fullKey = Text -> [Text] -> Text
intercalate Text
":" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (SingleContext -> Text) -> [SingleContext] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\SingleContext
c -> Text -> Text -> Text
canonicalizeKey (SingleContext -> Text
key SingleContext
c) (SingleContext -> Text
kind SingleContext
c)) [SingleContext]
sorted
, $sel:contexts:MultiContext :: KeyMap SingleContext
contexts = [(Text, SingleContext)] -> KeyMap SingleContext
forall v. [(Text, v)] -> KeyMap v
fromList ([(Text, SingleContext)] -> KeyMap SingleContext)
-> [(Text, SingleContext)] -> KeyMap SingleContext
forall a b. (a -> b) -> a -> b
$ (SingleContext -> (Text, SingleContext))
-> [SingleContext] -> [(Text, SingleContext)]
forall a b. (a -> b) -> [a] -> [b]
map (\SingleContext
c -> ((SingleContext -> Text
kind SingleContext
c), SingleContext
c)) [SingleContext]
singleContexts
}
withName :: Text -> Context -> Context
withName :: Text -> Context -> Context
withName Text
name (Single SingleContext
c) = SingleContext -> Context
Single (SingleContext -> Context) -> SingleContext -> Context
forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"name" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) SingleContext
c
withName Text
_ Context
c = Context
c
withAnonymous :: Bool -> Context -> Context
withAnonymous :: Bool -> Context -> Context
withAnonymous Bool
anonymous (Single SingleContext
c) = SingleContext -> Context
Single (SingleContext -> Context) -> SingleContext -> Context
forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) s a. HasField' f s a => a -> s -> s
setField @"anonymous" Bool
anonymous SingleContext
c
withAnonymous Bool
_ Context
c = Context
c
withAttribute :: Text -> Value -> Context -> Context
withAttribute :: Text -> Value -> Context -> Context
withAttribute Text
"key" Value
_ Context
c = Context
c
withAttribute Text
"kind" Value
_ Context
c = Context
c
withAttribute Text
"name" (String Text
value) Context
c = Text -> Context -> Context
withName Text
value Context
c
withAttribute Text
"name" Value
Null (Single SingleContext
c) = SingleContext -> Context
Single (SingleContext -> Context) -> SingleContext -> Context
forall a b. (a -> b) -> a -> b
$ SingleContext
c {name = Nothing}
withAttribute Text
"name" Value
_ Context
c = Context
c
withAttribute Text
"anonymous" (Bool Bool
value) Context
c = Bool -> Context -> Context
withAnonymous Bool
value Context
c
withAttribute Text
"anonymous" Value
_ Context
c = Context
c
withAttribute Text
"_meta" Value
_ Context
c = Context
c
withAttribute Text
"privateAttributeNames" Value
_ Context
c = Context
c
withAttribute Text
_ Value
Null c :: Context
c@(Single SingleContext {$sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Maybe (KeyMap Value)
Nothing}) = Context
c
withAttribute Text
attr Value
value (Single c :: SingleContext
c@(SingleContext {$sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Maybe (KeyMap Value)
Nothing})) =
SingleContext -> Context
Single (SingleContext -> Context) -> SingleContext -> Context
forall a b. (a -> b) -> a -> b
$ SingleContext
c {attributes = Just $ singleton attr value}
withAttribute Text
attr Value
Null (Single c :: SingleContext
c@(SingleContext {$sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Just KeyMap Value
attrs})) =
SingleContext -> Context
Single (SingleContext -> Context) -> SingleContext -> Context
forall a b. (a -> b) -> a -> b
$ SingleContext
c {attributes = Just $ deleteKey attr attrs}
withAttribute Text
attr Value
value (Single c :: SingleContext
c@(SingleContext {$sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Just KeyMap Value
attrs})) =
SingleContext -> Context
Single (SingleContext -> Context) -> SingleContext -> Context
forall a b. (a -> b) -> a -> b
$ SingleContext
c {attributes = Just $ insertKey attr value attrs}
withAttribute Text
_ Value
_ Context
c = Context
c
withPrivateAttributes :: Set Reference -> Context -> Context
withPrivateAttributes :: Set Reference -> Context -> Context
withPrivateAttributes Set Reference
attrs (Single SingleContext
c)
| Set Reference -> Bool
forall a. Set a -> Bool
S.null Set Reference
attrs = SingleContext -> Context
Single (SingleContext -> Context) -> SingleContext -> Context
forall a b. (a -> b) -> a -> b
$ SingleContext
c {privateAttributes = Nothing}
| Bool
otherwise = SingleContext -> Context
Single (SingleContext -> Context) -> SingleContext -> Context
forall a b. (a -> b) -> a -> b
$ SingleContext
c {privateAttributes = Just attrs}
withPrivateAttributes Set Reference
_ Context
c = Context
c
canonicalizeKey :: Text -> Text -> Text
canonicalizeKey :: Text -> Text -> Text
canonicalizeKey Text
key Text
"user" = Text
key
canonicalizeKey Text
key Text
kind = Text
kind Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
replace Text
"%" Text
"%25" Text
key Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
replace Text
":" Text
"%3A")
unwrapSingleContext :: Context -> Maybe SingleContext
unwrapSingleContext :: Context -> Maybe SingleContext
unwrapSingleContext (Single SingleContext
c) = SingleContext -> Maybe SingleContext
forall a. a -> Maybe a
Just SingleContext
c
unwrapSingleContext Context
_ = Maybe SingleContext
forall a. Maybe a
Nothing
getKey :: Context -> Text
getKey :: Context -> Text
getKey (Single SingleContext
c) = SingleContext -> Text
key SingleContext
c
getKey Context
_ = Text
""
getKeys :: Context -> KeyMap Text
getKeys :: Context -> KeyMap Text
getKeys (Single SingleContext
c) = Text -> Text -> KeyMap Text
forall v. Text -> v -> KeyMap v
singleton (SingleContext -> Text
kind SingleContext
c) (SingleContext -> Text
key SingleContext
c)
getKeys (Multi (MultiContext {KeyMap SingleContext
$sel:contexts:MultiContext :: MultiContext -> KeyMap SingleContext
contexts :: KeyMap SingleContext
contexts})) = (SingleContext -> Text) -> KeyMap SingleContext -> KeyMap Text
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues SingleContext -> Text
key KeyMap SingleContext
contexts
getKeys Context
_ = KeyMap Text
forall v. KeyMap v
emptyObject
getCanonicalKey :: Context -> Text
getCanonicalKey :: Context -> Text
getCanonicalKey (Single SingleContext
c) = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"fullKey" SingleContext
c
getCanonicalKey (Multi MultiContext
c) = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"fullKey" MultiContext
c
getCanonicalKey Context
_ = Text
""
getKinds :: Context -> [Text]
getKinds :: Context -> [Text]
getKinds (Single SingleContext
c) = [SingleContext -> Text
kind SingleContext
c]
getKinds (Multi (MultiContext {KeyMap SingleContext
$sel:contexts:MultiContext :: MultiContext -> KeyMap SingleContext
contexts :: KeyMap SingleContext
contexts})) = KeyMap SingleContext -> [Text]
forall v. KeyMap v -> [Text]
objectKeys KeyMap SingleContext
contexts
getKinds Context
_ = []
toJsonObject :: Bool -> SingleContext -> Value
toJsonObject :: Bool -> SingleContext -> Value
toJsonObject Bool
includeKind SingleContext
context =
KeyMap Value -> Value
Object (KeyMap Value -> Value) -> KeyMap Value -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> KeyMap Value
forall v. [(Text, v)] -> KeyMap v
fromList ([(Text, Value)] -> KeyMap Value)
-> [(Text, Value)] -> KeyMap Value
forall a b. (a -> b) -> a -> b
$ (SingleContext -> [(Text, Value)]
getMapOfRedactableProperties SingleContext
context [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. [a] -> [a] -> [a]
++ Bool -> SingleContext -> [(Text, Value)]
getMapOfRequiredProperties Bool
includeKind SingleContext
context)
getMapOfRedactableProperties :: SingleContext -> [(Text, Value)]
getMapOfRedactableProperties :: SingleContext -> [(Text, Value)]
getMapOfRedactableProperties (SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Maybe Text
Nothing, $sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Maybe (KeyMap Value)
Nothing}) = []
getMapOfRedactableProperties (SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Maybe Text
Nothing, $sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Just KeyMap Value
attrs}) = KeyMap Value -> [(Text, Value)]
forall v. KeyMap v -> [(Text, v)]
toList KeyMap Value
attrs
getMapOfRedactableProperties (SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Just Text
n, $sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Just KeyMap Value
attrs}) = (Text
"name", Text -> Value
String Text
n) (Text, Value) -> [(Text, Value)] -> [(Text, Value)]
forall a. a -> [a] -> [a]
: (KeyMap Value -> [(Text, Value)]
forall v. KeyMap v -> [(Text, v)]
toList KeyMap Value
attrs)
getMapOfRedactableProperties (SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Just Text
n, $sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Maybe (KeyMap Value)
Nothing}) = [(Text
"name", Text -> Value
String Text
n)]
getMapOfRequiredProperties :: Bool -> SingleContext -> [(Text, Value)]
getMapOfRequiredProperties :: Bool -> SingleContext -> [(Text, Value)]
getMapOfRequiredProperties Bool
includeKind SingleContext {Text
$sel:key:SingleContext :: SingleContext -> Text
key :: Text
key, Text
$sel:kind:SingleContext :: SingleContext -> Text
kind :: Text
kind, Bool
$sel:anonymous:SingleContext :: SingleContext -> Bool
anonymous :: Bool
anonymous, Maybe (Set Reference)
$sel:privateAttributes:SingleContext :: SingleContext -> Maybe (Set Reference)
privateAttributes :: Maybe (Set Reference)
privateAttributes} =
((Text, Value) -> Bool) -> [(Text, Value)] -> [(Text, Value)]
forall a. (a -> Bool) -> [a] -> [a]
filter
(Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Value
Null (Value -> Bool)
-> ((Text, Value) -> Value) -> (Text, Value) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Value) -> Value
forall a b. (a, b) -> b
snd)
[ (Text
"key", Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Text
key)
, (Text
"kind", Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ if Bool
includeKind then Text -> Value
String Text
kind else Value
Null)
, (Text
"anonymous", Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ if Bool
anonymous then Bool -> Value
Bool Bool
True else Value
Null)
, (Text
"_meta", Value -> (Set Reference -> Value) -> Maybe (Set Reference) -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Null Set Reference -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe (Set Reference)
privateAttributes)
,
( Text
"_meta"
, case Maybe (Set Reference)
privateAttributes of
Maybe (Set Reference)
Nothing -> Value
Null
Just Set Reference
attrs -> KeyMap Value -> Value
forall a. ToJSON a => a -> Value
toJSON (KeyMap Value -> Value) -> KeyMap Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> KeyMap Value
forall v. Text -> v -> KeyMap v
singleton Text
"privateAttributes" (Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Item Array] -> Array
forall l. IsList l => [Item l] -> l
Exts.fromList ([Item Array] -> Array) -> [Item Array] -> Array
forall a b. (a -> b) -> a -> b
$ (Reference -> Item Array) -> [Reference] -> [Item Array]
forall a b. (a -> b) -> [a] -> [b]
map Reference -> Value
Reference -> Item Array
forall a. ToJSON a => a -> Value
toJSON ([Reference] -> [Item Array]) -> [Reference] -> [Item Array]
forall a b. (a -> b) -> a -> b
$ Set Reference -> [Reference]
forall a. Set a -> [a]
S.elems Set Reference
attrs)
)
]
parseLegacyUser :: Value -> Parser Context
parseLegacyUser :: Value -> Parser Context
parseLegacyUser = String
-> (KeyMap Value -> Parser Context) -> Value -> Parser Context
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"LegacyUser" ((KeyMap Value -> Parser Context) -> Value -> Parser Context)
-> (KeyMap Value -> Parser Context) -> Value -> Parser Context
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> do
(Text
key :: Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"key"
(Maybe Text
secondary :: Maybe Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"secondary"
(Maybe Text
ip :: Maybe Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"ip"
(Maybe Text
country :: Maybe Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"country"
(Maybe Text
email :: Maybe Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"email"
(Maybe Text
firstName :: Maybe Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"firstName"
(Maybe Text
lastName :: Maybe Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"lastName"
(Maybe Text
avatar :: Maybe Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"avatar"
(Maybe Text
name :: Maybe Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Text)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"name"
(Maybe Bool
anonymous :: Maybe Bool) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"anonymous"
(Maybe (KeyMap Value)
custom :: Maybe (KeyMap Value)) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe (KeyMap Value))
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"custom"
(Maybe [Text]
privateAttributeNames :: Maybe [Text]) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"privateAttributeNames"
let context :: Context
context =
Text -> Text -> Context
makeSingleContext Text
key Text
"user"
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Text -> Value -> Context -> Context
withAttribute Text
"secondary" (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
secondary))
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Text -> Value -> Context -> Context
withAttribute Text
"ip" (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
ip))
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Text -> Value -> Context -> Context
withAttribute Text
"country" (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
country))
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Text -> Value -> Context -> Context
withAttribute Text
"email" (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
email))
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Text -> Value -> Context -> Context
withAttribute Text
"firstName" (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
firstName))
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Text -> Value -> Context -> Context
withAttribute Text
"lastName" (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
lastName))
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Text -> Value -> Context -> Context
withAttribute Text
"avatar" (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
avatar))
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Text -> Value -> Context -> Context
withAttribute Text
"name" (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
name))
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Text -> Value -> Context -> Context
withAttribute Text
"anonymous" (Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Bool -> Value
Bool (Bool -> Value) -> Maybe Bool -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Bool
anonymous))
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Set Reference -> Context -> Context
withPrivateAttributes ([Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
S.fromList ([Reference] -> Set Reference) -> [Reference] -> Set Reference
forall a b. (a -> b) -> a -> b
$ (Text -> Reference) -> [Text] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Reference
R.makeLiteral ([Text] -> [Reference]) -> [Text] -> [Reference]
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
privateAttributeNames)
in Context -> Parser Context
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Parser Context) -> Context -> Parser Context
forall a b. (a -> b) -> a -> b
$ (Text -> Value -> Context -> Context)
-> Context -> KeyMap Value -> Context
forall v a. (Text -> v -> a -> a) -> a -> KeyMap v -> a
foldrWithKey (\Text
k Value
v Context
c -> Text -> Value -> Context -> Context
withAttribute Text
k Value
v Context
c) Context
context (KeyMap Value -> Maybe (KeyMap Value) -> KeyMap Value
forall a. a -> Maybe a -> a
fromMaybe KeyMap Value
forall v. KeyMap v
emptyObject Maybe (KeyMap Value)
custom)
parseSingleContext :: Value -> Parser Context
parseSingleContext :: Value -> Parser Context
parseSingleContext = String
-> (KeyMap Value -> Parser Context) -> Value -> Parser Context
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"SingleContext" ((KeyMap Value -> Parser Context) -> Value -> Parser Context)
-> (KeyMap Value -> Parser Context) -> Value -> Parser Context
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> do
(Text
key :: Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"key"
(Text
kind :: Text) <- KeyMap Value
o KeyMap Value -> Key -> Parser Text
forall a. FromJSON a => KeyMap Value -> Key -> Parser a
.: Key
"kind"
(Maybe (KeyMap Value)
meta :: Maybe (KeyMap Value)) <- KeyMap Value
o KeyMap Value -> Key -> Parser (Maybe (KeyMap Value))
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"_meta"
(Maybe [Text]
privateAttributes :: Maybe [Text]) <- (KeyMap Value -> Maybe (KeyMap Value) -> KeyMap Value
forall a. a -> Maybe a -> a
fromMaybe KeyMap Value
forall v. KeyMap v
emptyObject Maybe (KeyMap Value)
meta) KeyMap Value -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => KeyMap Value -> Key -> Parser (Maybe a)
.:? Key
"privateAttributes"
let context :: Context
context =
Text -> Text -> Context
makeContext Text
key Text
kind
Context -> (Context -> Context) -> Context
forall a b. a -> (a -> b) -> b
& Set Reference -> Context -> Context
withPrivateAttributes ([Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
S.fromList ([Reference] -> Set Reference) -> [Reference] -> Set Reference
forall a b. (a -> b) -> a -> b
$ (Text -> Reference) -> [Text] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Reference
R.makeReference ([Text] -> [Reference]) -> [Text] -> [Reference]
forall a b. (a -> b) -> a -> b
$ [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Text]
privateAttributes)
in Context -> Parser Context
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Parser Context) -> Context -> Parser Context
forall a b. (a -> b) -> a -> b
$ (Text -> Value -> Context -> Context)
-> Context -> KeyMap Value -> Context
forall v a. (Text -> v -> a -> a) -> a -> KeyMap v -> a
foldrWithKey (\Text
k Value
v Context
c -> Text -> Value -> Context -> Context
withAttribute Text
k Value
v Context
c) Context
context KeyMap Value
o
parseMultiContext :: Value -> Parser Context
parseMultiContext :: Value -> Parser Context
parseMultiContext = String
-> (KeyMap Value -> Parser Context) -> Value -> Parser Context
forall a. String -> (KeyMap Value -> Parser a) -> Value -> Parser a
withObject String
"MultiContext" ((KeyMap Value -> Parser Context) -> Value -> Parser Context)
-> (KeyMap Value -> Parser Context) -> Value -> Parser Context
forall a b. (a -> b) -> a -> b
$ \KeyMap Value
o -> do
let contextLists :: [(Text, Value)]
contextLists = KeyMap Value -> [(Text, Value)]
forall v. KeyMap v -> [(Text, v)]
toList (KeyMap Value -> [(Text, Value)])
-> KeyMap Value -> [(Text, Value)]
forall a b. (a -> b) -> a -> b
$ Text -> KeyMap Value -> KeyMap Value
forall v. Text -> KeyMap v -> KeyMap v
deleteKey Text
"kind" KeyMap Value
o
contextObjectLists :: [(Text, KeyMap Value)]
contextObjectLists = ((Text, Value) -> Maybe (Text, KeyMap Value))
-> [(Text, Value)] -> [(Text, KeyMap Value)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Text
k, Value
v) -> case (Text
k, Value
v) of (Text
_, Object KeyMap Value
obj) -> (Text, KeyMap Value) -> Maybe (Text, KeyMap Value)
forall a. a -> Maybe a
Just (Text
k, KeyMap Value
obj); (Text, Value)
_ -> Maybe (Text, KeyMap Value)
forall a. Maybe a
Nothing) [(Text, Value)]
contextLists
results :: [Result Context]
results = ((Text, KeyMap Value) -> Result Context)
-> [(Text, KeyMap Value)] -> [Result Context]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
kind, KeyMap Value
obj) -> Value -> Result Context
forall a. FromJSON a => Value -> Result a
fromJSON (Value -> Result Context) -> Value -> Result Context
forall a b. (a -> b) -> a -> b
$ KeyMap Value -> Value
Object (KeyMap Value -> Value) -> KeyMap Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> KeyMap Value -> KeyMap Value
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"kind" (Text -> Value
String Text
kind) KeyMap Value
obj) [(Text, KeyMap Value)]
contextObjectLists
single :: [Context]
single = (Result Context -> Maybe Context) -> [Result Context] -> [Context]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Result Context
result -> case Result Context
result of Success Context
r -> Context -> Maybe Context
forall a. a -> Maybe a
Just Context
r; Result Context
_ -> Maybe Context
forall a. Maybe a
Nothing) [Result Context]
results
in case ([(Text, Value)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Value)]
contextLists, [Context] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Context]
single) of
(Int
a, Int
b) | Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
b -> Context -> Parser Context
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Parser Context) -> Context -> Parser Context
forall a b. (a -> b) -> a -> b
$ Invalid {$sel:error:Single :: Text
error = Text
"multi-kind context JSON contains non-single-kind contexts"}
(Int
_, Int
_) -> Context -> Parser Context
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Parser Context) -> Context -> Parser Context
forall a b. (a -> b) -> a -> b
$ [Context] -> Context
makeMultiContext [Context]
single
redactContext :: Config -> Context -> Value
redactContext :: Config -> Context -> Value
redactContext Config
config Context
context = Config -> Context -> Bool -> Value
internalRedactContext Config
config Context
context Bool
False
redactContextRedactAnonymous :: Config -> Context -> Value
redactContextRedactAnonymous :: Config -> Context -> Value
redactContextRedactAnonymous Config
config Context
context = Config -> Context -> Bool -> Value
internalRedactContext Config
config Context
context Bool
True
internalRedactContext :: Config -> Context -> Bool -> Value
internalRedactContext :: Config -> Context -> Bool -> Value
internalRedactContext Config
_ (Invalid Text
_) Bool
_ = Value
Null
internalRedactContext Config
config (Multi MultiContext {KeyMap SingleContext
$sel:contexts:MultiContext :: MultiContext -> KeyMap SingleContext
contexts :: KeyMap SingleContext
contexts}) Bool
redactAnonymous =
(SingleContext -> Value) -> KeyMap SingleContext -> KeyMap Value
forall v1 v2. (v1 -> v2) -> KeyMap v1 -> KeyMap v2
mapValues (\SingleContext
context -> Bool -> SingleContext -> Set Reference -> Value
redactSingleContext Bool
False SingleContext
context (Config -> SingleContext -> Bool -> Set Reference
getAllPrivateAttributes Config
config SingleContext
context Bool
redactAnonymous)) KeyMap SingleContext
contexts
KeyMap Value -> (KeyMap Value -> KeyMap Value) -> KeyMap Value
forall a b. a -> (a -> b) -> b
& Text -> Value -> KeyMap Value -> KeyMap Value
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"kind" Value
"multi"
KeyMap Value -> (KeyMap Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& KeyMap Value -> Value
Object
Value -> (Value -> Value) -> Value
forall a b. a -> (a -> b) -> b
& Value -> Value
forall a. ToJSON a => a -> Value
toJSON
internalRedactContext Config
config (Single SingleContext
context) Bool
redactAnonymous =
Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ Bool -> SingleContext -> Set Reference -> Value
redactSingleContext Bool
True SingleContext
context (Config -> SingleContext -> Bool -> Set Reference
getAllPrivateAttributes Config
config SingleContext
context Bool
redactAnonymous)
redactSingleContext :: Bool -> SingleContext -> Set Reference -> Value
redactSingleContext :: Bool -> SingleContext -> Set Reference -> Value
redactSingleContext Bool
includeKind SingleContext
context Set Reference
privateAttributes =
let State {$sel:context:State :: State -> KeyMap Value
context = KeyMap Value
redactedContext, [Text]
redacted :: [Text]
$sel:redacted:State :: State -> [Text]
redacted} = (Reference -> State -> State) -> State -> Set Reference -> State
forall a b. (a -> b -> b) -> b -> Set a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Reference -> State -> State
applyRedaction State {$sel:context:State :: KeyMap Value
context = [(Text, Value)] -> KeyMap Value
forall v. [(Text, v)] -> KeyMap v
fromList ([(Text, Value)] -> KeyMap Value)
-> [(Text, Value)] -> KeyMap Value
forall a b. (a -> b) -> a -> b
$ SingleContext -> [(Text, Value)]
getMapOfRedactableProperties SingleContext
context, $sel:redacted:State :: [Text]
redacted = []} Set Reference
privateAttributes
redactedValues :: Value
redactedValues = Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Item Array] -> Array
forall l. IsList l => [Item l] -> l
Exts.fromList ([Item Array] -> Array) -> [Item Array] -> Array
forall a b. (a -> b) -> a -> b
$ (Text -> Value) -> [Text] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Value
String [Text]
redacted
required :: KeyMap Value
required = [(Text, Value)] -> KeyMap Value
forall v. [(Text, v)] -> KeyMap v
fromList ([(Text, Value)] -> KeyMap Value)
-> [(Text, Value)] -> KeyMap Value
forall a b. (a -> b) -> a -> b
$ Bool -> SingleContext -> [(Text, Value)]
getMapOfRequiredProperties Bool
includeKind SingleContext
context
in case [Text]
redacted of
[] -> KeyMap Value -> Value
Object (KeyMap Value -> Value) -> KeyMap Value -> Value
forall a b. (a -> b) -> a -> b
$ KeyMap Value -> KeyMap Value -> KeyMap Value
forall v. KeyMap v -> KeyMap v -> KeyMap v
keyMapUnion KeyMap Value
redactedContext KeyMap Value
required
[Text]
_ -> KeyMap Value -> Value
Object (KeyMap Value -> Value) -> KeyMap Value -> Value
forall a b. (a -> b) -> a -> b
$ KeyMap Value -> KeyMap Value -> KeyMap Value
forall v. KeyMap v -> KeyMap v -> KeyMap v
keyMapUnion KeyMap Value
redactedContext (Text -> Value -> KeyMap Value -> KeyMap Value
forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"_meta" (KeyMap Value -> Value
Object (KeyMap Value -> Value) -> KeyMap Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> KeyMap Value
forall v. Text -> v -> KeyMap v
singleton Text
"redactedAttributes" Value
redactedValues) KeyMap Value
required)
getAllTopLevelRedactableNames :: SingleContext -> Set Reference
getAllTopLevelRedactableNames :: SingleContext -> Set Reference
getAllTopLevelRedactableNames SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Maybe Text
Nothing, $sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Maybe (KeyMap Value)
Nothing} = Set Reference
forall a. Set a
S.empty
getAllTopLevelRedactableNames SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Just Text
_, $sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Maybe (KeyMap Value)
Nothing} = Reference -> Set Reference
forall a. a -> Set a
S.singleton (Reference -> Set Reference) -> Reference -> Set Reference
forall a b. (a -> b) -> a -> b
$ Text -> Reference
R.makeLiteral Text
"name"
getAllTopLevelRedactableNames SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Maybe Text
Nothing, $sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Just KeyMap Value
attrs} = [Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
S.fromList ([Reference] -> Set Reference) -> [Reference] -> Set Reference
forall a b. (a -> b) -> a -> b
$ (Text -> Reference) -> [Text] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Reference
R.makeLiteral ([Text] -> [Reference]) -> [Text] -> [Reference]
forall a b. (a -> b) -> a -> b
$ KeyMap Value -> [Text]
forall v. KeyMap v -> [Text]
objectKeys KeyMap Value
attrs
getAllTopLevelRedactableNames SingleContext {$sel:name:SingleContext :: SingleContext -> Maybe Text
name = Just Text
_, $sel:attributes:SingleContext :: SingleContext -> Maybe (KeyMap Value)
attributes = Just KeyMap Value
attrs} = [Reference] -> Set Reference
forall a. Ord a => [a] -> Set a
S.fromList ([Reference] -> Set Reference) -> [Reference] -> Set Reference
forall a b. (a -> b) -> a -> b
$ (Text -> Reference
R.makeLiteral Text
"name") Reference -> [Reference] -> [Reference]
forall a. a -> [a] -> [a]
: ((Text -> Reference) -> [Text] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Reference
R.makeLiteral ([Text] -> [Reference]) -> [Text] -> [Reference]
forall a b. (a -> b) -> a -> b
$ KeyMap Value -> [Text]
forall v. KeyMap v -> [Text]
objectKeys KeyMap Value
attrs)
getAllPrivateAttributes :: Config -> SingleContext -> Bool -> Set Reference
getAllPrivateAttributes :: Config -> SingleContext -> Bool -> Set Reference
getAllPrivateAttributes (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"allAttributesPrivate" -> Bool
True) SingleContext
context Bool
_ = SingleContext -> Set Reference
getAllTopLevelRedactableNames SingleContext
context
getAllPrivateAttributes Config
_ context :: SingleContext
context@(SingleContext {$sel:anonymous:SingleContext :: SingleContext -> Bool
anonymous = Bool
True}) Bool
True = SingleContext -> Set Reference
getAllTopLevelRedactableNames SingleContext
context
getAllPrivateAttributes Config
config SingleContext {$sel:privateAttributes:SingleContext :: SingleContext -> Maybe (Set Reference)
privateAttributes = Maybe (Set Reference)
Nothing} Bool
_ = forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"privateAttributeNames" Config
config
getAllPrivateAttributes Config
config SingleContext {$sel:privateAttributes:SingleContext :: SingleContext -> Maybe (Set Reference)
privateAttributes = Just Set Reference
attrs} Bool
_ = Set Reference -> Set Reference -> Set Reference
forall a. Ord a => Set a -> Set a -> Set a
S.union (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"privateAttributeNames" Config
config) Set Reference
attrs
data State = State
{ State -> KeyMap Value
context :: KeyMap Value
, State -> [Text]
redacted :: ![Text]
}
data RedactState = RedactState
{ RedactState -> KeyMap Value
context :: KeyMap Value
, RedactState -> Reference
reference :: Reference
, RedactState -> [Text]
redacted :: ![Text]
}
applyRedaction :: Reference -> State -> State
applyRedaction :: Reference -> State -> State
applyRedaction Reference
reference State {KeyMap Value
$sel:context:State :: State -> KeyMap Value
context :: KeyMap Value
context, [Text]
$sel:redacted:State :: State -> [Text]
redacted :: [Text]
redacted} =
let (RedactState {$sel:context:RedactState :: RedactState -> KeyMap Value
context = KeyMap Value
c, $sel:redacted:RedactState :: RedactState -> [Text]
redacted = [Text]
r}) = [Text] -> Int -> RedactState -> RedactState
redactComponents (Reference -> [Text]
R.getComponents Reference
reference) Int
0 RedactState {KeyMap Value
$sel:context:RedactState :: KeyMap Value
context :: KeyMap Value
context, [Text]
$sel:redacted:RedactState :: [Text]
redacted :: [Text]
redacted, Reference
$sel:reference:RedactState :: Reference
reference :: Reference
reference}
in State {$sel:context:State :: KeyMap Value
context = KeyMap Value
c, $sel:redacted:State :: [Text]
redacted = [Text]
r}
redactComponents :: [Text] -> Int -> RedactState -> RedactState
redactComponents :: [Text] -> Int -> RedactState -> RedactState
redactComponents [] Int
_ RedactState
state = RedactState
state
redactComponents [Text
"kind"] Int
0 RedactState
state = RedactState
state
redactComponents [Text
"key"] Int
0 RedactState
state = RedactState
state
redactComponents [Text
"anonymous"] Int
0 RedactState
state = RedactState
state
redactComponents [Text
x] Int
level state :: RedactState
state@(RedactState {KeyMap Value
$sel:context:RedactState :: RedactState -> KeyMap Value
context :: KeyMap Value
context, Reference
$sel:reference:RedactState :: RedactState -> Reference
reference :: Reference
reference, [Text]
$sel:redacted:RedactState :: RedactState -> [Text]
redacted :: [Text]
redacted}) = case (Int
level, Text -> KeyMap Value -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
x KeyMap Value
context) of
(Int
_, Just Value
_) -> RedactState
state {context = deleteKey x context, redacted = (R.getRawPath reference) : redacted}
(Int
0, Maybe Value
_) -> RedactState
state {redacted = (R.getRawPath reference) : redacted}
(Int, Maybe Value)
_ -> RedactState
state
redactComponents (Text
x : [Text]
xs) Int
level state :: RedactState
state@(RedactState {KeyMap Value
$sel:context:RedactState :: RedactState -> KeyMap Value
context :: KeyMap Value
context}) = case Text -> KeyMap Value -> Maybe Value
forall v. Text -> KeyMap v -> Maybe v
lookupKey Text
x KeyMap Value
context of
Just (Object KeyMap Value
o) ->
let substate :: RedactState
substate@(RedactState {$sel:context:RedactState :: RedactState -> KeyMap Value
context = KeyMap Value
subcontext}) = [Text] -> Int -> RedactState -> RedactState
redactComponents [Text]
xs (Int
level Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (RedactState
state {context = o})
in RedactState
substate {context = insertKey x (Object $ subcontext) context}
Maybe Value
_ -> RedactState
state