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

-- | 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. 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