module LaunchDarkly.Server.User.Internal
( User(..)
, mapUser
, UserI(..)
, valueOf
, userSerializeRedacted
) where
import Data.Aeson (FromJSON, ToJSON, Value(..), (.:), (.:?), withObject, object, parseJSON, toJSON)
import Data.Foldable (fold)
import Data.Generics.Product (getField)
import qualified Data.HashMap.Strict as HM
import Data.HashMap.Strict (HashMap)
import qualified Data.Set as S
import Data.Set (Set)
import Data.Text (Text)
import Data.Vector ()
import GHC.Generics (Generic)
import LaunchDarkly.AesonCompat (KeyMap, adjustKey, keyToText, deleteKey, filterKeys, insertKey, objectKeys)
import LaunchDarkly.Server.Config.Internal (ConfigI)
mapUser :: (UserI -> UserI) -> User -> User
mapUser :: (UserI -> UserI) -> User -> User
mapUser UserI -> UserI
f (User UserI
c) = UserI -> User
User forall a b. (a -> b) -> a -> b
$ UserI -> UserI
f UserI
c
newtype User = User { User -> UserI
unwrapUser :: UserI }
data UserI = UserI
{ UserI -> Text
key :: !Text
, UserI -> Maybe Text
secondary :: !(Maybe Text)
, UserI -> Maybe Text
ip :: !(Maybe Text)
, UserI -> Maybe Text
country :: !(Maybe Text)
, UserI -> Maybe Text
email :: !(Maybe Text)
, UserI -> Maybe Text
firstName :: !(Maybe Text)
, UserI -> Maybe Text
lastName :: !(Maybe Text)
, UserI -> Maybe Text
avatar :: !(Maybe Text)
, UserI -> Maybe Text
name :: !(Maybe Text)
, UserI -> Bool
anonymous :: !Bool
, UserI -> HashMap Text Value
custom :: !(HashMap Text Value)
, UserI -> Set Text
privateAttributeNames :: !(Set Text)
} deriving (forall x. Rep UserI x -> UserI
forall x. UserI -> Rep UserI x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserI x -> UserI
$cfrom :: forall x. UserI -> Rep UserI x
Generic)
falseToNothing :: Bool -> Maybe Bool
falseToNothing :: Bool -> Maybe Bool
falseToNothing Bool
x = if Bool
x then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x else forall a. Maybe a
Nothing
emptyToNothing :: (Eq m, Monoid m) => m -> Maybe m
emptyToNothing :: forall m. (Eq m, Monoid m) => m -> Maybe m
emptyToNothing m
x = if m
x forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty then forall a. Monoid a => a
mempty else forall (f :: * -> *) a. Applicative f => a -> f a
pure m
x
instance FromJSON UserI where
parseJSON :: Value -> Parser UserI
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"User" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Bool
-> HashMap Text Value
-> Set Text
-> UserI
UserI
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"secondary"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ip"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"country"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"firstName"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lastName"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"avatar"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *). Foldable t => t Bool -> Bool
or (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"anonymous")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"privateAttributeNames")
instance ToJSON UserI where
toJSON :: UserI -> Value
toJSON UserI
user = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(/=) Value
Null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
[ (Key
"key", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user)
, (Key
"secondary", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"secondary" UserI
user)
, (Key
"ip", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"ip" UserI
user)
, (Key
"country", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"country" UserI
user)
, (Key
"email", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"email" UserI
user)
, (Key
"firstName", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"firstName" UserI
user)
, (Key
"lastName", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"lastName" UserI
user)
, (Key
"avatar", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"avatar" UserI
user)
, (Key
"name", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"name" UserI
user)
, (Key
"anonymous", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
falseToNothing forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"anonymous" UserI
user)
, (Key
"custom", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall m. (Eq m, Monoid m) => m -> Maybe m
emptyToNothing forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"custom" UserI
user)
, (Key
"privateAttributeNames", forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall m. (Eq m, Monoid m) => m -> Maybe m
emptyToNothing forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"privateAttributeNames" UserI
user)
]
valueOf :: UserI -> Text -> Maybe Value
valueOf :: UserI -> Text -> Maybe Value
valueOf UserI
user Text
attribute = case Text
attribute of
Text
"key" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Value
String forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user
Text
"secondary" -> Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"secondary" UserI
user
Text
"ip" -> Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"ip" UserI
user
Text
"country" -> Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"country" UserI
user
Text
"email" -> Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"email" UserI
user
Text
"firstName" -> Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"firstName" UserI
user
Text
"lastName" -> Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"lastName" UserI
user
Text
"avatar" -> Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"avatar" UserI
user
Text
"name" -> Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"name" UserI
user
Text
"anonymous" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> Value
Bool forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"anonymous" UserI
user
Text
x -> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
x forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"custom" UserI
user
userSerializeRedacted :: ConfigI -> UserI -> Value
userSerializeRedacted :: ConfigI -> UserI -> Value
userSerializeRedacted ConfigI
config UserI
user = if forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"allAttributesPrivate" ConfigI
config
then UserI -> Value
userSerializeAllPrivate UserI
user
else Set Text -> UserI -> Value
userSerializeRedactedNotAllPrivate (forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"privateAttributeNames" ConfigI
config) UserI
user
fromObject :: Value -> KeyMap Value
fromObject :: Value -> Object
fromObject Value
x = case Value
x of (Object Object
o) -> Object
o; Value
_ -> forall a. HasCallStack => String -> a
error String
"expected object"
keysToSet :: KeyMap v -> Set Text
keysToSet :: forall v. KeyMap v -> Set Text
keysToSet = forall a. Ord a => [a] -> Set a
S.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. KeyMap v -> [Text]
objectKeys
setPrivateAttrs :: Set Text -> KeyMap Value -> Value
setPrivateAttrs :: Set Text -> Object -> Value
setPrivateAttrs Set Text
private Object
redacted
| forall a. Set a -> Bool
S.null Set Text
private = Object -> Value
Object Object
redacted
| Bool
otherwise = Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. Text -> v -> KeyMap v -> KeyMap v
insertKey Text
"privateAttrs" (forall a. ToJSON a => a -> Value
toJSON Set Text
private) Object
redacted
redact :: Set Text -> KeyMap Value -> KeyMap Value
redact :: Set Text -> Object -> Object
redact Set Text
private = forall a. (Key -> Bool) -> KeyMap a -> KeyMap a
filterKeys (\Key
k -> forall a. Ord a => a -> Set a -> Bool
S.notMember (Key -> Text
keyToText Key
k) Set Text
private)
userSerializeAllPrivate :: UserI -> Value
userSerializeAllPrivate :: UserI -> Value
userSerializeAllPrivate UserI
user = Set Text -> Object -> Value
setPrivateAttrs Set Text
private (Set Text -> Object -> Object
redact Set Text
private Object
raw) where
raw :: Object
raw = forall v. Text -> KeyMap v -> KeyMap v
deleteKey Text
"custom" forall a b. (a -> b) -> a -> b
$ forall v. Text -> KeyMap v -> KeyMap v
deleteKey Text
"privateAttributeNames" forall a b. (a -> b) -> a -> b
$ Value -> Object
fromObject forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON UserI
user
private :: Set Text
private = forall a. Ord a => a -> Set a -> Set a
S.delete Text
"anonymous" forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
S.delete Text
"key" forall a b. (a -> b) -> a -> b
$ forall a. Ord a => Set a -> Set a -> Set a
S.union (forall v. KeyMap v -> Set Text
keysToSet Object
raw) (forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [k]
HM.keys forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"custom" UserI
user)
userSerializeRedactedNotAllPrivate :: Set Text -> UserI -> Value
userSerializeRedactedNotAllPrivate :: Set Text -> UserI -> Value
userSerializeRedactedNotAllPrivate Set Text
globalPrivate UserI
user = Set Text -> Object -> Value
setPrivateAttrs Set Text
private Object
redacted where
raw :: Object
raw = forall v. Text -> KeyMap v -> KeyMap v
deleteKey Text
"privateAttributeNames" forall a b. (a -> b) -> a -> b
$ Value -> Object
fromObject forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON UserI
user
keys :: Set Text
keys = forall a. Ord a => Set a -> Set a -> Set a
S.union (forall v. KeyMap v -> Set Text
keysToSet Object
raw) (forall v. KeyMap v -> Set Text
keysToSet forall a b. (a -> b) -> a -> b
$ Value -> Object
fromObject forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"custom" UserI
user)
private :: Set Text
private = forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set Text
keys (forall a. Ord a => Set a -> Set a -> Set a
S.union Set Text
globalPrivate forall a b. (a -> b) -> a -> b
$ forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"privateAttributeNames" UserI
user)
redacted :: Object
redacted = forall v. (v -> v) -> Key -> KeyMap v -> KeyMap v
adjustKey (Object -> Value
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Text -> Object -> Object
redact Set Text
private forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Object
fromObject) Key
"custom" forall a b. (a -> b) -> a -> b
$ Set Text -> Object -> Object
redact Set Text
private Object
raw