Skip to content

Commit 85e512a

Browse files
keelerm84keelerm84
authored
feat: Add option to omit anonymous users from index and identify events (#87)
1 parent 635c383 commit 85e512a

File tree

11 files changed

+277
-173
lines changed

11 files changed

+277
-173
lines changed

‎Setup.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,3 @@
11
import Distribution.Simple
2+
23
main = defaultMain

‎contract-tests/Setup.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,2 +1,3 @@
11
import Distribution.Simple
2+
23
main = defaultMain

‎contract-tests/src/Main.hs‎

Lines changed: 105 additions & 98 deletions
Large diffs are not rendered by default.

‎contract-tests/src/Types.hs‎

Lines changed: 49 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,21 @@
11
module Types where
22

3+
import Data.Aeson (FromJSON, ToJSON, object, parseJSON, toJSON, withObject, (.!=), (.:), (.:?))
4+
import Data.Aeson.Types (Value (..))
35
import Data.Function ((&))
4-
import Data.Text (Text)
5-
import qualified LaunchDarkly.Server as LD
6-
import Data.Aeson.Types (Value(..))
76
import Data.HashMap.Strict (HashMap)
8-
import Data.Aeson (FromJSON, ToJSON, toJSON, parseJSON, object, withObject, (.:), (.:?), (.!=))
9-
import GHC.Generics (Generic)
7+
import Data.Maybe (fromMaybe)
108
import Data.Set (Set)
9+
import Data.Text (Text)
10+
import GHC.Generics (Generic)
1111
import GHC.Natural (Natural)
12-
import Data.Maybe (fromMaybe)
12+
import qualified LaunchDarkly.Server as LD
1313

1414
data CreateClientParams = CreateClientParams
1515
{ tag :: !Text
1616
, configuration :: !ConfigurationParams
17-
} deriving (FromJSON, ToJSON, Show, Generic)
17+
}
18+
deriving (FromJSON, ToJSON, Show, Generic)
1819

1920
data ConfigurationParams = ConfigurationParams
2021
{ credential :: !Text
@@ -24,17 +25,20 @@ data ConfigurationParams = ConfigurationParams
2425
, polling :: !(Maybe PollingParams)
2526
, events :: !(Maybe EventParams)
2627
, tags :: !(Maybe TagParams)
27-
} deriving (FromJSON, ToJSON, Show, Generic)
28+
}
29+
deriving (FromJSON, ToJSON, Show, Generic)
2830

2931
data StreamingParams = StreamingParams
3032
{ baseUri :: !(Maybe Text)
3133
, initialRetryDelayMs :: !(Maybe Int)
32-
} deriving (FromJSON, ToJSON, Show, Generic)
34+
}
35+
deriving (FromJSON, ToJSON, Show, Generic)
3336

3437
data PollingParams = PollingParams
3538
{ baseUri :: !(Maybe Text)
3639
, pollIntervalMs :: !(Maybe Natural)
37-
} deriving (FromJSON, ToJSON, Show, Generic)
40+
}
41+
deriving (FromJSON, ToJSON, Show, Generic)
3842

3943
data EventParams = EventParams
4044
{ baseUri :: !(Maybe Text)
@@ -43,12 +47,15 @@ data EventParams = EventParams
4347
, allAttributesPrivate :: !(Maybe Bool)
4448
, globalPrivateAttributes :: !(Maybe (Set Text))
4549
, flushIntervalMs :: !(Maybe Natural)
46-
} deriving (FromJSON, ToJSON, Show, Generic)
50+
, omitAnonymousContexts :: !(Maybe Bool)
51+
}
52+
deriving (FromJSON, ToJSON, Show, Generic)
4753

4854
data TagParams = TagParams
4955
{ applicationId :: !(Maybe Text)
5056
, applicationVersion :: !(Maybe Text)
51-
} deriving (FromJSON, ToJSON, Show, Generic)
57+
}
58+
deriving (FromJSON, ToJSON, Show, Generic)
5259

5360
data CommandParams = CommandParams
5461
{ command :: !Text
@@ -59,40 +66,46 @@ data CommandParams = CommandParams
5966
, contextBuild :: !(Maybe ContextBuildParams)
6067
, contextConvert :: !(Maybe ContextConvertParams)
6168
, secureModeHash :: !(Maybe SecureModeHashParams)
62-
} deriving (FromJSON, Generic)
69+
}
70+
deriving (FromJSON, Generic)
6371

6472
data EvaluateFlagParams = EvaluateFlagParams
6573
{ flagKey :: !Text
6674
, context :: !LD.Context
6775
, valueType :: !Text
6876
, defaultValue :: !Value
6977
, detail :: !Bool
70-
} deriving (FromJSON, Generic)
78+
}
79+
deriving (FromJSON, Generic)
7180

7281
data EvaluateFlagResponse = EvaluateFlagResponse
7382
{ value :: !Value
7483
, variationIndex :: !(Maybe Integer)
7584
, reason :: !(Maybe LD.EvaluationReason)
76-
} deriving (ToJSON, Show, Generic)
85+
}
86+
deriving (ToJSON, Show, Generic)
7787

7888
data EvaluateAllFlagsParams = EvaluateAllFlagsParams
7989
{ context :: !LD.Context
8090
, withReasons :: !Bool
8191
, clientSideOnly :: !Bool
8292
, detailsOnlyForTrackedFlags :: !Bool
83-
} deriving (FromJSON, Generic)
93+
}
94+
deriving (FromJSON, Generic)
8495

8596
data EvaluateAllFlagsResponse = EvaluateAllFlagsResponse
8697
{ state :: !LD.AllFlagsState
87-
} deriving (ToJSON, Show, Generic)
98+
}
99+
deriving (ToJSON, Show, Generic)
88100

89101
data CustomEventParams = CustomEventParams
90102
{ eventKey :: !Text
91103
, context :: !LD.Context
92104
, dataValue :: !(Maybe Value)
93105
, omitNullData :: !(Maybe Bool)
94106
, metricValue :: !(Maybe Double)
95-
} deriving (Generic)
107+
}
108+
deriving (Generic)
96109

97110
instance FromJSON CustomEventParams where
98111
parseJSON = withObject "CustomEvent" $ \o -> do
@@ -101,16 +114,18 @@ instance FromJSON CustomEventParams where
101114
dataValue <- o .:? "data"
102115
omitNullData <- o .:? "omitNullData"
103116
metricValue <- o .:? "metricValue"
104-
return $ CustomEventParams { .. }
117+
return $ CustomEventParams {..}
105118

106119
data IdentifyEventParams = IdentifyEventParams
107120
{ context :: !LD.Context
108-
} deriving (FromJSON, Generic)
121+
}
122+
deriving (FromJSON, Generic)
109123

110124
data ContextBuildParams = ContextBuildParams
111125
{ single :: !(Maybe ContextBuildParam)
112126
, multi :: !(Maybe [ContextBuildParam])
113-
} deriving (FromJSON, Generic)
127+
}
128+
deriving (FromJSON, Generic)
114129

115130
data ContextBuildParam = ContextBuildParam
116131
{ kind :: !(Maybe Text)
@@ -119,26 +134,31 @@ data ContextBuildParam = ContextBuildParam
119134
, anonymous :: !(Maybe Bool)
120135
, private :: !(Maybe (Set Text))
121136
, custom :: !(Maybe (HashMap Text Value))
122-
} deriving (FromJSON, Generic)
137+
}
138+
deriving (FromJSON, Generic)
123139

124140
data ContextConvertParams = ContextConvertParams
125141
{ input :: !Text
126-
} deriving (FromJSON, Generic)
142+
}
143+
deriving (FromJSON, Generic)
127144

128145
data ContextResponse = ContextResponse
129146
{ output :: !(Maybe Text)
130147
, errorMessage :: !(Maybe Text)
131-
} deriving (Generic)
148+
}
149+
deriving (Generic)
132150

133151
instance ToJSON ContextResponse where
134-
toJSON (ContextResponse { output = Just o, errorMessage = Nothing }) = object [ ("output", String o) ]
135-
toJSON (ContextResponse { output = _, errorMessage = Just e }) = object [ ("error", String e) ]
136-
toJSON _ = object [ ("error", String "Invalid context response was generated") ]
152+
toJSON (ContextResponse {output = Just o, errorMessage = Nothing}) = object [("output", String o)]
153+
toJSON (ContextResponse {output = _, errorMessage = Just e}) = object [("error", String e)]
154+
toJSON _ = object [("error", String "Invalid context response was generated")]
137155

138156
data SecureModeHashParams = SecureModeHashParams
139157
{ context :: !(Maybe LD.Context)
140-
} deriving (FromJSON, Generic)
158+
}
159+
deriving (FromJSON, Generic)
141160

142161
data SecureModeHashResponse = SecureModeHashResponse
143162
{ result :: !Text
144-
} deriving (ToJSON, Show, Generic)
163+
}
164+
deriving (ToJSON, Show, Generic)

‎contract-tests/src/Utils.hs‎

Lines changed: 33 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -2,53 +2,58 @@
22

33
module Utils where
44

5-
import Control.Lens ((&))
65
import Control.Concurrent (threadDelay)
6+
import Control.Lens ((&))
7+
import Data.Generics.Product (getField)
8+
import Data.Maybe (fromMaybe)
9+
import qualified Data.Set as S
10+
import Data.Text (Text)
11+
import GHC.Natural (Natural, quotNatural)
712
import qualified LaunchDarkly.Server as LD
813
import qualified LaunchDarkly.Server.Reference as R
9-
import qualified Data.Set as S
1014
import Types
11-
import GHC.Natural (Natural, quotNatural)
12-
import Data.Generics.Product (getField)
13-
import Data.Text (Text)
14-
import Data.Maybe (fromMaybe)
1515

1616
createClient :: CreateClientParams -> IO LD.Client
1717
createClient p = LD.makeClient $ createConfig $ getField @"configuration" p
1818

1919
waitClient :: LD.Client -> IO ()
2020
waitClient client = do
21-
status <- LD.getStatus client
22-
case status of
23-
LD.Initialized -> return ()
24-
_ -> threadDelay (1 * 1_000) >> waitClient client
21+
status <- LD.getStatus client
22+
case status of
23+
LD.Initialized -> return ()
24+
_ -> threadDelay (1 * 1_000) >> waitClient client
2525

2626
createConfig :: ConfigurationParams -> LD.Config
27-
createConfig p = LD.makeConfig (getField @"credential" p)
28-
& streamingConfig (getField @"streaming" p)
29-
& pollingConfig (getField @"polling" p)
30-
& tagsConfig (getField @"tags" p)
31-
& eventConfig (getField @"events" p)
27+
createConfig p =
28+
LD.makeConfig (getField @"credential" p)
29+
& streamingConfig (getField @"streaming" p)
30+
& pollingConfig (getField @"polling" p)
31+
& tagsConfig (getField @"tags" p)
32+
& eventConfig (getField @"events" p)
3233

3334
updateConfig :: (a -> LD.Config -> LD.Config) -> Maybe a -> LD.Config -> LD.Config
3435
updateConfig f Nothing config = config
3536
updateConfig f (Just x) config = f x config
3637

3738
streamingConfig :: Maybe StreamingParams -> LD.Config -> LD.Config
3839
streamingConfig Nothing c = c
39-
streamingConfig (Just p) c = updateConfig LD.configSetStreamURI (getField @"baseUri" p)
40-
$ updateConfig LD.configSetInitialRetryDelay (getField @"initialRetryDelayMs" p) c
40+
streamingConfig (Just p) c =
41+
updateConfig LD.configSetStreamURI (getField @"baseUri" p) $
42+
updateConfig LD.configSetInitialRetryDelay (getField @"initialRetryDelayMs" p) c
4143

4244
pollingConfig :: Maybe PollingParams -> LD.Config -> LD.Config
4345
pollingConfig Nothing c = c
44-
pollingConfig (Just p) c = updateConfig LD.configSetBaseURI (getField @"baseUri" p)
45-
$ updateConfig LD.configSetStreaming (Just False)
46-
$ updateConfig LD.configSetPollIntervalSeconds ((`quotNatural` 1_000) <$> getField @"pollIntervalMs" p) c
46+
pollingConfig (Just p) c =
47+
updateConfig LD.configSetBaseURI (getField @"baseUri" p) $
48+
updateConfig LD.configSetStreaming (Just False) $
49+
updateConfig LD.configSetPollIntervalSeconds ((`quotNatural` 1_000) <$> getField @"pollIntervalMs" p) c
4750

4851
tagsConfig :: Maybe TagParams -> LD.Config -> LD.Config
4952
tagsConfig Nothing c = c
5053
tagsConfig (Just params) c = LD.configSetApplicationInfo appInfo c
51-
where appInfo = LD.makeApplicationInfo
54+
where
55+
appInfo =
56+
LD.makeApplicationInfo
5257
& setApplicationInfo "id" (getField @"applicationId" params)
5358
& setApplicationInfo "version" (getField @"applicationVersion" params)
5459

@@ -58,8 +63,10 @@ setApplicationInfo key (Just value) appInfo = LD.withApplicationValue key value
5863

5964
eventConfig :: Maybe EventParams -> LD.Config -> LD.Config
6065
eventConfig Nothing c = updateConfig LD.configSetSendEvents (Just False) c
61-
eventConfig (Just p) c = updateConfig LD.configSetEventsURI (getField @"baseUri" p)
62-
$ updateConfig LD.configSetEventsCapacity (getField @"capacity" p)
63-
$ updateConfig LD.configSetAllAttributesPrivate (getField @"allAttributesPrivate" p)
64-
$ updateConfig LD.configSetPrivateAttributeNames ((S.map R.makeReference) <$> getField @"globalPrivateAttributes" p)
65-
$ updateConfig LD.configSetFlushIntervalSeconds (getField @"flushIntervalMs" p) c
66+
eventConfig (Just p) c =
67+
updateConfig LD.configSetEventsURI (getField @"baseUri" p) $
68+
updateConfig LD.configSetEventsCapacity (getField @"capacity" p) $
69+
updateConfig LD.configSetAllAttributesPrivate (getField @"allAttributesPrivate" p) $
70+
updateConfig LD.configSetPrivateAttributeNames ((S.map R.makeReference) <$> getField @"globalPrivateAttributes" p) $
71+
updateConfig LD.configSetOmitAnonymousContexts (getField @"omitAnonymousContexts" p) $
72+
updateConfig LD.configSetFlushIntervalSeconds (getField @"flushIntervalMs" p) c

‎src/LaunchDarkly/Server/Client.hs‎

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ import LaunchDarkly.Server.Config.ClientContext (ClientContext (..))
5555
import LaunchDarkly.Server.Config.HttpConfiguration (HttpConfiguration (..))
5656
import LaunchDarkly.Server.Config.Internal (ApplicationInfo, Config, getApplicationInfoHeader, shouldSendEvents)
5757
import LaunchDarkly.Server.Context (getValue)
58-
import LaunchDarkly.Server.Context.Internal (Context (Invalid), getCanonicalKey, getKey, getKeys, redactContext)
58+
import LaunchDarkly.Server.Context.Internal (Context (Invalid), getCanonicalKey, getKey, getKeys, optionallyRedactAnonymous, redactContext)
5959
import LaunchDarkly.Server.DataSource.Internal (DataSource (..), DataSourceFactory, DataSourceUpdates (..), defaultDataSourceUpdates, nullDataSourceFactory)
6060
import LaunchDarkly.Server.Details (EvalErrorKind (..), EvaluationDetail (..), EvaluationReason (..))
6161
import LaunchDarkly.Server.Evaluate (evaluateDetail, evaluateTyped)
@@ -129,7 +129,7 @@ makeClient config = mfix $ \client -> do
129129
clientContext <- makeClientContext config
130130

131131
let dataSourceUpdates = defaultDataSourceUpdates status store
132-
dataSource <- dataSourceFactory config clientContext dataSourceUpdates
132+
dataSource <- getDataSourceFactory config clientContext dataSourceUpdates
133133
eventThreadPair <-
134134
if not (shouldSendEvents config)
135135
then pure Nothing
@@ -142,8 +142,8 @@ makeClient config = mfix $ \client -> do
142142

143143
pure $ Client {..}
144144

145-
dataSourceFactory :: Config -> DataSourceFactory
146-
dataSourceFactory config =
145+
getDataSourceFactory :: Config -> DataSourceFactory
146+
getDataSourceFactory config =
147147
if getField @"offline" config || getField @"useLdd" config
148148
then nullDataSourceFactory
149149
else case getField @"dataSourceFactory" config of
@@ -266,11 +266,15 @@ identify :: Client -> Context -> IO ()
266266
identify client (Invalid err) = clientRunLogger client $ $(logWarn) $ "identify called with an invalid context: " <> err
267267
identify client context = case (getValue "key" context) of
268268
(String "") -> clientRunLogger client $ $(logWarn) "identify called with empty key"
269-
_ -> do
270-
let redacted = redactContext (getField @"config" client) context
271-
x <- makeBaseEvent $ IdentifyEvent {key = getKey context, context = redacted}
272-
_ <- noticeContext (getField @"events" client) context
273-
queueEvent (getField @"config" client) (getField @"events" client) (EventTypeIdentify x)
269+
_anyValidKey -> do
270+
let identifyContext = optionallyRedactAnonymous (getField @"config" client) context
271+
case identifyContext of
272+
(Invalid _) -> pure ()
273+
_anyValidContext -> do
274+
let redacted = redactContext (getField @"config" client) identifyContext
275+
x <- makeBaseEvent $ IdentifyEvent {key = getKey context, context = redacted}
276+
_ <- noticeContext (getField @"events" client) context
277+
queueEvent (getField @"config" client) (getField @"events" client) (EventTypeIdentify x)
274278

275279
-- |
276280
-- Track reports that a context has performed an event. Custom data can be

‎src/LaunchDarkly/Server/Config.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ module LaunchDarkly.Server.Config
2727
, configSetUseLdd
2828
, configSetDataSourceFactory
2929
, configSetApplicationInfo
30+
, configSetOmitAnonymousContexts
3031
, ApplicationInfo
3132
, makeApplicationInfo
3233
, withApplicationValue
@@ -70,6 +71,7 @@ makeConfig key =
7071
, dataSourceFactory = Nothing
7172
, manager = Nothing
7273
, applicationInfo = Nothing
74+
, omitAnonymousContexts = False
7375
}
7476

7577
-- | Set the SDK key used to authenticate with LaunchDarkly.
@@ -221,3 +223,10 @@ configSetManager = setField @"manager" . Just
221223
-- appropriately configured dict to the 'Config' object.
222224
configSetApplicationInfo :: ApplicationInfo -> Config -> Config
223225
configSetApplicationInfo = setField @"applicationInfo" . Just
226+
227+
-- |
228+
-- Sets whether anonymous contexts should be omitted from index and identify events.
229+
--
230+
-- By default, anonymous contexts are included in index and identify events.
231+
configSetOmitAnonymousContexts :: Bool -> Config -> Config
232+
configSetOmitAnonymousContexts = setField @"omitAnonymousContexts"

‎src/LaunchDarkly/Server/Config/Internal.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -49,6 +49,7 @@ data Config = Config
4949
, dataSourceFactory :: !(Maybe DataSourceFactory)
5050
, manager :: !(Maybe Manager)
5151
, applicationInfo :: !(Maybe ApplicationInfo)
52+
, omitAnonymousContexts :: !Bool
5253
}
5354
deriving (Generic)
5455

0 commit comments

Comments
 (0)