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, or)
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 qualified Data.Vector as                      V
import           GHC.Generics                        (Generic)

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 (UserI -> User) -> UserI -> User
forall a b. (a -> b) -> a -> b
$ UserI -> UserI
f UserI
c

-- | User contains specific attributes of a user of your application
--
-- The only mandatory property is the Key, which must uniquely identify
-- each user. For authenticated users, this may be a username or e-mail address.
-- For anonymous users, this could be an IP address or session ID.
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. UserI -> Rep UserI x)
-> (forall x. Rep UserI x -> UserI) -> Generic UserI
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 Bool -> Maybe Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x else Maybe Bool
forall a. Maybe a
Nothing

emptyToNothing :: (Eq m, Monoid m) => m -> Maybe m
emptyToNothing :: m -> Maybe m
emptyToNothing m
x = if m
x m -> m -> Bool
forall a. Eq a => a -> a -> Bool
== m
forall a. Monoid a => a
mempty then Maybe m
forall a. Monoid a => a
mempty else m -> Maybe m
forall (f :: * -> *) a. Applicative f => a -> f a
pure m
x

instance FromJSON UserI where
    parseJSON :: Value -> Parser UserI
parseJSON = String
-> (HashMap Text Value -> Parser UserI) -> Value -> Parser UserI
forall a.
String -> (HashMap Text Value -> Parser a) -> Value -> Parser a
withObject String
"User" ((HashMap Text Value -> Parser UserI) -> Value -> Parser UserI)
-> (HashMap Text Value -> Parser UserI) -> Value -> Parser UserI
forall a b. (a -> b) -> a -> b
$ \HashMap Text Value
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
        (Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Bool
 -> HashMap Text Value
 -> Set Text
 -> UserI)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Bool
      -> HashMap Text Value
      -> Set Text
      -> UserI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HashMap Text Value
o HashMap Text Value -> Text -> Parser Text
forall a. FromJSON a => HashMap Text Value -> Text -> Parser a
.:  Text
"key"
        Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Bool
   -> HashMap Text Value
   -> Set Text
   -> UserI)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Bool
      -> HashMap Text Value
      -> Set Text
      -> UserI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe Text)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"secondary"
        Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Bool
   -> HashMap Text Value
   -> Set Text
   -> UserI)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Bool
      -> HashMap Text Value
      -> Set Text
      -> UserI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe Text)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"ip"
        Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Bool
   -> HashMap Text Value
   -> Set Text
   -> UserI)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Bool
      -> HashMap Text Value
      -> Set Text
      -> UserI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe Text)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"country"
        Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Bool
   -> HashMap Text Value
   -> Set Text
   -> UserI)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Bool
      -> HashMap Text Value
      -> Set Text
      -> UserI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe Text)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"email"
        Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Bool
   -> HashMap Text Value
   -> Set Text
   -> UserI)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Bool
      -> HashMap Text Value
      -> Set Text
      -> UserI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe Text)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"firstName"
        Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Bool
   -> HashMap Text Value
   -> Set Text
   -> UserI)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Bool -> HashMap Text Value -> Set Text -> UserI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe Text)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"lastName"
        Parser
  (Maybe Text
   -> Maybe Text -> Bool -> HashMap Text Value -> Set Text -> UserI)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Bool -> HashMap Text Value -> Set Text -> UserI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe Text)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"avatar"
        Parser
  (Maybe Text -> Bool -> HashMap Text Value -> Set Text -> UserI)
-> Parser (Maybe Text)
-> Parser (Bool -> HashMap Text Value -> Set Text -> UserI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe Text)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"name"
        Parser (Bool -> HashMap Text Value -> Set Text -> UserI)
-> Parser Bool -> Parser (HashMap Text Value -> Set Text -> UserI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe Bool -> Bool) -> Parser (Maybe Bool) -> Parser Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or (HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe Bool)
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"anonymous")
        Parser (HashMap Text Value -> Set Text -> UserI)
-> Parser (HashMap Text Value) -> Parser (Set Text -> UserI)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe (HashMap Text Value) -> HashMap Text Value)
-> Parser (Maybe (HashMap Text Value))
-> Parser (HashMap Text Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (HashMap Text Value) -> HashMap Text Value
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe (HashMap Text Value))
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"custom")
        Parser (Set Text -> UserI) -> Parser (Set Text) -> Parser UserI
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Maybe (Set Text) -> Set Text)
-> Parser (Maybe (Set Text)) -> Parser (Set Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Set Text) -> Set Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (HashMap Text Value
o HashMap Text Value -> Text -> Parser (Maybe (Set Text))
forall a.
FromJSON a =>
HashMap Text Value -> Text -> Parser (Maybe a)
.:? Text
"privateAttributeNames")

instance ToJSON UserI where
    toJSON :: UserI -> Value
toJSON UserI
user = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Value
Null (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> 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
$                  UserI -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key"                   UserI
user)
        , (Text
"secondary",             Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$                  UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"secondary"             UserI
user)
        , (Text
"ip",                    Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$                  UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"ip"                    UserI
user)
        , (Text
"country",               Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$                  UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"country"               UserI
user)
        , (Text
"email",                 Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$                  UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"email"                 UserI
user)
        , (Text
"firstName",             Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$                  UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"firstName"             UserI
user)
        , (Text
"lastName",              Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$                  UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"lastName"              UserI
user)
        , (Text
"avatar",                Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$                  UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"avatar"                UserI
user)
        , (Text
"name",                  Maybe Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Text -> Value) -> Maybe Text -> Value
forall a b. (a -> b) -> a -> b
$                  UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"name"                  UserI
user)
        , (Text
"anonymous",             Maybe Bool -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe Bool -> Value) -> Maybe Bool -> Value
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool
falseToNothing (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ UserI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"anonymous"             UserI
user)
        , (Text
"custom",                Maybe (HashMap Text Value) -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe (HashMap Text Value) -> Value)
-> Maybe (HashMap Text Value) -> Value
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> Maybe (HashMap Text Value)
forall m. (Eq m, Monoid m) => m -> Maybe m
emptyToNothing (HashMap Text Value -> Maybe (HashMap Text Value))
-> HashMap Text Value -> Maybe (HashMap Text Value)
forall a b. (a -> b) -> a -> b
$ UserI -> HashMap Text Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"custom"                UserI
user)
        , (Text
"privateAttributeNames", Maybe (Set Text) -> Value
forall a. ToJSON a => a -> Value
toJSON (Maybe (Set Text) -> Value) -> Maybe (Set Text) -> Value
forall a b. (a -> b) -> a -> b
$ Set Text -> Maybe (Set Text)
forall m. (Eq m, Monoid m) => m -> Maybe m
emptyToNothing (Set Text -> Maybe (Set Text)) -> Set Text -> Maybe (Set Text)
forall a b. (a -> b) -> a -> b
$ UserI -> Set Text
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"       -> Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ UserI -> Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"key" UserI
user
    Text
"secondary" -> Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"secondary" UserI
user
    Text
"ip"        -> Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"ip" UserI
user
    Text
"country"   -> Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"country" UserI
user
    Text
"email"     -> Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"email" UserI
user
    Text
"firstName" -> Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"firstName" UserI
user
    Text
"lastName"  -> Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"lastName" UserI
user
    Text
"avatar"    -> Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"avatar" UserI
user
    Text
"name"      -> Text -> Value
String (Text -> Value) -> Maybe Text -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserI -> Maybe Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"name" UserI
user
    Text
"anonymous" -> Value -> Maybe Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Bool (Bool -> Value) -> Bool -> Value
forall a b. (a -> b) -> a -> b
$ UserI -> Bool
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"anonymous" UserI
user
    Text
x           -> Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
x (HashMap Text Value -> Maybe Value)
-> HashMap Text Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ UserI -> HashMap Text Value
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 ConfigI -> Bool
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 (ConfigI -> Set Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"privateAttributeNames" ConfigI
config) UserI
user

fromObject :: Value -> HashMap Text Value
fromObject :: Value -> HashMap Text Value
fromObject Value
x = case Value
x of (Object HashMap Text Value
o) -> HashMap Text Value
o; Value
_ -> String -> HashMap Text Value
forall a. HasCallStack => String -> a
error String
"expected object"

keysToSet :: (Ord k) => HashMap k v -> Set k
keysToSet :: HashMap k v -> Set k
keysToSet = [k] -> Set k
forall a. Ord a => [a] -> Set a
S.fromList ([k] -> Set k) -> (HashMap k v -> [k]) -> HashMap k v -> Set k
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k v -> [k]
forall k v. HashMap k v -> [k]
HM.keys

setPrivateAttrs :: Set Text -> HashMap Text Value -> Value
setPrivateAttrs :: Set Text -> HashMap Text Value -> Value
setPrivateAttrs Set Text
private HashMap Text Value
redacted = HashMap Text Value -> Value
Object (HashMap Text Value -> Value) -> HashMap Text Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> HashMap Text Value -> HashMap Text Value
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Text
"privateAttrs" (Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array
forall a. [a] -> Vector a
V.fromList ([Value] -> Array) -> [Value] -> Array
forall a b. (a -> b) -> a -> b
$ (Text -> Value) -> [Text] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Value
String ([Text] -> [Value]) -> [Text] -> [Value]
forall a b. (a -> b) -> a -> b
$ Set Text -> [Text]
forall a. Set a -> [a]
S.toList Set Text
private) HashMap Text Value
redacted

redact :: Set Text -> HashMap Text Value -> HashMap Text Value
redact :: Set Text -> HashMap Text Value -> HashMap Text Value
redact Set Text
private = (Text -> Value -> Bool) -> HashMap Text Value -> HashMap Text Value
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HM.filterWithKey (\Text
k Value
_ -> Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
S.notMember Text
k Set Text
private)

userSerializeAllPrivate :: UserI -> Value
userSerializeAllPrivate :: UserI -> Value
userSerializeAllPrivate UserI
user = Set Text -> HashMap Text Value -> Value
setPrivateAttrs Set Text
private (Set Text -> HashMap Text Value -> HashMap Text Value
redact Set Text
private HashMap Text Value
raw) where
    raw :: HashMap Text Value
raw     = Text -> HashMap Text Value -> HashMap Text Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
"custom" (HashMap Text Value -> HashMap Text Value)
-> HashMap Text Value -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ Text -> HashMap Text Value -> HashMap Text Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
"privateAttributeNames" (HashMap Text Value -> HashMap Text Value)
-> HashMap Text Value -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ Value -> HashMap Text Value
fromObject (Value -> HashMap Text Value) -> Value -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ UserI -> Value
forall a. ToJSON a => a -> Value
toJSON UserI
user
    private :: Set Text
private = Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
S.delete Text
"anonymous" (Set Text -> Set Text) -> Set Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Text -> Set Text -> Set Text
forall a. Ord a => a -> Set a -> Set a
S.delete Text
"key" (Set Text -> Set Text) -> Set Text -> Set Text
forall a b. (a -> b) -> a -> b
$ Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
S.union (HashMap Text Value -> Set Text
forall k v. Ord k => HashMap k v -> Set k
keysToSet HashMap Text Value
raw) (HashMap Text Value -> Set Text
forall k v. Ord k => HashMap k v -> Set k
keysToSet (HashMap Text Value -> Set Text) -> HashMap Text Value -> Set Text
forall a b. (a -> b) -> a -> b
$ UserI -> HashMap Text Value
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 -> HashMap Text Value -> Value
setPrivateAttrs Set Text
private HashMap Text Value
redacted where
    raw :: HashMap Text Value
raw      = Text -> HashMap Text Value -> HashMap Text Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Text
"privateAttributeNames" (HashMap Text Value -> HashMap Text Value)
-> HashMap Text Value -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ Value -> HashMap Text Value
fromObject (Value -> HashMap Text Value) -> Value -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ UserI -> Value
forall a. ToJSON a => a -> Value
toJSON UserI
user
    keys :: Set Text
keys     = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
S.union (HashMap Text Value -> Set Text
forall k v. Ord k => HashMap k v -> Set k
keysToSet HashMap Text Value
raw) (HashMap Text Value -> Set Text
forall k v. Ord k => HashMap k v -> Set k
keysToSet (HashMap Text Value -> Set Text) -> HashMap Text Value -> Set Text
forall a b. (a -> b) -> a -> b
$ Value -> HashMap Text Value
fromObject (Value -> HashMap Text Value) -> Value -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ HashMap Text Value -> Value
forall a. ToJSON a => a -> Value
toJSON (HashMap Text Value -> Value) -> HashMap Text Value -> Value
forall a b. (a -> b) -> a -> b
$ UserI -> HashMap Text Value
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"custom" UserI
user)
    private :: Set Text
private  = Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set Text
keys (Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
S.union Set Text
globalPrivate (Set Text -> Set Text) -> Set Text -> Set Text
forall a b. (a -> b) -> a -> b
$ UserI -> Set Text
forall (f :: Symbol) a s. HasField' f s a => s -> a
getField @"privateAttributeNames" UserI
user)
    redacted :: HashMap Text Value
redacted = (Value -> Value)
-> Text -> HashMap Text Value -> HashMap Text Value
forall k v.
(Eq k, Hashable k) =>
(v -> v) -> k -> HashMap k v -> HashMap k v
HM.adjust (HashMap Text Value -> Value
Object (HashMap Text Value -> Value)
-> (Value -> HashMap Text Value) -> Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Text -> HashMap Text Value -> HashMap Text Value
redact Set Text
private (HashMap Text Value -> HashMap Text Value)
-> (Value -> HashMap Text Value) -> Value -> HashMap Text Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> HashMap Text Value
fromObject) Text
"custom" (HashMap Text Value -> HashMap Text Value)
-> HashMap Text Value -> HashMap Text Value
forall a b. (a -> b) -> a -> b
$ Set Text -> HashMap Text Value -> HashMap Text Value
redact Set Text
private HashMap Text Value
raw